(As PDF
(As PDF
(As PDF
----------------------------------------------
# File: PDF.pm
#
# Description: Read PDF meta information
#
# Revisions: 07/11/2005 - P. Harvey Created
# 07/25/2005 - P. Harvey Add support for encrypted documents
#
# References: 1) http://www.adobe.com/devnet/pdf/pdf_reference.html
# 2) http://search.cpan.org/dist/Crypt-RC4/
# 3) http://www.adobe.com/devnet/acrobat/pdfs/PDF32000_2008.pdf
# 4)
http://www.adobe.com/content/dam/Adobe/en/devnet/pdf/pdfs/adobe_supplement_iso32000.pdf
# 5) http://tools.ietf.org/search/rfc3454
# 6) http://www.armware.dk/RFC/rfc/rfc4013.html
#------------------------------------------------------------------------------
package PDF;
use strict;
use vars qw($VERSION $AUTOLOAD $lastFetched);
use ExifTool qw(:DataAccess :Utils);
require Exporter;
$VERSION = '1.31';
sub FetchObject($$$$);
sub ExtractObject($$;$$);
sub ReadToNested($;$);
sub ProcessDict($$$$;$$);
sub ProcessAcroForm($$$$;$$);
sub ReadPDFValue($);
sub CheckPDF($$$);
#------------------------------------------------------------------------------
# AutoLoad our writer routines when necessary
#
sub AUTOLOAD
{
return Image::ExifTool::DoAutoLoad($AUTOLOAD, @_);
}
#------------------------------------------------------------------------------
# Convert from PDF to EXIF-style date/time
# Inputs: 0) PDF date/time string (D:YYYYmmddHHMMSS+HH'MM')
# Returns: EXIF date string (YYYY:mm:dd HH:MM:SS+HH:MM)
sub ConvertPDFDate($)
{
my $date = shift;
# remove optional 'D:' prefix
$date =~ s/^D://;
# fill in default values if necessary
# YYYYmmddHHMMSS
my $default = '00000101000000';
if (length $date < length $default) {
$date .= substr($default, length $date);
}
$date =~ /^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(.*)/ or return $date;
$date = "$1:$2:$3 $4:$5:$6";
#------------------------------------------------------------------------------
# Locate any object in the XRef tables (including compressed objects)
# Inputs: 0) XRef reference, 1) object reference string (or free object number)
# Returns: offset to object in file or compressed object reference string,
# 0 if object is free, or undefined on error
sub LocateAnyObject($$)
{
my ($xref, $ref) = @_;
return undef unless $xref;
return $$xref{$ref} if exists $$xref{$ref};
# get the object number
return undef unless $ref =~ /^(\d+)/;
my $objNum = $1;
# return 0 if the object number has been reused (old object is free)
return 0 if defined $$xref{$objNum};
#
# scan our XRef stream dictionaries for this object
#
return undef unless $$xref{dicts};
my $dict;
foreach $dict (@{$$xref{dicts}}) {
# quick check to see if the object is in the range for this xref stream
next if $objNum >= $$dict{Size};
my $index = $$dict{Index};
next if $objNum < $$index[0];
# scan the tables for the specified object
my $size = $$dict{_entry_size};
my $num = scalar(@$index) / 2;
my $tot = 0;
my $i;
for ($i=0; $i<$num; ++$i) {
my $start = $$index[$i*2];
my $count = $$index[$i*2+1];
# table is in ascending order, so quit if we have passed the object
last if $objNum < $start;
if ($objNum < $start + $count) {
my $offset = $size * ($objNum - $start + $tot);
last if $offset + $size > length $$dict{_stream};
my @c = unpack("x$offset C$size", $$dict{_stream});
# extract values from this table entry
#------------------------------------------------------------------------------
# Locate a regular object in the XRef tables (does not include compressed objects)
# Inputs: 0) XRef reference, 1) object reference string (or free object number)
# Returns: offset to object in file, 0 if object is free,
# or undef on error or if object was compressed
sub LocateObject($$)
{
my ($xref, $ref) = @_;
my $offset = LocateAnyObject($xref, $ref);
return undef if $offset and $offset =~ /^I/;
return $offset;
#------------------------------------------------------------------------------
# Fetch indirect object from file (from inside a stream if required)
# Inputs: 0) ExifTool object reference, 1) object reference string,
# 2) xref lookup, 3) object name (for warning messages)
# Returns: object data or undefined on error
# Notes: sets $lastFetched to the object reference, or undef if the object
# was extracted from an encrypted stream
sub FetchObject($$$$)
{
my ($exifTool, $ref, $xref, $tag) = @_;
$lastFetched = $ref; # save this for decoding if necessary
my $offset = LocateAnyObject($xref, $ref);
$lastOffset = $offset;
unless ($offset) {
$exifTool->Warn("Bad $tag reference") unless defined $offset;
return undef;
}
my ($data, $obj);
if ($offset =~ s/^I(\d+) //) {
my $index = $1; # object index in stream
my ($objNum) = split ' ', $ref; # save original object number
$ref = $offset; # now a reference to the containing stream object
$obj = $streamObjs{$ref};
unless ($obj) {
# don't try to load the same object stream twice
return undef if defined $obj;
$streamObjs{$ref} = '';
# load the parent object stream
$obj = FetchObject($exifTool, $ref, $xref, $tag);
# make sure it contains everything we need
return undef unless defined $obj and ref($obj) eq 'HASH';
return undef unless $$obj{First} and $$obj{N};
return undef unless DecodeStream($exifTool, $obj);
# add a special '_table' entry to this dictionary which contains
# the list of object number/offset pairs from the stream header
my $num = $$obj{N} * 2;
my @table = split ' ', $$obj{_stream}, $num;
return undef unless @table == $num;
# remove everything before first object in stream
$$obj{_stream} = substr($$obj{_stream}, $$obj{First});
$table[$num-1] =~ s/^(\d+).*/$1/s; # trim excess from last number
$$obj{_table} = \@table;
# save the object stream so we don't have to re-load it later
$streamObjs{$ref} = $obj;
}
# verify that we have the specified object
my $i = 2 * $index;
my $table = $$obj{_table};
unless ($index < $$obj{N} and $$table[$i] == $objNum) {
$exifTool->Warn("Bad index for stream object $tag");
return undef;
#------------------------------------------------------------------------------
# Convert PDF value to something readable
# Inputs: 0) PDF object data
# Returns: converted object
sub ReadPDFValue($)
{
my $str = shift;
# decode all strings in an array
if (ref $str eq 'ARRAY') {
# create new list to not alter the original data when rewriting
my ($val, @vals);
foreach $val (@$str) {
push @vals, ReadPDFValue($val);
}
return \@vals;
}
length $str or return $str;
my $delim = substr($str, 0, 1);
if ($delim eq '(') { # literal string
$str = $1 if $str =~ /.*?\((.*)\)/s; # remove brackets
# decode escape sequences in literal strings
while ($str =~ /\\(.)/sg) {
my $n = pos($str) - 2;
my $c = $1;
my $r;
if ($c =~ /[0-7]/) {
# get up to 2 more octal digits
$c .= $1 if $str =~ /\G([0-7]{1,2})/g;
# convert octal escape code
$r = chr(oct($c) & 0xff);
#------------------------------------------------------------------------------
# Extract PDF object from combination of buffered data and file
# Inputs: 0) ExifTool object reference, 1) data reference,
# 2) optional raf reference, 3) optional xref table
# Returns: converted PDF object or undef on error
# a) dictionary object --> hash reference
# b) array object --> array reference
# c) indirect reference --> scalar reference
# d) string, name, integer, boolean, null --> scalar value
# - updates $$dataPt on return to contain unused data
# - creates two bogus entries ('_stream' and '_tags') in dictionaries to represent
# the stream data and a list of the tags (not including '_stream' and '_tags')
# in their original order
sub ExtractObject($$;$$)
{
my ($exifTool, $dataPt, $raf, $xref) = @_;
my (@tags, $data, $objData);
my $dict = { };
my $delim;
for (;;) {
if ($$dataPt =~ /^\s*(<{1,2}|\[|\()/s) {
$delim = $1;
#------------------------------------------------------------------------------
# Read to nested delimiter
# Inputs: 0) data reference, 1) optional raf reference
# Returns: data up to and including matching delimiter (or undef on error)
# - updates data reference with trailing data
# - unescapes characters in literal strings
my %closingDelim = ( # lookup for matching delimiter
'(' => ')',
'[' => ']',
'<' => '>',
if ($filter eq '/FlateDecode') {
if (eval 'require Compress::Zlib') {
my $inflate = Compress::Zlib::inflateInit();
my ($buff, $stat);
$inflate and ($buff, $stat) = $inflate->inflate($$dict{_stream});
if ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) {
$$dict{_stream} = $buff;
} else {
$exifTool->Warn('Error inflating stream');
return 0;
}
} else {
$exifTool->WarnOnce('Install Compress::Zlib to process filtered streams');
return 0;
}
# apply anti-predictor if necessary
next unless ref $decodeParms eq 'HASH';
#------------------------------------------------------------------------------
# Initialize state for RC4 en/decryption (ref 2)
# Inputs: 0) RC4 key string
# Returns: RC4 key hash reference
sub RC4Init($)
{
my @key = unpack('C*', shift);
my @state = (0 .. 255);
my ($i, $j) = (0, 0);
while ($i < 256) {
my $st = $state[$i];
$j = ($j + $st + $key[$i % scalar(@key)]) & 0xff;
$state[$i++] = $state[$j];
$state[$j] = $st;
}
return { State => \@state, XY => [ 0, 0 ] };
}
#------------------------------------------------------------------------------
# Apply RC4 en/decryption (ref 2)
# Inputs: 0) data reference, 1) RC4 key hash reference or RC4 key string
# - can call this method directly with a key string, or with with the key
# reference returned by RC4Init
# - RC4 is a symmetric algorithm, so encryption is the same as decryption
sub RC4Crypt($$)
{
my ($dataPt, $key) = @_;
$key = RC4Init($key) unless ref $key eq 'HASH';
my $state = $$key{State};
my ($x, $y) = @{$$key{XY}};
#------------------------------------------------------------------------------
# Initialize decryption
# Inputs: 0) ExifTool object reference, 1) Encrypt dictionary reference,
# 2) ID from file trailer dictionary
# Returns: error string or undef on success (and sets $cryptInfo)
sub DecryptInit($$$)
{
local $_;
my ($exifTool, $encrypt, $id) = @_;
undef $cryptInfo;
unless ($encrypt and ref $encrypt eq 'HASH') {
return 'Error loading Encrypt object';
}
my $filt = $$encrypt{Filter};
unless ($filt and $filt =~ s/^\///) {
return 'Encrypt dictionary has no Filter!';
}
# extract some interesting tags
my $ver = $$encrypt{V} || 0;
my $rev = $$encrypt{R} || 0;
my $enc = "$filt V$ver";
$enc .= ".$rev" if $filt eq 'Standard';
$enc .= " ($1)" if $$encrypt{SubFilter} and $$encrypt{SubFilter} =~ /^\/(.*)/;
$enc .= ' (' . ($$encrypt{Length} || 40) . '-bit)' if $filt eq 'Standard';
my $tagTablePtr = GetTagTable('PDF::Encrypt');
$exifTool->HandleTag($tagTablePtr, 'Filter', $enc);
if ($filt ne 'Standard') {
return "Encryption filter $filt not currently supported";
} elsif (not defined $$encrypt{R}) {
return 'Standard security handler missing revision';
}
unless ($$encrypt{O} and $$encrypt{P} and $$encrypt{U}) {
return 'Incomplete Encrypt specification';
}
$exifTool->HandleTag($tagTablePtr, 'P', $$encrypt{P});
if ($ver == 1 or $ver == 2) {
$cryptString = $cryptStream = 1;
} elsif ($ver == 4 or $ver == 5) {
# initialize our $cryptString and $cryptStream flags
foreach ('StrF', 'StmF') {
my $flagPt = $_ eq 'StrF' ? \$cryptString : \$cryptStream;
$$flagPt = $$encrypt{$_};
undef $$flagPt if $$flagPt and $$flagPt eq '/Identity';
return "Unsupported $_ encryption $$flagPt" if $$flagPt and $$flagPt ne '/StdCF';
}
if ($cryptString or $cryptStream) {
return 'Missing or invalid Encrypt StdCF entry' unless ref $$encrypt{CF} eq 'HASH' and
#------------------------------------------------------------------------------
# Decrypt/Encrypt data
# Inputs: 0) data ref
# 1) PDF object reference to use as crypt key extension (may be 'none' to
# avoid extending the encryption key, as for streams with Crypt Filter)
# 2) encrypt flag (false for decryption)
sub Crypt($$;$)
{
return unless $cryptInfo;
my ($dataPt, $keyExt, $encrypt) = @_;
# do not decrypt if the key extension object is undefined
# (this doubles as a flag to disable decryption/encryption)
return unless defined $keyExt;
my $key = $$cryptInfo{_key};
# apply the necessary crypt key extension
unless ($$cryptInfo{_aesv3}) {
unless ($keyExt eq 'none') {
# extend crypt key using object and generation number
unless ($keyExt =~ /^(I\d+ )?(\d+) (\d+)/) {
$$cryptInfo{_error} = 'Invalid object reference for encryption';
return;
}
$key .= substr(pack('V', $2), 0, 3) . substr(pack('V', $3), 0, 2);
}
# add AES-128 salt if necessary (this little gem is conveniently
# omitted from the Adobe PDF 1.6 documentation, causing me to
# waste 12 hours trying to figure out why this wasn't working --
# it appears in ISO32000 though, so I should have been using that)
$key .= 'sAlT' if $$cryptInfo{_aesv2};
my $len = length($key);
$key = Digest::MD5::md5($key); # get 16-byte MD5 digest
$key = substr($key, 0, $len) if $len < 16; # trim if necessary
}
# perform the decryption/encryption
if ($$cryptInfo{_aesv2} or $$cryptInfo{_aesv3}) {
require Image::ExifTool::AES;
#------------------------------------------------------------------------------
# Decrypt/Encrypt stream data
# Inputs: 0) dictionary ref, 1) PDF object reference to use as crypt key extension
sub CryptStream($$)
{
return unless $cryptStream;
my ($dict, $keyExt) = @_;
my $type = $$dict{Type} || '';
# XRef streams are not encrypted (ref 3, page 50),
# and Metadata may or may not be encrypted
if ($cryptInfo and $type ne '/XRef' and
($$cryptInfo{_meta} or $type ne '/Metadata'))
{
Crypt(\$$dict{_stream}, $keyExt, $$dict{_decrypted});
# toggle _decrypted flag
$$dict{_decrypted} = ($$dict{_decrypted} ? undef : 1);
} else {
$$dict{_decrypted} = 0; # stream should never be encrypted
}
}
#------------------------------------------------------------------------------
# Generate a new PDF tag (based on its ID) and add it to a tag table
# Inputs: 0) tag table ref, 1) tag ID
# Returns: tag info ref
sub NewPDFTag($$)
{
my ($tagTablePtr, $tag) = @_;
my $name = $tag;
# translate URL-like escape sequences
$name =~ s/#([0-9a-f]{2})/chr(hex($1))/ige;
$name =~ s/[^-\w]+/_/g; # translate invalid characters to an underline
$name =~ s/(^|_)([a-z])/\U$2/g; # start words with upper case
my $tagInfo = { Name => $name };
AddTagToTable($tagTablePtr, $tag, $tagInfo);
return $tagInfo;
}
#------------------------------------------------------------------------------
# Process AcroForm dictionary to set HasXMLFormsArchitecture flag
# Inputs: Same as ProcessDict
sub ProcessAcroForm($$$$;$$)
{
my ($exifTool, $tagTablePtr, $dict, $xref, $nesting, $type) = @_;
$exifTool->HandleTag($tagTablePtr, '_has_xfa', $$dict{XFA} ? 'true' : 'false');
ProcessDict($exifTool, $tagTablePtr, $dict, $xref, $nesting, $type);
#------------------------------------------------------------------------------
# Process PDF dictionary extract tag values
# Inputs: 0) ExifTool object reference, 1) tag table reference
# 2) dictionary reference, 3) cross-reference table reference,
# 4) nesting depth, 5) dictionary capture type
sub ProcessDict($$$$;$$)
{
my ($exifTool, $tagTablePtr, $dict, $xref, $nesting, $type) = @_;
my $verbose = $exifTool->Options('Verbose');
my $unknown = $$tagTablePtr{EXTRACT_UNKNOWN};
my $embedded = (defined $unknown and not $unknown and $exifTool->
Options('ExtractEmbedded'));
my @tags = @{$$dict{_tags}};
my ($next, %join);
my $index = 0;
$nesting = ($nesting || 0) + 1;
if ($nesting > 50) {
$exifTool->WarnOnce('Nesting too deep (directory ignored)');
return;
}
# save entire dictionary for rewriting if specified
if ($$exifTool{PDF_CAPTURE} and $$tagTablePtr{VARS} and
$tagTablePtr->{VARS}->{CAPTURE})
{
my $name;
foreach $name (@{$tagTablePtr->{VARS}->{CAPTURE}}) {
next if $exifTool->{PDF_CAPTURE}->{$name};
# make sure we load the right type if indicated
next if $type and $type ne $name;
$exifTool->{PDF_CAPTURE}->{$name} = $dict;
last;
}
}
#
# extract information from all tags in the dictionary
#
for (;;) {
my ($tag, $tagInfo);
if (@tags) {
$tag = shift @tags;
} elsif (defined $next and not $next) {
$tag = 'Next';
$next = 1;
} else {
last;
}
my $val = $$dict{$tag};
if ($$tagTablePtr{$tag}) {
$tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tag);
undef $tagInfo if $$tagInfo{NoProcess};
if (%join) {
my ($tag, $i);
foreach $tag (sort keys %join) {
my $list = $join{$tag};
last unless defined $$list[1] and $$list[1] =~ /^%.*?([\x0d\x0a]*)/;
my $buff = "%!PS-Adobe-3.0$1"; # add PS header with same line break
for ($i=1; defined $$list[$i]; ++$i) {
#------------------------------------------------------------------------------
# Extract information from PDF file
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 0 if not a PDF file, 1 on success, otherwise a negative error number
sub ReadPDF($$)
{
my ($exifTool, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my $verbose = $exifTool->Options('Verbose');
my ($buff, $encrypt, $id);
#
# validate PDF file
#
# (linearization dictionary must be in the first 1024 bytes of the file)
$raf->Read($buff, 1024) >= 8 or return 0;
$buff =~ /^%PDF-(\d+\.\d+)/ or return 0;
$pdfVer = $1;
$exifTool->SetFileType(); # set the FileType tag
$exifTool->Warn("May not be able to read a PDF version $pdfVer file") if $pdfVer >= 2.0;
# store PDFVersion tag
my $tagTablePtr = GetTagTable('PDF::Root');
$exifTool->HandleTag($tagTablePtr, 'Version', $pdfVer);
#------------------------------------------------------------------------------
# ReadPDF() warning strings for each error return value
my %pdfWarning = (
# -1 is reserved as error return value with no associated warning
-2 => 'Error seeking in file',
-3 => 'Error reading file',
-4 => 'Invalid xref table',
-5 => 'Invalid xref offset',
-6 => 'Error reading xref table',
-7 => 'Error reading trailer',
-8 => 'Error reading main dictionary',
-9 => 'Invalid xref stream in main dictionary',
);
#------------------------------------------------------------------------------
# Extract information from PDF file
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 if this was a valid PDF file
my ($exifTool, $dirInfo);
sub ProcessPDF($$)
{
undef $cryptInfo; # (must not delete after returning so writer can use it)
undef $cryptStream;
undef $cryptString;
my $result = ReadPDF($exifTool, $dirInfo);
if ($result < 0) {
$exifTool->Warn($pdfWarning{$result}) if $pdfWarning{$result};
$result = 1;
}
# clean up and return
undef %streamObjs;
undef %fetched;
return $result;
}
1; # end
__END__
=head1 NAME
=head1 SYNOPSIS
=head1 DESCRIPTION
This code reads meta information from PDF (Adobe Portable Document Format)
files. It supports object streams introduced in PDF-1.5 but only with a
limited set of Filter and Predictor algorithms, however all standard
encryption methods through PDF-1.7 extension level 3 are supported,
including AESV2 (AES-128) and AESV3 (AES-256).
=head1 AUTHOR
=head1 REFERENCES
=over 4
=item L<http://partners.adobe.com/public/developer/pdf/index_reference.html>
=item L<Crypt::RC4|Crypt::RC4>
=item L<http://www.adobe.com/devnet/acrobat/pdfs/PDF32000_2008.pdf>
=item
L<http://www.adobe.com/content/dam/Adobe/en/devnet/pdf/pdfs/adobe_supplement_iso32000.pdf>
=item L<http://tools.ietf.org/search/rfc3454>
=item L<http://www.armware.dk/RFC/rfc/rfc4013.html>
=back
L<Image::ExifTool::TagNames/PDF Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut