4 # Small multithreaded pr0n uploader. Use like
6 # pr0n-upload.pl http://pr0n.sesse.net/webdav/upload/random/ *.JPG
8 # Adjust $threads to your own liking.
20 my $running_threads :shared = 0;
21 my $queue :shared = Thread::Queue->new;
22 my @succeeded :shared = ();
23 my @failed :shared = ();
25 # Enqueue all the images.
26 my $url = shift @ARGV;
27 $url .= '/' if ($url !~ m#/$#);
28 $queue->enqueue(@ARGV);
30 # Fetch username and password, and check that they actually work.
31 my ($user, $pass) = get_credentials();
32 my $ua = init_ua($url, $user, $pass);
34 # Fire up the worker threads, and wait for them to finish.
36 for my $i (1..$threads) {
37 push @threads, threads->create(\&upload_thread);
39 while ($running_threads > 0) {
40 printf "%d threads running, %d images queued\n", $running_threads, $queue->pending;
43 for my $thread (@threads) {
47 if (scalar @failed != 0 && scalar @succeeded != 0) {
48 # Output failed files in an easily-pastable format.
49 print "\nFailed files: ", join(' ', @failed), "\n";
55 my $ua = init_ua($url, $user, $pass);
56 while (my $filename = $queue->dequeue_nb) {
57 my (undef, undef, $basename) = File::Spec->splitpath($filename);
58 my $newurl = $url . $basename;
59 my $req = HTTP::Request->new(PUT => $newurl);
62 open my $fh, "<", $filename
63 or die "Couldn't find $filename: $!";
68 my $res = $ua->request($req);
69 if ($res->is_success) {
70 push @succeeded, $filename;
72 push @failed, $filename;
73 warn "Couldn't upload $filename: " . $res->message . "\n";
81 my ($url, $user, $pass) = @_;
82 my $ua = LWP::UserAgent->new;
83 $ua->agent('pr0n-uploader/v1.0');
84 my $urlobj = URI->new($url);
85 my $hostport = $urlobj->host . ':' . $urlobj->port;
86 $ua->credentials($hostport, 'pr0n.sesse.net', $user, $pass);
88 # Check that it works.
89 my $req = HTTP::Request->new(OPTIONS => $url);
90 my $res = $ua->request($req);
91 die "$url: " . $res->status_line if (!$res->is_success);
97 print "\nEnter username for $url: ";
98 chomp (my $user = <STDIN>);
99 exit if (!defined($user));
101 system("stty -echo");
102 chomp (my $pass = <STDIN>);
106 return ($user, $pass);