This file is indexed.

/usr/share/perl5/Image/ExifTool/WritePNG.pl is in libimage-exiftool-perl 10.10-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
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
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
#------------------------------------------------------------------------------
# File:         WritePNG.pl
#
# Description:  Write PNG meta information
#
# Revisions:    09/16/2005 - P. Harvey Created
#
# References:   1) http://www.libpng.org/pub/png/spec/1.2/
#------------------------------------------------------------------------------
package Image::ExifTool::PNG;

use strict;

#------------------------------------------------------------------------------
# Calculate CRC or update running CRC (ref 1)
# Inputs: 0) data reference, 1) running crc to update (undef intially)
#         2) data position (undef for 0), 3) data length (undef for all data),
# Returns: updated CRC
my @crcTable;
sub CalculateCRC($;$$$)
{
    my ($dataPt, $crc, $pos, $len) = @_;
    $crc = 0 unless defined $crc;
    $pos = 0 unless defined $pos;
    $len = length($$dataPt) - $pos unless defined $len;
    $crc ^= 0xffffffff;         # undo 1's complement
    # build lookup table unless done already
    unless (@crcTable) {
        my ($c, $n, $k);
        for ($n=0; $n<256; ++$n) {
            for ($k=0, $c=$n; $k<8; ++$k) {
                $c = ($c & 1) ? 0xedb88320 ^ ($c >> 1) : $c >> 1;
            }
            $crcTable[$n] = $c;
        }
    }
    # calculate the CRC
    foreach (unpack("x${pos}C$len", $$dataPt)) {
        $crc = $crcTable[($crc^$_) & 0xff] ^ ($crc >> 8);
    }
    return $crc ^ 0xffffffff;   # return 1's complement
}

#------------------------------------------------------------------------------
# Encode data in ASCII Hex
# Inputs: 0) input data reference
# Returns: Hex-encoded data (max 72 chars per line)
sub HexEncode($)
{
    my $dataPt = shift;
    my $len = length($$dataPt);
    my $hex = '';
    my $pos;
    for ($pos = 0; $pos < $len; $pos += 36) {
        my $n = $len - $pos;
        $n > 36 and $n = 36;
        $hex .= unpack('H*',substr($$dataPt,$pos,$n)) . "\n";
    }
    return $hex;
}

#------------------------------------------------------------------------------
# Write profile to tEXt or zTXt chunk (zTXt if Zlib is available)
# Inputs: 0) outfile, 1) Raw profile type, 2) data ref
#         3) profile header type (undef if not a text profile)
# Returns: 1 on success
sub WriteProfile($$$;$)
{
    my ($outfile, $rawType, $dataPt, $profile) = @_;
    my ($buff, $prefix, $chunk, $deflate);
    if (eval { require Compress::Zlib }) {
        $deflate = Compress::Zlib::deflateInit();
    }
    if (not defined $profile) {
        # write ICC profile as compressed iCCP chunk if possible
        return 0 unless $deflate;
        $buff = $deflate->deflate($$dataPt);
        return 0 unless defined $buff;
        $buff .= $deflate->flush();
        my %rawTypeChunk = ( icm => 'iCCP' );
        $chunk = $rawTypeChunk{$rawType} or return 0;
        $prefix = "$rawType\0\0";
        $dataPt = \$buff;
    } else {
        # write as ASCII-hex encoded profile in tEXt or zTXt chunk
        my $txtHdr = sprintf("\n$profile profile\n%8d\n", length($$dataPt));
        $buff = $txtHdr . HexEncode($dataPt);
        $chunk = 'tEXt';         # write as tEXt if deflate not available
        $prefix = "Raw profile type $rawType\0";
        $dataPt = \$buff;
        # write profile as zTXt chunk if possible
        if ($deflate) {
            my $buf2 = $deflate->deflate($buff);
            if (defined $buf2) {
                $dataPt = \$buf2;
                $buf2 .= $deflate->flush();
                $chunk = 'zTXt';
                $prefix .= "\0";    # compression type byte (0=deflate)
            }
        }
    }
    my $hdr = pack('Na4', length($prefix) + length($$dataPt), $chunk) . $prefix;
    my $crc = CalculateCRC(\$hdr, undef, 4);
    $crc = CalculateCRC($dataPt, $crc);
    return Write($outfile, $hdr, $$dataPt, pack('N',$crc));
}

