Torrent.pm 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317
  1. #------------------------------------------------------------------------------
  2. # File: Torrent.pm
  3. #
  4. # Description: Read information from BitTorrent file
  5. #
  6. # Revisions: 2013/08/27 - P. Harvey Created
  7. #
  8. # References: 1) https://wiki.theory.org/BitTorrentSpecification
  9. #------------------------------------------------------------------------------
  10. package Image::ExifTool::Torrent;
  11. use strict;
  12. use vars qw($VERSION);
  13. use Image::ExifTool qw(:DataAccess :Utils);
  14. $VERSION = '1.03';
  15. sub ReadBencode($$);
  16. sub ExtractTags($$$;$$@);
  17. # tags extracted from BitTorrent files
  18. %Image::ExifTool::Torrent::Main = (
  19. GROUPS => { 2 => 'Document' },
  20. NOTES => q{
  21. Below are tags commonly found in BitTorrent files. As well as these tags,
  22. any other existing tags will be extracted. For convenience, list items are
  23. expanded into individual tags with an index in the tag name, but only the
  24. tags with index "1" are listed in the tables below. See
  25. L<https://wiki.theory.org/BitTorrentSpecification> for the BitTorrent
  26. specification.
  27. },
  28. 'announce' => { },
  29. 'announce-list' => { Name => 'AnnounceList1' },
  30. 'comment' => { },
  31. 'created by' => { Name => 'Creator' }, # software used to create the torrent
  32. 'creation date' => {
  33. Name => 'CreateDate',
  34. Groups => { 2 => 'Time' },
  35. ValueConv => 'ConvertUnixTime($val,1)',
  36. PrintConv => '$self->ConvertDateTime($val)',
  37. },
  38. 'encoding' => { },
  39. 'info' => { SubDirectory => { TagTable => 'Image::ExifTool::Torrent::Info' } },
  40. 'url-list' => { Name => 'URLList1' },
  41. );
  42. %Image::ExifTool::Torrent::Info = (
  43. GROUPS => { 2 => 'Document' },
  44. 'file-duration' => { Name => 'File1Duration' },
  45. 'file-media' => { Name => 'File1Media' },
  46. 'files' => { SubDirectory => { TagTable => 'Image::ExifTool::Torrent::Files' } },
  47. 'length' => { },
  48. 'md5sum' => { Name => 'MD5Sum' },
  49. 'name' => { },
  50. 'name.utf-8' => { Name => 'NameUTF-8' },
  51. 'piece length' => { Name => 'PieceLength' },
  52. 'pieces' => {
  53. Name => 'Pieces',
  54. Notes => 'concatenation of 20-byte SHA-1 digests for each piece',
  55. },
  56. 'private' => { },
  57. 'profiles' => { SubDirectory => { TagTable => 'Image::ExifTool::Torrent::Profiles' } },
  58. );
  59. %Image::ExifTool::Torrent::Profiles = (
  60. GROUPS => { 2 => 'Document' },
  61. 'width' => { Name => 'Profile1Width' },
  62. 'height' => { Name => 'Profile1Height' },
  63. 'acodec' => { Name => 'Profile1AudioCodec' },
  64. 'vcodec' => { Name => 'Profile1VideoCodec' },
  65. );
  66. %Image::ExifTool::Torrent::Files = (
  67. GROUPS => { 2 => 'Document' },
  68. 'length' => { Name => 'File1Length', PrintConv => 'ConvertFileSize($val)' },
  69. 'md5sum' => { Name => 'File1MD5Sum' },
  70. 'path' => { Name => 'File1Path', JoinPath => 1 },
  71. 'path.utf-8' => { Name => 'File1PathUTF-8', JoinPath => 1 },
  72. );
  73. #------------------------------------------------------------------------------
  74. # Read 64kB more data into buffer
  75. # Inputs: 0) RAF ref, 1) buffer ref
  76. # Returns: number of bytes read
  77. # Notes: Sets BencodeEOF element of RAF on end of file
  78. sub ReadMore($$)
  79. {
  80. my ($raf, $dataPt) = @_;
  81. my $buf2;
  82. my $n = $raf->Read($buf2, 65536);
  83. $$raf{BencodeEOF} = 1 if $n != 65536;
  84. $$dataPt = substr($$dataPt, pos($$dataPt)) . $buf2 if $n;
  85. return $n;
  86. }
  87. #------------------------------------------------------------------------------
  88. # Read bencoded value
  89. # Inputs: 0) input file, 1) buffer (pos must be set to current position)
  90. # Returns: HASH ref, ARRAY ref, SCALAR ref, SCALAR, or undef on error or end of data
  91. # Notes: Sets BencodeError element of RAF on any error
  92. sub ReadBencode($$)
  93. {
  94. my ($raf, $dataPt) = @_;
  95. # read more if necessary (keep a minimum of 64 bytes in the buffer)
  96. my $pos = pos($$dataPt);
  97. return undef unless defined $pos;
  98. my $remaining = length($$dataPt) - $pos;
  99. ReadMore($raf, $dataPt) if $remaining < 64 and not $$raf{BencodeEOF};
  100. # read next token
  101. $$dataPt =~ /(.)/sg or return undef;
  102. my $val;
  103. my $tok = $1;
  104. if ($tok eq 'i') { # integer
  105. $$dataPt =~ /\G(-?\d+)e/g or return $val;
  106. $val = $1;
  107. } elsif ($tok eq 'd') { # dictionary
  108. $val = { };
  109. for (;;) {
  110. my $k = ReadBencode($raf, $dataPt);
  111. last unless defined $k;
  112. # the key must be a byte string
  113. if (ref $k) {
  114. ref $k ne 'SCALAR' and $$raf{BencodeError} = 'Bad dictionary key', last;
  115. $k = $$k;
  116. }
  117. my $v = ReadBencode($raf, $dataPt);
  118. last unless defined $v;
  119. $$val{$k} = $v;
  120. }
  121. } elsif ($tok eq 'l') { # list
  122. $val = [ ];
  123. for (;;) {
  124. my $v = ReadBencode($raf, $dataPt);
  125. last unless defined $v;
  126. push @$val, $v;
  127. }
  128. } elsif ($tok eq 'e') { # end of dictionary or list
  129. # return undef (no error)
  130. } elsif ($tok =~ /^\d$/ and $$dataPt =~ /\G(\d*):/g) { # byte string
  131. my $len = $tok . $1;
  132. my $more = $len - (length($$dataPt) - pos($$dataPt));
  133. my $value;
  134. if ($more <= 0) {
  135. $value = substr($$dataPt,pos($$dataPt),$len);
  136. pos($$dataPt) = pos($$dataPt) + $len;
  137. } elsif ($more > 10000000) {
  138. # just skip over really long values
  139. $val = \ "(Binary data $len bytes)" if $raf->Seek($more, 1);
  140. } else {
  141. # need to read more from file
  142. my $buff;
  143. my $n = $raf->Read($buff, $more);
  144. if ($n == $more) {
  145. $value = substr($$dataPt,pos($$dataPt)) . $buff;
  146. $$dataPt = '';
  147. pos($$dataPt) = 0;
  148. }
  149. }
  150. if (defined $value) {
  151. # return as binary data unless it is a reasonable-length ASCII string
  152. if (length($value) > 256 or $value =~ /[^\t\x20-\x7e]/) {
  153. $val = \$value;
  154. } else {
  155. $val = $value;
  156. }
  157. } elsif (not defined $val) {
  158. $$raf{BencodeError} = 'Truncated byte string';
  159. }
  160. } else {
  161. $$raf{BencodeError} = 'Bad format';
  162. }
  163. return $val;
  164. }
  165. #------------------------------------------------------------------------------
  166. # Extract tags from dictionary hash
  167. # Inputs: 0) ExifTool ref, 1) dictionary hash reference, 2) tag table ref,
  168. # 3) parent hash ID, 4) parent hash name, 5-N) list indices
  169. # Returns: number of tags extracted
  170. sub ExtractTags($$$;$$@)
  171. {
  172. my ($et, $hashPtr, $tagTablePtr, $baseID, $baseName, @index) = @_;
  173. my $count = 0;
  174. my $tag;
  175. foreach $tag (sort keys %$hashPtr) {
  176. my $val = $$hashPtr{$tag};
  177. my ($i, $j, @more);
  178. for (; defined $val; $val = shift @more) {
  179. my $id = defined $baseID ? "$baseID/$tag" : $tag;
  180. unless ($$tagTablePtr{$id}) {
  181. my $name = ucfirst $tag;
  182. # capitalize all words in tag name and remove illegal characters
  183. $name =~ s/[^-_a-zA-Z0-9]+(.?)/\U$1/g;
  184. $name = "Tag$name" if length($name) < 2 or $name !~ /^[A-Z]/;
  185. $name = $baseName . $name if defined $baseName; # add base name if necessary
  186. AddTagToTable($tagTablePtr, $id, { Name => $name });
  187. $et->VPrint(0, " [adding $id '$name']\n");
  188. }
  189. my $tagInfo = $et->GetTagInfo($tagTablePtr, $id) or next;
  190. if (ref $val eq 'ARRAY') {
  191. if ($$tagInfo{JoinPath}) {
  192. $val = join '/', @$val;
  193. } else {
  194. push @more, @$val;
  195. next if ref $more[0] eq 'ARRAY'; # continue expanding nested lists
  196. $val = shift @more;
  197. $i or $i = 0, push(@index, $i);
  198. }
  199. }
  200. $index[-1] = ++$i if defined $i;
  201. if (@index) {
  202. $id .= join '_', @index; # add instance number(s) to tag ID
  203. unless ($$tagTablePtr{$id}) {
  204. my $name = $$tagInfo{Name};
  205. # embed indices at position of '1' in tag name
  206. my $n = ($name =~ tr/1/#/);
  207. for ($j=0; $j<$n; ++$j) {
  208. my $idx = $index[$j] || '';
  209. $name =~ s/#/$idx/;
  210. }
  211. # put remaining indices at end of tag name
  212. for (; $j<@index; ++$j) {
  213. $name .= '_' if $name =~ /\d$/;
  214. $name .= $index[$j];
  215. }
  216. AddTagToTable($tagTablePtr, $id, { %$tagInfo, Name => $name });
  217. }
  218. $tagInfo = $et->GetTagInfo($tagTablePtr, $id) or next;
  219. }
  220. if (ref $val eq 'HASH') {
  221. # extract tags from this dictionary
  222. my ($table, $rootID, $rootName);
  223. if ($$tagInfo{SubDirectory}) {
  224. $table = GetTagTable($$tagInfo{SubDirectory}{TagTable});
  225. } else {
  226. $table = $tagTablePtr;
  227. # use hash ID and Name as base for contained tags to avoid conflicts
  228. $rootID = $id;
  229. $rootName = $$tagInfo{Name};
  230. }
  231. $count += ExtractTags($et, $val, $table, $rootID, $rootName, @index);
  232. } else {
  233. # handle this simple tag value
  234. $et->HandleTag($tagTablePtr, $id, $val);
  235. ++$count;
  236. }
  237. }
  238. pop @index if defined $i;
  239. }
  240. return $count;
  241. }
  242. #------------------------------------------------------------------------------
  243. # Process BitTorrent file
  244. # Inputs: 0) ExifTool object reference, 1) dirInfo reference (with RAF set)
  245. # Returns: 1 on success, 0 if this wasn't a valid BitTorrent file
  246. sub ProcessTorrent($$)
  247. {
  248. my ($et, $dirInfo) = @_;
  249. my $success = 0;
  250. my $raf = $$dirInfo{RAF};
  251. my $buff = '';
  252. pos($buff) = 0;
  253. my $dict = ReadBencode($raf, \$buff);
  254. my $err = $$raf{BencodeError};
  255. $et->Warn("Bencode error: $err") if $err;
  256. if (ref $dict eq 'HASH' and $$dict{announce}) {
  257. $et->SetFileType();
  258. my $tagTablePtr = GetTagTable('Image::ExifTool::Torrent::Main');
  259. ExtractTags($et, $dict, $tagTablePtr) and $success = 1;
  260. }
  261. return $success;
  262. }
  263. 1; # end
  264. __END__
  265. =head1 NAME
  266. Image::ExifTool::Torrent - Read information from BitTorrent file
  267. =head1 SYNOPSIS
  268. This module is used by Image::ExifTool
  269. =head1 DESCRIPTION
  270. This module contains definitions required by Image::ExifTool to read
  271. bencoded information from BitTorrent files.
  272. =head1 AUTHOR
  273. Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
  274. This library is free software; you can redistribute it and/or modify it
  275. under the same terms as Perl itself.
  276. =head1 REFERENCES
  277. =over 4
  278. =item L<https://wiki.theory.org/BitTorrentSpecification>
  279. =back
  280. =head1 SEE ALSO
  281. L<Image::ExifTool::TagNames/Torrent Tags>,
  282. L<Image::ExifTool(3pm)|Image::ExifTool>
  283. =cut