Ticket #2656: dumptorrent.pl

File dumptorrent.pl, 2.9 KB (added by non7top, 11 years ago)
Line 
1#!/usr/bin/perl
2#
3# (C) 2009 Adrian Ulrich
4# ...simple bencoding dumper
5#
6# Released under the terms of The "Artistic License 2.0".
7# http://www.perlfoundation.org/legal/licenses/artistic-2_0.txt
8#
9
10use strict;
11use Carp;
12use Data::Dumper;
13
14foreach my $file (@ARGV) {
15        my $h = torrent2hash($file)->{content};
16        delete($h->{info}->{pieces});
17        print "# $file:\n";
18        print Data::Dumper::Dumper($h);
19}
20
21
22
23        sub decode {
24                my($string) = @_;
25                my $ref = { data=>$string, len=>length($string), pos=> 0 };
26                Carp::confess("decode(undef) called") if $ref->{len} == 0;
27                return d2($ref);
28        }
29       
30        sub encode {
31                my($ref) = @_;
32                Carp::confess("encode(undef) called") unless $ref;
33                return _encode($ref);
34        }
35       
36       
37       
38        sub _encode {
39                my($ref) = @_;
40               
41                my $encoded = undef;
42               
43                Carp::cluck() unless defined $ref;
44               
45                if(ref($ref) eq "HASH") {
46                        $encoded .= "d";
47                        foreach(sort keys(%$ref)) {
48                                $encoded .= length($_).":".$_;
49                                $encoded .= _encode($ref->{$_});
50                        }
51                        $encoded .= "e";
52                }
53                elsif(ref($ref) eq "ARRAY") {
54                        $encoded .= "l";
55                        foreach(@$ref) {
56                                $encoded .= _encode($_);
57                        }
58                        $encoded .= "e";
59                }
60                elsif($ref =~ /^(\d+)$/) {
61                        $encoded .= "i$1e";
62                }
63                else {
64                        # -> String
65                        $encoded .= length($ref).":".$ref;
66                }
67                return $encoded;
68        }
69       
70
71        sub d2 {
72                my($ref) = @_;
73               
74                my $cc = _curchar($ref);
75                if($cc eq 'd') {
76                        my $dict = {};
77                        for($ref->{pos}++;$ref->{pos} < $ref->{len};) {
78                                last if _curchar($ref) eq 'e';
79                                my $k = d2($ref);
80                                my $v = d2($ref);
81                                $dict->{$k} = $v;
82                        }
83                        $ref->{pos}++; # Skip the 'e'
84                        return $dict;
85                }
86                elsif($cc eq 'l') {
87                        my @list = ();
88                        for($ref->{pos}++;$ref->{pos} < $ref->{len};) {
89                                last if _curchar($ref) eq 'e';
90                                push(@list,d2($ref));
91                        }
92                        $ref->{pos}++; # Skip 'e'
93                        return \@list;
94                }
95                elsif($cc eq 'i') {
96                        my $integer = '';
97                        for($ref->{pos}++;$ref->{pos} < $ref->{len};$ref->{pos}++) {
98                                last if _curchar($ref) eq 'e';
99                                $integer .= _curchar($ref);
100                        }
101                        $ref->{pos}++; # Skip 'e'
102                        return $integer;
103                }
104                elsif($cc =~ /^\d$/) {
105                        my $s_len = '';
106                        while($ref->{pos} < $ref->{len}) {
107                                last if _curchar($ref) eq ':';
108                                $s_len .= _curchar($ref);
109                                $ref->{pos}++;
110                        }
111                        $ref->{pos}++; # Skip ':'
112                       
113                        return undef if ($ref->{len}-$ref->{pos} < $s_len);
114                        my $str = substr($ref->{data}, $ref->{pos}, $s_len);
115                        $ref->{pos} += $s_len;
116                        return $str;
117                }
118                else {
119#                       warn "Unhandled Dict-Type: $cc\n";
120                        $ref->{pos} = $ref->{len};
121                        return undef;
122                }
123        }
124
125        sub _curchar {
126                my($ref) = @_;
127                return(substr($ref->{data},$ref->{pos},1));
128        }
129
130
131
132#################################################################
133# Load a torrent file
134sub torrent2hash {
135        my($file) = @_;
136        my $buff = undef;
137        open(BENC, "<", $file) or return {};
138        while(<BENC>) {
139                $buff .= $_;
140        }
141        close(BENC);
142        return {} unless $buff;
143        return data2hash($buff);
144}
145
146sub data2hash {
147        my($buff) = @_;
148        my $href = decode($buff);
149        return {} unless ref($href) eq "HASH";
150        return {content=>$href, torrent_data=>$buff};   
151}
152
153