12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339 |
- #------------------------------------------------------------------------------
- # 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 Image::ExifTool::PDF;
- use strict;
- use vars qw($VERSION $AUTOLOAD $lastFetched);
- use Image::ExifTool qw(:DataAccess :Utils);
- require Exporter;
- $VERSION = '1.40';
- sub FetchObject($$$$);
- sub ExtractObject($$;$$);
- sub ReadToNested($;$);
- sub ProcessDict($$$$;$$);
- sub ProcessAcroForm($$$$;$$);
- sub ReadPDFValue($);
- sub CheckPDF($$$);
- # $lastFetched - last fetched object reference (used for decryption)
- # (undefined if fetched object was already decrypted, eg. object from stream)
- my $cryptInfo; # encryption object reference (plus additional information)
- my $cryptString; # flag that strings are encrypted
- my $cryptStream; # flag that streams are encrypted
- my $lastOffset; # last fetched object offset
- my %streamObjs; # hash of stream objects
- my %fetched; # dicts fetched in verbose mode (to avoid cyclical recursion)
- my $pdfVer; # version of PDF file being processed
- # filters supported in DecodeStream()
- my %supportedFilter = (
- '/FlateDecode' => 1,
- '/Crypt' => 1,
- '/Identity' => 1, # (not filtered)
- '/DCTDecode' => 1, # (JPEG image - not filtered)
- '/JPXDecode' => 1, # (Jpeg2000 image - not filtered)
- '/LZWDecode' => 1, # (usually a bitmapped image)
- '/ASCIIHexDecode' => 1,
- # other standard filters that we currently don't support
- #'/JBIG2Decode' => 0, # (JBIG2 image format not supported)
- #'/CCITTFaxDecode' => 0,
- #'/RunLengthDecode' => 0,
- #'/ASCII85Decode' => 0,
- );
- # tags in main PDF directories
- %Image::ExifTool::PDF::Main = (
- GROUPS => { 2 => 'Document' },
- VARS => { CAPTURE => ['Main','Prev'] },
- Info => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Info' },
- # Adobe Acrobat 10.1.5 will create a duplicate Info dictionary with
- # a different object number when metadata is edited. This flag
- # is part of a patch to ignore this duplicate information (unless
- # the IgnoreMinorErrors option is used)
- IgnoreDuplicates => 1,
- },
- Root => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Root' },
- },
- Encrypt => {
- NoProcess => 1, # don't process normally (processed in advance)
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Encrypt' },
- },
- _linearized => {
- Name => 'Linearized',
- Notes => 'flag set if document is linearized for fast web display; not a real Tag ID',
- PrintConv => { 'true' => 'Yes', 'false' => 'No' },
- },
- );
- # tags in PDF Info dictionary
- %Image::ExifTool::PDF::Info = (
- GROUPS => { 2 => 'Document' },
- VARS => { CAPTURE => ['Info'] },
- EXTRACT_UNKNOWN => 1, # extract all unknown tags in this directory
- WRITE_PROC => \&Image::ExifTool::DummyWriteProc,
- CHECK_PROC => \&CheckPDF,
- WRITABLE => 'string',
- # set PRIORITY to 0 so most recent Info dictionary takes precedence
- # (Acrobat Pro bug? doesn't use same object/generation number for
- # new Info dictionary when doing incrmental update)
- PRIORITY => 0,
- NOTES => q{
- As well as the tags listed below, the PDF specification allows for
- user-defined tags to exist in the Info dictionary. These tags, which should
- have corresponding XMP-pdfx entries in the XMP of the PDF XML Metadata
- object, are also extracted by ExifTool.
- B<Writable> specifies the value format, and may be C<string>, C<date>,
- C<integer>, C<real>, C<boolean> or C<name> for PDF tags.
- },
- Title => { },
- Author => { Groups => { 2 => 'Author' } },
- Subject => { },
- Keywords => { List => 'string' }, # this is a string list
- Creator => { },
- Producer => { },
- CreationDate => {
- Name => 'CreateDate',
- Writable => 'date',
- Groups => { 2 => 'Time' },
- Shift => 'Time',
- PrintConv => '$self->ConvertDateTime($val)',
- PrintConvInv => '$self->InverseDateTime($val)',
- },
- ModDate => {
- Name => 'ModifyDate',
- Writable => 'date',
- Groups => { 2 => 'Time' },
- Shift => 'Time',
- PrintConv => '$self->ConvertDateTime($val)',
- PrintConvInv => '$self->InverseDateTime($val)',
- },
- Trapped => {
- Protected => 1,
- # remove leading '/' from '/True' or '/False'
- ValueConv => '$val=~s{^/}{}; $val',
- ValueConvInv => '"/$val"',
- },
- 'AAPL:Keywords' => { #PH
- Name => 'AppleKeywords',
- List => 'array', # this is an array of values
- Notes => q{
- keywords written by Apple utilities, although they seem to use PDF:Keywords
- when reading
- },
- },
- );
- # tags in the PDF Root document catalog
- %Image::ExifTool::PDF::Root = (
- GROUPS => { 2 => 'Document' },
- # note: can't capture previous versions of Root since they are not parsed
- VARS => { CAPTURE => ['Root'] },
- NOTES => 'This is the PDF document catalog.',
- MarkInfo => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::MarkInfo' },
- },
- Metadata => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Metadata' },
- },
- Pages => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Pages' },
- },
- Perms => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Perms' },
- },
- AcroForm => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::AcroForm' },
- },
- Lang => 'Language',
- PageLayout => { },
- PageMode => { },
- Version => 'PDFVersion',
- );
- # tags extracted from the PDF Encrypt dictionary
- %Image::ExifTool::PDF::Encrypt = (
- GROUPS => { 2 => 'Document' },
- NOTES => 'Tags extracted from the document Encrypt dictionary.',
- Filter => {
- Name => 'Encryption',
- Notes => q{
- extracted value is actually a combination of the Filter, SubFilter, V, R and
- Length information from the Encrypt dictionary
- },
- },
- P => {
- Name => 'UserAccess',
- ValueConv => '$val & 0x0f3c', # ignore reserved bits
- PrintConvColumns => 2,
- PrintConv => { BITMASK => {
- 2 => 'Print',
- 3 => 'Modify',
- 4 => 'Copy',
- 5 => 'Annotate',
- 8 => 'Fill forms',
- 9 => 'Extract',
- 10 => 'Assemble',
- 11 => 'Print high-res',
- }},
- },
- );
- # tags in PDF Pages dictionary
- %Image::ExifTool::PDF::Pages = (
- GROUPS => { 2 => 'Document' },
- Count => 'PageCount',
- Kids => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Kids' },
- },
- );
- # tags in PDF Perms dictionary
- %Image::ExifTool::PDF::Perms = (
- NOTES => 'Additional document permissions imposed by digital signatures.',
- DocMDP => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Signature' },
- },
- FieldMDP => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Signature' },
- },
- UR3 => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Signature' },
- },
- );
- # tags in PDF Perms dictionary
- %Image::ExifTool::PDF::AcroForm = (
- PROCESS_PROC => \&ProcessAcroForm,
- _has_xfa => {
- Name => 'HasXFA',
- Notes => q{
- this tag is defined if a document contains form fields, and is true if it
- uses XML Forms Architecture; not a real Tag ID
- },
- PrintConv => { 'true' => 'Yes', 'false' => 'No' },
- },
- );
- # tags in PDF Kids dictionary
- %Image::ExifTool::PDF::Kids = (
- Metadata => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Metadata' },
- },
- PieceInfo => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::PieceInfo' },
- },
- Resources => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Resources' },
- },
- Kids => {
- Condition => '$self->Options("ExtractEmbedded")',
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Kids' },
- },
- );
- # tags in PDF Resources dictionary
- %Image::ExifTool::PDF::Resources = (
- ColorSpace => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::ColorSpace' },
- },
- XObject => {
- Condition => '$self->Options("ExtractEmbedded")',
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::XObject' },
- },
- Properties => {
- Condition => '$self->Options("ExtractEmbedded")',
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Properties' },
- },
- );
- # tags in PDF ColorSpace dictionary
- %Image::ExifTool::PDF::ColorSpace = (
- DefaultRGB => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::DefaultRGB' },
- },
- Cs1 => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Cs1' },
- },
- );
- # tags in PDF DefaultRGB dictionary
- %Image::ExifTool::PDF::DefaultRGB = (
- ICCBased => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::ICCBased' },
- },
- );
- # tags in PDF Cs1 dictionary
- %Image::ExifTool::PDF::Cs1 = (
- _stream => {
- SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
- },
- );
- # tags in PDF ICCBased dictionary
- %Image::ExifTool::PDF::ICCBased = (
- _stream => {
- SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
- },
- );
- # tags in PDF XObject dictionary (parsed only if ExtractEmbedded is enabled)
- %Image::ExifTool::PDF::XObject = (
- EXTRACT_UNKNOWN => 0, # extract known but numbered tags (Im1, Im2, etc)
- Im => {
- Notes => q{
- the ExtractEmbedded option enables information to be extracted from these
- embedded images
- },
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Im' },
- },
- );
- # tags in PDF Im# dictionary
- %Image::ExifTool::PDF::Im = (
- NOTES => q{
- Information extracted from embedded images with the ExtractEmbedded option.
- The EmbeddedImage and its metadata are extracted only for JPEG and Jpeg2000
- image formats.
- },
- Width => 'EmbeddedImageWidth',
- Height => 'EmbeddedImageHeight',
- Filter => { Name => 'EmbeddedImageFilter', List => 1 },
- ColorSpace => {
- Name => 'EmbeddedImageColorSpace',
- List => 1,
- RawConv => 'ref $val ? undef : $val', # (ignore color space data)
- },
- Image_stream => {
- Name => 'EmbeddedImage',
- Groups => { 2 => 'Preview' },
- Binary => 1,
- },
- );
- # tags in PDF Properties dictionary
- %Image::ExifTool::PDF::Properties = (
- EXTRACT_UNKNOWN => 0, # extract known but numbered tags (MC0, MC1, etc)
- MC => {
- Notes => q{
- the ExtractEmbedded option enables information to be extracted from these
- embedded metadata dictionaries
- },
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::MC' },
- }
- );
- # tags in PDF MC# dictionary
- %Image::ExifTool::PDF::MC = (
- Metadata => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Metadata' },
- }
- );
- # tags in PDF PieceInfo dictionary
- %Image::ExifTool::PDF::PieceInfo = (
- AdobePhotoshop => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::AdobePhotoshop' },
- },
- Illustrator => {
- # assume this is an illustrator file if it contains this directory
- # and doesn't have a ".PDF" extension
- Condition => q{
- $self->OverrideFileType("AI") unless $$self{FILE_EXT} and $$self{FILE_EXT} eq 'PDF';
- return 1;
- },
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Illustrator' },
- },
- );
- # tags in PDF AdobePhotoshop dictionary
- %Image::ExifTool::PDF::AdobePhotoshop = (
- Private => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Private' },
- },
- );
- # tags in PDF Illustrator dictionary
- %Image::ExifTool::PDF::Illustrator = (
- Private => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::AIPrivate' },
- },
- );
- # tags in PDF Private dictionary
- %Image::ExifTool::PDF::Private = (
- ImageResources => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::ImageResources' },
- },
- );
- # tags in PDF AI Private dictionary
- %Image::ExifTool::PDF::AIPrivate = (
- GROUPS => { 2 => 'Document' },
- EXTRACT_UNKNOWN => 0, # extract known but numbered tags
- AIMetaData => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::AIMetaData' },
- },
- AIPrivateData => {
- Notes => q{
- the ExtractEmbedded option enables information to be extracted from embedded
- PostScript documents in the AIPrivateData# and AIPDFPrivateData# streams
- },
- JoinStreams => 1, # join streams from numbered tags and process as one
- SubDirectory => { TagTable => 'Image::ExifTool::PostScript::Main' },
- },
- AIPDFPrivateData => {
- JoinStreams => 1, # join streams from numbered tags and process as one
- SubDirectory => { TagTable => 'Image::ExifTool::PostScript::Main' },
- },
- RoundTripVersion => { },
- ContainerVersion => { },
- CreatorVersion => { },
- );
- # tags in PDF AIMetaData dictionary
- %Image::ExifTool::PDF::AIMetaData = (
- _stream => {
- SubDirectory => { TagTable => 'Image::ExifTool::PostScript::Main' },
- },
- );
- # tags in PDF ImageResources dictionary
- %Image::ExifTool::PDF::ImageResources = (
- _stream => {
- SubDirectory => { TagTable => 'Image::ExifTool::Photoshop::Main' },
- },
- );
- # tags in PDF MarkInfo dictionary
- %Image::ExifTool::PDF::MarkInfo = (
- GROUPS => { 2 => 'Document' },
- Marked => {
- Name => 'TaggedPDF',
- Notes => "not a Tagged PDF if this tag is missing",
- PrintConv => { 'true' => 'Yes', 'false' => 'No' },
- },
- );
- # tags in PDF Metadata dictionary
- %Image::ExifTool::PDF::Metadata = (
- GROUPS => { 2 => 'Document' },
- XML_stream => { # this is the stream for a Subtype /XML dictionary (not a real tag)
- Name => 'XMP',
- SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
- },
- );
- # tags in PDF signature directories (DocMDP, FieldMDP or UR3)
- %Image::ExifTool::PDF::Signature = (
- GROUPS => { 2 => 'Document' },
- ContactInfo => 'SignerContactInfo',
- Location => 'SigningLocation',
- M => {
- Name => 'SigningDate',
- Format => 'date',
- Groups => { 2 => 'Time' },
- PrintConv => '$self->ConvertDateTime($val)',
- },
- Name => 'SigningAuthority',
- Reason => 'SigningReason',
- Reference => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Reference' },
- },
- Prop_AuthTime => {
- Name => 'AuthenticationTime',
- PrintConv => 'ConvertTimeSpan($val) . " ago"',
- },
- Prop_AuthType => 'AuthenticationType',
- );
- # tags in PDF Reference dictionary
- %Image::ExifTool::PDF::Reference = (
- TransformParams => {
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::TransformParams' },
- },
- );
- # tags in PDF TransformParams dictionary
- %Image::ExifTool::PDF::TransformParams = (
- GROUPS => { 2 => 'Document' },
- Annots => {
- Name => 'AnnotationUsageRights',
- Notes => q{
- possible values are Create, Delete, Modify, Copy, Import and Export;
- additional values for UR3 signatures are Online and SummaryView
- },
- List => 1,
- },
- Document => {
- Name => 'DocumentUsageRights',
- Notes => 'only possible value is FullSave',
- List => 1,
- },
- Form => {
- Name => 'FormUsageRights',
- Notes => q{
- possible values are FillIn, Import, Export, SubmitStandalone and
- SpawnTemplate; additional values for UR3 signatures are BarcodePlaintext and
- Online
- },
- List => 1,
- },
- FormEX => {
- Name => 'FormExtraUsageRights',
- Notes => 'UR signatures only; only possible value is BarcodePlaintext',
- List => 1,
- },
- Signature => {
- Name => 'SignatureUsageRights',
- Notes => 'only possible value is Modify',
- List => 1,
- },
- EF => {
- Name => 'EmbeddedFileUsageRights',
- Notes => 'possible values are Create, Delete, Modify and Import',
- List => 1,
- },
- Msg => 'UsageRightsMessage',
- P => {
- Name => 'ModificationPermissions',
- Notes => q{
- 1-3 for DocMDP signatures, default 2; true/false for UR3 signatures, default
- false
- },
- PrintConv => {
- 1 => 'No changes permitted',
- 2 => 'Fill forms, Create page templates, Sign',
- 3 => 'Fill forms, Create page templates, Sign, Create/Delete/Edit annotations',
- 'true' => 'Restrict all applications to reader permissions',
- 'false' => 'Do not restrict applications to reader permissions',
- },
- },
- Action => {
- Name => 'FieldPermissions',
- Notes => 'FieldMDP signatures only',
- PrintConv => {
- 'All' => 'Disallow changes to all form fields',
- 'Include' => 'Disallow changes to specified form fields',
- 'Exclude' => 'Allow changes to specified form fields',
- },
- },
- Fields => {
- Notes => 'FieldMDP signatures only',
- Name => 'FormFields',
- List => 1,
- },
- );
- # unknown tags for use in verbose option
- %Image::ExifTool::PDF::Unknown = (
- GROUPS => { 2 => 'Unknown' },
- );
- #------------------------------------------------------------------------------
- # 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";
- if ($7) {
- my $tz = $7;
- if ($tz =~ /^\s*Z/i) {
- # ignore any "HH'mm'" after the Z (OS X 10.6 does this)
- $date .= 'Z';
- # tolerate some improper formatting in timezone specification
- } elsif ($tz =~ /^\s*([-+])\s*(\d+)[': ]+(\d*)/) {
- $date .= $1 . $2 . ':' . ($3 || '00');
- }
- }
- return $date;
- }
- #------------------------------------------------------------------------------
- # 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
- # (can be 1, 2, 3, 4, etc.. bytes per value)
- my (@t, $j, $k);
- my $w = $$dict{W};
- for ($j=0; $j<3; ++$j) {
- # use default value if W entry is 0 (as per spec)
- # - 0th element defaults to 1, others default to 0
- $$w[$j] or $t[$j] = ($j ? 0 : 1), next;
- $t[$j] = shift(@c);
- for ($k=1; $k < $$w[$j]; ++$k) {
- $t[$j] = 256 * $t[$j] + shift(@c);
- }
- }
- # by default, use "o g R" as the xref key
- # (o = object number, g = generation number)
- my $ref2 = "$objNum $t[2] R";
- if ($t[0] == 1) {
- # normal object reference:
- # $t[1]=offset of object from start, $t[2]=generation number
- $$xref{$ref2} = $t[1];
- } elsif ($t[0] == 2) {
- # compressed object reference:
- # $t[1]=stream object number, $t[2]=index of object in stream
- $ref2 = "$objNum 0 R";
- $$xref{$ref2} = "I$t[2] $t[1] 0 R";
- } elsif ($t[0] == 0) {
- # free object:
- # $t[1]=next free object in linked list, $t[2]=generation number
- $$xref{$ref2} = 0;
- } else {
- # treat as a null object
- $$xref{$ref2} = undef;
- }
- $$xref{$objNum} = $t[1]; # remember offsets by object number too
- return $$xref{$ref} if $ref eq $ref2;
- return 0; # object is free or was reused
- }
- $tot += $count;
- }
- }
- return undef;
- }
- #------------------------------------------------------------------------------
- # 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 ($et, $ref, $xref, $tag) = @_;
- $lastFetched = $ref; # save this for decoding if necessary
- my $offset = LocateAnyObject($xref, $ref);
- $lastOffset = $offset;
- unless ($offset) {
- $et->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($et, $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($et, $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) {
- $et->Warn("Bad index for stream object $tag");
- return undef;
- }
- # extract the object at the specified index in the stream
- # (offsets in table are in sequential order, so we can subract from
- # the next offset to get the object length)
- $offset = $$table[$i + 1];
- my $len = ($$table[$i + 3] || length($$obj{_stream})) - $offset;
- $data = substr($$obj{_stream}, $offset, $len);
- # avoid re-decrypting data in already decrypted streams
- undef $lastFetched if $cryptStream;
- return ExtractObject($et, \$data);
- }
- my $raf = $$et{RAF};
- $raf->Seek($offset, 0) or $et->Warn("Bad $tag offset"), return undef;
- # verify that we are reading the expected object
- $raf->ReadLine($data) or $et->Warn("Error reading $tag data"), return undef;
- ($obj = $ref) =~ s/R/obj/;
- unless ($data =~ s/^$obj//) {
- $et->Warn("$tag object ($obj) not found at $offset");
- return undef;
- }
- # read the first line of data for the object (skipping comments if necessary)
- for (;;) {
- last if $data =~ /\S/ and $data !~ /^\s*%/;
- $raf->ReadLine($data) or $et->Warn("Error reading $tag data"), return undef;
- }
- return ExtractObject($et, \$data, $raf, $xref);
- }
- #------------------------------------------------------------------------------
- # 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);
- } elsif ($c eq "\x0d") {
- # the string is continued if the line ends with '\'
- # (also remove "\x0d\x0a")
- $c .= $1 if $str =~ /\G(\x0a)/g;
- $r = '';
- } elsif ($c eq "\x0a") {
- $r = '';
- } else {
- # convert escaped characters
- ($r = $c) =~ tr/nrtbf/\n\r\t\b\f/;
- }
- substr($str, $n, length($c)+1) = $r;
- # continue search after this character
- pos($str) = $n + length($r);
- }
- Crypt(\$str, $lastFetched) if $cryptString;
- } elsif ($delim eq '<') { # hex string
- # decode hex data
- $str =~ tr/0-9A-Fa-f//dc;
- $str .= '0' if length($str) & 0x01; # (by the spec)
- $str = pack('H*', $str);
- Crypt(\$str, $lastFetched) if $cryptString;
- } elsif ($delim eq '/') { # name
- $str = substr($str, 1);
- # convert escape codes (PDF 1.2 or later)
- $str =~ s/#([0-9a-f]{2})/chr(hex($1))/sgei if $pdfVer >= 1.2;
- }
- return $str;
- }
- #------------------------------------------------------------------------------
- # 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 ($et, $dataPt, $raf, $xref) = @_;
- my (@tags, $data, $objData);
- my $dict = { };
- my $delim;
- for (;;) {
- if ($$dataPt =~ /^\s*(<{1,2}|\[|\()/s) {
- $delim = $1;
- $$dataPt =~ s/^\s+//; # remove leading white space
- $objData = ReadToNested($dataPt, $raf);
- return undef unless defined $objData;
- last;
- } elsif ($$dataPt =~ s{^\s*(\S[^[(/<>\s]*)\s*}{}s) {
- #
- # extract boolean, numerical, string, name, null object or indirect reference
- #
- $objData = $1;
- # look for an indirect reference
- if ($objData =~ /^\d+$/ and $$dataPt =~ s/^(\d+)\s+R//s) {
- $objData .= "$1 R";
- $objData = \$objData; # return scalar reference
- }
- return $objData; # return simple scalar or scalar reference
- }
- $raf and $raf->ReadLine($data) or return undef;
- $$dataPt .= $data;
- }
- #
- # return literal string or hex string without parsing
- #
- if ($delim eq '(' or $delim eq '<') {
- return $objData;
- #
- # extract array
- #
- } elsif ($delim eq '[') {
- $objData =~ /^.*?\[(.*)\]/s or return undef;
- my $data = $1; # brackets removed
- my @list;
- for (;;) {
- last unless $data =~ m{\s*(\S[^[(/<>\s]*)}sg;
- my $val = $1;
- if ($val =~ /^(<{1,2}|\[|\()/) {
- my $pos = pos($data) - length($val);
- # nested dict, array, literal string or hex string
- my $buff = substr($data, $pos);
- $val = ReadToNested(\$buff);
- last unless defined $val;
- pos($data) = $pos + length($val);
- $val = ExtractObject($et, \$val);
- } elsif ($val =~ /^\d/) {
- my $pos = pos($data);
- if ($data =~ /\G\s+(\d+)\s+R/g) {
- $val = \ "$val $1 R"; # make a reference
- } else {
- pos($data) = $pos;
- }
- }
- push @list, $val;
- }
- return \@list;
- }
- #
- # extract dictionary
- #
- # Note: entries are not necessarily separated by whitespace (doh!)
- # eg) "/Tag/Name", "/Tag(string)", "/Tag[array]", etc are legal!
- # Also, they may be separated by a comment (eg. "/Tag%comment\nValue"),
- # but comments have already been removed
- while ($objData =~ m{(\s*)/([^/[\]()<>{}\s]+)\s*(\S[^[(/<>\s]*)}sg) {
- my $tag = $2;
- my $val = $3;
- if ($val =~ /^(<{1,2}|\[|\()/) {
- # nested dict, array, literal string or hex string
- $objData = substr($objData, pos($objData)-length($val));
- $val = ReadToNested(\$objData, $raf);
- last unless defined $val;
- $val = ExtractObject($et, \$val);
- pos($objData) = 0;
- } elsif ($val =~ /^\d/) {
- my $pos = pos($objData);
- if ($objData =~ /\G\s+(\d+)\s+R/sg) {
- $val = \ "$val $1 R"; # make a reference
- } else {
- pos($objData) = $pos;
- }
- }
- if ($$dict{$tag}) {
- # duplicate dictionary entries are not allowed
- $et->Warn("Duplicate '$tag' entry in dictionary (ignored)");
- } else {
- # save the entry
- push @tags, $tag;
- $$dict{$tag} = $val;
- }
- }
- return undef unless @tags;
- $$dict{_tags} = \@tags;
- return $dict unless $raf; # direct objects can not have streams
- #
- # extract the stream object
- #
- # dictionary must specify stream Length
- my $length = $$dict{Length} or return $dict;
- if (ref $length) {
- $length = $$length;
- my $oldpos = $raf->Tell();
- # get the location of the object specifying the length
- # (compressed objects are not allowed)
- my $offset = LocateObject($xref, $length) or return $dict;
- $offset or $et->Warn('Bad Length object'), return $dict;
- $raf->Seek($offset, 0) or $et->Warn('Bad Length offset'), return $dict;
- # verify that we are reading the expected object
- $raf->ReadLine($data) or $et->Warn('Error reading Length data'), return $dict;
- $length =~ s/R/obj/;
- unless ($data =~ /^$length\s+(\d+)?/) {
- $et->Warn("Length object ($length) not found at $offset");
- return $dict;
- }
- if (defined $1) {
- $length = $1;
- } else {
- $raf->ReadLine($data) or $et->Warn('Error reading stream Length'), return $dict;
- $data =~ /^\s*(\d+)/ or $et->Warn('Stream length not found'), return $dict;
- $length = $1;
- }
- $raf->Seek($oldpos, 0); # restore position to start of stream
- }
- # extract the trailing stream data
- for (;;) {
- # find the stream token
- if ($$dataPt =~ /(\S+)/) {
- last unless $1 eq 'stream';
- # read an extra line because it may contain our \x0a
- $$dataPt .= $data if $raf->ReadLine($data);
- # remove our stream header
- $$dataPt =~ s/^\s*stream(\x0a|\x0d\x0a)//s;
- my $more = $length - length($$dataPt);
- if ($more > 0) {
- unless ($raf->Read($data, $more) == $more) {
- $et->Warn('Error reading stream data');
- $$dataPt = '';
- return $dict;
- }
- $$dict{_stream} = $$dataPt . $data;
- $$dataPt = '';
- } elsif ($more < 0) {
- $$dict{_stream} = substr($$dataPt, 0, $length);
- $$dataPt = substr($$dataPt, $length);
- } else {
- $$dict{_stream} = $$dataPt;
- $$dataPt = '';
- }
- last;
- }
- $raf->ReadLine($data) or last;
- $$dataPt .= $data;
- }
- return $dict;
- }
- #------------------------------------------------------------------------------
- # 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
- '(' => ')',
- '[' => ']',
- '<' => '>',
- '<<' => '>>',
- );
- sub ReadToNested($;$)
- {
- my ($dataPt, $raf) = @_;
- my @delim = (''); # closing delimiter list, most deeply nested first
- pos($$dataPt) = 0; # begin at start of data
- for (;;) {
- unless ($$dataPt =~ /(\\*)(\(|\)|<{1,2}|>{1,2}|\[|\]|%)/g) {
- # must read some more data
- my $buff;
- last unless $raf and $raf->ReadLine($buff);
- $$dataPt .= $buff;
- pos($$dataPt) = length($$dataPt) - length($buff);
- next;
- }
- # are we in a literal string?
- if ($delim[0] eq ')') {
- # ignore escaped delimiters (preceded by odd number of \'s)
- next if length($1) & 0x01;
- # ignore all delimiters but unescaped braces
- next unless $2 eq '(' or $2 eq ')';
- } elsif ($2 eq '%') {
- # ignore the comment
- my $pos = pos($$dataPt) - 1;
- # remove everything from '%' up to but not including newline
- $$dataPt =~ /.*/g;
- my $end = pos($$dataPt);
- $$dataPt = substr($$dataPt, 0, $pos) . substr($$dataPt, $end);
- pos($$dataPt) = $pos;
- next;
- }
- if ($closingDelim{$2}) {
- # push the corresponding closing delimiter
- unshift @delim, $closingDelim{$2};
- next;
- }
- unless ($2 eq $delim[0]) {
- # handle the case where we find a ">>>" and interpret it
- # as ">> >" instead of "> >>"
- next unless $2 eq '>>' and $delim[0] eq '>';
- pos($$dataPt) = pos($$dataPt) - 1;
- }
- shift @delim; # remove from nesting list
- next if $delim[0]; # keep going if we have more nested delimiters
- my $pos = pos($$dataPt);
- my $buff = substr($$dataPt, 0, $pos);
- $$dataPt = substr($$dataPt, $pos);
- return $buff; # success!
- }
- return undef; # didn't find matching delimiter
- }
- #------------------------------------------------------------------------------
- # Decode LZW-encoded data (ref 1)
- # Inputs: 0) data reference
- # Returns: true on success and data is decoded, or false and data is untouched
- sub DecodeLZW($)
- {
- my $dataPt = shift;
- return 0 if length $$dataPt < 4;
- my @lzw = (map(chr, 0..255), undef, undef); # LZW code table
- my $mask = 0x01ff; # mask for least-significant 9 bits
- my @dat = unpack 'n*', $$dataPt . "\0";
- my $word = ($dat[0] << 16) | $dat[1];
- my ($bit, $pos, $bits, $out) = (0, 2, 9, '');
- my $lastVal;
- for (;;) {
- # bits are packed MSB first in PDF LZW (the PDF spec doesn't mention this)
- my $shift = 32 - ($bit + $bits);
- if ($shift < 0) {
- return 0 if $pos >= @dat; # missing EOD marker
- $word = (($word & 0xffff) << 16) | $dat[$pos++]; # read next word
- $bit -= 16;
- $shift += 16;
- };
- my $code = ($word >> $shift) & $mask;
- $bit += $bits;
- my $val = $lzw[$code];
- if (defined $val) {
- # store new code as previous sequence plus 1st char of new sequence
- push @lzw, $lastVal . substr($val, 0, 1) if defined $lastVal;
- } elsif ($code == @lzw) { # new code
- return 0 unless defined $lastVal;
- # we are using the code that we are about to generate, so the last
- # character in the new sequence must be the same as the first
- # character in the previous sequence (makes sense if you think about it)
- $val = $lastVal . substr($lastVal, 0, 1);
- push @lzw, $val;
- } elsif ($code == 256) { # clear table
- splice @lzw, 258;
- $bits = 9;
- $mask = 0x1ff;
- undef $lastVal;
- next;
- } elsif ($code == 257) { # EOD marker
- last; # all done!
- } else {
- return 0;
- }
- $out .= $val; # add this byte sequence to the output
- # we added a new entry to the LZW table, so we must increase
- # the bit width if necessary, up to a maximum of 12
- @lzw >= $mask and $bits < 12 and ++$bits, $mask |= $mask << 1;
- $lastVal = $val;
- }
- $$dataPt = $out; # return decompressed data
- return 1;
- }
- #------------------------------------------------------------------------------
- # Decode filtered stream
- # Inputs: 0) ExifTool object reference, 1) dictionary reference
- # Returns: true if stream has been decoded OK
- sub DecodeStream($$)
- {
- local $_;
- my ($et, $dict) = @_;
- return 0 unless $$dict{_stream}; # no stream to decode
- # get list of filters
- my (@filters, @decodeParms, $filter);
- if (ref $$dict{Filter} eq 'ARRAY') {
- @filters = @{$$dict{Filter}};
- } elsif (defined $$dict{Filter}) {
- @filters = ($$dict{Filter});
- }
- # be sure we can process all the filters before we take the time to do the decryption
- foreach $filter (@filters) {
- next if $supportedFilter{$filter};
- $et->WarnOnce("Unsupported Filter $filter");
- return 0;
- }
- # apply decryption first if required (and if the default encryption
- # has not been overridden by a Crypt filter. Note: the Crypt filter
- # must be first in the Filter array: ref 3, page 38)
- unless (defined $$dict{_decrypted} or ($filters[0] and $filters[0] eq '/Crypt')) {
- CryptStream($dict, $lastFetched);
- }
- return 1 unless $$dict{Filter}; # Filter entry is mandatory
- return 0 if defined $$dict{_filtered}; # avoid double-filtering
- $$dict{_filtered} = 1; # set flag to prevent double-filtering
- # get array of DecodeParms dictionaries
- if (ref $$dict{DecodeParms} eq 'ARRAY') {
- @decodeParms = @{$$dict{DecodeParms}};
- } else {
- @decodeParms = ($$dict{DecodeParms});
- }
- foreach $filter (@filters) {
- my $decodeParms = shift @decodeParms;
- if ($filter eq '/FlateDecode') {
- # make sure we support the predictor (if used) before decoding
- my $pre;
- if (ref $decodeParms eq 'HASH') {
- $pre = $$decodeParms{Predictor};
- if ($pre and $pre ne '1' and $pre ne '12') {
- $et->WarnOnce("FlateDecode Predictor $pre currently not supported");
- return 0;
- }
- }
- 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 {
- $et->Warn('Error inflating stream');
- return 0;
- }
- } else {
- $et->WarnOnce('Install Compress::Zlib to process filtered streams');
- return 0;
- }
- next unless $pre and $pre eq '12'; # 12 = 'up' prediction
- # apply anti-predictor
- my $cols = $$decodeParms{Columns};
- unless ($cols) {
- # currently only support 'up' prediction
- $et->WarnOnce('No Columns for decoding stream');
- return 0;
- }
- my @bytes = unpack('C*', $$dict{_stream});
- my @pre = (0) x $cols; # initialize predictor array
- my $buff = '';
- while (@bytes > $cols) {
- unless (($_ = shift @bytes) == 2) {
- $et->WarnOnce("Unsupported PNG filter $_"); # (yes, PNG)
- return 0;
- }
- foreach (@pre) {
- $_ = ($_ + shift(@bytes)) & 0xff;
- }
- $buff .= pack('C*', @pre);
- }
- $$dict{_stream} = $buff;
- } elsif ($filter eq '/Crypt') {
- # (we shouldn't have to check the _decrypted flag since we
- # already checked the _filtered flag, but what the heck...)
- next if defined $$dict{_decrypted};
- # assume Identity filter (the default) if DecodeParms are missing
- next unless ref $decodeParms eq 'HASH';
- my $name = $$decodeParms{Name};
- next unless defined $name or $name eq 'Identity';
- if ($name ne 'StdCF') {
- $et->WarnOnce("Unsupported Crypt Filter $name");
- return 0;
- }
- unless ($cryptInfo) {
- $et->WarnOnce('Missing Encrypt StdCF entry');
- return 0;
- }
- # decrypt the stream manually because we want to:
- # 1) ignore $cryptStream (StmF) setting
- # 2) ignore EncryptMetadata setting (I can't find mention of how to
- # reconcile this in the spec., but this would make sense)
- # 3) avoid adding the crypt key extension (ref 3, page 58, Algorithm 1b)
- # 4) set _decrypted flag so we will recrypt according to StmF when
- # writing (since we don't yet write Filter'd streams)
- Crypt(\$$dict{_stream}, 'none');
- $$dict{_decrypted} = ($cryptStream ? 1 : 0);
- } elsif ($filter eq '/LZWDecode') {
- # make sure we don't have any unsupported decoding parameters
- if (ref $decodeParms eq 'HASH') {
- if ($$decodeParms{Predictor}) {
- $et->WarnOnce("LZWDecode Predictor $$decodeParms{Predictor} currently not supported");
- return 0;
- } elsif ($$decodeParms{EarlyChange}) {
- $et->WarnOnce("LZWDecode EarlyChange currently not supported");
- return 0;
- }
- }
- unless (DecodeLZW(\$$dict{_stream})) {
- $et->WarnOnce('LZW decompress error');
- return 0;
- }
- } elsif ($filter eq '/ASCIIHexDecode') {
- $$dict{_stream} =~ s/>.*//; # truncate at '>' (end of data mark)
- $$dict{_stream} =~ tr/0-9a-zA-Z//d; # remove illegal characters
- $$dict{_stream} = pack 'H*', $$dict{_stream};
- }
- }
- return 1;
- }
- #------------------------------------------------------------------------------
- # 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}};
- my @data = unpack('C*', $$dataPt);
- foreach (@data) {
- $x = ($x + 1) & 0xff;
- my $stx = $$state[$x];
- $y = ($stx + $y) & 0xff;
- my $sty = $$state[$x] = $$state[$y];
- $$state[$y] = $stx;
- $_ ^= $$state[($stx + $sty) & 0xff];
- }
- $$key{XY} = [ $x, $y ];
- $$dataPt = pack('C*', @data);
- }
- #------------------------------------------------------------------------------
- # Update AES cipher with a bit of data
- # Inputs: 0) data
- # Returns: encrypted data
- my $cipherMore;
- sub CipherUpdate($)
- {
- my $dat = shift;
- my $pos = 0;
- $dat = $cipherMore . $dat if length $dat;
- while ($pos + 16 <= length($dat)) {
- substr($dat,$pos,16) = Image::ExifTool::AES::Cipher(substr($dat,$pos,16));
- $pos += 16;
- }
- if ($pos < length $dat) {
- $cipherMore = substr($dat,$pos);
- $dat = substr($dat,0,$pos);
- } else {
- $cipherMore = '';
- }
- return $dat;
- }
- #------------------------------------------------------------------------------
- # Get encrypted hash
- # Inputs: 0) Password, 1) salt, 2) vector, 3) encryption revision
- # Returns: hash
- sub GetHash($$$$)
- {
- my ($password, $salt, $vector, $rev) = @_;
- # return Rev 5 hash
- return Digest::SHA::sha256($password, $salt, $vector) if $rev == 5;
- # compute Rev 6 hardened hash
- # (ref http://code.google.com/p/origami-pdf/source/browse/lib/origami/encryption.rb)
- my $blockSize = 32;
- my $input = Digest::SHA::sha256($password, $salt, $vector) . ("\0" x 32);
- my $key = substr($input, 0, 16);
- my $iv = substr($input, 16, 16);
- my $h;
- my $x = '';
- my $i = 0;
- while ($i < 64 or $i < ord(substr($x,-1,1))+32) {
- my $block = substr($input, 0, $blockSize);
- $x = '';
- Image::ExifTool::AES::Crypt(\$x, $key, $iv, 1);
- $cipherMore = '';
- my ($j, $digest);
- for ($j=0; $j<64; ++$j) {
- $x = '';
- $x .= CipherUpdate($password) if length $password;
- $x .= CipherUpdate($block);
- $x .= CipherUpdate($vector) if length $vector;
- if ($j == 0) {
- my @a = unpack('C16', $x);
- my $sum = 0;
- $sum += $_ foreach @a;
- # set SHA block size (32, 48 or 64 bytes = SHA-256, 384 or 512)
- $blockSize = 32 + ($sum % 3) * 16;
- $digest = Digest::SHA->new($blockSize * 8);
- }
- $digest->add($x);
- }
- $h = $digest->digest();
- $key = substr($h, 0, 16);
- substr($input,0,16) = $h;
- $iv = substr($h, 16, 16);
- ++$i;
- }
- return substr($h, 0, 32);
- }
- #------------------------------------------------------------------------------
- # 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 ($et, $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('Image::ExifTool::PDF::Encrypt');
- $et->HandleTag($tagTablePtr, 'Filter', $enc);
- if ($filt ne 'Standard') {
- return "Encryption filter $filt currently not 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';
- }
- if ("$ver.$rev" >= 5.6) {
- # apologize for poor performance (AES is a pure Perl implementation)
- $et->Warn('Decryption is very slow for encryption V5.6 or higher', 1);
- }
- $et->HandleTag($tagTablePtr, 'P', $$encrypt{P});
- my %parm; # optional parameters extracted from Encrypt dictionary
- 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
- ref $$encrypt{CF}{StdCF} eq 'HASH' and $$encrypt{CF}{StdCF}{CFM};
- my $cryptMeth = $$encrypt{CF}{StdCF}{CFM};
- unless ($cryptMeth =~ /^\/(V2|AESV2|AESV3)$/) {
- return "Unsupported encryption method $cryptMeth";
- }
- # set "_aesv2" or "_aesv3" flag in %$encrypt hash if AES encryption was used
- $$encrypt{'_' . lc($1)} = 1 if $cryptMeth =~ /^\/(AESV2|AESV3)$/;
- }
- if ($ver == 5) {
- # validate OE and UE entries
- foreach ('OE', 'UE') {
- return "Missing Encrypt $_ entry" unless $$encrypt{$_};
- $parm{$_} = ReadPDFValue($$encrypt{$_});
- return "Invalid Encrypt $_ entry" unless length $parm{$_} == 32;
- }
- require Image::ExifTool::AES; # will need this later
- }
- } else {
- return "Encryption version $ver currently not supported";
- }
- $id or return "Can't decrypt (no document ID)";
- # make sure we have the necessary libraries available
- if ($ver < 5) {
- unless (eval { require Digest::MD5 }) {
- return "Install Digest::MD5 to process encrypted PDF";
- }
- } else {
- unless (eval { require Digest::SHA }) {
- return "Install Digest::SHA to process AES-256 encrypted PDF";
- }
- }
- # calculate file-level en/decryption key
- my $pad = "\x28\xBF\x4E\x5E\x4E\x75\x8A\x41\x64\x00\x4E\x56\xFF\xFA\x01\x08".
- "\x2E\x2E\x00\xB6\xD0\x68\x3E\x80\x2F\x0C\xA9\xFE\x64\x53\x69\x7A";
- my $o = ReadPDFValue($$encrypt{O});
- my $u = ReadPDFValue($$encrypt{U});
- # set flag indicating whether metadata is encrypted
- # (in version 4 and higher, metadata streams may not be encrypted)
- if ($ver < 4 or not $$encrypt{EncryptMetadata} or $$encrypt{EncryptMetadata} !~ /false/i) {
- $$encrypt{_meta} = 1;
- }
- # try no password first, then try provided password if available
- my ($try, $key);
- for ($try=0; ; ++$try) {
- my $password;
- if ($try == 0) {
- $password = '';
- } elsif ($try == 1) {
- $password = $et->Options('Password');
- return 'Document is password protected (use Password option)' unless defined $password;
- # make sure there is no UTF-8 flag on the password
- if ($] >= 5.006 and (eval { require Encode; Encode::is_utf8($password) } or $@)) {
- # repack by hand if Encode isn't available
- $password = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$password)) : Encode::encode('utf8',$password);
- }
- } else {
- return 'Incorrect password';
- }
- if ($ver < 5) {
- if (length $password) {
- # password must be encoding in PDFDocEncoding (ref iso32000)
- $password = $et->Encode($password, 'PDFDoc');
- # truncate or pad the password to exactly 32 bytes
- if (length($password) > 32) {
- $password = substr($password, 0, 32);
- } elsif (length($password) < 32) {
- $password .= substr($pad, 0, 32-length($password));
- }
- } else {
- $password = $pad;
- }
- $key = $password . $o . pack('V', $$encrypt{P}) . $id;
- my $rep = 1;
- if ($rev == 3 or $rev == 4) {
- # must add this if metadata not encrypted
- $key .= "\xff\xff\xff\xff" unless $$encrypt{_meta};
- $rep += 50; # repeat MD5 50 more times if revision is 3 or greater
- }
- my ($len, $i, $dat);
- if ($ver == 1) {
- $len = 5;
- } else {
- $len = $$encrypt{Length} || 40;
- $len >= 40 or return 'Bad Encrypt Length';
- $len = int($len / 8);
- }
- for ($i=0; $i<$rep; ++$i) {
- $key = substr(Digest::MD5::md5($key), 0, $len);
- }
- # decrypt U to see if a user password is required
- if ($rev >= 3) {
- $dat = Digest::MD5::md5($pad . $id);
- RC4Crypt(\$dat, $key);
- for ($i=1; $i<=19; ++$i) {
- my @key = unpack('C*', $key);
- foreach (@key) { $_ ^= $i; }
- RC4Crypt(\$dat, pack('C*', @key));
- }
- $dat .= substr($u, 16);
- } else {
- $dat = $pad;
- RC4Crypt(\$dat, $key);
- }
- last if $dat eq $u; # all done if this was the correct key
- } else {
- return 'Invalid O or U Encrypt entries' if length($o) < 48 or length($u) < 48;
- if (length $password) {
- # Note: this should be good for passwords containing reasonable characters,
- # but to be bullet-proof we need to apply the SASLprep (IETF RFC 4013) profile
- # of stringprep (IETF RFC 3454) to the password before encoding in UTF-8
- $password = $et->Encode($password, 'UTF8');
- $password = substr($password, 0, 127) if length($password) > 127;
- }
- # test for the owner password
- my $sha = GetHash($password, substr($o,32,8), substr($u,0,48), $rev);
- if ($sha eq substr($o, 0, 32)) {
- $key = GetHash($password, substr($o,40,8), substr($u,0,48), $rev);
- my $dat = ("\0" x 16) . $parm{OE};
- # decrypt with no padding
- my $err = Image::ExifTool::AES::Crypt(\$dat, $key, 0, 1);
- return $err if $err;
- $key = $dat; # use this as the file decryption key
- last;
- }
- # test for the user password
- $sha = GetHash($password, substr($u,32,8), '', $rev);
- if ($sha eq substr($u, 0, 32)) {
- $key = GetHash($password, substr($u,40,8), '', $rev);
- my $dat = ("\0" x 16) . $parm{UE};
- my $err = Image::ExifTool::AES::Crypt(\$dat, $key, 0, 1);
- return $err if $err;
- $key = $dat; # use this as the file decryption key
- last;
- }
- }
- }
- $$encrypt{_key} = $key; # save the file-level encryption key
- $cryptInfo = $encrypt; # save reference to the file-level Encrypt object
- return undef; # success!
- }
- #------------------------------------------------------------------------------
- # 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;
- my $err = Image::ExifTool::AES::Crypt($dataPt, $key, $encrypt);
- $err and $$cryptInfo{_error} = $err;
- } else {
- RC4Crypt($dataPt, $key);
- }
- }
- #------------------------------------------------------------------------------
- # 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 ($et, $tagTablePtr, $dict, $xref, $nesting, $type) = @_;
- $et->HandleTag($tagTablePtr, '_has_xfa', $$dict{XFA} ? 'true' : 'false');
- return ProcessDict($et, $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 ($et, $tagTablePtr, $dict, $xref, $nesting, $type) = @_;
- my $verbose = $et->Options('Verbose');
- my $unknown = $$tagTablePtr{EXTRACT_UNKNOWN};
- my $embedded = (defined $unknown and not $unknown and $et->Options('ExtractEmbedded'));
- my @tags = @{$$dict{_tags}};
- my ($next, %join);
- my $index = 0;
- $nesting = ($nesting || 0) + 1;
- if ($nesting > 50) {
- $et->WarnOnce('Nesting too deep (directory ignored)');
- return;
- }
- # save entire dictionary for rewriting if specified
- if ($$et{PDF_CAPTURE} and $$tagTablePtr{VARS} and
- $tagTablePtr->{VARS}->{CAPTURE})
- {
- my $name;
- foreach $name (@{$tagTablePtr->{VARS}->{CAPTURE}}) {
- next if $$et{PDF_CAPTURE}{$name};
- # make sure we load the right type if indicated
- next if $type and $type ne $name;
- $$et{PDF_CAPTURE}{$name} = $dict;
- last;
- }
- }
- #
- # extract information from all tags in the dictionary
- #
- for (;;) {
- my ($tag, $isSubDoc);
- if (@tags) {
- $tag = shift @tags;
- } elsif (defined $next and not $next) {
- $tag = 'Next';
- $next = 1;
- } else {
- last;
- }
- my $val = $$dict{$tag};
- my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
- if ($tagInfo) {
- undef $tagInfo if $$tagInfo{NoProcess};
- } elsif ($embedded and $tag =~ /^(.*?)(\d+)$/ and
- $$tagTablePtr{$1} and (ref $val ne 'SCALAR' or not $fetched{$$val}))
- {
- my ($name, $num) = ($1, $2);
- $tagInfo = $et->GetTagInfo($tagTablePtr, $name);
- if (ref $tagInfo eq 'HASH' and $$tagInfo{JoinStreams}) {
- $fetched{$$val} = 1;
- my $obj = FetchObject($et, $$val, $xref, $tag);
- $join{$name} = [] unless $join{$name};
- next unless ref $obj eq 'HASH' and $$obj{_stream};
- # save all the stream data to join later
- DecodeStream($et, $obj);
- $join{$name}->[$num] = $$obj{_stream};
- undef $tagInfo; # don't process
- } else {
- $isSubDoc = 1; # treat as a sub-document
- }
- }
- if ($verbose) {
- my ($val2, $extra);
- if (ref $val eq 'SCALAR') {
- $extra = ", indirect object ($$val)";
- if ($fetched{$$val}) {
- $val2 = "ref($$val)";
- } elsif ($tag eq 'Next' and not $next) {
- # handle 'Next' links after all others
- $next = 0;
- next;
- } else {
- $fetched{$$val} = 1;
- $val = FetchObject($et, $$val, $xref, $tag);
- unless (defined $val) {
- my $str;
- if (defined $lastOffset) {
- $val2 = '<free>';
- $str = 'Object was freed';
- } else {
- $val2 = '<err>';
- $str = 'Error reading object';
- }
- $et->VPrint(0, "$$et{INDENT}${str}:\n");
- }
- }
- } elsif (ref $val eq 'HASH') {
- $extra = ', direct dictionary';
- } elsif (ref $val eq 'ARRAY') {
- $extra = ', direct array of ' . scalar(@$val) . ' objects';
- } else {
- $extra = ', direct object';
- }
- my $isSubdir;
- if (ref $val eq 'HASH') {
- $isSubdir = 1;
- } elsif (ref $val eq 'ARRAY') {
- # recurse into objects in arrays only if they are lists of
- # dictionaries or indirect objects which could be dictionaries
- $isSubdir = 1 if @$val;
- foreach (@$val) {
- next if ref $_ eq 'HASH' or ref $_ eq 'SCALAR';
- undef $isSubdir;
- last;
- }
- }
- if ($isSubdir) {
- # create bogus subdirectory to recurse into this dict
- $tagInfo or $tagInfo = {
- Name => $tag,
- SubDirectory => { TagTable => 'Image::ExifTool::PDF::Unknown' },
- };
- } else {
- if (ref $val eq 'ARRAY') {
- my @list = @$val;
- foreach (@list) {
- $_ = "ref($$_)" if ref $_ eq 'SCALAR';
- $_ = '<undef>' unless defined $_;
- }
- $val2 = '[' . join(',',@list) . ']';
- }
- # generate tag info if we will use it later
- if (not $tagInfo and defined $val and $unknown) {
- $tagInfo = NewPDFTag($tagTablePtr, $tag);
- }
- }
- $et->VerboseInfo($tag, $tagInfo,
- Value => $val2 || $val,
- Extra => $extra,
- Index => $index++,
- );
- next unless defined $val;
- }
- unless ($tagInfo) {
- # add any tag found in Info dictionary to table
- next unless $unknown;
- $tagInfo = NewPDFTag($tagTablePtr, $tag);
- }
- # increment document number if necessary
- my ($oldDocNum, $oldNumTags);
- if ($isSubDoc) {
- $oldDocNum = $$et{DOC_NUM};
- $oldNumTags = $$et{NUM_FOUND};
- $$et{DOC_NUM} = ++$$et{DOC_COUNT};
- }
- if ($$tagInfo{SubDirectory}) {
- # process the subdirectory
- my @subDicts;
- if (ref $val eq 'ARRAY') {
- @subDicts = @{$val};
- } else {
- @subDicts = ( $val );
- }
- # loop through all values of this tag
- for (;;) {
- my $subDict = shift @subDicts or last;
- # save last fetched object in case we fetch another one here
- my $prevFetched = $lastFetched;
- if (ref $subDict eq 'SCALAR') {
- # only fetch once (other copies are obsolete)
- next if $fetched{$$subDict};
- if ($$tagInfo{IgnoreDuplicates}) {
- my $flag = "ProcessedPDF_$tag";
- if ($$et{$flag}) {
- next if $et->WarnOnce("Ignored duplicate $tag dictionary", 2);
- } else {
- $$et{$flag} = 1;
- }
- }
- # load dictionary via an indirect reference
- $fetched{$$subDict} = 1;
- my $obj = FetchObject($et, $$subDict, $xref, $tag);
- unless (defined $obj) {
- unless (defined $lastOffset) {
- $et->Warn("Error reading $tag object ($$subDict)");
- }
- next;
- }
- $subDict = $obj;
- }
- if (ref $subDict eq 'ARRAY') {
- # convert array of key/value pairs to a hash
- next if @$subDict < 2;
- my %hash = ( _tags => [] );
- while (@$subDict >= 2) {
- my $key = shift @$subDict;
- $key =~ s/^\///;
- push @{$hash{_tags}}, $key;
- $hash{$key} = shift @$subDict;
- }
- $subDict = \%hash;
- } else {
- next unless ref $subDict eq 'HASH';
- }
- # set flag to re-crypt all strings when rewriting if the dictionary
- # came from an encrypted stream
- $$subDict{_needCrypt}{'*'} = 1 unless $lastFetched;
- my $subTablePtr = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
- if (not $verbose) {
- my $proc = $$subTablePtr{PROCESS_PROC} || \&ProcessDict;
- &$proc($et, $subTablePtr, $subDict, $xref, $nesting);
- } elsif ($next) {
- # handle 'Next' links at this level to avoid deep recursion
- undef $next;
- $index = 0;
- $tagTablePtr = $subTablePtr;
- $dict = $subDict;
- @tags = @{$$subDict{_tags}};
- $et->VerboseDir($tag, scalar(@tags));
- } else {
- my $oldIndent = $$et{INDENT};
- my $oldDir = $$et{DIR_NAME};
- $$et{INDENT} .= '| ';
- $$et{DIR_NAME} = $tag;
- $et->VerboseDir($tag, scalar(@{$$subDict{_tags}}));
- ProcessDict($et, $subTablePtr, $subDict, $xref, $nesting);
- $$et{INDENT} = $oldIndent;
- $$et{DIR_NAME} = $oldDir;
- }
- $lastFetched = $prevFetched;
- }
- } else {
- # fetch object if necessary
- # (OS X 10.6 writes indirect objects in the Info dictionary!)
- if (ref $val eq 'SCALAR') {
- my $prevFetched = $lastFetched;
- # (note: fetching the same object multiple times is OK here)
- $val = FetchObject($et, $$val, $xref, $tag);
- if (defined $val) {
- $val = ReadPDFValue($val);
- # set flag to re-encrypt if necessary if rewritten
- $$dict{_needCrypt}{$tag} = ($lastFetched ? 0 : 1) if $cryptString;
- $lastFetched = $prevFetched; # restore last fetched object reference
- }
- } else {
- $val = ReadPDFValue($val);
- }
- # convert from UTF-16 (big endian) to UTF-8 or Latin if necessary
- # unless this is binary data (hex-encoded strings would not have been converted)
- if (ref $val) {
- if (ref $val eq 'ARRAY') {
- my $v;
- foreach $v (@$val) {
- $et->FoundTag($tagInfo, $v);
- }
- }
- } elsif (defined $val) {
- my $format = $$tagInfo{Format} || $$tagInfo{Writable} || 'string';
- $val = ConvertPDFDate($val) if $format eq 'date';
- if (not $$tagInfo{Binary} and $val =~ /[\x18-\x1f\x80-\xff]/) {
- # text string is already in Unicode if it starts with "\xfe\xff",
- # otherwise we must first convert from PDFDocEncoding
- $val = $et->Decode($val, ($val=~s/^\xfe\xff// ? 'UCS2' : 'PDFDoc'), 'MM');
- }
- if ($$tagInfo{List} and not $$et{OPTIONS}{NoPDFList}) {
- # separate tokens in comma or whitespace delimited lists
- my @values = ($val =~ /,/) ? split /,+\s*/, $val : split ' ', $val;
- foreach $val (@values) {
- $et->FoundTag($tagInfo, $val);
- }
- } else {
- # a simple tag value
- $et->FoundTag($tagInfo, $val);
- }
- }
- }
- if ($isSubDoc) {
- # restore original document number
- $$et{DOC_NUM} = $oldDocNum;
- --$$et{DOC_COUNT} if $oldNumTags == $$et{NUM_FOUND};
- }
- }
- #
- # extract information from joined streams if necessary
- #
- 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) {
- $buff .= $$list[$i];
- undef $$list[$i]; # free memory
- }
- # increment document number for tags extracted from embedded EPS
- my $oldDocNum = $$et{DOC_NUM};
- my $oldNumTags = $$et{NUM_FOUND};
- $$et{DOC_NUM} = ++$$et{DOC_COUNT};
- # extract PostScript information
- $et->HandleTag($tagTablePtr, $tag, $buff);
- $$et{DOC_NUM} = $oldDocNum;
- # revert document counter if we didn't add any new tags
- --$$et{DOC_COUNT} if $oldNumTags == $$et{NUM_FOUND};
- delete $$et{DOC_NUM};
- }
- }
- #
- # extract information from stream object if it exists (eg. Metadata stream)
- #
- for (;;) { # (cheap goto)
- last unless $$dict{_stream};
- my $tag = '_stream';
- # add Subtype (if it exists) to stream name and remove leading '/'
- ($tag = $$dict{Subtype} . $tag) =~ s/^\/// if $$dict{Subtype};
- last unless $$tagTablePtr{$tag};
- my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag) or last;
- unless ($$tagInfo{SubDirectory}) {
- # don't build filter lists across different images
- delete $$et{LIST_TAGS}{$$tagTablePtr{Filter}};
- # we arrive here only when extracting embedded images
- # - only extract known image types and ignore others
- my $filter = $$dict{Filter} || '';
- $filter = @$filter[-1] if ref $filter eq 'ARRAY'; # (get last Filter type)
- my $result;
- if ($filter eq '/DCTDecode' or $filter eq '/JPXDecode') {
- DecodeStream($et, $dict) or last;
- # save the image itself
- $et->FoundTag($tagInfo, \$$dict{_stream});
- # extract information from embedded image
- $result = $et->ExtractInfo(\$$dict{_stream}, { ReEntry => 1 });
- }
- unless ($result) {
- $et->FoundTag('FileType', defined $result ? '(unknown)' : '(unsupported)');
- }
- last;
- }
- # decode stream if necessary
- DecodeStream($et, $dict) or last;
- if ($verbose > 2) {
- $et->VPrint(2,"$$et{INDENT}$$et{DIR_NAME} stream data\n");
- my %parms = ( Prefix => $$et{INDENT} );
- $parms{MaxLen} = $verbose > 3 ? 1024 : 96 if $verbose < 5;
- HexDump(\$$dict{_stream}, undef, %parms);
- }
- # extract information from stream
- my %dirInfo = (
- DataPt => \$$dict{_stream},
- DataLen => length $$dict{_stream},
- DirStart => 0,
- DirLen => length $$dict{_stream},
- Parent => 'PDF',
- );
- my $subTablePtr = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
- unless ($et->ProcessDirectory(\%dirInfo, $subTablePtr)) {
- $et->Warn("Error processing $$tagInfo{Name} information");
- }
- last;
- }
- }
- #------------------------------------------------------------------------------
- # 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 ($et, $dirInfo) = @_;
- my $raf = $$dirInfo{RAF};
- my $verbose = $et->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;
- $et->SetFileType(); # set the FileType tag
- $et->Warn("May not be able to read a PDF version $pdfVer file") if $pdfVer >= 2.0;
- # store PDFVersion tag
- my $tagTablePtr = GetTagTable('Image::ExifTool::PDF::Root');
- $et->HandleTag($tagTablePtr, 'Version', $pdfVer);
- $tagTablePtr = GetTagTable('Image::ExifTool::PDF::Main');
- #
- # check for a linearized PDF (only if reading)
- #
- my $capture = $$et{PDF_CAPTURE};
- unless ($capture) {
- my $lin = 'false';
- if ($buff =~ /<</g) {
- $buff = substr($buff, pos($buff) - 2);
- my $dict = ExtractObject($et, \$buff);
- if (ref $dict eq 'HASH' and $$dict{Linearized} and $$dict{L}) {
- if (not $$et{VALUE}{FileSize}) {
- undef $lin; # can't determine if it is linearized
- } elsif ($$dict{L} == $$et{VALUE}{FileSize}) {
- $lin = 'true';
- }
- }
- }
- $et->HandleTag($tagTablePtr, '_linearized', $lin) if $lin;
- }
- #
- # read the xref tables referenced from startxref at the end of the file
- #
- my @xrefOffsets;
- $raf->Seek(0, 2) or return -2;
- # the %%EOF must occur within the last 1024 bytes of the file (PDF spec, appendix H)
- my $len = $raf->Tell();
- $len = 1024 if $len > 1024;
- $raf->Seek(-$len, 2) or return -2;
- $raf->Read($buff, $len) == $len or return -3;
- # find the LAST xref table in the file (may be multiple %%EOF marks)
- $buff =~ /^.*startxref(\s+)(\d+)(\s+)%%EOF/s or return -4;
- my $ws = $1 . $3;
- my $xr = $2;
- push @xrefOffsets, $xr, 'Main';
- # set input record separator
- local $/ = $ws =~ /(\x0d\x0a|\x0d|\x0a)/ ? $1 : "\x0a";
- my (%xref, @mainDicts, %loaded, $mainFree);
- # initialize variables to capture when rewriting
- if ($capture) {
- $capture->{startxref} = $xr;
- $capture->{xref} = \%xref;
- $capture->{newline} = $/;
- $capture->{mainFree} = $mainFree = { };
- }
- XRef:
- while (@xrefOffsets) {
- my $offset = shift @xrefOffsets;
- my $type = shift @xrefOffsets;
- next if $loaded{$offset}; # avoid infinite recursion
- unless ($raf->Seek($offset, 0)) {
- %loaded or return -5;
- $et->Warn('Bad offset for secondary xref table');
- next;
- }
- # Note: care must be taken because ReadLine may read more than we want if
- # the newline sequence for this table is different than the rest of the file
- for (;;) {
- unless ($raf->ReadLine($buff)) {
- %loaded or return -6;
- $et->Warn('Bad offset for secondary xref table');
- next XRef;
- }
- last if $buff =~/\S/; # skip blank lines
- }
- my $loadXRefStream;
- if ($buff =~ s/^\s*xref\s+//s) {
- # load xref table
- for (;;) {
- # read another line if necessary (skipping blank lines)
- $raf->ReadLine($buff) or return -6 until $buff =~ /\S/;
- last if $buff =~ s/^\s*trailer([\s<[(])/$1/s;
- $buff =~ s/^\s*(\d+)\s+(\d+)\s+//s or return -4;
- my ($start, $num) = ($1, $2);
- $raf->Seek(-length($buff), 1) or return -4;
- my $i;
- for ($i=0; $i<$num; ++$i) {
- $raf->Read($buff, 20) == 20 or return -6;
- $buff =~ /^\s*(\d{10}) (\d{5}) (f|n)/s or return -4;
- my $num = $start + $i;
- # save offset for newest copy of all objects
- # (or next object number for free objects)
- unless (defined $xref{$num}) {
- my ($offset, $gen) = (int($1), int($2));
- $xref{$num} = $offset;
- if ($3 eq 'f') {
- # save free objects in last xref table for rewriting
- $$mainFree{$num} = [ $offset, $gen, 'f' ] if $mainFree;
- next;
- }
- # also save offset keyed by object reference string
- $xref{"$num $gen R"} = $offset;
- }
- }
- # (I have a sample from Adobe which has an empty xref table)
- # %xref or return -4; # xref table may not be empty
- $buff = '';
- }
- undef $mainFree; # only do this for the last xref table
- } elsif ($buff =~ s/^\s*(\d+)\s+(\d+)\s+obj//s) {
- # this is a PDF-1.5 cross-reference stream dictionary
- $loadXRefStream = 1;
- } else {
- %loaded or return -4;
- $et->Warn('Invalid secondary xref table');
- next;
- }
- my $mainDict = ExtractObject($et, \$buff, $raf, \%xref);
- unless (ref $mainDict eq 'HASH') {
- %loaded or return -8;
- $et->Warn('Error loading secondary dictionary');
- next;
- }
- if ($loadXRefStream) {
- # decode and save our XRef stream from PDF-1.5 file
- # (but parse it later as required to save time)
- # Note: this technique can potentially result in an old object
- # being used if the file was incrementally updated and an older
- # object from an xref table was replaced by a newer object in an
- # xref stream. But doing so isn't a good idea (if allowed at all)
- # because a PDF 1.4 consumer would also make this same mistake.
- if ($$mainDict{Type} eq '/XRef' and $$mainDict{W} and
- @{$$mainDict{W}} > 2 and $$mainDict{Size} and
- DecodeStream($et, $mainDict))
- {
- # create Index entry if it doesn't exist
- $$mainDict{Index} or $$mainDict{Index} = [ 0, $$mainDict{Size} ];
- # create '_entry_size' entry for internal use
- my $w = $$mainDict{W};
- my $size = 0;
- foreach (@$w) { $size += $_; }
- $$mainDict{_entry_size} = $size;
- # save this stream dictionary to use later if required
- $xref{dicts} = [] unless $xref{dicts};
- push @{$xref{dicts}}, $mainDict;
- } else {
- %loaded or return -9;
- $et->Warn('Invalid xref stream in secondary dictionary');
- }
- }
- $loaded{$offset} = 1;
- # load XRef stream in hybrid file if it exists
- push @xrefOffsets, $$mainDict{XRefStm}, 'XRefStm' if $$mainDict{XRefStm};
- $encrypt = $$mainDict{Encrypt} if $$mainDict{Encrypt};
- if ($$mainDict{ID} and ref $$mainDict{ID} eq 'ARRAY') {
- $id = ReadPDFValue($mainDict->{ID}->[0]);
- }
- push @mainDicts, $mainDict, $type;
- # load previous xref table if it exists
- push @xrefOffsets, $$mainDict{Prev}, 'Prev' if $$mainDict{Prev};
- }
- #
- # extract encryption information if necessary
- #
- if ($encrypt) {
- if (ref $encrypt eq 'SCALAR') {
- $encrypt = FetchObject($et, $$encrypt, \%xref, 'Encrypt');
- }
- # generate Encryption tag information
- my $err = DecryptInit($et, $encrypt, $id);
- if ($err) {
- $et->Warn($err);
- $$capture{Error} = $err if $capture;
- return -1;
- }
- }
- #
- # extract the information beginning with each of the main dictionaries
- #
- my $i = 0;
- my $num = (scalar @mainDicts) / 2;
- while (@mainDicts) {
- my $dict = shift @mainDicts;
- my $type = shift @mainDicts;
- if ($verbose) {
- ++$i;
- my $n = scalar(@{$$dict{_tags}});
- $et->VPrint(0, "PDF dictionary ($i of $num) with $n entries:\n");
- }
- ProcessDict($et, $tagTablePtr, $dict, \%xref, 0, $type);
- }
- # handle any decryption errors
- if ($encrypt) {
- my $err = $$encrypt{_error};
- if ($err) {
- $et->Warn($err);
- $$capture{Error} = $err if $capture;
- return -1;
- }
- }
- return 1;
- }
- #------------------------------------------------------------------------------
- # 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
- sub ProcessPDF($$)
- {
- my ($et, $dirInfo) = @_;
- undef $cryptInfo; # (must not delete after returning so writer can use it)
- undef $cryptStream;
- undef $cryptString;
- my $result = ReadPDF($et, $dirInfo);
- if ($result < 0) {
- $et->Warn($pdfWarning{$result}) if $pdfWarning{$result};
- $result = 1;
- }
- # clean up and return
- undef %streamObjs;
- undef %fetched;
- return $result;
- }
- 1; # end
- __END__
- =head1 NAME
- Image::ExifTool::PDF - Read PDF meta information
- =head1 SYNOPSIS
- This module is loaded automatically by Image::ExifTool when required.
- =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
- 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 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
- =head1 SEE ALSO
- L<Image::ExifTool::TagNames/PDF Tags>,
- L<Image::ExifTool(3pm)|Image::ExifTool>
- =cut
|