exiftool-vendored.exe 12.60.0 → 12.62.0

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
@@ -0,0 +1,296 @@
1
+ #------------------------------------------------------------------------------
2
+ # File: WPG.pm
3
+ #
4
+ # Description: Read WordPerfect Graphics meta information
5
+ #
6
+ # Revisions: 2023-05-01 - P. Harvey Created
7
+ #
8
+ # References: 1) https://www.fileformat.info/format/wpg/egff.htm
9
+ # 2) https://archive.org/details/mac_Graphics_File_Formats_Second_Edition_1996/page/n991/mode/2up
10
+ # 3) http://libwpg.sourceforge.net/
11
+ #------------------------------------------------------------------------------
12
+
13
+ package Image::ExifTool::WPG;
14
+
15
+ use strict;
16
+ use vars qw($VERSION);
17
+ use Image::ExifTool qw(:DataAccess :Utils);
18
+
19
+ $VERSION = '1.00';
20
+
21
+ sub PrintRecord($$$);
22
+
23
+ # WPG metadata
24
+ %Image::ExifTool::WPG::Main = (
25
+ GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
26
+ VARS => { NO_ID => 1 },
27
+ NOTES => 'Tags extracted from WordPerfect Graphics (WPG) images.',
28
+ WPGVersion => { },
29
+ ImageWidthInches => { PrintConv => 'sprintf("%.2f",$val)' },
30
+ ImageHeightInches => { PrintConv => 'sprintf("%.2f",$val)' },
31
+ Records => {
32
+ Notes => 'records for version 1.0 files',
33
+ List => 1,
34
+ PrintHex => 2,
35
+ PrintConvColumns => 2,
36
+ PrintConv => {
37
+ OTHER => \&PrintRecord,
38
+ 0x01 => 'Fill Attributes',
39
+ 0x02 => 'Line Attributes',
40
+ 0x03 => 'Marker Attributes',
41
+ 0x04 => 'Polymarker',
42
+ 0x05 => 'Line',
43
+ 0x06 => 'Polyline',
44
+ 0x07 => 'Rectangle',
45
+ 0x08 => 'Polygon',
46
+ 0x09 => 'Ellipse',
47
+ 0x0a => 'Reserved',
48
+ 0x0b => 'Bitmap (Type 1)',
49
+ 0x0c => 'Graphics Text (Type 1)',
50
+ 0x0d => 'Graphics Text Attributes',
51
+ 0x0e => 'Color Map',
52
+ 0x0f => 'Start WPG (Type 1)',
53
+ 0x10 => 'End WPG',
54
+ 0x11 => 'PostScript Data (Type 1)',
55
+ 0x12 => 'Output Attributes',
56
+ 0x13 => 'Curved Polyline',
57
+ 0x14 => 'Bitmap (Type 2)',
58
+ 0x15 => 'Start Figure',
59
+ 0x16 => 'Start Chart',
60
+ 0x17 => 'PlanPerfect Data',
61
+ 0x18 => 'Graphics Text (Type 2)',
62
+ 0x19 => 'Start WPG (Type 2)',
63
+ 0x1a => 'Graphics Text (Type 3)',
64
+ 0x1b => 'PostScript Data (Type 2)',
65
+ },
66
+ },
67
+ RecordsV2 => {
68
+ Notes => 'records for version 2.0 files',
69
+ List => 1,
70
+ PrintHex => 2,
71
+ PrintConvColumns => 2,
72
+ PrintConv => {
73
+ OTHER => \&PrintRecord,
74
+ 0x00 => 'End Marker',
75
+ 0x01 => 'Start WPG',
76
+ 0x02 => 'End WPG',
77
+ 0x03 => 'Form Settings',
78
+ 0x04 => 'Ruler Settings',
79
+ 0x05 => 'Grid Settings',
80
+ 0x06 => 'Layer',
81
+ 0x08 => 'Pen Style Definition',
82
+ 0x09 => 'Pattern Definition',
83
+ 0x0a => 'Comment',
84
+ 0x0b => 'Color Transfer',
85
+ 0x0c => 'Color Palette',
86
+ 0x0d => 'DP Color Palette',
87
+ 0x0e => 'Bitmap Data',
88
+ 0x0f => 'Text Data',
89
+ 0x10 => 'Chart Style',
90
+ 0x11 => 'Chart Data',
91
+ 0x12 => 'Object Image',
92
+ 0x15 => 'Polyline',
93
+ 0x16 => 'Polyspline',
94
+ 0x17 => 'Polycurve',
95
+ 0x18 => 'Rectangle',
96
+ 0x19 => 'Arc',
97
+ 0x1a => 'Compound Polygon',
98
+ 0x1b => 'Bitmap',
99
+ 0x1c => 'Text Line',
100
+ 0x1d => 'Text Block',
101
+ 0x1e => 'Text Path',
102
+ 0x1f => 'Chart',
103
+ 0x20 => 'Group',
104
+ 0x21 => 'Object Capsule',
105
+ 0x22 => 'Font Settings',
106
+ 0x25 => 'Pen Fore Color',
107
+ 0x26 => 'DP Pen Fore Color',
108
+ 0x27 => 'Pen Back Color',
109
+ 0x28 => 'DP Pen Back Color',
110
+ 0x29 => 'Pen Style',
111
+ 0x2a => 'Pen Pattern',
112
+ 0x2b => 'Pen Size',
113
+ 0x2c => 'DP Pen Size',
114
+ 0x2d => 'Line Cap',
115
+ 0x2e => 'Line Join',
116
+ 0x2f => 'Brush Gradient',
117
+ 0x30 => 'DP Brush Gradient',
118
+ 0x31 => 'Brush Fore Color',
119
+ 0x32 => 'DP Brush Fore Color',
120
+ 0x33 => 'Brush Back Color',
121
+ 0x34 => 'DP Brush Back Color',
122
+ 0x35 => 'Brush Pattern',
123
+ 0x36 => 'Horizontal Line',
124
+ 0x37 => 'Vertical Line',
125
+ 0x38 => 'Poster Settings',
126
+ 0x39 => 'Image State',
127
+ 0x3a => 'Envelope Definition',
128
+ 0x3b => 'Envelope',
129
+ 0x3c => 'Texture Definition',
130
+ 0x3d => 'Brush Texture',
131
+ 0x3e => 'Texture Alignment',
132
+ 0x3f => 'Pen Texture ',
133
+ }
134
+ },
135
+ );
136
+
137
+ #------------------------------------------------------------------------------
138
+ # Print record type
139
+ # Inputs: 0) record type and count, 1) inverse flag, 2) PrintConv hash ref
140
+ # Returns: converted record name
141
+ sub PrintRecord($$$)
142
+ {
143
+ my ($val, $inv, $printConv) = @_;
144
+ my ($type, $count) = split 'x', $val;
145
+ my $prt = $$printConv{$type} || sprintf('Unknown (0x%.2x)', $type);
146
+ $prt .= " x $count" if $count;
147
+ return $prt;
148
+ }
149
+
150
+ #------------------------------------------------------------------------------
151
+ # Read variable-length integer
152
+ # Inputs: 0) RAF ref
153
+ # Returns: integer value
154
+ sub ReadVarInt($)
155
+ {
156
+ my $raf = shift;
157
+ my $buff;
158
+ $raf->Read($buff, 1) or return 0;
159
+ my $val = ord($buff);
160
+ if ($val == 0xff) {
161
+ $raf->Read($buff, 2) == 2 or return 0;
162
+ $val = unpack('v', $buff);
163
+ if ($val & 0x8000) {
164
+ $raf->Read($buff, 2) == 2 or return 0;
165
+ $val = (($val & 0x7fff) << 16) | unpack('v', $buff);
166
+ }
167
+ }
168
+ return $val;
169
+ }
170
+
171
+ #------------------------------------------------------------------------------
172
+ # Read WPG version 1 or 2 image
173
+ # Inputs: 0) ExifTool object reference, 1) dirInfo reference
174
+ # Returns: 1 on success, 0 if this wasn't a valid WPG file
175
+ sub ProcessWPG($$)
176
+ {
177
+ my ($et, $dirInfo) = @_;
178
+ my $raf = $$dirInfo{RAF};
179
+ my ($buff, $lastType, $count);
180
+
181
+ # verify this is a valid WPG file
182
+ return 0 unless $raf->Read($buff, 16) == 16;
183
+ return 0 unless $buff =~ /^\xff\x57\x50\x43/;
184
+ $et->SetFileType();
185
+ SetByteOrder('II');
186
+ my $tagTablePtr = GetTagTable('Image::ExifTool::WPG::Main');
187
+ my $offset = Get32u(\$buff, 4);
188
+ my ($ver, $rev) = unpack('x10CC', $buff);
189
+ $et->HandleTag($tagTablePtr, WPGVersion => "$ver.$rev");
190
+ if ($ver < 1 or $ver > 2) {
191
+ # currently support only version 1 and 2 formats
192
+ $et->Warn('Unsupported WPG version');
193
+ return 1;
194
+ }
195
+ my $tag = $ver == 1 ? 'Records' : 'RecordsV2';
196
+ $raf->Seek($offset - 16, 1) or return 1 if $offset > 16;
197
+ # loop through records
198
+ for (;;) {
199
+ my ($type, $len, $getSize);
200
+ if ($raf->Read($buff, $ver) == $ver) { # read 1 or 2 bytes, based on version
201
+ if ($ver == 1) {
202
+ # read version 1 record header
203
+ $type = ord($buff);
204
+ $len = ReadVarInt($raf);
205
+ $getSize = 1 if $type == 0x0f; # Start WPG (Type 1)
206
+ } else {
207
+ # read version 2 record header
208
+ $type = unpack('xC', $buff);
209
+ ReadVarInt($raf); # skip extensions
210
+ $len = ReadVarInt($raf);
211
+ $getSize = 1 if $type == 0x01; # Start WPG
212
+ undef $type if $type > 0x3f;
213
+ }
214
+ if ($getSize) {
215
+ # read Start record to obtain image size
216
+ $raf->Read($buff, $len) == $len or $et->Warn('File format error'), last;
217
+ my ($w, $h, $xres, $yres);
218
+ if ($ver == 1) {
219
+ ($w, $h) = unpack('x2vv', $buff);
220
+ } else {
221
+ my ($precision, $format);
222
+ ($xres, $yres, $precision) = unpack('vvC', $buff);
223
+ if ($precision == 0 and $len >= 21) {
224
+ $format = 'int16s';
225
+ } elsif ($precision == 1 and $len >= 29) {
226
+ $format = 'int32s';
227
+ } else {
228
+ $et->Warn('Invalid integer precision');
229
+ next;
230
+ }
231
+ my ($x1,$y1,$x2,$y2) = ReadValue(\$buff, 13, $format, 4, $len-13);
232
+ $w = abs($x2 - $x1);
233
+ $h = abs($y2 - $y1);
234
+ }
235
+ $et->HandleTag($tagTablePtr, ImageWidthInches => $w / ($xres || 1200));
236
+ $et->HandleTag($tagTablePtr, ImageHeightInches => $h / ($yres || 1200));
237
+ } else {
238
+ $raf->Seek($len, 1) or last; # skip to the next record
239
+ }
240
+ }
241
+ # go to some trouble to collapse identical sequential entries in record list
242
+ # (trying to keep the length of the list managable for complex images)
243
+ $lastType and $type and $type == $lastType and ++$count, next;
244
+ if ($lastType) {
245
+ my $val = $count > 1 ? "${lastType}x$count" : $lastType;
246
+ $et->HandleTag($tagTablePtr, $tag => $val);
247
+ }
248
+ last unless $type;
249
+ $lastType = $type;
250
+ $count = 1;
251
+ }
252
+ return 1;
253
+ }
254
+
255
+ 1; # end
256
+
257
+ __END__
258
+
259
+ =head1 NAME
260
+
261
+ Image::ExifTool::WPG - Read WPG meta information
262
+
263
+ =head1 SYNOPSIS
264
+
265
+ This module is used by Image::ExifTool
266
+
267
+ =head1 DESCRIPTION
268
+
269
+ This module contains definitions required by Image::ExifTool to read WPG
270
+ (WordPerfect Graphics) images.
271
+
272
+ =head1 AUTHOR
273
+
274
+ Copyright 2003-2023, Phil Harvey (philharvey66 at gmail.com)
275
+
276
+ This library is free software; you can redistribute it and/or modify it
277
+ under the same terms as Perl itself.
278
+
279
+ =head1 REFERENCES
280
+
281
+ =over 4
282
+
283
+ =item L<https://www.fileformat.info/format/wpg/egff.htm>
284
+
285
+ =item L<https://archive.org/details/mac_Graphics_File_Formats_Second_Edition_1996/page/n991/mode/2up>
286
+
287
+ =item L<http://libwpg.sourceforge.net/>
288
+
289
+ =back
290
+
291
+ =head1 SEE ALSO
292
+
293
+ L<Image::ExifTool::TagNames/WPG Tags>,
294
+ L<Image::ExifTool(3pm)|Image::ExifTool>
295
+
296
+ =cut
@@ -23,7 +23,7 @@ my $beginComment = '%BeginExifToolUpdate';
23
23
  my $endComment = '%EndExifToolUpdate ';
