PDF.pm 87 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339
  1. #------------------------------------------------------------------------------
  2. # File: PDF.pm
  3. #
  4. # Description: Read PDF meta information
  5. #
  6. # Revisions: 07/11/2005 - P. Harvey Created
  7. # 07/25/2005 - P. Harvey Add support for encrypted documents
  8. #
  9. # References: 1) http://www.adobe.com/devnet/pdf/pdf_reference.html
  10. # 2) http://search.cpan.org/dist/Crypt-RC4/
  11. # 3) http://www.adobe.com/devnet/acrobat/pdfs/PDF32000_2008.pdf
  12. # 4) http://www.adobe.com/content/dam/Adobe/en/devnet/pdf/pdfs/adobe_supplement_iso32000.pdf
  13. # 5) http://tools.ietf.org/search/rfc3454
  14. # 6) http://www.armware.dk/RFC/rfc/rfc4013.html
  15. #------------------------------------------------------------------------------
  16. package Image::ExifTool::PDF;
  17. use strict;
  18. use vars qw($VERSION $AUTOLOAD $lastFetched);
  19. use Image::ExifTool qw(:DataAccess :Utils);
  20. require Exporter;
  21. $VERSION = '1.40';
  22. sub FetchObject($$$$);
  23. sub ExtractObject($$;$$);
  24. sub ReadToNested($;$);
  25. sub ProcessDict($$$$;$$);
  26. sub ProcessAcroForm($$$$;$$);
  27. sub ReadPDFValue($);
  28. sub CheckPDF($$$);
  29. # $lastFetched - last fetched object reference (used for decryption)
  30. # (undefined if fetched object was already decrypted, eg. object from stream)
  31. my $cryptInfo; # encryption object reference (plus additional information)
  32. my $cryptString; # flag that strings are encrypted
  33. my $cryptStream; # flag that streams are encrypted
  34. my $lastOffset; # last fetched object offset
  35. my %streamObjs; # hash of stream objects
  36. my %fetched; # dicts fetched in verbose mode (to avoid cyclical recursion)
  37. my $pdfVer; # version of PDF file being processed
  38. # filters supported in DecodeStream()
  39. my %supportedFilter = (
  40. '/FlateDecode' => 1,
  41. '/Crypt' => 1,
  42. '/Identity' => 1, # (not filtered)
  43. '/DCTDecode' => 1, # (JPEG image - not filtered)
  44. '/JPXDecode' => 1, # (Jpeg2000 image - not filtered)
  45. '/LZWDecode' => 1, # (usually a bitmapped image)
  46. '/ASCIIHexDecode' => 1,
  47. # other standard filters that we currently don't support
  48. #'/JBIG2Decode' => 0, # (JBIG2 image format not supported)
  49. #'/CCITTFaxDecode' => 0,
  50. #'/RunLengthDecode' => 0,
  51. #'/ASCII85Decode' => 0,
  52. );
  53. # tags in main PDF directories
  54. %Image::ExifTool::PDF::Main = (
  55. GROUPS => { 2 => 'Document' },
  56. VARS => { CAPTURE => ['Main','Prev'] },
  57. Info => {
  58. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Info' },
  59. # Adobe Acrobat 10.1.5 will create a duplicate Info dictionary with
  60. # a different object number when metadata is edited. This flag
  61. # is part of a patch to ignore this duplicate information (unless
  62. # the IgnoreMinorErrors option is used)
  63. IgnoreDuplicates => 1,
  64. },
  65. Root => {
  66. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Root' },
  67. },
  68. Encrypt => {
  69. NoProcess => 1, # don't process normally (processed in advance)
  70. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Encrypt' },
  71. },
  72. _linearized => {
  73. Name => 'Linearized',
  74. Notes => 'flag set if document is linearized for fast web display; not a real Tag ID',
  75. PrintConv => { 'true' => 'Yes', 'false' => 'No' },
  76. },
  77. );
  78. # tags in PDF Info dictionary
  79. %Image::ExifTool::PDF::Info = (
  80. GROUPS => { 2 => 'Document' },
  81. VARS => { CAPTURE => ['Info'] },
  82. EXTRACT_UNKNOWN => 1, # extract all unknown tags in this directory
  83. WRITE_PROC => \&Image::ExifTool::DummyWriteProc,
  84. CHECK_PROC => \&CheckPDF,
  85. WRITABLE => 'string',
  86. # set PRIORITY to 0 so most recent Info dictionary takes precedence
  87. # (Acrobat Pro bug? doesn't use same object/generation number for
  88. # new Info dictionary when doing incrmental update)
  89. PRIORITY => 0,
  90. NOTES => q{
  91. As well as the tags listed below, the PDF specification allows for
  92. user-defined tags to exist in the Info dictionary. These tags, which should
  93. have corresponding XMP-pdfx entries in the XMP of the PDF XML Metadata
  94. object, are also extracted by ExifTool.
  95. B<Writable> specifies the value format, and may be C<string>, C<date>,
  96. C<integer>, C<real>, C<boolean> or C<name> for PDF tags.
  97. },
  98. Title => { },
  99. Author => { Groups => { 2 => 'Author' } },
  100. Subject => { },
  101. Keywords => { List => 'string' }, # this is a string list
  102. Creator => { },
  103. Producer => { },
  104. CreationDate => {
  105. Name => 'CreateDate',
  106. Writable => 'date',
  107. Groups => { 2 => 'Time' },
  108. Shift => 'Time',
  109. PrintConv => '$self->ConvertDateTime($val)',
  110. PrintConvInv => '$self->InverseDateTime($val)',
  111. },
  112. ModDate => {
  113. Name => 'ModifyDate',
  114. Writable => 'date',
  115. Groups => { 2 => 'Time' },
  116. Shift => 'Time',
  117. PrintConv => '$self->ConvertDateTime($val)',
  118. PrintConvInv => '$self->InverseDateTime($val)',
  119. },
  120. Trapped => {
  121. Protected => 1,
  122. # remove leading '/' from '/True' or '/False'
  123. ValueConv => '$val=~s{^/}{}; $val',
  124. ValueConvInv => '"/$val"',
  125. },
  126. 'AAPL:Keywords' => { #PH
  127. Name => 'AppleKeywords',
  128. List => 'array', # this is an array of values
  129. Notes => q{
  130. keywords written by Apple utilities, although they seem to use PDF:Keywords
  131. when reading
  132. },
  133. },
  134. );
  135. # tags in the PDF Root document catalog
  136. %Image::ExifTool::PDF::Root = (
  137. GROUPS => { 2 => 'Document' },
  138. # note: can't capture previous versions of Root since they are not parsed
  139. VARS => { CAPTURE => ['Root'] },
  140. NOTES => 'This is the PDF document catalog.',
  141. MarkInfo => {
  142. SubDirectory => { TagTable => 'Image::ExifTool::PDF::MarkInfo' },
  143. },
  144. Metadata => {
  145. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Metadata' },
  146. },
  147. Pages => {
  148. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Pages' },
  149. },
  150. Perms => {
  151. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Perms' },
  152. },
  153. AcroForm => {
  154. SubDirectory => { TagTable => 'Image::ExifTool::PDF::AcroForm' },
  155. },
  156. Lang => 'Language',
  157. PageLayout => { },
  158. PageMode => { },
  159. Version => 'PDFVersion',
  160. );
  161. # tags extracted from the PDF Encrypt dictionary
  162. %Image::ExifTool::PDF::Encrypt = (
  163. GROUPS => { 2 => 'Document' },
  164. NOTES => 'Tags extracted from the document Encrypt dictionary.',
  165. Filter => {
  166. Name => 'Encryption',
  167. Notes => q{
  168. extracted value is actually a combination of the Filter, SubFilter, V, R and
  169. Length information from the Encrypt dictionary
  170. },
  171. },
  172. P => {
  173. Name => 'UserAccess',
  174. ValueConv => '$val & 0x0f3c', # ignore reserved bits
  175. PrintConvColumns => 2,
  176. PrintConv => { BITMASK => {
  177. 2 => 'Print',
  178. 3 => 'Modify',
  179. 4 => 'Copy',
  180. 5 => 'Annotate',
  181. 8 => 'Fill forms',
  182. 9 => 'Extract',
  183. 10 => 'Assemble',
  184. 11 => 'Print high-res',
  185. }},
  186. },
  187. );
  188. # tags in PDF Pages dictionary
  189. %Image::ExifTool::PDF::Pages = (
  190. GROUPS => { 2 => 'Document' },
  191. Count => 'PageCount',
  192. Kids => {
  193. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Kids' },
  194. },
  195. );
  196. # tags in PDF Perms dictionary
  197. %Image::ExifTool::PDF::Perms = (
  198. NOTES => 'Additional document permissions imposed by digital signatures.',
  199. DocMDP => {
  200. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Signature' },
  201. },
  202. FieldMDP => {
  203. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Signature' },
  204. },
  205. UR3 => {
  206. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Signature' },
  207. },
  208. );
  209. # tags in PDF Perms dictionary
  210. %Image::ExifTool::PDF::AcroForm = (
  211. PROCESS_PROC => \&ProcessAcroForm,
  212. _has_xfa => {
  213. Name => 'HasXFA',
  214. Notes => q{
  215. this tag is defined if a document contains form fields, and is true if it
  216. uses XML Forms Architecture; not a real Tag ID
  217. },
  218. PrintConv => { 'true' => 'Yes', 'false' => 'No' },
  219. },
  220. );
  221. # tags in PDF Kids dictionary
  222. %Image::ExifTool::PDF::Kids = (
  223. Metadata => {
  224. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Metadata' },
  225. },
  226. PieceInfo => {
  227. SubDirectory => { TagTable => 'Image::ExifTool::PDF::PieceInfo' },
  228. },
  229. Resources => {
  230. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Resources' },
  231. },
  232. Kids => {
  233. Condition => '$self->Options("ExtractEmbedded")',
  234. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Kids' },
  235. },
  236. );
  237. # tags in PDF Resources dictionary
  238. %Image::ExifTool::PDF::Resources = (
  239. ColorSpace => {
  240. SubDirectory => { TagTable => 'Image::ExifTool::PDF::ColorSpace' },
  241. },
  242. XObject => {
  243. Condition => '$self->Options("ExtractEmbedded")',
  244. SubDirectory => { TagTable => 'Image::ExifTool::PDF::XObject' },
  245. },
  246. Properties => {
  247. Condition => '$self->Options("ExtractEmbedded")',
  248. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Properties' },
  249. },
  250. );
  251. # tags in PDF ColorSpace dictionary
  252. %Image::ExifTool::PDF::ColorSpace = (
  253. DefaultRGB => {
  254. SubDirectory => { TagTable => 'Image::ExifTool::PDF::DefaultRGB' },
  255. },
  256. Cs1 => {
  257. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Cs1' },
  258. },
  259. );
  260. # tags in PDF DefaultRGB dictionary
  261. %Image::ExifTool::PDF::DefaultRGB = (
  262. ICCBased => {
  263. SubDirectory => { TagTable => 'Image::ExifTool::PDF::ICCBased' },
  264. },
  265. );
  266. # tags in PDF Cs1 dictionary
  267. %Image::ExifTool::PDF::Cs1 = (
  268. _stream => {
  269. SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
  270. },
  271. );
  272. # tags in PDF ICCBased dictionary
  273. %Image::ExifTool::PDF::ICCBased = (
  274. _stream => {
  275. SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
  276. },
  277. );
  278. # tags in PDF XObject dictionary (parsed only if ExtractEmbedded is enabled)
  279. %Image::ExifTool::PDF::XObject = (
  280. EXTRACT_UNKNOWN => 0, # extract known but numbered tags (Im1, Im2, etc)
  281. Im => {
  282. Notes => q{
  283. the ExtractEmbedded option enables information to be extracted from these
  284. embedded images
  285. },
  286. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Im' },
  287. },
  288. );
  289. # tags in PDF Im# dictionary
  290. %Image::ExifTool::PDF::Im = (
  291. NOTES => q{
  292. Information extracted from embedded images with the ExtractEmbedded option.
  293. The EmbeddedImage and its metadata are extracted only for JPEG and Jpeg2000
  294. image formats.
  295. },
  296. Width => 'EmbeddedImageWidth',
  297. Height => 'EmbeddedImageHeight',
  298. Filter => { Name => 'EmbeddedImageFilter', List => 1 },
  299. ColorSpace => {
  300. Name => 'EmbeddedImageColorSpace',
  301. List => 1,
  302. RawConv => 'ref $val ? undef : $val', # (ignore color space data)
  303. },
  304. Image_stream => {
  305. Name => 'EmbeddedImage',
  306. Groups => { 2 => 'Preview' },
  307. Binary => 1,
  308. },
  309. );
  310. # tags in PDF Properties dictionary
  311. %Image::ExifTool::PDF::Properties = (
  312. EXTRACT_UNKNOWN => 0, # extract known but numbered tags (MC0, MC1, etc)
  313. MC => {
  314. Notes => q{
  315. the ExtractEmbedded option enables information to be extracted from these
  316. embedded metadata dictionaries
  317. },
  318. SubDirectory => { TagTable => 'Image::ExifTool::PDF::MC' },
  319. }
  320. );
  321. # tags in PDF MC# dictionary
  322. %Image::ExifTool::PDF::MC = (
  323. Metadata => {
  324. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Metadata' },
  325. }
  326. );
  327. # tags in PDF PieceInfo dictionary
  328. %Image::ExifTool::PDF::PieceInfo = (
  329. AdobePhotoshop => {
  330. SubDirectory => { TagTable => 'Image::ExifTool::PDF::AdobePhotoshop' },
  331. },
  332. Illustrator => {
  333. # assume this is an illustrator file if it contains this directory
  334. # and doesn't have a ".PDF" extension
  335. Condition => q{
  336. $self->OverrideFileType("AI") unless $$self{FILE_EXT} and $$self{FILE_EXT} eq 'PDF';
  337. return 1;
  338. },
  339. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Illustrator' },
  340. },
  341. );
  342. # tags in PDF AdobePhotoshop dictionary
  343. %Image::ExifTool::PDF::AdobePhotoshop = (
  344. Private => {
  345. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Private' },
  346. },
  347. );
  348. # tags in PDF Illustrator dictionary
  349. %Image::ExifTool::PDF::Illustrator = (
  350. Private => {
  351. SubDirectory => { TagTable => 'Image::ExifTool::PDF::AIPrivate' },
  352. },
  353. );
  354. # tags in PDF Private dictionary
  355. %Image::ExifTool::PDF::Private = (
  356. ImageResources => {
  357. SubDirectory => { TagTable => 'Image::ExifTool::PDF::ImageResources' },
  358. },
  359. );
  360. # tags in PDF AI Private dictionary
  361. %Image::ExifTool::PDF::AIPrivate = (
  362. GROUPS => { 2 => 'Document' },
  363. EXTRACT_UNKNOWN => 0, # extract known but numbered tags
  364. AIMetaData => {
  365. SubDirectory => { TagTable => 'Image::ExifTool::PDF::AIMetaData' },
  366. },
  367. AIPrivateData => {
  368. Notes => q{
  369. the ExtractEmbedded option enables information to be extracted from embedded
  370. PostScript documents in the AIPrivateData# and AIPDFPrivateData# streams
  371. },
  372. JoinStreams => 1, # join streams from numbered tags and process as one
  373. SubDirectory => { TagTable => 'Image::ExifTool::PostScript::Main' },
  374. },
  375. AIPDFPrivateData => {
  376. JoinStreams => 1, # join streams from numbered tags and process as one
  377. SubDirectory => { TagTable => 'Image::ExifTool::PostScript::Main' },
  378. },
  379. RoundTripVersion => { },
  380. ContainerVersion => { },
  381. CreatorVersion => { },
  382. );
  383. # tags in PDF AIMetaData dictionary
  384. %Image::ExifTool::PDF::AIMetaData = (
  385. _stream => {
  386. SubDirectory => { TagTable => 'Image::ExifTool::PostScript::Main' },
  387. },
  388. );
  389. # tags in PDF ImageResources dictionary
  390. %Image::ExifTool::PDF::ImageResources = (
  391. _stream => {
  392. SubDirectory => { TagTable => 'Image::ExifTool::Photoshop::Main' },
  393. },
  394. );
  395. # tags in PDF MarkInfo dictionary
  396. %Image::ExifTool::PDF::MarkInfo = (
  397. GROUPS => { 2 => 'Document' },
  398. Marked => {
  399. Name => 'TaggedPDF',
  400. Notes => "not a Tagged PDF if this tag is missing",
  401. PrintConv => { 'true' => 'Yes', 'false' => 'No' },
  402. },
  403. );
  404. # tags in PDF Metadata dictionary
  405. %Image::ExifTool::PDF::Metadata = (
  406. GROUPS => { 2 => 'Document' },
  407. XML_stream => { # this is the stream for a Subtype /XML dictionary (not a real tag)
  408. Name => 'XMP',
  409. SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
  410. },
  411. );
  412. # tags in PDF signature directories (DocMDP, FieldMDP or UR3)
  413. %Image::ExifTool::PDF::Signature = (
  414. GROUPS => { 2 => 'Document' },
  415. ContactInfo => 'SignerContactInfo',
  416. Location => 'SigningLocation',
  417. M => {
  418. Name => 'SigningDate',
  419. Format => 'date',
  420. Groups => { 2 => 'Time' },
  421. PrintConv => '$self->ConvertDateTime($val)',
  422. },
  423. Name => 'SigningAuthority',
  424. Reason => 'SigningReason',
  425. Reference => {
  426. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Reference' },
  427. },
  428. Prop_AuthTime => {
  429. Name => 'AuthenticationTime',
  430. PrintConv => 'ConvertTimeSpan($val) . " ago"',
  431. },
  432. Prop_AuthType => 'AuthenticationType',
  433. );
  434. # tags in PDF Reference dictionary
  435. %Image::ExifTool::PDF::Reference = (
  436. TransformParams => {
  437. SubDirectory => { TagTable => 'Image::ExifTool::PDF::TransformParams' },
  438. },
  439. );
  440. # tags in PDF TransformParams dictionary
  441. %Image::ExifTool::PDF::TransformParams = (
  442. GROUPS => { 2 => 'Document' },
  443. Annots => {
  444. Name => 'AnnotationUsageRights',
  445. Notes => q{
  446. possible values are Create, Delete, Modify, Copy, Import and Export;
  447. additional values for UR3 signatures are Online and SummaryView
  448. },
  449. List => 1,
  450. },
  451. Document => {
  452. Name => 'DocumentUsageRights',
  453. Notes => 'only possible value is FullSave',
  454. List => 1,
  455. },
  456. Form => {
  457. Name => 'FormUsageRights',
  458. Notes => q{
  459. possible values are FillIn, Import, Export, SubmitStandalone and
  460. SpawnTemplate; additional values for UR3 signatures are BarcodePlaintext and
  461. Online
  462. },
  463. List => 1,
  464. },
  465. FormEX => {
  466. Name => 'FormExtraUsageRights',
  467. Notes => 'UR signatures only; only possible value is BarcodePlaintext',
  468. List => 1,
  469. },
  470. Signature => {
  471. Name => 'SignatureUsageRights',
  472. Notes => 'only possible value is Modify',
  473. List => 1,
  474. },
  475. EF => {
  476. Name => 'EmbeddedFileUsageRights',
  477. Notes => 'possible values are Create, Delete, Modify and Import',
  478. List => 1,
  479. },
  480. Msg => 'UsageRightsMessage',
  481. P => {
  482. Name => 'ModificationPermissions',
  483. Notes => q{
  484. 1-3 for DocMDP signatures, default 2; true/false for UR3 signatures, default
  485. false
  486. },
  487. PrintConv => {
  488. 1 => 'No changes permitted',
  489. 2 => 'Fill forms, Create page templates, Sign',
  490. 3 => 'Fill forms, Create page templates, Sign, Create/Delete/Edit annotations',
  491. 'true' => 'Restrict all applications to reader permissions',
  492. 'false' => 'Do not restrict applications to reader permissions',
  493. },
  494. },
  495. Action => {
  496. Name => 'FieldPermissions',
  497. Notes => 'FieldMDP signatures only',
  498. PrintConv => {
  499. 'All' => 'Disallow changes to all form fields',
  500. 'Include' => 'Disallow changes to specified form fields',
  501. 'Exclude' => 'Allow changes to specified form fields',
  502. },
  503. },
  504. Fields => {
  505. Notes => 'FieldMDP signatures only',
  506. Name => 'FormFields',
  507. List => 1,
  508. },
  509. );
  510. # unknown tags for use in verbose option
  511. %Image::ExifTool::PDF::Unknown = (
  512. GROUPS => { 2 => 'Unknown' },
  513. );
  514. #------------------------------------------------------------------------------
  515. # AutoLoad our writer routines when necessary
  516. #
  517. sub AUTOLOAD
  518. {
  519. return Image::ExifTool::DoAutoLoad($AUTOLOAD, @_);
  520. }
  521. #------------------------------------------------------------------------------
  522. # Convert from PDF to EXIF-style date/time
  523. # Inputs: 0) PDF date/time string (D:YYYYmmddHHMMSS+HH'MM')
  524. # Returns: EXIF date string (YYYY:mm:dd HH:MM:SS+HH:MM)
  525. sub ConvertPDFDate($)
  526. {
  527. my $date = shift;
  528. # remove optional 'D:' prefix
  529. $date =~ s/^D://;
  530. # fill in default values if necessary
  531. # YYYYmmddHHMMSS
  532. my $default = '00000101000000';
  533. if (length $date < length $default) {
  534. $date .= substr($default, length $date);
  535. }
  536. $date =~ /^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(.*)/ or return $date;
  537. $date = "$1:$2:$3 $4:$5:$6";
  538. if ($7) {
  539. my $tz = $7;
  540. if ($tz =~ /^\s*Z/i) {
  541. # ignore any "HH'mm'" after the Z (OS X 10.6 does this)
  542. $date .= 'Z';
  543. # tolerate some improper formatting in timezone specification
  544. } elsif ($tz =~ /^\s*([-+])\s*(\d+)[': ]+(\d*)/) {
  545. $date .= $1 . $2 . ':' . ($3 || '00');
  546. }
  547. }
  548. return $date;
  549. }
  550. #------------------------------------------------------------------------------
  551. # Locate any object in the XRef tables (including compressed objects)
  552. # Inputs: 0) XRef reference, 1) object reference string (or free object number)
  553. # Returns: offset to object in file or compressed object reference string,
  554. # 0 if object is free, or undefined on error
  555. sub LocateAnyObject($$)
  556. {
  557. my ($xref, $ref) = @_;
  558. return undef unless $xref;
  559. return $$xref{$ref} if exists $$xref{$ref};
  560. # get the object number
  561. return undef unless $ref =~ /^(\d+)/;
  562. my $objNum = $1;
  563. # return 0 if the object number has been reused (old object is free)
  564. return 0 if defined $$xref{$objNum};
  565. #
  566. # scan our XRef stream dictionaries for this object
  567. #
  568. return undef unless $$xref{dicts};
  569. my $dict;
  570. foreach $dict (@{$$xref{dicts}}) {
  571. # quick check to see if the object is in the range for this xref stream
  572. next if $objNum >= $$dict{Size};
  573. my $index = $$dict{Index};
  574. next if $objNum < $$index[0];
  575. # scan the tables for the specified object
  576. my $size = $$dict{_entry_size};
  577. my $num = scalar(@$index) / 2;
  578. my $tot = 0;
  579. my $i;
  580. for ($i=0; $i<$num; ++$i) {
  581. my $start = $$index[$i*2];
  582. my $count = $$index[$i*2+1];
  583. # table is in ascending order, so quit if we have passed the object
  584. last if $objNum < $start;
  585. if ($objNum < $start + $count) {
  586. my $offset = $size * ($objNum - $start + $tot);
  587. last if $offset + $size > length $$dict{_stream};
  588. my @c = unpack("x$offset C$size", $$dict{_stream});
  589. # extract values from this table entry
  590. # (can be 1, 2, 3, 4, etc.. bytes per value)
  591. my (@t, $j, $k);
  592. my $w = $$dict{W};
  593. for ($j=0; $j<3; ++$j) {
  594. # use default value if W entry is 0 (as per spec)
  595. # - 0th element defaults to 1, others default to 0
  596. $$w[$j] or $t[$j] = ($j ? 0 : 1), next;
  597. $t[$j] = shift(@c);
  598. for ($k=1; $k < $$w[$j]; ++$k) {
  599. $t[$j] = 256 * $t[$j] + shift(@c);
  600. }
  601. }
  602. # by default, use "o g R" as the xref key
  603. # (o = object number, g = generation number)
  604. my $ref2 = "$objNum $t[2] R";
  605. if ($t[0] == 1) {
  606. # normal object reference:
  607. # $t[1]=offset of object from start, $t[2]=generation number
  608. $$xref{$ref2} = $t[1];
  609. } elsif ($t[0] == 2) {
  610. # compressed object reference:
  611. # $t[1]=stream object number, $t[2]=index of object in stream
  612. $ref2 = "$objNum 0 R";
  613. $$xref{$ref2} = "I$t[2] $t[1] 0 R";
  614. } elsif ($t[0] == 0) {
  615. # free object:
  616. # $t[1]=next free object in linked list, $t[2]=generation number
  617. $$xref{$ref2} = 0;
  618. } else {
  619. # treat as a null object
  620. $$xref{$ref2} = undef;
  621. }
  622. $$xref{$objNum} = $t[1]; # remember offsets by object number too
  623. return $$xref{$ref} if $ref eq $ref2;
  624. return 0; # object is free or was reused
  625. }
  626. $tot += $count;
  627. }
  628. }
  629. return undef;
  630. }
  631. #------------------------------------------------------------------------------
  632. # Locate a regular object in the XRef tables (does not include compressed objects)
  633. # Inputs: 0) XRef reference, 1) object reference string (or free object number)
  634. # Returns: offset to object in file, 0 if object is free,
  635. # or undef on error or if object was compressed
  636. sub LocateObject($$)
  637. {
  638. my ($xref, $ref) = @_;
  639. my $offset = LocateAnyObject($xref, $ref);
  640. return undef if $offset and $offset =~ /^I/;
  641. return $offset;
  642. }
  643. #------------------------------------------------------------------------------
  644. # Fetch indirect object from file (from inside a stream if required)
  645. # Inputs: 0) ExifTool object reference, 1) object reference string,
  646. # 2) xref lookup, 3) object name (for warning messages)
  647. # Returns: object data or undefined on error
  648. # Notes: sets $lastFetched to the object reference, or undef if the object
  649. # was extracted from an encrypted stream
  650. sub FetchObject($$$$)
  651. {
  652. my ($et, $ref, $xref, $tag) = @_;
  653. $lastFetched = $ref; # save this for decoding if necessary
  654. my $offset = LocateAnyObject($xref, $ref);
  655. $lastOffset = $offset;
  656. unless ($offset) {
  657. $et->Warn("Bad $tag reference") unless defined $offset;
  658. return undef;
  659. }
  660. my ($data, $obj);
  661. if ($offset =~ s/^I(\d+) //) {
  662. my $index = $1; # object index in stream
  663. my ($objNum) = split ' ', $ref; # save original object number
  664. $ref = $offset; # now a reference to the containing stream object
  665. $obj = $streamObjs{$ref};
  666. unless ($obj) {
  667. # don't try to load the same object stream twice
  668. return undef if defined $obj;
  669. $streamObjs{$ref} = '';
  670. # load the parent object stream
  671. $obj = FetchObject($et, $ref, $xref, $tag);
  672. # make sure it contains everything we need
  673. return undef unless defined $obj and ref($obj) eq 'HASH';
  674. return undef unless $$obj{First} and $$obj{N};
  675. return undef unless DecodeStream($et, $obj);
  676. # add a special '_table' entry to this dictionary which contains
  677. # the list of object number/offset pairs from the stream header
  678. my $num = $$obj{N} * 2;
  679. my @table = split ' ', $$obj{_stream}, $num;
  680. return undef unless @table == $num;
  681. # remove everything before first object in stream
  682. $$obj{_stream} = substr($$obj{_stream}, $$obj{First});
  683. $table[$num-1] =~ s/^(\d+).*/$1/s; # trim excess from last number
  684. $$obj{_table} = \@table;
  685. # save the object stream so we don't have to re-load it later
  686. $streamObjs{$ref} = $obj;
  687. }
  688. # verify that we have the specified object
  689. my $i = 2 * $index;
  690. my $table = $$obj{_table};
  691. unless ($index < $$obj{N} and $$table[$i] == $objNum) {
  692. $et->Warn("Bad index for stream object $tag");
  693. return undef;
  694. }
  695. # extract the object at the specified index in the stream
  696. # (offsets in table are in sequential order, so we can subract from
  697. # the next offset to get the object length)
  698. $offset = $$table[$i + 1];
  699. my $len = ($$table[$i + 3] || length($$obj{_stream})) - $offset;
  700. $data = substr($$obj{_stream}, $offset, $len);
  701. # avoid re-decrypting data in already decrypted streams
  702. undef $lastFetched if $cryptStream;
  703. return ExtractObject($et, \$data);
  704. }
  705. my $raf = $$et{RAF};
  706. $raf->Seek($offset, 0) or $et->Warn("Bad $tag offset"), return undef;
  707. # verify that we are reading the expected object
  708. $raf->ReadLine($data) or $et->Warn("Error reading $tag data"), return undef;
  709. ($obj = $ref) =~ s/R/obj/;
  710. unless ($data =~ s/^$obj//) {
  711. $et->Warn("$tag object ($obj) not found at $offset");
  712. return undef;
  713. }
  714. # read the first line of data for the object (skipping comments if necessary)
  715. for (;;) {
  716. last if $data =~ /\S/ and $data !~ /^\s*%/;
  717. $raf->ReadLine($data) or $et->Warn("Error reading $tag data"), return undef;
  718. }
  719. return ExtractObject($et, \$data, $raf, $xref);
  720. }
  721. #------------------------------------------------------------------------------
  722. # Convert PDF value to something readable
  723. # Inputs: 0) PDF object data
  724. # Returns: converted object
  725. sub ReadPDFValue($)
  726. {
  727. my $str = shift;
  728. # decode all strings in an array
  729. if (ref $str eq 'ARRAY') {
  730. # create new list to not alter the original data when rewriting
  731. my ($val, @vals);
  732. foreach $val (@$str) {
  733. push @vals, ReadPDFValue($val);
  734. }
  735. return \@vals;
  736. }
  737. length $str or return $str;
  738. my $delim = substr($str, 0, 1);
  739. if ($delim eq '(') { # literal string
  740. $str = $1 if $str =~ /^.*?\((.*)\)/s; # remove brackets
  741. # decode escape sequences in literal strings
  742. while ($str =~ /\\(.)/sg) {
  743. my $n = pos($str) - 2;
  744. my $c = $1;
  745. my $r;
  746. if ($c =~ /[0-7]/) {
  747. # get up to 2 more octal digits
  748. $c .= $1 if $str =~ /\G([0-7]{1,2})/g;
  749. # convert octal escape code
  750. $r = chr(oct($c) & 0xff);
  751. } elsif ($c eq "\x0d") {
  752. # the string is continued if the line ends with '\'
  753. # (also remove "\x0d\x0a")
  754. $c .= $1 if $str =~ /\G(\x0a)/g;
  755. $r = '';
  756. } elsif ($c eq "\x0a") {
  757. $r = '';
  758. } else {
  759. # convert escaped characters
  760. ($r = $c) =~ tr/nrtbf/\n\r\t\b\f/;
  761. }
  762. substr($str, $n, length($c)+1) = $r;
  763. # continue search after this character
  764. pos($str) = $n + length($r);
  765. }
  766. Crypt(\$str, $lastFetched) if $cryptString;
  767. } elsif ($delim eq '<') { # hex string
  768. # decode hex data
  769. $str =~ tr/0-9A-Fa-f//dc;
  770. $str .= '0' if length($str) & 0x01; # (by the spec)
  771. $str = pack('H*', $str);
  772. Crypt(\$str, $lastFetched) if $cryptString;
  773. } elsif ($delim eq '/') { # name
  774. $str = substr($str, 1);
  775. # convert escape codes (PDF 1.2 or later)
  776. $str =~ s/#([0-9a-f]{2})/chr(hex($1))/sgei if $pdfVer >= 1.2;
  777. }
  778. return $str;
  779. }
  780. #------------------------------------------------------------------------------
  781. # Extract PDF object from combination of buffered data and file
  782. # Inputs: 0) ExifTool object reference, 1) data reference,
  783. # 2) optional raf reference, 3) optional xref table
  784. # Returns: converted PDF object or undef on error
  785. # a) dictionary object --> hash reference
  786. # b) array object --> array reference
  787. # c) indirect reference --> scalar reference
  788. # d) string, name, integer, boolean, null --> scalar value
  789. # - updates $$dataPt on return to contain unused data
  790. # - creates two bogus entries ('_stream' and '_tags') in dictionaries to represent
  791. # the stream data and a list of the tags (not including '_stream' and '_tags')
  792. # in their original order
  793. sub ExtractObject($$;$$)
  794. {
  795. my ($et, $dataPt, $raf, $xref) = @_;
  796. my (@tags, $data, $objData);
  797. my $dict = { };
  798. my $delim;
  799. for (;;) {
  800. if ($$dataPt =~ /^\s*(<{1,2}|\[|\()/s) {
  801. $delim = $1;
  802. $$dataPt =~ s/^\s+//; # remove leading white space
  803. $objData = ReadToNested($dataPt, $raf);
  804. return undef unless defined $objData;
  805. last;
  806. } elsif ($$dataPt =~ s{^\s*(\S[^[(/<>\s]*)\s*}{}s) {
  807. #
  808. # extract boolean, numerical, string, name, null object or indirect reference
  809. #
  810. $objData = $1;
  811. # look for an indirect reference
  812. if ($objData =~ /^\d+$/ and $$dataPt =~ s/^(\d+)\s+R//s) {
  813. $objData .= "$1 R";
  814. $objData = \$objData; # return scalar reference
  815. }
  816. return $objData; # return simple scalar or scalar reference
  817. }
  818. $raf and $raf->ReadLine($data) or return undef;
  819. $$dataPt .= $data;
  820. }
  821. #
  822. # return literal string or hex string without parsing
  823. #
  824. if ($delim eq '(' or $delim eq '<') {
  825. return $objData;
  826. #
  827. # extract array
  828. #
  829. } elsif ($delim eq '[') {
  830. $objData =~ /^.*?\[(.*)\]/s or return undef;
  831. my $data = $1; # brackets removed
  832. my @list;
  833. for (;;) {
  834. last unless $data =~ m{\s*(\S[^[(/<>\s]*)}sg;
  835. my $val = $1;
  836. if ($val =~ /^(<{1,2}|\[|\()/) {
  837. my $pos = pos($data) - length($val);
  838. # nested dict, array, literal string or hex string
  839. my $buff = substr($data, $pos);
  840. $val = ReadToNested(\$buff);
  841. last unless defined $val;
  842. pos($data) = $pos + length($val);
  843. $val = ExtractObject($et, \$val);
  844. } elsif ($val =~ /^\d/) {
  845. my $pos = pos($data);
  846. if ($data =~ /\G\s+(\d+)\s+R/g) {
  847. $val = \ "$val $1 R"; # make a reference
  848. } else {
  849. pos($data) = $pos;
  850. }
  851. }
  852. push @list, $val;
  853. }
  854. return \@list;
  855. }
  856. #
  857. # extract dictionary
  858. #
  859. # Note: entries are not necessarily separated by whitespace (doh!)
  860. # eg) "/Tag/Name", "/Tag(string)", "/Tag[array]", etc are legal!
  861. # Also, they may be separated by a comment (eg. "/Tag%comment\nValue"),
  862. # but comments have already been removed
  863. while ($objData =~ m{(\s*)/([^/[\]()<>{}\s]+)\s*(\S[^[(/<>\s]*)}sg) {
  864. my $tag = $2;
  865. my $val = $3;
  866. if ($val =~ /^(<{1,2}|\[|\()/) {
  867. # nested dict, array, literal string or hex string
  868. $objData = substr($objData, pos($objData)-length($val));
  869. $val = ReadToNested(\$objData, $raf);
  870. last unless defined $val;
  871. $val = ExtractObject($et, \$val);
  872. pos($objData) = 0;
  873. } elsif ($val =~ /^\d/) {
  874. my $pos = pos($objData);
  875. if ($objData =~ /\G\s+(\d+)\s+R/sg) {
  876. $val = \ "$val $1 R"; # make a reference
  877. } else {
  878. pos($objData) = $pos;
  879. }
  880. }
  881. if ($$dict{$tag}) {
  882. # duplicate dictionary entries are not allowed
  883. $et->Warn("Duplicate '$tag' entry in dictionary (ignored)");
  884. } else {
  885. # save the entry
  886. push @tags, $tag;
  887. $$dict{$tag} = $val;
  888. }
  889. }
  890. return undef unless @tags;
  891. $$dict{_tags} = \@tags;
  892. return $dict unless $raf; # direct objects can not have streams
  893. #
  894. # extract the stream object
  895. #
  896. # dictionary must specify stream Length
  897. my $length = $$dict{Length} or return $dict;
  898. if (ref $length) {
  899. $length = $$length;
  900. my $oldpos = $raf->Tell();
  901. # get the location of the object specifying the length
  902. # (compressed objects are not allowed)
  903. my $offset = LocateObject($xref, $length) or return $dict;
  904. $offset or $et->Warn('Bad Length object'), return $dict;
  905. $raf->Seek($offset, 0) or $et->Warn('Bad Length offset'), return $dict;
  906. # verify that we are reading the expected object
  907. $raf->ReadLine($data) or $et->Warn('Error reading Length data'), return $dict;
  908. $length =~ s/R/obj/;
  909. unless ($data =~ /^$length\s+(\d+)?/) {
  910. $et->Warn("Length object ($length) not found at $offset");
  911. return $dict;
  912. }
  913. if (defined $1) {
  914. $length = $1;
  915. } else {
  916. $raf->ReadLine($data) or $et->Warn('Error reading stream Length'), return $dict;
  917. $data =~ /^\s*(\d+)/ or $et->Warn('Stream length not found'), return $dict;
  918. $length = $1;
  919. }
  920. $raf->Seek($oldpos, 0); # restore position to start of stream
  921. }
  922. # extract the trailing stream data
  923. for (;;) {
  924. # find the stream token
  925. if ($$dataPt =~ /(\S+)/) {
  926. last unless $1 eq 'stream';
  927. # read an extra line because it may contain our \x0a
  928. $$dataPt .= $data if $raf->ReadLine($data);
  929. # remove our stream header
  930. $$dataPt =~ s/^\s*stream(\x0a|\x0d\x0a)//s;
  931. my $more = $length - length($$dataPt);
  932. if ($more > 0) {
  933. unless ($raf->Read($data, $more) == $more) {
  934. $et->Warn('Error reading stream data');
  935. $$dataPt = '';
  936. return $dict;
  937. }
  938. $$dict{_stream} = $$dataPt . $data;
  939. $$dataPt = '';
  940. } elsif ($more < 0) {
  941. $$dict{_stream} = substr($$dataPt, 0, $length);
  942. $$dataPt = substr($$dataPt, $length);
  943. } else {
  944. $$dict{_stream} = $$dataPt;
  945. $$dataPt = '';
  946. }
  947. last;
  948. }
  949. $raf->ReadLine($data) or last;
  950. $$dataPt .= $data;
  951. }
  952. return $dict;
  953. }
  954. #------------------------------------------------------------------------------
  955. # Read to nested delimiter
  956. # Inputs: 0) data reference, 1) optional raf reference
  957. # Returns: data up to and including matching delimiter (or undef on error)
  958. # - updates data reference with trailing data
  959. # - unescapes characters in literal strings
  960. my %closingDelim = ( # lookup for matching delimiter
  961. '(' => ')',
  962. '[' => ']',
  963. '<' => '>',
  964. '<<' => '>>',
  965. );
  966. sub ReadToNested($;$)
  967. {
  968. my ($dataPt, $raf) = @_;
  969. my @delim = (''); # closing delimiter list, most deeply nested first
  970. pos($$dataPt) = 0; # begin at start of data
  971. for (;;) {
  972. unless ($$dataPt =~ /(\\*)(\(|\)|<{1,2}|>{1,2}|\[|\]|%)/g) {
  973. # must read some more data
  974. my $buff;
  975. last unless $raf and $raf->ReadLine($buff);
  976. $$dataPt .= $buff;
  977. pos($$dataPt) = length($$dataPt) - length($buff);
  978. next;
  979. }
  980. # are we in a literal string?
  981. if ($delim[0] eq ')') {
  982. # ignore escaped delimiters (preceded by odd number of \'s)
  983. next if length($1) & 0x01;
  984. # ignore all delimiters but unescaped braces
  985. next unless $2 eq '(' or $2 eq ')';
  986. } elsif ($2 eq '%') {
  987. # ignore the comment
  988. my $pos = pos($$dataPt) - 1;
  989. # remove everything from '%' up to but not including newline
  990. $$dataPt =~ /.*/g;
  991. my $end = pos($$dataPt);
  992. $$dataPt = substr($$dataPt, 0, $pos) . substr($$dataPt, $end);
  993. pos($$dataPt) = $pos;
  994. next;
  995. }
  996. if ($closingDelim{$2}) {
  997. # push the corresponding closing delimiter
  998. unshift @delim, $closingDelim{$2};
  999. next;
  1000. }
  1001. unless ($2 eq $delim[0]) {
  1002. # handle the case where we find a ">>>" and interpret it
  1003. # as ">> >" instead of "> >>"
  1004. next unless $2 eq '>>' and $delim[0] eq '>';
  1005. pos($$dataPt) = pos($$dataPt) - 1;
  1006. }
  1007. shift @delim; # remove from nesting list
  1008. next if $delim[0]; # keep going if we have more nested delimiters
  1009. my $pos = pos($$dataPt);
  1010. my $buff = substr($$dataPt, 0, $pos);
  1011. $$dataPt = substr($$dataPt, $pos);
  1012. return $buff; # success!
  1013. }
  1014. return undef; # didn't find matching delimiter
  1015. }
  1016. #------------------------------------------------------------------------------
  1017. # Decode LZW-encoded data (ref 1)
  1018. # Inputs: 0) data reference
  1019. # Returns: true on success and data is decoded, or false and data is untouched
  1020. sub DecodeLZW($)
  1021. {
  1022. my $dataPt = shift;
  1023. return 0 if length $$dataPt < 4;
  1024. my @lzw = (map(chr, 0..255), undef, undef); # LZW code table
  1025. my $mask = 0x01ff; # mask for least-significant 9 bits
  1026. my @dat = unpack 'n*', $$dataPt . "\0";
  1027. my $word = ($dat[0] << 16) | $dat[1];
  1028. my ($bit, $pos, $bits, $out) = (0, 2, 9, '');
  1029. my $lastVal;
  1030. for (;;) {
  1031. # bits are packed MSB first in PDF LZW (the PDF spec doesn't mention this)
  1032. my $shift = 32 - ($bit + $bits);
  1033. if ($shift < 0) {
  1034. return 0 if $pos >= @dat; # missing EOD marker
  1035. $word = (($word & 0xffff) << 16) | $dat[$pos++]; # read next word
  1036. $bit -= 16;
  1037. $shift += 16;
  1038. };
  1039. my $code = ($word >> $shift) & $mask;
  1040. $bit += $bits;
  1041. my $val = $lzw[$code];
  1042. if (defined $val) {
  1043. # store new code as previous sequence plus 1st char of new sequence
  1044. push @lzw, $lastVal . substr($val, 0, 1) if defined $lastVal;
  1045. } elsif ($code == @lzw) { # new code
  1046. return 0 unless defined $lastVal;
  1047. # we are using the code that we are about to generate, so the last
  1048. # character in the new sequence must be the same as the first
  1049. # character in the previous sequence (makes sense if you think about it)
  1050. $val = $lastVal . substr($lastVal, 0, 1);
  1051. push @lzw, $val;
  1052. } elsif ($code == 256) { # clear table
  1053. splice @lzw, 258;
  1054. $bits = 9;
  1055. $mask = 0x1ff;
  1056. undef $lastVal;
  1057. next;
  1058. } elsif ($code == 257) { # EOD marker
  1059. last; # all done!
  1060. } else {
  1061. return 0;
  1062. }
  1063. $out .= $val; # add this byte sequence to the output
  1064. # we added a new entry to the LZW table, so we must increase
  1065. # the bit width if necessary, up to a maximum of 12
  1066. @lzw >= $mask and $bits < 12 and ++$bits, $mask |= $mask << 1;
  1067. $lastVal = $val;
  1068. }
  1069. $$dataPt = $out; # return decompressed data
  1070. return 1;
  1071. }
  1072. #------------------------------------------------------------------------------
  1073. # Decode filtered stream
  1074. # Inputs: 0) ExifTool object reference, 1) dictionary reference
  1075. # Returns: true if stream has been decoded OK
  1076. sub DecodeStream($$)
  1077. {
  1078. local $_;
  1079. my ($et, $dict) = @_;
  1080. return 0 unless $$dict{_stream}; # no stream to decode
  1081. # get list of filters
  1082. my (@filters, @decodeParms, $filter);
  1083. if (ref $$dict{Filter} eq 'ARRAY') {
  1084. @filters = @{$$dict{Filter}};
  1085. } elsif (defined $$dict{Filter}) {
  1086. @filters = ($$dict{Filter});
  1087. }
  1088. # be sure we can process all the filters before we take the time to do the decryption
  1089. foreach $filter (@filters) {
  1090. next if $supportedFilter{$filter};
  1091. $et->WarnOnce("Unsupported Filter $filter");
  1092. return 0;
  1093. }
  1094. # apply decryption first if required (and if the default encryption
  1095. # has not been overridden by a Crypt filter. Note: the Crypt filter
  1096. # must be first in the Filter array: ref 3, page 38)
  1097. unless (defined $$dict{_decrypted} or ($filters[0] and $filters[0] eq '/Crypt')) {
  1098. CryptStream($dict, $lastFetched);
  1099. }
  1100. return 1 unless $$dict{Filter}; # Filter entry is mandatory
  1101. return 0 if defined $$dict{_filtered}; # avoid double-filtering
  1102. $$dict{_filtered} = 1; # set flag to prevent double-filtering
  1103. # get array of DecodeParms dictionaries
  1104. if (ref $$dict{DecodeParms} eq 'ARRAY') {
  1105. @decodeParms = @{$$dict{DecodeParms}};
  1106. } else {
  1107. @decodeParms = ($$dict{DecodeParms});
  1108. }
  1109. foreach $filter (@filters) {
  1110. my $decodeParms = shift @decodeParms;
  1111. if ($filter eq '/FlateDecode') {
  1112. # make sure we support the predictor (if used) before decoding
  1113. my $pre;
  1114. if (ref $decodeParms eq 'HASH') {
  1115. $pre = $$decodeParms{Predictor};
  1116. if ($pre and $pre ne '1' and $pre ne '12') {
  1117. $et->WarnOnce("FlateDecode Predictor $pre currently not supported");
  1118. return 0;
  1119. }
  1120. }
  1121. if (eval { require Compress::Zlib }) {
  1122. my $inflate = Compress::Zlib::inflateInit();
  1123. my ($buff, $stat);
  1124. $inflate and ($buff, $stat) = $inflate->inflate($$dict{_stream});
  1125. if ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) {
  1126. $$dict{_stream} = $buff;
  1127. } else {
  1128. $et->Warn('Error inflating stream');
  1129. return 0;
  1130. }
  1131. } else {
  1132. $et->WarnOnce('Install Compress::Zlib to process filtered streams');
  1133. return 0;
  1134. }
  1135. next unless $pre and $pre eq '12'; # 12 = 'up' prediction
  1136. # apply anti-predictor
  1137. my $cols = $$decodeParms{Columns};
  1138. unless ($cols) {
  1139. # currently only support 'up' prediction
  1140. $et->WarnOnce('No Columns for decoding stream');
  1141. return 0;
  1142. }
  1143. my @bytes = unpack('C*', $$dict{_stream});
  1144. my @pre = (0) x $cols; # initialize predictor array
  1145. my $buff = '';
  1146. while (@bytes > $cols) {
  1147. unless (($_ = shift @bytes) == 2) {
  1148. $et->WarnOnce("Unsupported PNG filter $_"); # (yes, PNG)
  1149. return 0;
  1150. }
  1151. foreach (@pre) {
  1152. $_ = ($_ + shift(@bytes)) & 0xff;
  1153. }
  1154. $buff .= pack('C*', @pre);
  1155. }
  1156. $$dict{_stream} = $buff;
  1157. } elsif ($filter eq '/Crypt') {
  1158. # (we shouldn't have to check the _decrypted flag since we
  1159. # already checked the _filtered flag, but what the heck...)
  1160. next if defined $$dict{_decrypted};
  1161. # assume Identity filter (the default) if DecodeParms are missing
  1162. next unless ref $decodeParms eq 'HASH';
  1163. my $name = $$decodeParms{Name};
  1164. next unless defined $name or $name eq 'Identity';
  1165. if ($name ne 'StdCF') {
  1166. $et->WarnOnce("Unsupported Crypt Filter $name");
  1167. return 0;
  1168. }
  1169. unless ($cryptInfo) {
  1170. $et->WarnOnce('Missing Encrypt StdCF entry');
  1171. return 0;
  1172. }
  1173. # decrypt the stream manually because we want to:
  1174. # 1) ignore $cryptStream (StmF) setting
  1175. # 2) ignore EncryptMetadata setting (I can't find mention of how to
  1176. # reconcile this in the spec., but this would make sense)
  1177. # 3) avoid adding the crypt key extension (ref 3, page 58, Algorithm 1b)
  1178. # 4) set _decrypted flag so we will recrypt according to StmF when
  1179. # writing (since we don't yet write Filter'd streams)
  1180. Crypt(\$$dict{_stream}, 'none');
  1181. $$dict{_decrypted} = ($cryptStream ? 1 : 0);
  1182. } elsif ($filter eq '/LZWDecode') {
  1183. # make sure we don't have any unsupported decoding parameters
  1184. if (ref $decodeParms eq 'HASH') {
  1185. if ($$decodeParms{Predictor}) {
  1186. $et->WarnOnce("LZWDecode Predictor $$decodeParms{Predictor} currently not supported");
  1187. return 0;
  1188. } elsif ($$decodeParms{EarlyChange}) {
  1189. $et->WarnOnce("LZWDecode EarlyChange currently not supported");
  1190. return 0;
  1191. }
  1192. }
  1193. unless (DecodeLZW(\$$dict{_stream})) {
  1194. $et->WarnOnce('LZW decompress error');
  1195. return 0;
  1196. }
  1197. } elsif ($filter eq '/ASCIIHexDecode') {
  1198. $$dict{_stream} =~ s/>.*//; # truncate at '>' (end of data mark)
  1199. $$dict{_stream} =~ tr/0-9a-zA-Z//d; # remove illegal characters
  1200. $$dict{_stream} = pack 'H*', $$dict{_stream};
  1201. }
  1202. }
  1203. return 1;
  1204. }
  1205. #------------------------------------------------------------------------------
  1206. # Initialize state for RC4 en/decryption (ref 2)
  1207. # Inputs: 0) RC4 key string
  1208. # Returns: RC4 key hash reference
  1209. sub RC4Init($)
  1210. {
  1211. my @key = unpack('C*', shift);
  1212. my @state = (0 .. 255);
  1213. my ($i, $j) = (0, 0);
  1214. while ($i < 256) {
  1215. my $st = $state[$i];
  1216. $j = ($j + $st + $key[$i % scalar(@key)]) & 0xff;
  1217. $state[$i++] = $state[$j];
  1218. $state[$j] = $st;
  1219. }
  1220. return { State => \@state, XY => [ 0, 0 ] };
  1221. }
  1222. #------------------------------------------------------------------------------
  1223. # Apply RC4 en/decryption (ref 2)
  1224. # Inputs: 0) data reference, 1) RC4 key hash reference or RC4 key string
  1225. # - can call this method directly with a key string, or with with the key
  1226. # reference returned by RC4Init
  1227. # - RC4 is a symmetric algorithm, so encryption is the same as decryption
  1228. sub RC4Crypt($$)
  1229. {
  1230. my ($dataPt, $key) = @_;
  1231. $key = RC4Init($key) unless ref $key eq 'HASH';
  1232. my $state = $$key{State};
  1233. my ($x, $y) = @{$$key{XY}};
  1234. my @data = unpack('C*', $$dataPt);
  1235. foreach (@data) {
  1236. $x = ($x + 1) & 0xff;
  1237. my $stx = $$state[$x];
  1238. $y = ($stx + $y) & 0xff;
  1239. my $sty = $$state[$x] = $$state[$y];
  1240. $$state[$y] = $stx;
  1241. $_ ^= $$state[($stx + $sty) & 0xff];
  1242. }
  1243. $$key{XY} = [ $x, $y ];
  1244. $$dataPt = pack('C*', @data);
  1245. }
  1246. #------------------------------------------------------------------------------
  1247. # Update AES cipher with a bit of data
  1248. # Inputs: 0) data
  1249. # Returns: encrypted data
  1250. my $cipherMore;
  1251. sub CipherUpdate($)
  1252. {
  1253. my $dat = shift;
  1254. my $pos = 0;
  1255. $dat = $cipherMore . $dat if length $dat;
  1256. while ($pos + 16 <= length($dat)) {
  1257. substr($dat,$pos,16) = Image::ExifTool::AES::Cipher(substr($dat,$pos,16));
  1258. $pos += 16;
  1259. }
  1260. if ($pos < length $dat) {
  1261. $cipherMore = substr($dat,$pos);
  1262. $dat = substr($dat,0,$pos);
  1263. } else {
  1264. $cipherMore = '';
  1265. }
  1266. return $dat;
  1267. }
  1268. #------------------------------------------------------------------------------
  1269. # Get encrypted hash
  1270. # Inputs: 0) Password, 1) salt, 2) vector, 3) encryption revision
  1271. # Returns: hash
  1272. sub GetHash($$$$)
  1273. {
  1274. my ($password, $salt, $vector, $rev) = @_;
  1275. # return Rev 5 hash
  1276. return Digest::SHA::sha256($password, $salt, $vector) if $rev == 5;
  1277. # compute Rev 6 hardened hash
  1278. # (ref http://code.google.com/p/origami-pdf/source/browse/lib/origami/encryption.rb)
  1279. my $blockSize = 32;
  1280. my $input = Digest::SHA::sha256($password, $salt, $vector) . ("\0" x 32);
  1281. my $key = substr($input, 0, 16);
  1282. my $iv = substr($input, 16, 16);
  1283. my $h;
  1284. my $x = '';
  1285. my $i = 0;
  1286. while ($i < 64 or $i < ord(substr($x,-1,1))+32) {
  1287. my $block = substr($input, 0, $blockSize);
  1288. $x = '';
  1289. Image::ExifTool::AES::Crypt(\$x, $key, $iv, 1);
  1290. $cipherMore = '';
  1291. my ($j, $digest);
  1292. for ($j=0; $j<64; ++$j) {
  1293. $x = '';
  1294. $x .= CipherUpdate($password) if length $password;
  1295. $x .= CipherUpdate($block);
  1296. $x .= CipherUpdate($vector) if length $vector;
  1297. if ($j == 0) {
  1298. my @a = unpack('C16', $x);
  1299. my $sum = 0;
  1300. $sum += $_ foreach @a;
  1301. # set SHA block size (32, 48 or 64 bytes = SHA-256, 384 or 512)
  1302. $blockSize = 32 + ($sum % 3) * 16;
  1303. $digest = Digest::SHA->new($blockSize * 8);
  1304. }
  1305. $digest->add($x);
  1306. }
  1307. $h = $digest->digest();
  1308. $key = substr($h, 0, 16);
  1309. substr($input,0,16) = $h;
  1310. $iv = substr($h, 16, 16);
  1311. ++$i;
  1312. }
  1313. return substr($h, 0, 32);
  1314. }
  1315. #------------------------------------------------------------------------------
  1316. # Initialize decryption
  1317. # Inputs: 0) ExifTool object reference, 1) Encrypt dictionary reference,
  1318. # 2) ID from file trailer dictionary
  1319. # Returns: error string or undef on success (and sets $cryptInfo)
  1320. sub DecryptInit($$$)
  1321. {
  1322. local $_;
  1323. my ($et, $encrypt, $id) = @_;
  1324. undef $cryptInfo;
  1325. unless ($encrypt and ref $encrypt eq 'HASH') {
  1326. return 'Error loading Encrypt object';
  1327. }
  1328. my $filt = $$encrypt{Filter};
  1329. unless ($filt and $filt =~ s/^\///) {
  1330. return 'Encrypt dictionary has no Filter!';
  1331. }
  1332. # extract some interesting tags
  1333. my $ver = $$encrypt{V} || 0;
  1334. my $rev = $$encrypt{R} || 0;
  1335. my $enc = "$filt V$ver";
  1336. $enc .= ".$rev" if $filt eq 'Standard';
  1337. $enc .= " ($1)" if $$encrypt{SubFilter} and $$encrypt{SubFilter} =~ /^\/(.*)/;
  1338. $enc .= ' (' . ($$encrypt{Length} || 40) . '-bit)' if $filt eq 'Standard';
  1339. my $tagTablePtr = GetTagTable('Image::ExifTool::PDF::Encrypt');
  1340. $et->HandleTag($tagTablePtr, 'Filter', $enc);
  1341. if ($filt ne 'Standard') {
  1342. return "Encryption filter $filt currently not supported";
  1343. } elsif (not defined $$encrypt{R}) {
  1344. return 'Standard security handler missing revision';
  1345. }
  1346. unless ($$encrypt{O} and $$encrypt{P} and $$encrypt{U}) {
  1347. return 'Incomplete Encrypt specification';
  1348. }
  1349. if ("$ver.$rev" >= 5.6) {
  1350. # apologize for poor performance (AES is a pure Perl implementation)
  1351. $et->Warn('Decryption is very slow for encryption V5.6 or higher', 1);
  1352. }
  1353. $et->HandleTag($tagTablePtr, 'P', $$encrypt{P});
  1354. my %parm; # optional parameters extracted from Encrypt dictionary
  1355. if ($ver == 1 or $ver == 2) {
  1356. $cryptString = $cryptStream = 1;
  1357. } elsif ($ver == 4 or $ver == 5) {
  1358. # initialize our $cryptString and $cryptStream flags
  1359. foreach ('StrF', 'StmF') {
  1360. my $flagPt = $_ eq 'StrF' ? \$cryptString : \$cryptStream;
  1361. $$flagPt = $$encrypt{$_};
  1362. undef $$flagPt if $$flagPt and $$flagPt eq '/Identity';
  1363. return "Unsupported $_ encryption $$flagPt" if $$flagPt and $$flagPt ne '/StdCF';
  1364. }
  1365. if ($cryptString or $cryptStream) {
  1366. return 'Missing or invalid Encrypt StdCF entry' unless ref $$encrypt{CF} eq 'HASH' and
  1367. ref $$encrypt{CF}{StdCF} eq 'HASH' and $$encrypt{CF}{StdCF}{CFM};
  1368. my $cryptMeth = $$encrypt{CF}{StdCF}{CFM};
  1369. unless ($cryptMeth =~ /^\/(V2|AESV2|AESV3)$/) {
  1370. return "Unsupported encryption method $cryptMeth";
  1371. }
  1372. # set "_aesv2" or "_aesv3" flag in %$encrypt hash if AES encryption was used
  1373. $$encrypt{'_' . lc($1)} = 1 if $cryptMeth =~ /^\/(AESV2|AESV3)$/;
  1374. }
  1375. if ($ver == 5) {
  1376. # validate OE and UE entries
  1377. foreach ('OE', 'UE') {
  1378. return "Missing Encrypt $_ entry" unless $$encrypt{$_};
  1379. $parm{$_} = ReadPDFValue($$encrypt{$_});
  1380. return "Invalid Encrypt $_ entry" unless length $parm{$_} == 32;
  1381. }
  1382. require Image::ExifTool::AES; # will need this later
  1383. }
  1384. } else {
  1385. return "Encryption version $ver currently not supported";
  1386. }
  1387. $id or return "Can't decrypt (no document ID)";
  1388. # make sure we have the necessary libraries available
  1389. if ($ver < 5) {
  1390. unless (eval { require Digest::MD5 }) {
  1391. return "Install Digest::MD5 to process encrypted PDF";
  1392. }
  1393. } else {
  1394. unless (eval { require Digest::SHA }) {
  1395. return "Install Digest::SHA to process AES-256 encrypted PDF";
  1396. }
  1397. }
  1398. # calculate file-level en/decryption key
  1399. my $pad = "\x28\xBF\x4E\x5E\x4E\x75\x8A\x41\x64\x00\x4E\x56\xFF\xFA\x01\x08".
  1400. "\x2E\x2E\x00\xB6\xD0\x68\x3E\x80\x2F\x0C\xA9\xFE\x64\x53\x69\x7A";
  1401. my $o = ReadPDFValue($$encrypt{O});
  1402. my $u = ReadPDFValue($$encrypt{U});
  1403. # set flag indicating whether metadata is encrypted
  1404. # (in version 4 and higher, metadata streams may not be encrypted)
  1405. if ($ver < 4 or not $$encrypt{EncryptMetadata} or $$encrypt{EncryptMetadata} !~ /false/i) {
  1406. $$encrypt{_meta} = 1;
  1407. }
  1408. # try no password first, then try provided password if available
  1409. my ($try, $key);
  1410. for ($try=0; ; ++$try) {
  1411. my $password;
  1412. if ($try == 0) {
  1413. $password = '';
  1414. } elsif ($try == 1) {
  1415. $password = $et->Options('Password');
  1416. return 'Document is password protected (use Password option)' unless defined $password;
  1417. # make sure there is no UTF-8 flag on the password
  1418. if ($] >= 5.006 and (eval { require Encode; Encode::is_utf8($password) } or $@)) {
  1419. # repack by hand if Encode isn't available
  1420. $password = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$password)) : Encode::encode('utf8',$password);
  1421. }
  1422. } else {
  1423. return 'Incorrect password';
  1424. }
  1425. if ($ver < 5) {
  1426. if (length $password) {
  1427. # password must be encoding in PDFDocEncoding (ref iso32000)
  1428. $password = $et->Encode($password, 'PDFDoc');
  1429. # truncate or pad the password to exactly 32 bytes
  1430. if (length($password) > 32) {
  1431. $password = substr($password, 0, 32);
  1432. } elsif (length($password) < 32) {
  1433. $password .= substr($pad, 0, 32-length($password));
  1434. }
  1435. } else {
  1436. $password = $pad;
  1437. }
  1438. $key = $password . $o . pack('V', $$encrypt{P}) . $id;
  1439. my $rep = 1;
  1440. if ($rev == 3 or $rev == 4) {
  1441. # must add this if metadata not encrypted
  1442. $key .= "\xff\xff\xff\xff" unless $$encrypt{_meta};
  1443. $rep += 50; # repeat MD5 50 more times if revision is 3 or greater
  1444. }
  1445. my ($len, $i, $dat);
  1446. if ($ver == 1) {
  1447. $len = 5;
  1448. } else {
  1449. $len = $$encrypt{Length} || 40;
  1450. $len >= 40 or return 'Bad Encrypt Length';
  1451. $len = int($len / 8);
  1452. }
  1453. for ($i=0; $i<$rep; ++$i) {
  1454. $key = substr(Digest::MD5::md5($key), 0, $len);
  1455. }
  1456. # decrypt U to see if a user password is required
  1457. if ($rev >= 3) {
  1458. $dat = Digest::MD5::md5($pad . $id);
  1459. RC4Crypt(\$dat, $key);
  1460. for ($i=1; $i<=19; ++$i) {
  1461. my @key = unpack('C*', $key);
  1462. foreach (@key) { $_ ^= $i; }
  1463. RC4Crypt(\$dat, pack('C*', @key));
  1464. }
  1465. $dat .= substr($u, 16);
  1466. } else {
  1467. $dat = $pad;
  1468. RC4Crypt(\$dat, $key);
  1469. }
  1470. last if $dat eq $u; # all done if this was the correct key
  1471. } else {
  1472. return 'Invalid O or U Encrypt entries' if length($o) < 48 or length($u) < 48;
  1473. if (length $password) {
  1474. # Note: this should be good for passwords containing reasonable characters,
  1475. # but to be bullet-proof we need to apply the SASLprep (IETF RFC 4013) profile
  1476. # of stringprep (IETF RFC 3454) to the password before encoding in UTF-8
  1477. $password = $et->Encode($password, 'UTF8');
  1478. $password = substr($password, 0, 127) if length($password) > 127;
  1479. }
  1480. # test for the owner password
  1481. my $sha = GetHash($password, substr($o,32,8), substr($u,0,48), $rev);
  1482. if ($sha eq substr($o, 0, 32)) {
  1483. $key = GetHash($password, substr($o,40,8), substr($u,0,48), $rev);
  1484. my $dat = ("\0" x 16) . $parm{OE};
  1485. # decrypt with no padding
  1486. my $err = Image::ExifTool::AES::Crypt(\$dat, $key, 0, 1);
  1487. return $err if $err;
  1488. $key = $dat; # use this as the file decryption key
  1489. last;
  1490. }
  1491. # test for the user password
  1492. $sha = GetHash($password, substr($u,32,8), '', $rev);
  1493. if ($sha eq substr($u, 0, 32)) {
  1494. $key = GetHash($password, substr($u,40,8), '', $rev);
  1495. my $dat = ("\0" x 16) . $parm{UE};
  1496. my $err = Image::ExifTool::AES::Crypt(\$dat, $key, 0, 1);
  1497. return $err if $err;
  1498. $key = $dat; # use this as the file decryption key
  1499. last;
  1500. }
  1501. }
  1502. }
  1503. $$encrypt{_key} = $key; # save the file-level encryption key
  1504. $cryptInfo = $encrypt; # save reference to the file-level Encrypt object
  1505. return undef; # success!
  1506. }
  1507. #------------------------------------------------------------------------------
  1508. # Decrypt/Encrypt data
  1509. # Inputs: 0) data ref
  1510. # 1) PDF object reference to use as crypt key extension (may be 'none' to
  1511. # avoid extending the encryption key, as for streams with Crypt Filter)
  1512. # 2) encrypt flag (false for decryption)
  1513. sub Crypt($$;$)
  1514. {
  1515. return unless $cryptInfo;
  1516. my ($dataPt, $keyExt, $encrypt) = @_;
  1517. # do not decrypt if the key extension object is undefined
  1518. # (this doubles as a flag to disable decryption/encryption)
  1519. return unless defined $keyExt;
  1520. my $key = $$cryptInfo{_key};
  1521. # apply the necessary crypt key extension
  1522. unless ($$cryptInfo{_aesv3}) {
  1523. unless ($keyExt eq 'none') {
  1524. # extend crypt key using object and generation number
  1525. unless ($keyExt =~ /^(I\d+ )?(\d+) (\d+)/) {
  1526. $$cryptInfo{_error} = 'Invalid object reference for encryption';
  1527. return;
  1528. }
  1529. $key .= substr(pack('V', $2), 0, 3) . substr(pack('V', $3), 0, 2);
  1530. }
  1531. # add AES-128 salt if necessary (this little gem is conveniently
  1532. # omitted from the Adobe PDF 1.6 documentation, causing me to
  1533. # waste 12 hours trying to figure out why this wasn't working --
  1534. # it appears in ISO32000 though, so I should have been using that)
  1535. $key .= 'sAlT' if $$cryptInfo{_aesv2};
  1536. my $len = length($key);
  1537. $key = Digest::MD5::md5($key); # get 16-byte MD5 digest
  1538. $key = substr($key, 0, $len) if $len < 16; # trim if necessary
  1539. }
  1540. # perform the decryption/encryption
  1541. if ($$cryptInfo{_aesv2} or $$cryptInfo{_aesv3}) {
  1542. require Image::ExifTool::AES;
  1543. my $err = Image::ExifTool::AES::Crypt($dataPt, $key, $encrypt);
  1544. $err and $$cryptInfo{_error} = $err;
  1545. } else {
  1546. RC4Crypt($dataPt, $key);
  1547. }
  1548. }
  1549. #------------------------------------------------------------------------------
  1550. # Decrypt/Encrypt stream data
  1551. # Inputs: 0) dictionary ref, 1) PDF object reference to use as crypt key extension
  1552. sub CryptStream($$)
  1553. {
  1554. return unless $cryptStream;
  1555. my ($dict, $keyExt) = @_;
  1556. my $type = $$dict{Type} || '';
  1557. # XRef streams are not encrypted (ref 3, page 50),
  1558. # and Metadata may or may not be encrypted
  1559. if ($cryptInfo and $type ne '/XRef' and
  1560. ($$cryptInfo{_meta} or $type ne '/Metadata'))
  1561. {
  1562. Crypt(\$$dict{_stream}, $keyExt, $$dict{_decrypted});
  1563. # toggle _decrypted flag
  1564. $$dict{_decrypted} = ($$dict{_decrypted} ? undef : 1);
  1565. } else {
  1566. $$dict{_decrypted} = 0; # stream should never be encrypted
  1567. }
  1568. }
  1569. #------------------------------------------------------------------------------
  1570. # Generate a new PDF tag (based on its ID) and add it to a tag table
  1571. # Inputs: 0) tag table ref, 1) tag ID
  1572. # Returns: tag info ref
  1573. sub NewPDFTag($$)
  1574. {
  1575. my ($tagTablePtr, $tag) = @_;
  1576. my $name = $tag;
  1577. # translate URL-like escape sequences
  1578. $name =~ s/#([0-9a-f]{2})/chr(hex($1))/ige;
  1579. $name =~ s/[^-\w]+/_/g; # translate invalid characters to an underline
  1580. $name =~ s/(^|_)([a-z])/\U$2/g; # start words with upper case
  1581. my $tagInfo = { Name => $name };
  1582. AddTagToTable($tagTablePtr, $tag, $tagInfo);
  1583. return $tagInfo;
  1584. }
  1585. #------------------------------------------------------------------------------
  1586. # Process AcroForm dictionary to set HasXMLFormsArchitecture flag
  1587. # Inputs: Same as ProcessDict
  1588. sub ProcessAcroForm($$$$;$$)
  1589. {
  1590. my ($et, $tagTablePtr, $dict, $xref, $nesting, $type) = @_;
  1591. $et->HandleTag($tagTablePtr, '_has_xfa', $$dict{XFA} ? 'true' : 'false');
  1592. return ProcessDict($et, $tagTablePtr, $dict, $xref, $nesting, $type);
  1593. }
  1594. #------------------------------------------------------------------------------
  1595. # Process PDF dictionary extract tag values
  1596. # Inputs: 0) ExifTool object reference, 1) tag table reference
  1597. # 2) dictionary reference, 3) cross-reference table reference,
  1598. # 4) nesting depth, 5) dictionary capture type
  1599. sub ProcessDict($$$$;$$)
  1600. {
  1601. my ($et, $tagTablePtr, $dict, $xref, $nesting, $type) = @_;
  1602. my $verbose = $et->Options('Verbose');
  1603. my $unknown = $$tagTablePtr{EXTRACT_UNKNOWN};
  1604. my $embedded = (defined $unknown and not $unknown and $et->Options('ExtractEmbedded'));
  1605. my @tags = @{$$dict{_tags}};
  1606. my ($next, %join);
  1607. my $index = 0;
  1608. $nesting = ($nesting || 0) + 1;
  1609. if ($nesting > 50) {
  1610. $et->WarnOnce('Nesting too deep (directory ignored)');
  1611. return;
  1612. }
  1613. # save entire dictionary for rewriting if specified
  1614. if ($$et{PDF_CAPTURE} and $$tagTablePtr{VARS} and
  1615. $tagTablePtr->{VARS}->{CAPTURE})
  1616. {
  1617. my $name;
  1618. foreach $name (@{$tagTablePtr->{VARS}->{CAPTURE}}) {
  1619. next if $$et{PDF_CAPTURE}{$name};
  1620. # make sure we load the right type if indicated
  1621. next if $type and $type ne $name;
  1622. $$et{PDF_CAPTURE}{$name} = $dict;
  1623. last;
  1624. }
  1625. }
  1626. #
  1627. # extract information from all tags in the dictionary
  1628. #
  1629. for (;;) {
  1630. my ($tag, $isSubDoc);
  1631. if (@tags) {
  1632. $tag = shift @tags;
  1633. } elsif (defined $next and not $next) {
  1634. $tag = 'Next';
  1635. $next = 1;
  1636. } else {
  1637. last;
  1638. }
  1639. my $val = $$dict{$tag};
  1640. my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
  1641. if ($tagInfo) {
  1642. undef $tagInfo if $$tagInfo{NoProcess};
  1643. } elsif ($embedded and $tag =~ /^(.*?)(\d+)$/ and
  1644. $$tagTablePtr{$1} and (ref $val ne 'SCALAR' or not $fetched{$$val}))
  1645. {
  1646. my ($name, $num) = ($1, $2);
  1647. $tagInfo = $et->GetTagInfo($tagTablePtr, $name);
  1648. if (ref $tagInfo eq 'HASH' and $$tagInfo{JoinStreams}) {
  1649. $fetched{$$val} = 1;
  1650. my $obj = FetchObject($et, $$val, $xref, $tag);
  1651. $join{$name} = [] unless $join{$name};
  1652. next unless ref $obj eq 'HASH' and $$obj{_stream};
  1653. # save all the stream data to join later
  1654. DecodeStream($et, $obj);
  1655. $join{$name}->[$num] = $$obj{_stream};
  1656. undef $tagInfo; # don't process
  1657. } else {
  1658. $isSubDoc = 1; # treat as a sub-document
  1659. }
  1660. }
  1661. if ($verbose) {
  1662. my ($val2, $extra);
  1663. if (ref $val eq 'SCALAR') {
  1664. $extra = ", indirect object ($$val)";
  1665. if ($fetched{$$val}) {
  1666. $val2 = "ref($$val)";
  1667. } elsif ($tag eq 'Next' and not $next) {
  1668. # handle 'Next' links after all others
  1669. $next = 0;
  1670. next;
  1671. } else {
  1672. $fetched{$$val} = 1;
  1673. $val = FetchObject($et, $$val, $xref, $tag);
  1674. unless (defined $val) {
  1675. my $str;
  1676. if (defined $lastOffset) {
  1677. $val2 = '<free>';
  1678. $str = 'Object was freed';
  1679. } else {
  1680. $val2 = '<err>';
  1681. $str = 'Error reading object';
  1682. }
  1683. $et->VPrint(0, "$$et{INDENT}${str}:\n");
  1684. }
  1685. }
  1686. } elsif (ref $val eq 'HASH') {
  1687. $extra = ', direct dictionary';
  1688. } elsif (ref $val eq 'ARRAY') {
  1689. $extra = ', direct array of ' . scalar(@$val) . ' objects';
  1690. } else {
  1691. $extra = ', direct object';
  1692. }
  1693. my $isSubdir;
  1694. if (ref $val eq 'HASH') {
  1695. $isSubdir = 1;
  1696. } elsif (ref $val eq 'ARRAY') {
  1697. # recurse into objects in arrays only if they are lists of
  1698. # dictionaries or indirect objects which could be dictionaries
  1699. $isSubdir = 1 if @$val;
  1700. foreach (@$val) {
  1701. next if ref $_ eq 'HASH' or ref $_ eq 'SCALAR';
  1702. undef $isSubdir;
  1703. last;
  1704. }
  1705. }
  1706. if ($isSubdir) {
  1707. # create bogus subdirectory to recurse into this dict
  1708. $tagInfo or $tagInfo = {
  1709. Name => $tag,
  1710. SubDirectory => { TagTable => 'Image::ExifTool::PDF::Unknown' },
  1711. };
  1712. } else {
  1713. if (ref $val eq 'ARRAY') {
  1714. my @list = @$val;
  1715. foreach (@list) {
  1716. $_ = "ref($$_)" if ref $_ eq 'SCALAR';
  1717. $_ = '<undef>' unless defined $_;
  1718. }
  1719. $val2 = '[' . join(',',@list) . ']';
  1720. }
  1721. # generate tag info if we will use it later
  1722. if (not $tagInfo and defined $val and $unknown) {
  1723. $tagInfo = NewPDFTag($tagTablePtr, $tag);
  1724. }
  1725. }
  1726. $et->VerboseInfo($tag, $tagInfo,
  1727. Value => $val2 || $val,
  1728. Extra => $extra,
  1729. Index => $index++,
  1730. );
  1731. next unless defined $val;
  1732. }
  1733. unless ($tagInfo) {
  1734. # add any tag found in Info dictionary to table
  1735. next unless $unknown;
  1736. $tagInfo = NewPDFTag($tagTablePtr, $tag);
  1737. }
  1738. # increment document number if necessary
  1739. my ($oldDocNum, $oldNumTags);
  1740. if ($isSubDoc) {
  1741. $oldDocNum = $$et{DOC_NUM};
  1742. $oldNumTags = $$et{NUM_FOUND};
  1743. $$et{DOC_NUM} = ++$$et{DOC_COUNT};
  1744. }
  1745. if ($$tagInfo{SubDirectory}) {
  1746. # process the subdirectory
  1747. my @subDicts;
  1748. if (ref $val eq 'ARRAY') {
  1749. @subDicts = @{$val};
  1750. } else {
  1751. @subDicts = ( $val );
  1752. }
  1753. # loop through all values of this tag
  1754. for (;;) {
  1755. my $subDict = shift @subDicts or last;
  1756. # save last fetched object in case we fetch another one here
  1757. my $prevFetched = $lastFetched;
  1758. if (ref $subDict eq 'SCALAR') {
  1759. # only fetch once (other copies are obsolete)
  1760. next if $fetched{$$subDict};
  1761. if ($$tagInfo{IgnoreDuplicates}) {
  1762. my $flag = "ProcessedPDF_$tag";
  1763. if ($$et{$flag}) {
  1764. next if $et->WarnOnce("Ignored duplicate $tag dictionary", 2);
  1765. } else {
  1766. $$et{$flag} = 1;
  1767. }
  1768. }
  1769. # load dictionary via an indirect reference
  1770. $fetched{$$subDict} = 1;
  1771. my $obj = FetchObject($et, $$subDict, $xref, $tag);
  1772. unless (defined $obj) {
  1773. unless (defined $lastOffset) {
  1774. $et->Warn("Error reading $tag object ($$subDict)");
  1775. }
  1776. next;
  1777. }
  1778. $subDict = $obj;
  1779. }
  1780. if (ref $subDict eq 'ARRAY') {
  1781. # convert array of key/value pairs to a hash
  1782. next if @$subDict < 2;
  1783. my %hash = ( _tags => [] );
  1784. while (@$subDict >= 2) {
  1785. my $key = shift @$subDict;
  1786. $key =~ s/^\///;
  1787. push @{$hash{_tags}}, $key;
  1788. $hash{$key} = shift @$subDict;
  1789. }
  1790. $subDict = \%hash;
  1791. } else {
  1792. next unless ref $subDict eq 'HASH';
  1793. }
  1794. # set flag to re-crypt all strings when rewriting if the dictionary
  1795. # came from an encrypted stream
  1796. $$subDict{_needCrypt}{'*'} = 1 unless $lastFetched;
  1797. my $subTablePtr = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
  1798. if (not $verbose) {
  1799. my $proc = $$subTablePtr{PROCESS_PROC} || \&ProcessDict;
  1800. &$proc($et, $subTablePtr, $subDict, $xref, $nesting);
  1801. } elsif ($next) {
  1802. # handle 'Next' links at this level to avoid deep recursion
  1803. undef $next;
  1804. $index = 0;
  1805. $tagTablePtr = $subTablePtr;
  1806. $dict = $subDict;
  1807. @tags = @{$$subDict{_tags}};
  1808. $et->VerboseDir($tag, scalar(@tags));
  1809. } else {
  1810. my $oldIndent = $$et{INDENT};
  1811. my $oldDir = $$et{DIR_NAME};
  1812. $$et{INDENT} .= '| ';
  1813. $$et{DIR_NAME} = $tag;
  1814. $et->VerboseDir($tag, scalar(@{$$subDict{_tags}}));
  1815. ProcessDict($et, $subTablePtr, $subDict, $xref, $nesting);
  1816. $$et{INDENT} = $oldIndent;
  1817. $$et{DIR_NAME} = $oldDir;
  1818. }
  1819. $lastFetched = $prevFetched;
  1820. }
  1821. } else {
  1822. # fetch object if necessary
  1823. # (OS X 10.6 writes indirect objects in the Info dictionary!)
  1824. if (ref $val eq 'SCALAR') {
  1825. my $prevFetched = $lastFetched;
  1826. # (note: fetching the same object multiple times is OK here)
  1827. $val = FetchObject($et, $$val, $xref, $tag);
  1828. if (defined $val) {
  1829. $val = ReadPDFValue($val);
  1830. # set flag to re-encrypt if necessary if rewritten
  1831. $$dict{_needCrypt}{$tag} = ($lastFetched ? 0 : 1) if $cryptString;
  1832. $lastFetched = $prevFetched; # restore last fetched object reference
  1833. }
  1834. } else {
  1835. $val = ReadPDFValue($val);
  1836. }
  1837. # convert from UTF-16 (big endian) to UTF-8 or Latin if necessary
  1838. # unless this is binary data (hex-encoded strings would not have been converted)
  1839. if (ref $val) {
  1840. if (ref $val eq 'ARRAY') {
  1841. my $v;
  1842. foreach $v (@$val) {
  1843. $et->FoundTag($tagInfo, $v);
  1844. }
  1845. }
  1846. } elsif (defined $val) {
  1847. my $format = $$tagInfo{Format} || $$tagInfo{Writable} || 'string';
  1848. $val = ConvertPDFDate($val) if $format eq 'date';
  1849. if (not $$tagInfo{Binary} and $val =~ /[\x18-\x1f\x80-\xff]/) {
  1850. # text string is already in Unicode if it starts with "\xfe\xff",
  1851. # otherwise we must first convert from PDFDocEncoding
  1852. $val = $et->Decode($val, ($val=~s/^\xfe\xff// ? 'UCS2' : 'PDFDoc'), 'MM');
  1853. }
  1854. if ($$tagInfo{List} and not $$et{OPTIONS}{NoPDFList}) {
  1855. # separate tokens in comma or whitespace delimited lists
  1856. my @values = ($val =~ /,/) ? split /,+\s*/, $val : split ' ', $val;
  1857. foreach $val (@values) {
  1858. $et->FoundTag($tagInfo, $val);
  1859. }
  1860. } else {
  1861. # a simple tag value
  1862. $et->FoundTag($tagInfo, $val);
  1863. }
  1864. }
  1865. }
  1866. if ($isSubDoc) {
  1867. # restore original document number
  1868. $$et{DOC_NUM} = $oldDocNum;
  1869. --$$et{DOC_COUNT} if $oldNumTags == $$et{NUM_FOUND};
  1870. }
  1871. }
  1872. #
  1873. # extract information from joined streams if necessary
  1874. #
  1875. if (%join) {
  1876. my ($tag, $i);
  1877. foreach $tag (sort keys %join) {
  1878. my $list = $join{$tag};
  1879. last unless defined $$list[1] and $$list[1] =~ /^%.*?([\x0d\x0a]*)/;
  1880. my $buff = "%!PS-Adobe-3.0$1"; # add PS header with same line break
  1881. for ($i=1; defined $$list[$i]; ++$i) {
  1882. $buff .= $$list[$i];
  1883. undef $$list[$i]; # free memory
  1884. }
  1885. # increment document number for tags extracted from embedded EPS
  1886. my $oldDocNum = $$et{DOC_NUM};
  1887. my $oldNumTags = $$et{NUM_FOUND};
  1888. $$et{DOC_NUM} = ++$$et{DOC_COUNT};
  1889. # extract PostScript information
  1890. $et->HandleTag($tagTablePtr, $tag, $buff);
  1891. $$et{DOC_NUM} = $oldDocNum;
  1892. # revert document counter if we didn't add any new tags
  1893. --$$et{DOC_COUNT} if $oldNumTags == $$et{NUM_FOUND};
  1894. delete $$et{DOC_NUM};
  1895. }
  1896. }
  1897. #
  1898. # extract information from stream object if it exists (eg. Metadata stream)
  1899. #
  1900. for (;;) { # (cheap goto)
  1901. last unless $$dict{_stream};
  1902. my $tag = '_stream';
  1903. # add Subtype (if it exists) to stream name and remove leading '/'
  1904. ($tag = $$dict{Subtype} . $tag) =~ s/^\/// if $$dict{Subtype};
  1905. last unless $$tagTablePtr{$tag};
  1906. my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag) or last;
  1907. unless ($$tagInfo{SubDirectory}) {
  1908. # don't build filter lists across different images
  1909. delete $$et{LIST_TAGS}{$$tagTablePtr{Filter}};
  1910. # we arrive here only when extracting embedded images
  1911. # - only extract known image types and ignore others
  1912. my $filter = $$dict{Filter} || '';
  1913. $filter = @$filter[-1] if ref $filter eq 'ARRAY'; # (get last Filter type)
  1914. my $result;
  1915. if ($filter eq '/DCTDecode' or $filter eq '/JPXDecode') {
  1916. DecodeStream($et, $dict) or last;
  1917. # save the image itself
  1918. $et->FoundTag($tagInfo, \$$dict{_stream});
  1919. # extract information from embedded image
  1920. $result = $et->ExtractInfo(\$$dict{_stream}, { ReEntry => 1 });
  1921. }
  1922. unless ($result) {
  1923. $et->FoundTag('FileType', defined $result ? '(unknown)' : '(unsupported)');
  1924. }
  1925. last;
  1926. }
  1927. # decode stream if necessary
  1928. DecodeStream($et, $dict) or last;
  1929. if ($verbose > 2) {
  1930. $et->VPrint(2,"$$et{INDENT}$$et{DIR_NAME} stream data\n");
  1931. my %parms = ( Prefix => $$et{INDENT} );
  1932. $parms{MaxLen} = $verbose > 3 ? 1024 : 96 if $verbose < 5;
  1933. HexDump(\$$dict{_stream}, undef, %parms);
  1934. }
  1935. # extract information from stream
  1936. my %dirInfo = (
  1937. DataPt => \$$dict{_stream},
  1938. DataLen => length $$dict{_stream},
  1939. DirStart => 0,
  1940. DirLen => length $$dict{_stream},
  1941. Parent => 'PDF',
  1942. );
  1943. my $subTablePtr = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
  1944. unless ($et->ProcessDirectory(\%dirInfo, $subTablePtr)) {
  1945. $et->Warn("Error processing $$tagInfo{Name} information");
  1946. }
  1947. last;
  1948. }
  1949. }
  1950. #------------------------------------------------------------------------------
  1951. # Extract information from PDF file
  1952. # Inputs: 0) ExifTool object reference, 1) dirInfo reference
  1953. # Returns: 0 if not a PDF file, 1 on success, otherwise a negative error number
  1954. sub ReadPDF($$)
  1955. {
  1956. my ($et, $dirInfo) = @_;
  1957. my $raf = $$dirInfo{RAF};
  1958. my $verbose = $et->Options('Verbose');
  1959. my ($buff, $encrypt, $id);
  1960. #
  1961. # validate PDF file
  1962. #
  1963. # (linearization dictionary must be in the first 1024 bytes of the file)
  1964. $raf->Read($buff, 1024) >= 8 or return 0;
  1965. $buff =~ /^%PDF-(\d+\.\d+)/ or return 0;
  1966. $pdfVer = $1;
  1967. $et->SetFileType(); # set the FileType tag
  1968. $et->Warn("May not be able to read a PDF version $pdfVer file") if $pdfVer >= 2.0;
  1969. # store PDFVersion tag
  1970. my $tagTablePtr = GetTagTable('Image::ExifTool::PDF::Root');
  1971. $et->HandleTag($tagTablePtr, 'Version', $pdfVer);
  1972. $tagTablePtr = GetTagTable('Image::ExifTool::PDF::Main');
  1973. #
  1974. # check for a linearized PDF (only if reading)
  1975. #
  1976. my $capture = $$et{PDF_CAPTURE};
  1977. unless ($capture) {
  1978. my $lin = 'false';
  1979. if ($buff =~ /<</g) {
  1980. $buff = substr($buff, pos($buff) - 2);
  1981. my $dict = ExtractObject($et, \$buff);
  1982. if (ref $dict eq 'HASH' and $$dict{Linearized} and $$dict{L}) {
  1983. if (not $$et{VALUE}{FileSize}) {
  1984. undef $lin; # can't determine if it is linearized
  1985. } elsif ($$dict{L} == $$et{VALUE}{FileSize}) {
  1986. $lin = 'true';
  1987. }
  1988. }
  1989. }
  1990. $et->HandleTag($tagTablePtr, '_linearized', $lin) if $lin;
  1991. }
  1992. #
  1993. # read the xref tables referenced from startxref at the end of the file
  1994. #
  1995. my @xrefOffsets;
  1996. $raf->Seek(0, 2) or return -2;
  1997. # the %%EOF must occur within the last 1024 bytes of the file (PDF spec, appendix H)
  1998. my $len = $raf->Tell();
  1999. $len = 1024 if $len > 1024;
  2000. $raf->Seek(-$len, 2) or return -2;
  2001. $raf->Read($buff, $len) == $len or return -3;
  2002. # find the LAST xref table in the file (may be multiple %%EOF marks)
  2003. $buff =~ /^.*startxref(\s+)(\d+)(\s+)%%EOF/s or return -4;
  2004. my $ws = $1 . $3;
  2005. my $xr = $2;
  2006. push @xrefOffsets, $xr, 'Main';
  2007. # set input record separator
  2008. local $/ = $ws =~ /(\x0d\x0a|\x0d|\x0a)/ ? $1 : "\x0a";
  2009. my (%xref, @mainDicts, %loaded, $mainFree);
  2010. # initialize variables to capture when rewriting
  2011. if ($capture) {
  2012. $capture->{startxref} = $xr;
  2013. $capture->{xref} = \%xref;
  2014. $capture->{newline} = $/;
  2015. $capture->{mainFree} = $mainFree = { };
  2016. }
  2017. XRef:
  2018. while (@xrefOffsets) {
  2019. my $offset = shift @xrefOffsets;
  2020. my $type = shift @xrefOffsets;
  2021. next if $loaded{$offset}; # avoid infinite recursion
  2022. unless ($raf->Seek($offset, 0)) {
  2023. %loaded or return -5;
  2024. $et->Warn('Bad offset for secondary xref table');
  2025. next;
  2026. }
  2027. # Note: care must be taken because ReadLine may read more than we want if
  2028. # the newline sequence for this table is different than the rest of the file
  2029. for (;;) {
  2030. unless ($raf->ReadLine($buff)) {
  2031. %loaded or return -6;
  2032. $et->Warn('Bad offset for secondary xref table');
  2033. next XRef;
  2034. }
  2035. last if $buff =~/\S/; # skip blank lines
  2036. }
  2037. my $loadXRefStream;
  2038. if ($buff =~ s/^\s*xref\s+//s) {
  2039. # load xref table
  2040. for (;;) {
  2041. # read another line if necessary (skipping blank lines)
  2042. $raf->ReadLine($buff) or return -6 until $buff =~ /\S/;
  2043. last if $buff =~ s/^\s*trailer([\s<[(])/$1/s;
  2044. $buff =~ s/^\s*(\d+)\s+(\d+)\s+//s or return -4;
  2045. my ($start, $num) = ($1, $2);
  2046. $raf->Seek(-length($buff), 1) or return -4;
  2047. my $i;
  2048. for ($i=0; $i<$num; ++$i) {
  2049. $raf->Read($buff, 20) == 20 or return -6;
  2050. $buff =~ /^\s*(\d{10}) (\d{5}) (f|n)/s or return -4;
  2051. my $num = $start + $i;
  2052. # save offset for newest copy of all objects
  2053. # (or next object number for free objects)
  2054. unless (defined $xref{$num}) {
  2055. my ($offset, $gen) = (int($1), int($2));
  2056. $xref{$num} = $offset;
  2057. if ($3 eq 'f') {
  2058. # save free objects in last xref table for rewriting
  2059. $$mainFree{$num} = [ $offset, $gen, 'f' ] if $mainFree;
  2060. next;
  2061. }
  2062. # also save offset keyed by object reference string
  2063. $xref{"$num $gen R"} = $offset;
  2064. }
  2065. }
  2066. # (I have a sample from Adobe which has an empty xref table)
  2067. # %xref or return -4; # xref table may not be empty
  2068. $buff = '';
  2069. }
  2070. undef $mainFree; # only do this for the last xref table
  2071. } elsif ($buff =~ s/^\s*(\d+)\s+(\d+)\s+obj//s) {
  2072. # this is a PDF-1.5 cross-reference stream dictionary
  2073. $loadXRefStream = 1;
  2074. } else {
  2075. %loaded or return -4;
  2076. $et->Warn('Invalid secondary xref table');
  2077. next;
  2078. }
  2079. my $mainDict = ExtractObject($et, \$buff, $raf, \%xref);
  2080. unless (ref $mainDict eq 'HASH') {
  2081. %loaded or return -8;
  2082. $et->Warn('Error loading secondary dictionary');
  2083. next;
  2084. }
  2085. if ($loadXRefStream) {
  2086. # decode and save our XRef stream from PDF-1.5 file
  2087. # (but parse it later as required to save time)
  2088. # Note: this technique can potentially result in an old object
  2089. # being used if the file was incrementally updated and an older
  2090. # object from an xref table was replaced by a newer object in an
  2091. # xref stream. But doing so isn't a good idea (if allowed at all)
  2092. # because a PDF 1.4 consumer would also make this same mistake.
  2093. if ($$mainDict{Type} eq '/XRef' and $$mainDict{W} and
  2094. @{$$mainDict{W}} > 2 and $$mainDict{Size} and
  2095. DecodeStream($et, $mainDict))
  2096. {
  2097. # create Index entry if it doesn't exist
  2098. $$mainDict{Index} or $$mainDict{Index} = [ 0, $$mainDict{Size} ];
  2099. # create '_entry_size' entry for internal use
  2100. my $w = $$mainDict{W};
  2101. my $size = 0;
  2102. foreach (@$w) { $size += $_; }
  2103. $$mainDict{_entry_size} = $size;
  2104. # save this stream dictionary to use later if required
  2105. $xref{dicts} = [] unless $xref{dicts};
  2106. push @{$xref{dicts}}, $mainDict;
  2107. } else {
  2108. %loaded or return -9;
  2109. $et->Warn('Invalid xref stream in secondary dictionary');
  2110. }
  2111. }
  2112. $loaded{$offset} = 1;
  2113. # load XRef stream in hybrid file if it exists
  2114. push @xrefOffsets, $$mainDict{XRefStm}, 'XRefStm' if $$mainDict{XRefStm};
  2115. $encrypt = $$mainDict{Encrypt} if $$mainDict{Encrypt};
  2116. if ($$mainDict{ID} and ref $$mainDict{ID} eq 'ARRAY') {
  2117. $id = ReadPDFValue($mainDict->{ID}->[0]);
  2118. }
  2119. push @mainDicts, $mainDict, $type;
  2120. # load previous xref table if it exists
  2121. push @xrefOffsets, $$mainDict{Prev}, 'Prev' if $$mainDict{Prev};
  2122. }
  2123. #
  2124. # extract encryption information if necessary
  2125. #
  2126. if ($encrypt) {
  2127. if (ref $encrypt eq 'SCALAR') {
  2128. $encrypt = FetchObject($et, $$encrypt, \%xref, 'Encrypt');
  2129. }
  2130. # generate Encryption tag information
  2131. my $err = DecryptInit($et, $encrypt, $id);
  2132. if ($err) {
  2133. $et->Warn($err);
  2134. $$capture{Error} = $err if $capture;
  2135. return -1;
  2136. }
  2137. }
  2138. #
  2139. # extract the information beginning with each of the main dictionaries
  2140. #
  2141. my $i = 0;
  2142. my $num = (scalar @mainDicts) / 2;
  2143. while (@mainDicts) {
  2144. my $dict = shift @mainDicts;
  2145. my $type = shift @mainDicts;
  2146. if ($verbose) {
  2147. ++$i;
  2148. my $n = scalar(@{$$dict{_tags}});
  2149. $et->VPrint(0, "PDF dictionary ($i of $num) with $n entries:\n");
  2150. }
  2151. ProcessDict($et, $tagTablePtr, $dict, \%xref, 0, $type);
  2152. }
  2153. # handle any decryption errors
  2154. if ($encrypt) {
  2155. my $err = $$encrypt{_error};
  2156. if ($err) {
  2157. $et->Warn($err);
  2158. $$capture{Error} = $err if $capture;
  2159. return -1;
  2160. }
  2161. }
  2162. return 1;
  2163. }
  2164. #------------------------------------------------------------------------------
  2165. # ReadPDF() warning strings for each error return value
  2166. my %pdfWarning = (
  2167. # -1 is reserved as error return value with no associated warning
  2168. -2 => 'Error seeking in file',
  2169. -3 => 'Error reading file',
  2170. -4 => 'Invalid xref table',
  2171. -5 => 'Invalid xref offset',
  2172. -6 => 'Error reading xref table',
  2173. -7 => 'Error reading trailer',
  2174. -8 => 'Error reading main dictionary',
  2175. -9 => 'Invalid xref stream in main dictionary',
  2176. );
  2177. #------------------------------------------------------------------------------
  2178. # Extract information from PDF file
  2179. # Inputs: 0) ExifTool object reference, 1) dirInfo reference
  2180. # Returns: 1 if this was a valid PDF file
  2181. sub ProcessPDF($$)
  2182. {
  2183. my ($et, $dirInfo) = @_;
  2184. undef $cryptInfo; # (must not delete after returning so writer can use it)
  2185. undef $cryptStream;
  2186. undef $cryptString;
  2187. my $result = ReadPDF($et, $dirInfo);
  2188. if ($result < 0) {
  2189. $et->Warn($pdfWarning{$result}) if $pdfWarning{$result};
  2190. $result = 1;
  2191. }
  2192. # clean up and return
  2193. undef %streamObjs;
  2194. undef %fetched;
  2195. return $result;
  2196. }
  2197. 1; # end
  2198. __END__
  2199. =head1 NAME
  2200. Image::ExifTool::PDF - Read PDF meta information
  2201. =head1 SYNOPSIS
  2202. This module is loaded automatically by Image::ExifTool when required.
  2203. =head1 DESCRIPTION
  2204. This code reads meta information from PDF (Adobe Portable Document Format)
  2205. files. It supports object streams introduced in PDF-1.5 but only with a
  2206. limited set of Filter and Predictor algorithms, however all standard
  2207. encryption methods through PDF-1.7 extension level 3 are supported,
  2208. including AESV2 (AES-128) and AESV3 (AES-256).
  2209. =head1 AUTHOR
  2210. Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
  2211. This library is free software; you can redistribute it and/or modify it
  2212. under the same terms as Perl itself.
  2213. =head1 REFERENCES
  2214. =over 4
  2215. =item L<http://partners.adobe.com/public/developer/pdf/index_reference.html>
  2216. =item L<Crypt::RC4|Crypt::RC4>
  2217. =item L<http://www.adobe.com/devnet/acrobat/pdfs/PDF32000_2008.pdf>
  2218. =item L<http://www.adobe.com/content/dam/Adobe/en/devnet/pdf/pdfs/adobe_supplement_iso32000.pdf>
  2219. =item L<http://tools.ietf.org/search/rfc3454>
  2220. =item L<http://www.armware.dk/RFC/rfc/rfc4013.html>
  2221. =back
  2222. =head1 SEE ALSO
  2223. L<Image::ExifTool::TagNames/PDF Tags>,
  2224. L<Image::ExifTool(3pm)|Image::ExifTool>
  2225. =cut