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