This file is indexed.

/usr/share/arc/LdifPrinter.pm is in nordugrid-arc-arex 5.3.0~rc1-1.

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
package LdifPrinter;

use MIME::Base64;

use LogUtils;
our $log = LogUtils->getLogger(__PACKAGE__);


sub new {
    my ($this, $handle) = @_; 
    my $class = ref($this) || $this;
    # This would only affect comment lines, the rest is guaranteed to be ASCII
    binmode $handle, ':encoding(utf8)'
        or $log->error("binmode failed: $!");
    #print $handle "# extended LDIF\n#\n# LDAPv3\n"
    #    or $log->error("print failed: $!");
    my $self = {fh => $handle, dn => undef, nick => undef, attrs => undef};
    return bless $self, $class;
}

sub begin {
    my ($self, $dnkey, $name) = @_;
    $self->_flush() if defined $self->{dn};
    unshift @{$self->{dn}}, safe_dn("$dnkey=$name");
    unshift @{$self->{nick}}, safe_comment("$name");
}

sub attribute {
    my ($self, $attr, $value) = @_;
    push @{$self->{attrs}}, [$attr, $value];
}

sub attributes {
    my ($self, $data, $prefix, @keys) = @_;
    my $attrs = $self->{attrs} ||= [];
    push @$attrs, ["$prefix$_", $data->{$_}] for @keys;
}

sub end {
    my ($self) = @_;
    $self->_flush();
    shift @{$self->{dn}};
    shift @{$self->{nick}};
}

#
# Prints an entry with the attributes added so far.
# Prints nothing if there are no attributes.
#
sub _flush {
    my ($self) = @_;
    my $fh = $self->{fh};
    my $attrs = $self->{attrs};
    return unless defined $attrs;
    my $dn = join ",", @{$self->{dn}};
    my $nick = join ", ", @{$self->{nick}};
    print $fh "\n";
    #print $fh "# $nick\n";
    print $fh safe_attrval("dn", $dn)."\n"
        or $log->error("print failed: $!");
    for my $pair (@$attrs) {
        my ($attr, $val) = @$pair;
        next unless defined $val;
        if (not ref $val) {
            print $fh safe_attrval($attr, $val)."\n"
                or $log->error("print failed: $!");
        } elsif (ref $val eq 'ARRAY') {
            for (@$val) {
            print $fh safe_attrval($attr, $_)."\n"
                or $log->error("print failed: $!");
            }
        } else {
            $log->error("Not an ARRAY reference in: $attr");
        }
    }
    $self->{attrs} = undef;
}

#
# Make a string safe to use as a Relative Distinguished Name, cf. RFC 2253
#
sub safe_dn {
    my ($rdn) = @_;
    # Escape with \ the following characters ,;+"\<> Also escape # at the
    # beginning and space at the beginning and at the end of the string.
    $rdn =~ s/((?:^[#\s])|[,+"\\<>;]|(?:\s$))/\\$1/g;
    # Encode CR, LF and NUL characters (necessary except when the string
    # is further base64 encoded)
    $rdn =~ s/\x0D/\\0D/g;
    $rdn =~ s/\x0A/\\0A/g;
    $rdn =~ s/\x00/\\00/g;
    return $rdn;
}

#
# Construct an attribute-value string safe to use in LDIF, fc. RFC 2849
#
sub safe_attrval {
    my ($attr, $val) = @_;
    return "${attr}:: ".encode_base64($val,'') if $val =~ /^[\s,:<]/
                                               or $val =~ /[\x0D\x0A\x00]/
                                               or $val =~ /[^\x00-\x7F]/;
    return "${attr}: $val";
}

#
# Leave comments as they are, just encode CR, LF and NUL characters
#
sub safe_comment {
    my ($line) = @_;
    $line =~ s/\x0D/\\0D/g;
    $line =~ s/\x0A/\\0A/g;
    $line =~ s/\x00/\\00/g;
    return $line;
}

#
# Fold long lines and add a final newline. Handles comments specially.
#
sub fold78 {
    my ($tail) = @_;
    my $is_comment = "#" eq substr($tail, 0, 1);
    my $contchar = $is_comment ? "# " : " ";
    my $output = "";
    while (length $tail > 78) {
        $output .= substr($tail, 0, 78) . "\n";
        $tail = $contchar . substr($tail, 78);
    }
    return "$output$tail\n";
}


#
# Higher level functions for recursive printing
#
#   $collector  - a func ref that upon evaluation returns a hash ref ($data)
#   $idkey      - a key in %$data to be used to construct the relative DN component
#   $prefix     - to be prepended to the relative DN
#   $attributes - a func ref that is meant to print attributes. Called with $data as input.
#   $subtree    - yet another func ref that is meant to descend into the hierachy. Called
#                 with $data as input. Optional.
#

# Prints a single entry

sub Entry {
    my ($self, $collector, $prefix, $idkey, $attributes, $subtree) = @_;
    return unless $collector and my $data = &$collector();
    $self->begin("$prefix$idkey", $data->{$idkey});
    &$attributes($self,$data);
    &$subtree($self, $data) if $subtree;
    $self->end();
}

# Prints entries for as long as $collector continues to evaluate to non-null

sub Entries {
    my ($self, $collector, $prefix, $idkey, $attributes, $subtree) = @_;
    while ($collector and my $data = &$collector()) {
        $self->begin("$prefix$idkey", $data->{$idkey});
        &$attributes($self,$data);
        &$subtree($self, $data) if $subtree;
        $self->end();
    }
}



#### TEST ##### TEST ##### TEST ##### TEST ##### TEST ##### TEST ##### TEST ####

sub test {
    my $data;
    my $printer = LdifPrinter->new(*STDOUT);
    $printer->begin(o => "glue");
    $data = { objectClass => "organization", o => "glue" };
    $printer->attributes("", $data, qw(objectClass o));
    $printer->begin(GLUE2GroupID => "grid");
    $printer->attribute(objectClass => "GLUE2GroupID");
    $data = { GLUE2GroupID => "grid" };
    $printer->attributes("GLUE2", $data, qw( GroupID ));
    $printer->end();
    $printer->end();
} 

#test;

1;