=================================================================== RCS file: /cvs/openbsd/OpenBSDTorrents/MakeTorrents.pl,v retrieving revision 1.3 retrieving revision 1.25 diff -u -r1.3 -r1.25 --- openbsd/OpenBSDTorrents/MakeTorrents.pl 2005/03/22 23:07:23 1.3 +++ openbsd/OpenBSDTorrents/MakeTorrents.pl 2010/03/22 21:15:06 1.25 @@ -1,134 +1,190 @@ -#!/usr/bin/perl -T -#$Id: MakeTorrents.pl,v 1.3 2005/03/22 23:07:23 andrew Exp $ +#!/usr/bin/perl +# -T +#$RedRiver: MakeTorrents.pl,v 1.24 2010/03/08 20:19:37 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); } - # 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 =~ /^\./; 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 ($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'"; - } + if ($#{ $files } < $OBT->{MIN_FILES}) { + print "Too few files in $basedir, skipping . . .\n"; + return undef; + } - foreach (@$files) { - if (/^([^\/]+)$/) { - $_ = "$basedir/$1"; - } else { - die "Invalid characters in file '$_' in '$basedir'"; + my $torrent = Name_Torrent($basedir); + my $comment = "Files from $basedir"; + + my %torrents; + foreach my $file (@$files) { + if ($file =~ /^([^\/]+)$/) { + $file = $1; + + my $t = $torrent; + my $c = $comment; + + if ($file =~ /$INSTALL_ISO_REGEX/xms) { + $t = Name_Torrent("$basedir/$file"); + $c = "$basedir/$file"; + } + elsif (my ($ext) = $file =~ /$SONG_REGEX/xms) { + $t = Name_Torrent("$basedir/$ext"); + $c = "$ext files from $basedir"; + } + + $torrents{$t}{comment} = $c; + push @{ $torrents{$t}{files} }, "$basedir/$file"; + } + else { + die "Invalid characters in file '$file' in '$basedir'"; + } + } + + + foreach my $t (keys %torrents) { + + print "Creating $t (" + . (scalar @{ $torrents{$t}{files} }) . " files)\n"; + + my $c = $torrents{$t}{comment}; + $c .= "\nCreated by andrew fresh (andrew\@afresh1.com)\n" . + "http://OpenBSD.somedomain.net/"; + + eval { btmake($t, $c, $torrents{$t}{files}); }; + if ($@) { + print "Error creating $t\n$@\n"; } + +# system($BTMake, +# '-C', +# '-c', $comment, +# '-n', $OBT->{BASENAME}, +# '-o', $OBT->{DIR_TORRENT} . "/$t", +# '-a', $Tracker, +# @$files +# );# || die "Couldn't system $BTMake $t: $!"; } - my $date = Torrent_Date(); + return [ keys %torrents ]; +} - my $torrent = $basedir; - $torrent =~ s/\W/_/g; - $torrent .= '-' . $date; - $torrent .= '.torrent'; - #print Dump $torrent, $basedir, $files; - print "Creating $torrent\n"; +# Stole and modified from btmake to work for this. +sub btmake { + no locale; - my $comment = "Files from $basedir\n" . - "Created by andrew fresh (andrew\@mad-techies.org)\n" . - "http://OpenBSD.somedomain.net/", + my $torrent = shift; + my $comment = shift; + my $files = shift; - system($BTMake, - '-C', - '-c', $comment, - '-n', $BaseName, - '-o', "$OutDir/$torrent", - '-a', $Tracker, - @$files - );# || die "Couldn't system $BTMake $torrent: $!"; -} + my $name = $OBT->{BASENAME}; + my $announce = $OBT->{URL_TRACKER}; + my $piece_len = 2 << ($OBT->{PIECE_LENGTH} - 1); + my $torrent_with_path = $OBT->{DIR_NEW_TORRENT} . "/$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; + #if (@$files == 1) { + #$name = $files->[0]; + #} - my %dirs; # lookup table - my @files;# answer + my $t = BT::MetaInfo::Cached->new( + { + cache_root => '/tmp/OBTFileCache' + } + ); - # build lookup table - @dirs{@dirs} = (); + $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"; - foreach my $item (@contents) { - push(@files, $item) unless exists $dirs{$item}; - } + # Can't use this, have to do this manually because + # we need to have the multi-file type of torrent + # even when we have only one file. + #$t->set_files(@$files); - @dirs = grep { ! /$SkipDirs/ } @dirs if $SkipDirs; - @files = grep { ! /$SkipFiles/ } @files if $SkipFiles; + my @file_list; + foreach my $f (@$files) { + my $l = (stat("$OBT->{DIR_FTP}/$f"))[7]; + my @p = split /\//, $f; + shift @p; + push @file_list, { + length => $l, + path => \@p, + } + } + $t->files(\@file_list); + $t->make_pieces(@$files); - return \@dirs, \@files; -} + if ($t->total_size < $OBT->{MIN_SIZE}) { + print "Skipping smaller than minimum size\n"; + return 0; + } -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); + my $hash = $t->info_hash; + $hash = unpack("H*", $hash); + + $t->save($torrent_with_path); + print "Created: $torrent_with_path\n"; } +