This file is indexed.

/usr/share/perl5/WebKDC/XmlElement.pm is in libwebkdc-perl 4.7.0-4.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
# Parse and manipulate XML documents and elements.
#
# Written by Roland Schemers
# Copyright 2002, 2009, 2012, 2013
#     The Board of Trustees of the Leland Stanford Junior University
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.

package WebKDC::XmlElement;

use strict;
use warnings;

use XML::Parser ();

our $VERSION;

# This version matches the version of WebAuth with which this module was
# released, but with two digits for the minor and patch versions.
BEGIN {
    $VERSION = '4.0700';
}

# An internaml method to convert the tree returned by XML::Parse into a tree
# of WebKDC::XmlElements rooted in the WebKDC::XmlElement passed as the first
# argument.  Calls itself recursively.
#
# This method destroys the contents of the tree argument.
sub _convert_tree {
    my ($root, $tree) = @_;
    $root->attrs (shift @$tree);
    my ($element, $content);
    while (defined ($element = shift @$tree)) {
        $content = shift @$tree;
        if ($element eq '0') {
            $root->append_content ($content) if ($content ne '');
        } elsif (ref $content eq 'ARRAY') {
            my $child = WebKDC::XmlElement->new;
            $child->name ($element);
            $child->_convert_tree ($content);
            $root->add_child ($child);
        } else {
            die "convert tree error: unknown tree content $content";
        }
    }
}

# Create a new WebKDC::XMLElement.
#
# If the optional argument is given, it is an XML document.  Parse that
# document into a tree of WebKDC::XMLElement objects.  Each object contains
# four attributes: name, attrs (a hash of the attributes), children (an array
# of the child elements), and content.
#
# For example:
#
#     <getTokensRequest>
#       <requesterCredential type="krb5">
#         {base64-krb5-mk-req-data}
#       </requesterCredential>
#       <tokens>
#         <token type="service" id="0"/>
#       </tokens>
#     </getTokensRequest>
#
# will parse into:
#
#     $tree = {
#       'name' => 'getTokensRequest'
#       'attrs' => {}
#       'children' => [
#           {
#             'name' => 'requesterCredential',
#             'attrs' => { 'type' => 'krb5' },
#             'content' => '    {base64-krb5-mk-req-data}  '
#           }
#           {
#              'name' => 'tokens',
#              'attrs' => {},
#              'children' => [
#                 {
#                   'name' => 'token',
#                   'attrs' => { 'id' => 0, 'type' => 'service'},
#                   'content' => '     '
#                 }
#              ]
#           }
#       ]
#       'content' => '      '
#     };
#
# with some minor variations in whitespace.  Note that all the whitespace in
# the document will get left in.  It should be trimmed if needed.
sub new {
    my ($type, $xml) = @_;
    my $self = { 'attrs' => {}, 'children' => [] };
    bless ($self, $type);
    if (defined $xml) {
        my $parser = XML::Parser->new (Style => 'Tree');
        my $tree = $parser->parse ($xml);
        $self->name (shift @$tree);
        $self->_convert_tree (shift @$tree);
    }
    return $self;
}

# Shared code for all simple accessor methods.  Takes the object, the
# attribute name, and the value.  Sets the value if one was given, and returns
# the current value of that attribute.
sub _attr {
    my ($self, $attr, $value) = @_;
    $self->{$attr} = $value if defined ($value);
    return $self->{$attr};
}

# Simple accessor functions.
sub attrs    { my $e = shift; $e->_attr ('attrs',    @_) };
sub children { my $e = shift; $e->_attr ('children', @_) };
sub content  { my $e = shift; $e->_attr ('content',  @_) };
sub name     { my $e = shift; $e->_attr ('name',     @_) };

# Returns the content trimmed of whitespace.
sub content_trimmed {
    my ($self) = @_;
    my $content = $self->content;
    return unless defined $content;
    $content =~ s/^\s+//;
    $content =~ s/\s+$//;
    return $content;
}

# Append additional content to this element.
sub append_content {
    my ($self, $content) = @_;
    $self->{content} = '' unless defined $self->{content};
    $self->{content} .= $content;
}

