Annotation of openbsd/OpenBSDTorrents/MakeTorrents.pl, Revision 1.25
1.20 andrew 1: #!/usr/bin/perl
2: # -T
1.25 ! andrew 3: #$RedRiver: MakeTorrents.pl,v 1.24 2010/03/08 20:19:37 andrew Exp $
1.1 andrew 4: use strict;
5: use warnings;
6: use diagnostics;
7:
1.4 andrew 8: use lib 'lib';
1.14 andrew 9: use BT::MetaInfo::Cached;
1.4 andrew 10: use OpenBSDTorrents;
11:
1.1 andrew 12: %ENV = ();
13:
1.11 andrew 14: chdir($OBT->{DIR_FTP}) || die "Couldn't change dir to " . $OBT->{DIR_FTP} . ": $!";
1.1 andrew 15:
1.11 andrew 16: my $StartDir = '';
17: if (@ARGV) {
18: foreach (@ARGV) {
19: s#/$##;
20: Process_Dir($_);
21: }
22: } else {
23: $StartDir = $OBT->{BASENAME};
24: Process_Dir($StartDir);
25: }
1.1 andrew 26:
27:
28:
29: sub Process_Dir
30: {
31: my $basedir = shift;
32:
1.13 andrew 33: #return undef if $basedir =~ /packages/;
1.12 andrew 34:
1.1 andrew 35: my ($dirs, $files) = Get_Files_and_Dirs($basedir);
36: if (@$files) {
1.25 ! andrew 37: Make_Torrent($basedir, $files);
1.1 andrew 38: }
1.3 andrew 39:
1.12 andrew 40: # don't recurse if we were started with a specific directory
1.10 andrew 41: return 1 if $StartDir ne $OBT->{BASENAME};
1.3 andrew 42:
1.1 andrew 43: foreach my $subdir (@$dirs) {
1.21 andrew 44: next if $subdir =~ /^\./;
1.1 andrew 45: Process_Dir("$basedir/$subdir")
46: }
47: }
48:
49: sub Make_Torrent
50: {
1.4 andrew 51: my $basedir = shift;
52: my $files = shift;
1.3 andrew 53:
1.4 andrew 54: if ($basedir !~ /\.\./ && $basedir =~ /^([\w\/\.-]+)$/) {
55: $basedir = $1;
56: } else {
57: die "Invalid characters in dir '$basedir'";
58: }
1.1 andrew 59:
1.25 ! andrew 60: if ($#{ $files } < $OBT->{MIN_FILES}) {
! 61: print "Too few files in $basedir, skipping . . .\n";
! 62: return undef;
! 63: }
! 64:
! 65: my $torrent = Name_Torrent($basedir);
! 66: my $comment = "Files from $basedir";
! 67:
! 68: my %torrents;
1.22 andrew 69: foreach my $file (@$files) {
1.25 ! andrew 70: if ($file =~ /^([^\/]+)$/) {
! 71: $file = $1;
! 72:
! 73: my $t = $torrent;
! 74: my $c = $comment;
! 75:
! 76: if ($file =~ /$INSTALL_ISO_REGEX/xms) {
! 77: $t = Name_Torrent("$basedir/$file");
! 78: $c = "$basedir/$file";
! 79: }
! 80: elsif (my ($ext) = $file =~ /$SONG_REGEX/xms) {
! 81: $t = Name_Torrent("$basedir/$ext");
! 82: $c = "$ext files from $basedir";
! 83: }
! 84:
! 85: $torrents{$t}{comment} = $c;
! 86: push @{ $torrents{$t}{files} }, "$basedir/$file";
1.22 andrew 87: }
88: else {
89: die "Invalid characters in file '$file' in '$basedir'";
1.4 andrew 90: }
91: }
1.1 andrew 92:
1.3 andrew 93:
1.25 ! andrew 94: foreach my $t (keys %torrents) {
1.1 andrew 95:
1.25 ! andrew 96: print "Creating $t ("
! 97: . (scalar @{ $torrents{$t}{files} }) . " files)\n";
1.1 andrew 98:
1.25 ! andrew 99: my $c = $torrents{$t}{comment};
! 100: $c .= "\nCreated by andrew fresh (andrew\@afresh1.com)\n" .
! 101: "http://OpenBSD.somedomain.net/";
! 102:
! 103: eval { btmake($t, $c, $torrents{$t}{files}); };
! 104: if ($@) {
! 105: print "Error creating $t\n$@\n";
! 106: }
1.3 andrew 107:
1.5 andrew 108: # system($BTMake,
109: # '-C',
110: # '-c', $comment,
1.10 andrew 111: # '-n', $OBT->{BASENAME},
1.25 ! andrew 112: # '-o', $OBT->{DIR_TORRENT} . "/$t",
1.5 andrew 113: # '-a', $Tracker,
114: # @$files
1.25 ! andrew 115: # );# || die "Couldn't system $BTMake $t: $!";
! 116: }
1.5 andrew 117:
1.25 ! andrew 118: return [ keys %torrents ];
1.5 andrew 119: }
120:
121:
122: # Stole and modified from btmake to work for this.
123: sub btmake {
124: no locale;
125:
126: my $torrent = shift;
127: my $comment = shift;
128: my $files = shift;
129:
1.10 andrew 130: my $name = $OBT->{BASENAME};
131: my $announce = $OBT->{URL_TRACKER};
132: my $piece_len = 2 << ($OBT->{PIECE_LENGTH} - 1);
1.5 andrew 133:
1.12 andrew 134: my $torrent_with_path = $OBT->{DIR_NEW_TORRENT} . "/$torrent";
1.5 andrew 135:
1.22 andrew 136: #if (@$files == 1) {
137: #$name = $files->[0];
138: #}
139:
1.16 andrew 140: my $t = BT::MetaInfo::Cached->new(
1.15 andrew 141: {
1.20 andrew 142: cache_root => '/tmp/OBTFileCache'
1.15 andrew 143: }
144: );
145:
1.5 andrew 146: $t->name($name);
147: $t->announce($announce);
148: unless ($announce =~ m!^http://[^/]+/!i) {
149: warn " [ WARNING: announce URL does not look like: http://hostname/ ]\n";
150: }
151: $t->comment($comment);
152: #foreach my $pair (split(/;/, $::opt_f)) {
153: # if (my($key, $val) = split(/,/, $pair, 2)) {
154: # $t->set($key, $val);
155: # }
156: #}
157: $t->piece_length($piece_len);
1.18 andrew 158: $t->creation_date(time);
1.24 andrew 159: #print "Checksumming files. This may take a little while...\n";
1.22 andrew 160:
161: # Can't use this, have to do this manually because
162: # we need to have the multi-file type of torrent
163: # even when we have only one file.
164: #$t->set_files(@$files);
165:
166: my @file_list;
167: foreach my $f (@$files) {
168: my $l = (stat("$OBT->{DIR_FTP}/$f"))[7];
169: my @p = split /\//, $f;
170: shift @p;
171: push @file_list, {
172: length => $l,
173: path => \@p,
174: }
175: }
176: $t->files(\@file_list);
177: $t->make_pieces(@$files);
1.8 andrew 178:
1.10 andrew 179: if ($t->total_size < $OBT->{MIN_SIZE}) {
1.8 andrew 180: print "Skipping smaller than minimum size\n";
181: return 0;
182: }
183:
1.14 andrew 184: my $hash = $t->info_hash;
1.12 andrew 185: $hash = unpack("H*", $hash);
186:
187: $t->save($torrent_with_path);
188: print "Created: $torrent_with_path\n";
1.1 andrew 189: }
1.3 andrew 190:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to MakeTorrents.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / openbsd / OpenBSDTorrents