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