# Return true if this element has attributes or has children.
sub has_attrs    ($) { my $e = shift; return !!%{ $e->{attrs} } }
sub has_children ($) { my $e = shift; return $#{ $e->{children} } != -1 }

# Set or return a specific attribute.
sub attr {
    my ($self, $name, $value) = @_;
    $self->{attrs}{$name} = $value if defined $value;
    return $self->{attrs}{$name};
}

# Find and return the first child element with the given name, or undef if
# there is no such element.
sub find_child {
    my ($self, $name) = @_;
    for my $child (@{ $self->children }) {
        return $child if ($child->name eq $name);
    }
    return;
}

# Add the given WebKDC::XmlElement object as a child of this element.  It
# will be added after all the existing children.
sub add_child {
    my ($self, $element) = @_;
    push (@{ $self->{children} }, $element);
}

# Internal function to do XML escaping of a text string.  Returns the new
# value.
sub _escape {
    my ($self, $text) = @_;
    $text =~ s/&/&amp;/g;
    $text =~ s/</&lt;/g;
    $text =~ s/>/&gt;/g;
    $text =~ s/\"/&quot;/g;
    $text =~ s/\'/&apos;/g;
    return $text;
}

# Internal recursive function implementing the core of to_string.  Takes the
# element to turn to a string, a reference to the output string, a flag saying
# whether or not to pretty-print the output, and an indentation level (used
# only for pretty-printing).  Appends the output to the output buffer and
# returns nothing.
sub _recursive_to_string {
    my ($e, $out, $pretty, $level) = @_;
    my $name = $e->name;
    my $closed = 0;
    my $cont = 0;

    # Encode the open tag and the attributes.
    $$out .= ' ' x $level if $pretty;
    $$out .= "<$name";
    while (my ($attr, $val) = each %{ $e->attrs }) {
        $val = $e->_escape ($val);
        $$out .= qq( $attr="$val");
    }

    # Encode the content.
    if (defined $e->content) {
        unless ($closed) {
            $$out .= '>';
            $closed = 1;
        }
        $cont = 1;
        $$out .= $e->_escape ($e->content);
    }

    # Encode the child elements.
    for my $child (@{ $e->children }) {
        unless ($closed) {
            $$out .= '>';
            $$out .= "\n" if $pretty;
            $closed = 1;
        }
        $child->_recursive_to_string($out, $pretty, $level + 2);
    }

    # Close the tag.
    if ($closed) {
        $$out .= ' ' x $level if ($pretty && !$cont);
        $$out .= "</$name>";
        $$out .= "\n" if $pretty;
    } else {
        $$out .= ' />';
        $$out .= "\n" if $pretty;
    }
}

# Convert this element (and hence the whole document rooted at this element)
# into XML and return the result.  Tags a flag saying whether to pretty-print
# the output.
sub to_string {
    my ($self, $pretty) = @_;
    my $output;
    $self->_recursive_to_string (\$output, $pretty, 0);
    return $output;
}

1;

__END__

=for stopwords
WebKDC WebAuth attr attrs Allbery

=head1 NAME

WebKDC::XmlElement - Parse and manipulate XML documents and elements

=head1 SYNOPSIS

    use WebKDC::XmlElement;

    my $root = WebKDC::XmlElement->new ($xml);
    my $e = $root->find_child ('foo');
    my $content = $e->content_trimmed;
    print $root->to_string (1);

=head1 DESCRIPTION

A WebKDC::XmlElement object represents an XML element, including its
attributes, textual content, and any nested elements.  It therefore can
represent an entire XML document, although XML documents are normally
constructed via the methods provided by WebKDC::XmlDoc.  It is used
internally by the WebKDC module to create and parse XML documents when
talking to a WebAuth WebKDC.

=head1 CLASS METHODS

=over 4

=item new ([XML])

Create a new WebKDC::XmlElement.  If XML is given, do so by parsing that
XML using XML::Parser.  The resulting element will represent the complete
structure of that document, including any nested elements, any attributes,
and any non-element content.

=back

=head1 INSTANCE METHODS

=over 4

=item add_child (ELEMENT)

Add a WebKDC::XmlElement object as a child of this element.  It will be
appended to the end of the list of all existing children.

=item append_content (CONTENT)

Append the provided content to the textual content of this element.

=item attr (NAME[, VALUE])

Retrieve or set the value of a specific attribute.  Returns undef if that
attribute isn't present for this element.

=item attrs ([ATTRS])

Retrieve or set the attributes for this element (as a reference to an
anonymous hash).

=item children ([CHILDREN])

Retrieve or set the children of this element (as a reference to an
anonymous array of WebKDC::XmlElement objects).

=item content ([CONTENT])

Retrieve or set the textual content of this element as a string, not
including any child elements.  Returns undef if the element has no
content.

=item content_trimmed ()

Retrieve the textual content of this element with all leading and trailing
whitespace removed.  Returns undef if the element has no content.

=item find_child (NAME)

Returns the first child (as a WebKDC::XmlElement object) of this element
whose name matches NAME.

=item has_attrs ()

Returns true if this element has attributes, false otherwise.

=item has_children ()

Returns true if this element has children, false otherwise.

=item name ([NAME])

Retrieve or set the name of this element as a string.

=item to_string ()

Convert this XML element (and, recursively, all of its children) to XML.

=back

=head1 AUTHOR

Roland Schemers and Russ Allbery <eagle@eyrie.org>

=head1 SEE ALSO

WebKDC(3), WebKDC::XmlDoc(3)

This module is part of WebAuth.  The current version is available from
L<http://webauth.stanford.edu/>.

=cut