24
24
 
25
25
  my $keyExt; # crypt key extension
26
- my $pdfVer; # version of PDF file we are currently writing
26
+ my $pdfVer; # version of PDF file we are writing (highest Version in Root dictionaries)
27
27
 
28
28
  # internal tags used in dictionary objects
29
29
  my %myDictTags = (
@@ -297,15 +297,11 @@ sub WritePDF($$)
297
297
  $$newTool{PDF_CAPTURE} = \%capture;
298
298
  my $info = $newTool->ImageInfo($raf, 'XMP', 'PDF:*', 'Error', 'Warning');
299
299
  # not a valid PDF file unless we got a version number
300
- # (note: can't just check $$info{PDFVersion} due to possibility of XMP-pdf:PDFVersion)
301
- my $vers = $newTool->GetInfo('PDF:PDFVersion');
302
- # take highest version number if multiple versions in an incremental save
303
- ($pdfVer) = sort { $b <=> $a } values %$vers;
300
+ $pdfVer = $$newTool{PDFVersion};
304
301
  $pdfVer or $et->Error('Missing PDF:PDFVersion'), return 0;
305
302
  # check version number
306
- if ($pdfVer > 1.7) {
307
- $et->Warn("The PDF $pdfVer specification is not freely available", 1);
308
- # (so writing by ExifTool is based on trial and error)
303
+ if ($pdfVer > 2.0) {
304
+ $et->Error("Writing PDF $pdfVer is untested", 1) and return 0;
309
305
  }
310
306
  # fail if we had any serious errors while extracting information
311
307
  if ($capture{Error} or $$info{Error}) {
@@ -412,6 +408,9 @@ sub WritePDF($$)
412
408
  my $tagID;
413
409
  foreach $tagID (sort keys %$newTags) {
414
410
  my $tagInfo = $$newTags{$tagID};
411
+ if ($pdfVer >= 2.0 and not $$tagInfo{PDF2}) {
412
+ next if $et->Warn("Writing PDF:$$tagInfo{Name} is deprecated for PDF 2.0 documents",2);
413
+ }
415
414
  my $nvHash = $et->GetNewValueHash($tagInfo);
416
415
  my (@vals, $deleted);
417
416
  my $tag = $$tagInfo{Name};
@@ -1302,6 +1302,7 @@ sub SetNewValuesFromFile($$;@)
1302
1302
  MDItemTags => $$options{MDItemTags},
1303
1303
  MissingTagValue => $$options{MissingTagValue},
1304
1304
  NoPDFList => $$options{NoPDFList},
1305
+ NoWarning => $$options{NoWarning},
1305
1306
  Password => $$options{Password},
1306
1307
  PrintConv => $$options{PrintConv},
1307
1308
  QuickTimeUTC => $$options{QuickTimeUTC},
@@ -1569,10 +1570,17 @@ SET: foreach $set (@setList) {
1569
1570
  # handle expressions
1570
1571
  if ($$opts{EXPR}) {
1571
1572
  my $val = $srcExifTool->InsertTagValues(\@tags, $$set[1], 'Error');
1572
- if ($$srcExifTool{VALUE}{Error}) {
1573
- # pass on any error as a warning
1574
- $tag = NextFreeTagKey(\%rtnInfo, 'Warning');
1575
- $rtnInfo{$tag} = $$srcExifTool{VALUE}{Error};
1573
+ my $err = $$srcExifTool{VALUE}{Error};
1574
+ if ($err) {
1575
+ # pass on any error as a warning unless it is suppressed
1576
+ my $noWarn = $$srcExifTool{OPTIONS}{NoWarning};
1577
+ unless ($noWarn and (eval { $err =~ /$noWarn/ } or
1578
+ # (also apply expression to warning without "[minor] " prefix)
1579
+ ($err =~ s/^\[minor\] //i and eval { $err =~ /$noWarn/ })))
1580
+ {
1581
+ $tag = NextFreeTagKey(\%rtnInfo, 'Warning');
1582
+ $rtnInfo{$tag} = $$srcExifTool{VALUE}{Error};
1583
+ }
1576
1584
  delete $$srcExifTool{VALUE}{Error};
1577
1585
  next unless defined $val;
1578
1586
  }
@@ -50,7 +50,7 @@ use Image::ExifTool::Exif;
50
50
  use Image::ExifTool::GPS;
51
51
  require Exporter;
52
52
 
53
- $VERSION = '3.58';
53
+ $VERSION = '3.59';
54
54
  @ISA = qw(Exporter);
55
55
  @EXPORT_OK = qw(EscapeXML UnescapeXML);
56
56
 
@@ -248,7 +248,11 @@ my %boolConv = (
248
248
 
249
249
  # XMP namespaces which we don't want to contribute to generated EXIF tag names
250
250
  # (Note: namespaces with non-standard prefixes aren't currently ignored)
251
- my %ignoreNamespace = ( 'x'=>1, rdf=>1, xmlns=>1, xml=>1, svg=>1, et=>1, office=>1 );
251
+ my %ignoreNamespace = ( 'x'=>1, rdf=>1, xmlns=>1, xml=>1, svg=>1, office=>1 );
252
+
253
+ # ExifTool properties that don't generate tag names (et:tagid is historic)
254
+ my %ignoreEtProp = ( 'et:desc'=>1, 'et:prt'=>1, 'et:val'=>1 , 'et:id'=>1, 'et:tagid'=>1,
255
+ 'et:toolkit'=>1, 'et:table'=>1, 'et:index'=>1 );
252
256
 
253
257
  # XMP properties to ignore (set dynamically via dirInfo IgnoreProp)
254
258
  my %ignoreProp;
@@ -2485,6 +2489,9 @@ my %sPantryItem = (
2485
2489
  EnhanceSuperResolutionAlreadyApplied => { Writable => 'boolean' },
2486
2490
  EnhanceSuperResolutionVersion => { }, # integer?
2487
2491
  EnhanceSuperResolutionScale => { Writable => 'rational' },
2492
+ EnhanceDenoiseAlreadyApplied => { Writable => 'boolean' }, #forum14760
2493
+ EnhanceDenoiseVersion => { }, #forum14760 integer?
2494
+ EnhanceDenoiseLumaAmount => { }, #forum14760 integer?
2488
2495
  );
2489
2496
 
2490
2497
  # IPTC Core namespace properties (Iptc4xmpCore) (ref 4)
@@ -2850,7 +2857,7 @@ sub GetXMPTagID($;$$)
2850
2857
  # split name into namespace and property name
2851
2858
  # (Note: namespace can be '' for property qualifiers)
2852
2859
  my ($ns, $nm) = ($prop =~ /(.*?):(.*)/) ? ($1, $2) : ('', $prop);
2853
- if ($ignoreNamespace{$ns} or $ignoreProp{$prop}) {
2860
+ if ($ignoreNamespace{$ns} or $ignoreProp{$prop} or $ignoreEtProp{$prop}) {
2854
2861
  # special case: don't ignore rdf numbered items
2855
2862
  # (not technically allowed in XMP, but used in RDF/XML)
2856
2863
  unless ($prop =~ /^rdf:(_\d+)$/) {
@@ -3420,7 +3427,10 @@ NoLoop:
3420
3427
  my %grps = ( 0 => $1, 1 => $2 );
3421
3428
  # apply a little magic to recover original group names
3422
3429
  # from this exiftool-written RDF/XML file
3423
- if ($grps{1} =~ /^\d/) {
3430
+ if ($grps{1} eq 'System') {
3431
+ $grps{1} = 'XML-System';
3432
+ $grps{0} = 'XML';
3433
+ } elsif ($grps{1} =~ /^\d/) {
3424
3434
  # URI's with only family 0 are internal tags from the source file,
3425
3435
  # so change the group name to avoid confusion with tags from this file
3426
3436
  $grps{1} = "XML-$grps{0}";
@@ -3888,7 +3898,9 @@ sub ParseXMPElement($$$;$$$$)
3888
3898
  }
3889
3899
  }
3890
3900
  my $shortVal = $attrs{$shortName};
3891
- if ($ignoreNamespace{$ns} or $ignoreProp{$prop}) {
3901
+ # Note: $prop is the containing property in this loop (not the shorthand property)
3902
+ # so $ignoreProp ignores all attributes of the ignored property
3903
+ if ($ignoreNamespace{$ns} or $ignoreProp{$prop} or $ignoreEtProp{$propName}) {
3892
3904
  $ignored = $propName;
3893
3905
  # handle special attributes (extract as tags only once if not empty)
3894
3906
  if (ref $recognizedAttrs{$propName} and $shortVal) {
@@ -11,6 +11,7 @@
11
11
  # 4) http://DataCompression.info/ArchiveFormats/RAR202.txt
12
12
  # 5) https://jira.atlassian.com/browse/CONF-21706
13
13
  # 6) http://wwwimages.adobe.com/www.adobe.com/content/dam/Adobe/en/devnet/indesign/cs55-docs/IDML/idml-specification.pdf
14
+ # 7) https://www.rarlab.com/technote.htm
14
15
  #------------------------------------------------------------------------------
15
16
 
16
17
  package Image::ExifTool::ZIP;
@@ -19,7 +20,7 @@ use strict;
19
20
  use vars qw($VERSION $warnString);
20
21
  use Image::ExifTool qw(:DataAccess :Utils);
21
22
 
22
- $VERSION = '1.28';
23
+ $VERSION = '1.29';
23
24
 
24
25
  sub WarnProc($) { $warnString = $_[0]; }
25
26
 
@@ -191,7 +192,7 @@ my %iWorkType = (
191
192
  11 => 'Comment',
192
193
  );
193
194
 
194
- # RAR tags (ref 4)
195
+ # RAR v4 tags (ref 4)
195
196
  %Image::ExifTool::ZIP::RAR = (
196
197
  PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
197
198
  GROUPS => { 2 => 'Other' },
@@ -254,8 +255,45 @@ my %iWorkType = (
254
255
  },
255
256
  );
256
257
 
258
+ # RAR v5 tags (ref 7, github#203)
259
+ %Image::ExifTool::ZIP::RAR5 = (
260
+ GROUPS => { 2 => 'Other' },
261
+ VARS => { NO_ID => 1 },
262
+ NOTES => 'These tags are extracted from RAR v5 archive files.',
263
+ RARVersion => { },
264
+ CompressedSize => { },
265
+ ModifyDate => {
266
+ Groups => { 2 => 'Time' },
267
+ ValueConv => 'ConvertUnixTime($val,1)',
268
+ PrintConv => '$self->ConvertDateTime($val)',
269
+ },
270
+ UncompressedSize => { },
271
+ OperatingSystem => {
272
+ PrintConv => { 0 => 'Win32', 1 => 'Unix' },
273
+ },
274
+ ArchivedFileName => { },
275
+ );
276
+
277
+ #------------------------------------------------------------------------------
278
+ # Read unsigned LEB (Little Endian Base) from file
279
+ # Inputs: 0) RAF ref
280
+ # Returns: integer value
281
+ sub ReadULEB($)
282
+ {
283
+ my $raf = shift;
284
+ my ($i, $buff);
285
+ my $rtnVal = 0;
286
+ for ($i=0; ; ++$i) {
287
+ $raf->Read($buff, 1) or last;
288
+ my $num = ord($buff);
289
+ $rtnVal += ($num & 0x7f) << ($i * 7);
290
+ $num & 0x80 or last;
291
+ }
292
+ return $rtnVal;
293
+ }
294
+
257
295
  #------------------------------------------------------------------------------
258
- # Extract information from a RAR file (ref 4)
296
+ # Extract information from a RAR file
259
297
  # Inputs: 0) ExifTool object reference, 1) dirInfo reference
260
298
  # Returns: 1 on success, 0 if this wasn't a valid RAR file
261
299
  sub ProcessRAR($$)
@@ -263,51 +301,129 @@ sub ProcessRAR($$)
263
301
  my ($et, $dirInfo) = @_;
264
302
  my $raf = $$dirInfo{RAF};
265
303
  my ($flags, $buff);
304
+ my $docNum = 0;
266
305
 
267
- return 0 unless $raf->Read($buff, 7) and $buff eq "Rar!\x1a\x07\0";
306
+ return 0 unless $raf->Read($buff, 7) and $buff =~ "Rar!\x1a\x07[\0\x01]";
268
307
 
269
- $et->SetFileType();
270
- SetByteOrder('II');
271
- my $tagTablePtr = GetTagTable('Image::ExifTool::ZIP::RAR');
272
- my $docNum = 0;
308
+ if ($buff eq "Rar!\x1a\x07\0") { # RARv4 (ref 4)
273
309
 
274
- for (;;) {
275
- # read block header
276
- $raf->Read($buff, 7) == 7 or last;
277
- my ($type, $flags, $size) = unpack('xxCvv', $buff);
278
- $size -= 7;
279
- if ($flags & 0x8000) {
280
- $raf->Read($buff, 4) == 4 or last;
281
- $size += unpack('V',$buff) - 4;
282
- }
283
- last if $size < 0;
284
- next unless $size; # ignore blocks with no data
285
- # don't try to read very large blocks unless LargeFileSupport is enabled
286
- if ($size >= 0x80000000 and not $et->Options('LargeFileSupport')) {
287
- $et->Warn('Large block encountered. Aborting.');
288
- last;
310
+ $et->SetFileType();
311
+ SetByteOrder('II');
312
+ my $tagTablePtr = GetTagTable('Image::ExifTool::ZIP::RAR5');
313
+ $et->HandleTag($tagTablePtr, 'RARVersion', 4);
314
+ $tagTablePtr = GetTagTable('Image::ExifTool::ZIP::RAR');
315
+
316
+ for (;;) {
317
+ # read block header
318
+ $raf->Read($buff, 7) == 7 or last;
319
+ my ($type, $flags, $size) = unpack('xxCvv', $buff);
320
+ $size -= 7;
321
+ if ($flags & 0x8000) {
322
+ $raf->Read($buff, 4) == 4 or last;
323
+ $size += unpack('V',$buff) - 4;
324
+ }
325
+ last if $size < 0;
326
+ next unless $size; # ignore blocks with no data
327
+ # don't try to read very large blocks unless LargeFileSupport is enabled
328
+ if ($size >= 0x80000000 and not $et->Options('LargeFileSupport')) {
329
+ $et->Warn('Large block encountered. Aborting.');
330
+ last;
331
+ }
332
+ # process the block
333
+ if ($type == 0x74) { # file block
334
+ # read maximum 4 KB from a file block
335
+ my $n = $size > 4096 ? 4096 : $size;
336
+ $raf->Read($buff, $n) == $n or last;
337
+ # add compressed size to start of data so we can extract it with the other tags
338
+ $buff = pack('V',$size) . $buff;
339
+ $$et{DOC_NUM} = ++$docNum;
340
+ $et->ProcessDirectory({ DataPt => \$buff }, $tagTablePtr);
341
+ $size -= $n;
342
+ } elsif ($type == 0x75 and $size > 6) { # comment block
343
+ $raf->Read($buff, $size) == $size or last;
344
+ # save comment, only if "Stored" (this is untested)
345
+ if (Get8u(\$buff, 3) == 0x30) {
346
+ $et->FoundTag('Comment', substr($buff, 6));
347
+ }
348
+ next;
349
+ }
350
+ # seek to the start of the next block
351
+ $raf->Seek($size, 1) or last if $size;
289
352
  }
290
- # process the block
291
- if ($type == 0x74) { # file block
292
- # read maximum 4 KB from a file block
293
- my $n = $size > 4096 ? 4096 : $size;
294
- $raf->Read($buff, $n) == $n or last;
295
- # add compressed size to start of data so we can extract it with the other tags
296
- $buff = pack('V',$size) . $buff;
297
- $$et{DOC_NUM} = ++$docNum;
298
- $et->ProcessDirectory({ DataPt => \$buff }, $tagTablePtr);
299
- $size -= $n;
300
- } elsif ($type == 0x75 and $size > 6) { # comment block
301
- $raf->Read($buff, $size) == $size or last;
302
- # save comment, only if "Stored" (this is untested)
303
- if (Get8u(\$buff, 3) == 0x30) {
304
- $et->FoundTag('Comment', substr($buff, 6));
353
+
354
+ } else { # RARv5 (ref 7, github#203)
355
+
356
+ return 0 unless $raf->Read($buff, 1) and $buff eq "\0";
357
+ $et->SetFileType();
358
+ my $tagTablePtr = GetTagTable('Image::ExifTool::ZIP::RAR5');
359
+ $et->HandleTag($tagTablePtr, 'RARVersion', 5);
360
+ $$et{INDENT} .= '| ';
361
+
362
+ # loop through header blocks
363
+ for (;;) {
364
+ $raf->Seek(4, 1); # skip header CRC
365
+ my $headSize = ReadULEB($raf);
366
+ last if $headSize == 0;
367
+ # read the header and create new RAF object for reading it
368
+ my $header;
369
+ $raf->Read($header, $headSize) == $headSize or last;
370
+ my $rafHdr = new File::RandomAccess(\$header);
371
+ my $headType = ReadULEB($rafHdr); # get header type
372
+
373
+ if ($headType == 4) { # encryption block
374
+ $et->Warn("File is encrypted.", 0);
375
+ last;
305
376
  }
306
- next;
377
+ # skip over all headers except file or service header
378
+ next unless $headType == 2 or $headType == 3;
379
+ $et->VerboseDir('RAR5 file', undef, $headSize) if $headType == 2;
380
+
381
+ my $headFlag = ReadULEB($rafHdr);
382
+ ReadULEB($rafHdr); # skip extraSize
383
+ my $dataSize;
384
+ if ($headFlag & 0x0002) {
385
+ $dataSize = ReadULEB($rafHdr); # compressed data size
386
+ if ($headType == 2) {
387
+ $et->HandleTag($tagTablePtr, 'CompressedSize', $dataSize);
388
+ } else {
389
+ $raf->Seek($dataSize, 1); # skip service data section
390
+ next;
391
+ }
392
+ } else {
393
+ next if $headType == 3; # all done with service header
394
+ $dataSize = 0;
395
+ }
396
+ my $fileFlag = ReadULEB($rafHdr);
397
+ my $uncompressedSize = ReadULEB($rafHdr);
398
+ $et->HandleTag($tagTablePtr, 'UncompressedSize', $uncompressedSize) unless $fileFlag & 0x0008;
399
+ ReadULEB($rafHdr); # skip file attributes
400
+ if ($fileFlag & 0x0002) {
401
+ $rafHdr->Read($buff, 4) == 4 or last;
402
+ # (untested)
403
+ $et->HandleTag($tagTablePtr, 'ModifyDate', unpack('V', $buff));
404
+ }
405
+ $rafHdr->Seek(4, 1) if $fileFlag & 0x0004; # skip CRC if present
406
+
407
+ ReadULEB($rafHdr); # skip compressionInfo
408
+
409
+ # get operating system
410
+ my $os = ReadULEB($rafHdr);
411
+ $et->HandleTag($tagTablePtr, 'OperatingSystem', $os);
412
+
413
+ # get filename
414
+ $rafHdr->Read($buff, 1) == 1 or last;
415
+ my $nameLen = ord($buff);
416
+ $rafHdr->Read($buff, $nameLen) == $nameLen or last;
417
+ $buff =~ s/\0+$//; # remove trailing nulls (if any)
418
+ $et->HandleTag($tagTablePtr, 'ArchivedFileName', $buff);
419
+
420
+ $$et{DOC_NUM} = ++$docNum;
421
+
422
+ $raf->Seek($dataSize, 1); # skip data section
307
423
  }
308
- # seek to the start of the next block
309
- $raf->Seek($size, 1) or last if $size;
424
+ $$et{INDENT} = substr($$et{INDENT}, 0, -2);
310
425
  }
426
+
311
427
  $$et{DOC_NUM} = 0;
312
428
  if ($docNum > 1 and not $et->Options('Duplicates')) {
313
429
  $et->Warn("Use the Duplicates option to extract tags for all $docNum files", 1);
@@ -735,6 +851,8 @@ under the same terms as Perl itself.
735
851
 
736
852
  =item L<http://DataCompression.info/ArchiveFormats/RAR202.txt>
737
853
 
854
+ =item L<https://www.rarlab.com/technote.htm>
855
+
738
856
  =back
739
857
 
740
858
  =head1 SEE ALSO