#------------------------------------------------------------------------------
# Add iCCP to the PNG image if necessary (must come before PLTE and IDAT)
# Inputs: 0) ExifTool object ref, 1) output file or scalar ref
# Returns: true on success
sub Add_iCCP($$)
{
    my ($et, $outfile) = @_;
    if ($$et{ADD_DIRS}{ICC_Profile}) {
        # write new ICC data
        my $tagTablePtr = Image::ExifTool::GetTagTable('Image::ExifTool::ICC_Profile::Main');
        my %dirInfo = ( Parent => 'PNG', DirName => 'ICC_Profile' );
        my $buff = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
        if (defined $buff and length $buff and WriteProfile($outfile, 'icm', \$buff)) {
            $et->VPrint(0, "Created ICC profile\n");
            delete $$et{ADD_DIRS}{ICC_Profile}; # don't add it again
            $$et{PNGDoneDir}{ICC_Profile} = 2;
        }
    }
    return 1;
}

#------------------------------------------------------------------------------
# This routine is called after we edit an existing directory
# Inputs: 0) ExifTool ref, 1) dir name, 2) output data ref
#         3) flag set if location is non-standard (to update, but not create from scratch)
# - on return, $$outBuff is set to '' if the directory is to be deleted
sub DoneDir($$$;$)
{
    my ($et, $dir, $outBuff, $nonStandard) = @_;
    # don't add this directory again unless this is in a non-standard location
    delete $$et{ADD_DIRS}{$dir} unless $nonStandard;
    # handle problem with duplicate XMP when using PNGEarlyXMP option
    return unless $dir eq 'XMP' and defined $$outBuff and length $$outBuff;
    if ($nonStandard and $$et{DEL_GROUP}{$dir}) {
        $et->VPrint(0,"  Deleting non-standard $dir\n");
        $$outBuff = '';
    } elsif (not $$et{PNGDoneDir}{$dir}) {
        $$et{PNGDoneDir}{$dir} = 1;   # set flag indicating the directory exists
    } elsif ($$et{OPTIONS}{PNGEarlyXMP}) {
        if ($$et{PNGDoneDir}{$dir} == 2) {
            if ($$et{OPTIONS}{IgnoreMinorErrors}) {
                $et->Warn("Deleted existing $dir");
            } else {
                $et->Error("Duplicate $dir created. Ignore to delete existing $dir", 1);
                return;
            }
        } elsif ($et->Warn("Duplicate $dir. Ignore to delete", 2)) {
            return; # warning not ignored: don't delete the duplicate
        }
        $et->VPrint(0,"  Deleting duplicate $dir\n");
        $$outBuff = '';
    }
}

#------------------------------------------------------------------------------
# Generate tEXt, zTXt or iTXt data for writing
# Inputs: 0) ExifTool ref, 1) tagID, 2) tagInfo ref, 3) value string, 4) language code
# Returns: chunk data (not including 8-byte chunk header)
# Notes: Sets ExifTool TextChunkType member to the type of chunk written
sub BuildTextChunk($$$$$)
{
    my ($et, $tag, $tagInfo, $val, $lang) = @_;
    my ($xtra, $compVal, $iTXt, $comp);
    if ($$tagInfo{SubDirectory}) {
        if ($$tagInfo{Name} eq 'XMP') {
            $iTXt = 2;      # write as iTXt but flag to avoid encoding
            # (never compress XMP)
        } else {
            $comp = 2;      # compress raw profile if possible
        }
    } else {
        # compress if specified
        $comp = 1 if $et->Options('Compress');
        if ($lang) {
            $iTXt = 1;      # write as iTXt if it has a language code
            $tag =~ s/-$lang$//;    # remove language code from tagID
        } elsif ($$et{OPTIONS}{Charset} ne 'Latin' and $val =~  /[\x80-\xff]/) {
            $iTXt = 1;      # write as iTXt if it contains non-Latin special characters
        }
    }
    if ($comp) {
        my $warn;
        if (eval { require Compress::Zlib }) {
            my $deflate = Compress::Zlib::deflateInit();
            $compVal = $deflate->deflate($val) if $deflate;
            if (defined $compVal) {
                $compVal .= $deflate->flush();
                # only compress if it actually saves space
                unless (length($compVal) < length($val)) {
                    undef $compVal;
                    $warn = 'uncompressed data is smaller';
                }
            } else {
                $warn = 'deflate error';
            }
        } else {
            $warn = 'Compress::Zlib not available';
        }
        # warn if any user-specified compression fails
        if ($warn and $comp == 1) {
            $et->Warn("PNG:$$tagInfo{Name} not compressed ($warn)", 1);
        }
    }
    # decide whether to write as iTXt, zTXt or tEXt
    if ($iTXt) {
        $$et{TextChunkType} = 'iTXt';
        $xtra = (defined $compVal ? "\x01\0" : "\0\0") . ($lang || '') . "\0\0";
        # iTXt is encoded as UTF-8 (but note that XMP is already UTF-8)
        $val = $et->Encode($val, 'UTF8') if $iTXt == 1;
    } elsif (defined $compVal) {
        $$et{TextChunkType} = 'zTXt';
        $xtra = "\0";
    } else {
        $$et{TextChunkType} = 'tEXt';
        $xtra = '';
    }
    return $tag . "\0" . $xtra . (defined $compVal ? $compVal : $val);
}

