=================================================================== RCS file: /cvs/openbsd/OpenBSDTorrents/MakeTorrents.pl,v retrieving revision 1.3 retrieving revision 1.18 diff -u -r1.3 -r1.18 --- openbsd/OpenBSDTorrents/MakeTorrents.pl 2005/03/22 23:07:23 1.3 +++ openbsd/OpenBSDTorrents/MakeTorrents.pl 2005/05/20 17:25:35 1.18 @@ -1,134 +1,147 @@ #!/usr/bin/perl -T -#$Id: MakeTorrents.pl,v 1.3 2005/03/22 23:07:23 andrew Exp $ +#$Id: MakeTorrents.pl,v 1.18 2005/05/20 16:25:35 andrew Exp $ use strict; use warnings; use diagnostics; +use lib 'lib'; +use BT::MetaInfo::Cached; +use OpenBSDTorrents; + %ENV = (); -use YAML; +chdir($OBT->{DIR_FTP}) || die "Couldn't change dir to " . $OBT->{DIR_FTP} . ": $!"; -my $BaseDir = '/home/ftp/pub'; -my $BaseName = 'OpenBSD'; -my $OutDir = '/home/andrew/torrents'; -my $BTMake = '/usr/local/bin/btmake'; -my $Tracker = 'http://OpenBSD.somedomain.net/announce.php'; +my $StartDir = ''; +if (@ARGV) { + foreach (@ARGV) { + s#/$##; + Process_Dir($_); + } +} else { + $StartDir = $OBT->{BASENAME}; + Process_Dir($StartDir); +} -my $MinFiles = 5; -# These are regexes that tell what files to skip; -my $SkipDirs = qr/\/patches$/; -my $SkipFiles = qr/^\./; - -my $StartDir = shift || $BaseName; -$StartDir =~ s#/$##; - -chdir($BaseDir) || die "Couldn't change dir to $BaseDir"; - -Process_Dir($StartDir); - sub Process_Dir { my $basedir = shift; + #return undef if $basedir =~ /packages/; + my ($dirs, $files) = Get_Files_and_Dirs($basedir); if (@$files) { - Make_Torrent($basedir, $files); + my $torrent = Make_Torrent($basedir, $files); } - # don't recurse if we were called on a specific directory - return 1 if $StartDir ne $BaseName; + # don't recurse if we were started with a specific directory + return 1 if $StartDir ne $OBT->{BASENAME}; foreach my $subdir (@$dirs) { - #next if $subdir eq '.'; - #next if $subdir eq '..'; + next if $subdir eq '.'; + next if $subdir eq '..'; Process_Dir("$basedir/$subdir") } } sub Make_Torrent { - my $basedir = shift; - my $files = shift; + my $basedir = shift; + my $files = shift; - if ($#files < $MinFiles) { - print "Too few files in $basedir, skipping . . .\n"; - return undef; - } + if ($#{ $files } < $OBT->{MIN_FILES}) { + print "Too few files in $basedir, skipping . . .\n"; + return undef; + } - if ($basedir !~ /\.\./ && $basedir =~ /^([\w\/\.-]+)$/) { - $basedir = $1; - } else { - die "Invalid characters in dir '$basedir'"; - } + if ($basedir !~ /\.\./ && $basedir =~ /^([\w\/\.-]+)$/) { + $basedir = $1; + } else { + die "Invalid characters in dir '$basedir'"; + } - foreach (@$files) { - if (/^([^\/]+)$/) { - $_ = "$basedir/$1"; - } else { - die "Invalid characters in file '$_' in '$basedir'"; - } - } + foreach (@$files) { + if (/^([^\/]+)$/) { + $_ = "$basedir/$1"; + } else { + die "Invalid characters in file '$_' in '$basedir'"; + } + } - my $date = Torrent_Date(); + my $torrent = Name_Torrent($basedir); - my $torrent = $basedir; - $torrent =~ s/\W/_/g; - $torrent .= '-' . $date; - $torrent .= '.torrent'; + print "Creating $torrent\n"; - #print Dump $torrent, $basedir, $files; - print "Creating $torrent\n"; + my $comment = "Files from $basedir\n" . + "Created by andrew fresh (andrew\@mad-techies.org)\n" . + "http://OpenBSD.somedomain.net/"; - my $comment = "Files from $basedir\n" . - "Created by andrew fresh (andrew\@mad-techies.org)\n" . - "http://OpenBSD.somedomain.net/", + eval { btmake($torrent, $comment, $files); }; + if ($@) { + print "Error creating $torrent\n$@\n"; + } - system($BTMake, - '-C', - '-c', $comment, - '-n', $BaseName, - '-o', "$OutDir/$torrent", - '-a', $Tracker, - @$files - );# || die "Couldn't system $BTMake $torrent: $!"; +# system($BTMake, +# '-C', +# '-c', $comment, +# '-n', $OBT->{BASENAME}, +# '-o', $OBT->{DIR_TORRENT} . "/$torrent", +# '-a', $Tracker, +# @$files +# );# || die "Couldn't system $BTMake $torrent: $!"; + + return $torrent; } -sub Get_Files_and_Dirs -{ - my $basedir = shift; - opendir DIR, $basedir or die "Couldn't opendir $basedir: $!"; - my @contents = grep { ! /^\.\.$/ } grep { ! /^\.$/ } readdir DIR; - closedir DIR; - my @dirs = grep { -d "$basedir/$_" } @contents; +# Stole and modified from btmake to work for this. +sub btmake { + no locale; - my %dirs; # lookup table - my @files;# answer + my $torrent = shift; + my $comment = shift; + my $files = shift; - # build lookup table - @dirs{@dirs} = (); + my $name = $OBT->{BASENAME}; + my $announce = $OBT->{URL_TRACKER}; + my $piece_len = 2 << ($OBT->{PIECE_LENGTH} - 1); - foreach my $item (@contents) { - push(@files, $item) unless exists $dirs{$item}; - } + my $torrent_with_path = $OBT->{DIR_NEW_TORRENT} . "/$torrent"; - @dirs = grep { ! /$SkipDirs/ } @dirs if $SkipDirs; - @files = grep { ! /$SkipFiles/ } @files if $SkipFiles; + my $t = BT::MetaInfo::Cached->new( + { + cache_root => + $OBT->{DIR_HOME} . '/FileCache' + } + ); - return \@dirs, \@files; -} + $t->name($name); + $t->announce($announce); + unless ($announce =~ m!^http://[^/]+/!i) { + warn " [ WARNING: announce URL does not look like: http://hostname/ ]\n"; + } + $t->comment($comment); + #foreach my $pair (split(/;/, $::opt_f)) { + # if (my($key, $val) = split(/,/, $pair, 2)) { + # $t->set($key, $val); + # } + #} + $t->piece_length($piece_len); + $t->creation_date(time); + print "Checksumming files. This may take a little while...\n"; + $t->set_files(@$files); -sub Torrent_Date -{ - my ($min, $hour, $mday, $mon, $year) = (gmtime)[1..5]; - $mon++; - $year += 1900; - foreach ($min, $hour, $mday, $mon) { - if (length $_ == 1) { - $_ = '0' . $_; - } - } - return join '-', ($year, $mon, $mday, $hour . $min); + if ($t->total_size < $OBT->{MIN_SIZE}) { + print "Skipping smaller than minimum size\n"; + return 0; + } + + my $hash = $t->info_hash; + $hash = unpack("H*", $hash); + + $t->save($torrent_with_path); + print "Created: $torrent_with_path\n"; } +