git.sesse.net Git - pr0n/blob - perl/pr0n-upload.pl

   1 #! /usr/bin/perl
   2
   3 #
   4 # Small multithreaded pr0n uploader. Use like
   5 #
   6 #   pr0n-upload.pl http://pr0n.sesse.net/webdav/upload/random/ *.JPG
   7 #
   8 # Adjust $threads to your own liking.
   9 #
  10
  11 use strict;
  12 use warnings;
  13 use LWP::UserAgent;
  14 use threads;
  15 use Thread::Queue;
  16 use File::Spec;
  17 use URI;
  18
  19 my $threads = 40;
  20 my $running_threads :shared = 0;
  21 my $queue :shared = Thread::Queue->new;
  22 my @succeeded :shared = ();
  23 my @failed :shared = ();
  24
  25 # Enqueue all the images.
  26 my $url = shift @ARGV;
  27 $url .= '/' if ($url !~ m#/$#);
  28 $queue->enqueue(@ARGV);
  29
  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);
  33
  34 # Fire up the worker threads, and wait for them to finish.
  35 my @threads = ();
  36 for my $i (1..$threads) {
  37         push @threads, threads->create(\&upload_thread);
  38 }
  39 while ($running_threads > 0) {
  40         printf "%d threads running, %d images queued\n", $running_threads, $queue->pending;
  41         sleep 1;
  42 }
  43 for my $thread (@threads) {
  44         $thread->join();
  45 }
  46
  47 if (scalar @failed != 0 && scalar @succeeded != 0) {
  48         # Output failed files in an easily-pastable format.
  49         print "\nFailed files: ", join(' ', @failed), "\n";
  50 }
  51
  52 sub upload_thread {
  53         $running_threads++;
  54
  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);
  60                 {
  61                         local $/ = undef;
  62                         open my $fh, "<", $filename
  63                                 or die "Couldn't find $filename: $!";
  64                         $req->content(<$fh>);
  65                         close $fh;
  66                 }
  67
  68                 my $res = $ua->request($req);
  69                 if ($res->is_success) {
  70                         push @succeeded, $filename;
  71                 } else {
  72                         push @failed, $filename;
  73                         warn "Couldn't upload $filename: " . $res->message . "\n";
  74                 }
  75         }
  76
  77         $running_threads--;
  78 }
  79
  80 sub init_ua {
  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);
  87
  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);
  92
  93         return $ua;
  94 }
  95
  96 sub get_credentials {
  97         print "\nEnter username for $url: ";
  98         chomp (my $user = <STDIN>);
  99         exit if (!defined($user));
 100         print "Password: ";
 101         system("stty -echo");
 102         chomp (my $pass = <STDIN>);
 103         system("stty echo");
 104         print "\n";
 105
 106         return ($user, $pass);
 107 }