X-Git-Url: https://git.sesse.net/?p=pr0n;a=blobdiff_plain;f=perl%2Fpr0n-upload.pl;h=ca5ff76bbb69ea5a4e128a235c7e40f7ada58c47;hp=4cde1f7398f168f9546346095a42b9314336c1d8;hb=5e125fda482f5887459721b76ef24cf82aa4202b;hpb=0362e5aac13eb1d847a706b933f47c47e3f6cf5a diff --git a/perl/pr0n-upload.pl b/perl/pr0n-upload.pl index 4cde1f7..ca5ff76 100755 --- a/perl/pr0n-upload.pl +++ b/perl/pr0n-upload.pl @@ -1,8 +1,7 @@ #! /usr/bin/perl # -# Small multithreaded pr0n uploader, based partially on dave from HTTP::DAV. -# Use like +# Small multithreaded pr0n uploader. Use like # # pr0n-upload.pl http://pr0n.sesse.net/webdav/upload/random/ *.JPG # @@ -11,9 +10,11 @@ use strict; use warnings; -use HTTP::DAV; +use LWP::UserAgent; use threads; use Thread::Queue; +use File::Spec; +use URI; my $threads = 40; my $running_threads :shared = 0; @@ -23,11 +24,12 @@ my @failed :shared = (); # Enqueue all the images. my $url = shift @ARGV; +$url .= '/' if ($url !~ m#/$#); $queue->enqueue(@ARGV); # Fetch username and password, and check that they actually work. my ($user, $pass) = get_credentials(); -my $dav = init_dav($url, $user, $pass); +my $ua = init_ua($url, $user, $pass); # Fire up the worker threads, and wait for them to finish. my @threads = (); @@ -50,28 +52,45 @@ if (scalar @failed != 0 && scalar @succeeded != 0) { sub upload_thread { $running_threads++; - my $dav = init_dav($url, $user, $pass); + my $ua = init_ua($url, $user, $pass); while (my $filename = $queue->dequeue_nb) { - if ($dav->put(-local => $filename, -url => $url)) { + my (undef, undef, $basename) = File::Spec->splitpath($filename); + my $newurl = $url . $basename; + my $req = HTTP::Request->new(PUT => $newurl); + { + local $/ = undef; + open my $fh, "<", $filename + or die "Couldn't find $filename: $!"; + $req->content(<$fh>); + close $fh; + } + + my $res = $ua->request($req); + if ($res->is_success) { push @succeeded, $filename; } else { push @failed, $filename; - warn "Couldn't upload $filename: " . $dav->message . "\n"; + warn "Couldn't upload $filename: " . $res->message . "\n"; } } $running_threads--; } -sub init_dav { +sub init_ua { my ($url, $user, $pass) = @_; - my $ua = HTTP::DAV::UserAgent->new(); - $ua->agent('pr0n-uploader/v1.0 (perldav)'); - my $dav = HTTP::DAV->new(-useragent=>$ua); - $dav->credentials(-user=>$user, -pass=>$pass, -url=>$url, -realm=>'pr0n.sesse.net'); - $dav->open(-url => $url) - or die "Couldn't open $url: " . $dav->message . "\n"; - return $dav; + my $ua = LWP::UserAgent->new; + $ua->agent('pr0n-uploader/v1.0'); + my $urlobj = URI->new($url); + my $hostport = $urlobj->host . ':' . $urlobj->port; + $ua->credentials($hostport, 'pr0n.sesse.net', $user, $pass); + + # Check that it works. + my $req = HTTP::Request->new(OPTIONS => $url); + my $res = $ua->request($req); + die "$url: " . $res->status_line if (!$res->is_success); + + return $ua; } sub get_credentials {