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