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

   1 #! /usr/bin/perl
   2
   3 #
   4 # Small multithreaded pr0n uploader, based partially on dave from HTTP::DAV.
   5 # Use like
   6 #
   7 #   pr0n-upload.pl http://pr0n.sesse.net/webdav/upload/random/ *.JPG
   8 #
   9 # Adjust $threads to your own liking.
  10 #
  11
  12 use strict;
  13 use warnings;
  14 use HTTP::DAV;
  15 use threads;
  16 use Thread::Queue;
  17
  18 my $threads = 16;
  19 my $running_threads :shared = 0;
  20 my $queue :shared = Thread::Queue->new;
  21
  22 # Enqueue all the images.
  23 my $url = shift @ARGV;
  24 $queue->enqueue(@ARGV);
  25
  26 # Fetch username and password, and check that they actually work.
  27 my ($user, $pass) = get_credentials();
  28 my $dav = init_dav($url, $user, $pass);
  29 my $r = $dav->propfind(-url => $url, -depth => 0);
  30 if ($r == 0) {
  31         die "Couldn't open $url: " . $dav->message . "\n";
  32 }
  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 sub upload_thread {
  48         $running_threads++;
  49
  50         my $dav = init_dav($url, $user, $pass);
  51         while (my $filename = $queue->dequeue_nb) {
  52                 $dav->put(-local => $filename, -url => $url)
  53                         or warn "Couldn't upload $filename: " . $dav->message . "\n";
  54         }
  55
  56         $running_threads--;
  57 }
  58
  59 sub init_dav {
  60         my ($url, $user, $pass) = @_;
  61         my $ua = HTTP::DAV::UserAgent->new();
  62         $ua->agent('pr0n-uploader/v1.0 (perldav)');
  63         my $dav = HTTP::DAV->new(-useragent=>$ua);
  64         $dav->credentials(-user=>$user, -pass=>$pass, -url=>$url);
  65         $dav->open(-url => $url)
  66                 or die "Couldn't open $url: " . $dav->message . "\n";
  67         return $dav;
  68 }
  69
  70 sub get_credentials {
  71         print "\nEnter username for $url: ";
  72         chomp (my $user = <STDIN>);
  73         exit if (!defined($user));
  74         print "Password: ";
  75         system("stty -echo");
  76         chomp (my $pass = <STDIN>);
  77         system("stty echo");
  78         print "\n";
  79
  80         return ($user, $pass);
  81 }