#------------------------------------------------------------------------------
# Add any outstanding new chunks to the PNG image
# Inputs: 0) ExifTool object ref, 1) output file or scalar ref
#         2-N) dirs to add (empty to add all, including PNG tags)
# Returns: true on success
sub AddChunks($$;@)
{
    my ($et, $outfile, @add) = @_;
    my ($addTags, $tag, $dir, $err, $tagTablePtr);

    if (@add) {
        $addTags = { }; # don't add any PNG tags
    } else {
        $addTags = $$et{ADD_PNG};    # add all PNG tags...
        delete $$et{ADD_PNG};        # ...once
        # add all directories
        @add = sort keys %{$$et{ADD_DIRS}};
    }
    # write any outstanding PNG tags
    foreach $tag (sort keys %$addTags) {
        my $tagInfo = $$addTags{$tag};
        my $nvHash = $et->GetNewValueHash($tagInfo);
        # (native PNG information is always preferred, so don't check IsCreating)
        next unless $et->IsOverwriting($nvHash);
        my $val = $et->GetNewValue($nvHash);
        if (defined $val) {
            next if $$nvHash{EditOnly};
            my $data;
            if ($$tagInfo{Table} eq \%Image::ExifTool::PNG::TextualData) {
                $data = BuildTextChunk($et, $tag, $tagInfo, $val, $$tagInfo{LangCode});
                $data = $$et{TextChunkType} . $data;
                delete $$et{TextChunkType};
            } else {
                $data = "$tag$val";
            }
            my $hdr = pack('N', length($data) - 4);
            my $cbuf = pack('N', CalculateCRC(\$data, undef));
            Write($outfile, $hdr, $data, $cbuf) or $err = 1;
            $et->VerboseValue("+ PNG:$$tagInfo{Name}", $val);
            $$et{PNGDoneTag}{$tag} = 1;   # set flag indicating this tag was added
            ++$$et{CHANGED};
        }
    }
    # create any necessary directories
    foreach $dir (@add) {
        next unless $$et{ADD_DIRS}{$dir}; # make sure we want to add it first
        my $buff;
        my %dirInfo = (
            Parent => 'PNG',
            DirName => $dir,
        );
        if ($dir eq 'IFD0') {
            $et->Warn('Creating non-standard EXIF in PNG', 1);
            $et->VPrint(0, "Creating EXIF profile:\n");
            $$et{TIFF_TYPE} = 'APP1';
            $tagTablePtr = Image::ExifTool::GetTagTable('Image::ExifTool::Exif::Main');
            $buff = $et->WriteDirectory(\%dirInfo, $tagTablePtr, \&Image::ExifTool::WriteTIFF);
            if (defined $buff and length $buff) {
                $buff = $Image::ExifTool::exifAPP1hdr . $buff;
                WriteProfile($outfile, 'APP1', \$buff, 'generic') or $err = 1;
            }
        } elsif ($dir eq 'XMP') {
            $et->VPrint(0, "Creating XMP iTXt chunk:\n");
            $tagTablePtr = Image::ExifTool::GetTagTable('Image::ExifTool::XMP::Main');
            $dirInfo{ReadOnly} = 1;
            $buff = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
            if (defined $buff and length $buff and
                # the packet is read-only (because of CRC)
                Image::ExifTool::XMP::ValidateXMP(\$buff, 'r'))
            {
                # (previously, XMP was created as a non-standard XMP profile chunk)
                # $buff = $Image::ExifTool::xmpAPP1hdr . $buff;
                # WriteProfile($outfile, 'APP1', \$buff, 'generic') or $err = 1;
                # (but now write XMP iTXt chunk according to XMP specification)
                $buff = "iTXtXML:com.adobe.xmp\0\0\0\0\0" . $buff;
                my $hdr = pack('N', length($buff) - 4);
                my $cbuf = pack('N', CalculateCRC(\$buff, undef));
                Write($outfile, $hdr, $buff, $cbuf) or $err = 1;
            }
        } elsif ($dir eq 'IPTC') {
            $et->Warn('Creating non-standard EXIF in PNG', 1);
            $et->VPrint(0, "Creating IPTC profile:\n");
            # write new IPTC data (stored in a Photoshop directory)
            $dirInfo{DirName} = 'Photoshop';
            $tagTablePtr = Image::ExifTool::GetTagTable('Image::ExifTool::Photoshop::Main');
            $buff = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
            if (defined $buff and length $buff) {
                WriteProfile($outfile, 'iptc', \$buff, 'IPTC') or $err = 1;
            }
        } elsif ($dir eq 'ICC_Profile') {
            $et->VPrint(0, "Creating ICC profile:\n");
            # write new ICC data (only done if we couldn't create iCCP chunk)
            $tagTablePtr = Image::ExifTool::GetTagTable('Image::ExifTool::ICC_Profile::Main');
            $buff = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
            if (defined $buff and length $buff) {
                WriteProfile($outfile, 'icm', \$buff, 'ICC') or $err = 1;
                $et->Warn('Wrote ICC as a raw profile (no Compress::Zlib)');
            }
        } elsif ($dir eq 'PNG-pHYs') {
            $et->VPrint(0, "Creating pHYs chunk:\n");
            $tagTablePtr = Image::ExifTool::GetTagTable('Image::ExifTool::PNG::PhysicalPixel');
            my $blank = "\0\0\x0b\x12\0\0\x0b\x12\x01"; # 2834 pixels per meter (72 dpi)
            $dirInfo{DataPt} = \$blank;
            $buff = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
            if (defined $buff and length $buff) {
                $buff = 'pHYs' . $buff; # CRC includes chunk name
                my $hdr = pack('N', length($buff) - 4);
                my $cbuf = pack('N', CalculateCRC(\$buff, undef));
                Write($outfile, $hdr, $buff, $cbuf) or $err = 1;
            }
        } else {
            next;
        }
        delete $$et{ADD_DIRS}{$dir};  # don't add again
        # keep track of the directories that we added
        $$et{PNGDoneDir}{$dir} = 2 if defined $buff and length $buff;
    }
    return not $err;
}


1; # end

__END__

=head1 NAME

Image::ExifTool::WritePNG.pl - Write PNG meta information

=head1 SYNOPSIS

These routines are autoloaded by Image::ExifTool::PNG.

=head1 DESCRIPTION

This file contains routines to write PNG metadata.

=head1 NOTES

Compress::Zlib is required to write compressed text.

Existing text tags are always rewritten in their original form (compressed
zTXt, uncompressed tEXt or internation iTXt), so pre-existing compressed
information can only be modified if Compress::Zlib is available.

Newly created textual information is written in uncompressed tEXt form by
default, or as compressed zTXt if the Compress option is used and
Compress::Zlib is available (but only if the resulting compressed data is
smaller than the original text, which isn't always the case for short text
strings).

=head1 AUTHOR

Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

L<Image::ExifTool::PNG(3pm)|Image::ExifTool::PNG>,
L<Image::ExifTool(3pm)|Image::ExifTool>

=cut