SVN: toys/rsget.pl/Get: . DepositFiles FileFactory FlyfileUs HotFile MegaShares MegaUpload NetLoad O...
sparky
sparky at pld-linux.org
Thu Aug 27 15:28:59 CEST 2009
Author: sparky
Date: Thu Aug 27 15:28:58 2009
New Revision: 10495
Added:
toys/rsget.pl/Get/
toys/rsget.pl/Get/DepositFiles
toys/rsget.pl/Get/FileFactory
toys/rsget.pl/Get/FlyfileUs
toys/rsget.pl/Get/HotFile
toys/rsget.pl/Get/MegaShares
toys/rsget.pl/Get/MegaUpload
toys/rsget.pl/Get/NetLoad
toys/rsget.pl/Get/OdSiebie
toys/rsget.pl/Get/RapidShare
toys/rsget.pl/Get/RapidShark
toys/rsget.pl/Get/StorageTo
toys/rsget.pl/Get/TurboUpload
toys/rsget.pl/Get/UploadedTo
Log:
- getters from original rsget.pl and some new ones:
- MegaShares, woohoo !
- RapidShark
- fixed OdSiebie
Added: toys/rsget.pl/Get/DepositFiles
==============================================================================
--- (empty file)
+++ toys/rsget.pl/Get/DepositFiles Thu Aug 27 15:28:58 2009
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+
+name: DepositFiles
+short: DF
+uri: qr{depositfiles\.com/}
+status: OK 2009-08-24
+
+start:
+ GET( $-{_uri} );
+
+ ERROR( "file not found" ) if /Such file does not exist /;
+ ! m{<div class="info">.*?<b .*?>(.*?)</b>\s*<span .*?>.*?<b>(\d+(\.\d+)?) ([KM]B)</b></span>}s;
+ INFO( name => $1, size => "$2 $4" );
+ RESTART( 5 * 60, "servers overloaded" )
+ if /We are sorry, but all downloading slots for your country are busy/;
+
+ if ( m{<form action="(.*)" method="get" onSubmit="download_started} ) {
+ $-{file_uri} = $1;
+ return $self->stage_download();
+ }
+
+ ! /<form action="(.*?)" method="post">/;
+ GET( $1, post => { gateway_result => 1 } );
+
+ RESTART( $1, "free limit reached" )
+ if m#<span class="html_download_api-limit_interval">(\d+)</span>#;
+
+ MULTI() if m#<span class="html_download_api-limit_parallel">#;
+ ! /<form action="(.*?)" method="get" onSubmit="download_started/;
+ $-{file_uri} = $1;
+
+ WAIT( 60, "starting download" );
+stage_download:
+
+ DOWNLOAD( $-{file_uri} );
+ RESTART( $1, "traffic limit" ) if /Wait (\d+) seconds/;
+
+# vim:ts=4:sw=4
Added: toys/rsget.pl/Get/FileFactory
==============================================================================
--- (empty file)
+++ toys/rsget.pl/Get/FileFactory Thu Aug 27 15:28:58 2009
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+
+name: FileFactory
+short: FF
+uri: qr{filefactory\.com/}
+status: OK 2009-08-24
+
+start:
+ GET( $-{_uri} );
+
+ ERROR( "file not found" ) if /File Not Found/;
+ ! m{<h1>(<a.*?</a>|<img .*?/>) (.*?)(<span.*?</span>)?</h1>\s*<div id="info" class="metadata">\s*<span>([\d\.]+ [KM]B) file uploaded}s;
+ my ( $name, $size ) = ( $2, $4 );
+ $name =~ s/​//g;
+ INFO( name => $name, size => $size );
+
+ MULTI() if /You are currently downloading/;
+ if ( /starthtimer[\s\S]*timerend=d\.getTime\(\)\+(\d+);/m ) {
+ RESTART( $1 / 1000, "free limit reached" ) if $1 > 0;
+ }
+
+ ! m#<form action="(.*)" method="post">\s*<input type="submit" value="Free#m;
+ GET( $1, post => { freeBtn => "Free Download" } );
+
+ ! m#<a href="(.*?)">Click here to begin your download</a>#;
+ $-{file_uri} = $1;
+
+ ! m#<p id="countdown">(\d+)</p>#;
+ WAIT( $1, "starting soon" );
+
+ DOWNLOAD( $-{file_uri} );
+
+ # file turned out to be html, meens we need to wait
+ MULTI() if /You are currently downloading too many files at once/;
+ RESTART( $1 * 60 - 30, "free limit reached" )
+ if /Please wait (\d+) minutes to download more files/;
+ RESTART( $1, "free limit reached" )
+ if /Please wait (\d+) seconds to download more files/;
+
+# vim:ts=4:sw=4
Added: toys/rsget.pl/Get/FlyfileUs
==============================================================================
--- (empty file)
+++ toys/rsget.pl/Get/FlyfileUs Thu Aug 27 15:28:58 2009
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+
+name: FlyfileUs
+short: FU
+uri: qr{flyfile\.us/}
+status: OK 2009-08-24
+
+start:
+ GET( $-{_uri} );
+
+ ERROR( "file not found" ) if /(No such file|No such user)/;
+ m{<h2>Download File (.*?)</h2>}; #\s*<font .*?>You have requested .*? \((\d+\.\d+) Mb\)</font>}s;
+ $-{name} = $1;
+
+ ! s/^.*?<Form method="POST" action=''>//s;
+ ! s/(.*?)<\/Form>.*$/$1/s;
+ my %opts;
+ $opts{$1} = $2 while s/<input type="hidden" name="(.*?)" value="(.*?)">//;
+ $opts{method_free} = "Free Download";
+
+ GET( "", post => \%opts );
+
+ m{<small>\((\d+) bytes\)</small>};
+ INFO( name => $-{name}, size => $1 );
+
+ RESTART( 600, "download-limit reached" )
+ if /You have reached the download-limit/;
+
+ ! s/^.*?<Form name="F1" method="POST" action=""//s;
+ ! s/(.*?)<\/Form>.*$/$1/s;
+ my %opts;
+ $opts{$1} = $2 while s/<input type="hidden" name="(.*?)" value="(.*?)">//;
+ $opts{btn_download} = "Create Download Link";
+
+ DOWNLOAD( $-{_referer}, post => \%opts );
+
+ # html
+ RESTART( 120, "temporarily unavailable" )
+ if /temporarily unavailable/;
+
+# vim:ts=4:sw=4
Added: toys/rsget.pl/Get/HotFile
==============================================================================
--- (empty file)
+++ toys/rsget.pl/Get/HotFile Thu Aug 27 15:28:58 2009
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+
+name: HotFile
+short: HF
+uri: qr{hotfile\.com/}
+status: BROKEN
+
+start:
+ GET( $-{uri} );
+
+ ERROR( "file not found" ) unless length $_;
+ ERROR( "file not found" ) if /This file is either removed/;
+ MULTI() if /You are currently downloading/;
+ ! /starthtimer[\s\S]*?timerend=d\.getTime\(\)\+(\d+);/;
+ RESTART( $1 / 1000, "free limit reached" ) if $1 > 0;
+ ! /starttimer[\s\S]*?timerend=d\.getTime\(\)\+(\d+);/;
+ my $wait = $1 / 1000;
+
+ ! s/^.*?<form style=".*?" action="(.*?)" method=post name=f>//s;
+ $-{action} = $1;
+ ! s#^(.*?)</form>.*#$1#;
+ my %post;
+ $post{$1} = $2 while s/<input type=hidden name=(.*?) value=(.*?)>//;
+ $-{post} = \%post;
+
+ WAIT( $wait, "starting download" );
+
+ GET( $-{action}, post => $-{post} );
+
+ ! m#<a href="(.*?)">Click here to download</a>#;
+ DOWNLOAD( $1 );
+
+# vim:ts=4:sw=4
Added: toys/rsget.pl/Get/MegaShares
==============================================================================
--- (empty file)
+++ toys/rsget.pl/Get/MegaShares Thu Aug 27 15:28:58 2009
@@ -0,0 +1,115 @@
+#!/usr/bin/perl
+
+name: MegaShares
+short: MS
+uri: qr{d01\.megashares\.com/\?d01=}
+cookie: ms
+status: OK ?
+
+pre:
+ use IPC::Open2;
+ my @ocr;
+ push @ocr, "gocr -f ASCII -a 5 -m 56 -C 0-9 -l 31" if require_prog( "gocr" );
+ push @ocr, "ocrad --filter=numbers_only" if require_prog( "ocrad" );
+ die "ocrad or gocr is required" unless @ocr;
+ die "pngtopnm is required" unless require_prog( "pngtopnm" );
+
+start:
+ my $stime = time() - 600;
+ my @line = (qw(.megashares.com TRUE / FALSE), $stime + 43200, 'freest', $stime . "%3A" );
+
+ open my $c, ">", $-{_cookie};
+ print $c join( "\t", @line ), "\n";
+ close $c;
+
+ GET( $-{_uri} );
+
+ ERROR( "temporarily unavailable" )
+ if m{<dd class="red">([^<]|<br>)*(link is currently offline)([^<]|<br>)*</dd>};
+ ERROR( "file not found" )
+ if m{<dd class="red">([^<]|<br>)*(Link was removed|Invalid link)([^<]|<br>)*</dd>};
+ MULTI()
+ if m{You already have the maximum of 1 download running};
+
+ m{<dt>Filename: <strong>(.*?)</strong> size: (\d+\.\d+ [GMK]B)</dt>};
+ INFO( name => $1, size => $2 );
+
+ RESTART( $1 * 60 + $2, "free limit reached" )
+ if m{Your download passport will renew\s*in 00:<strong>(\d+)</strong>:<strong>(\d+)</strong>};
+
+ unless( m{<dt>Your Passport needs to be reactivated.</dt>} ) {
+ ! m{<a href="(.*?)">Click here to download</a>};
+ $-{file_uri} = $1;
+
+ m{You have ([\d\.]+ .*?) left that you can download with this passport.};
+ my $left = $1;
+ m{Your download passport will renew in\s*<strong>0</strong>:<strong>(\d+)</strong>:<strong>(\d+)</strong>}s;
+ my $time = s2string( $1 * 60 + $2 );
+ my $if = $-{_outif} ? "[$-{_outif}]" : "";
+ p "${if}[MS] Passport: $left, $time";
+
+ return $self->stage_download();
+ }
+
+ ! m{var request_uri = "(.*?)";};
+ $-{ajax} = $1 . "&rs=check_passport_renewal";
+
+ ! m{<input type="hidden" name="random_num" id="random_num" value="(\d+)" />};
+ $-{random_num} = $1;
+
+ ! m{<input type="hidden" name="passport_num" id="passport_num" value="([0-9a-f]+)" />};
+ $-{passport_num} = $1;
+
+ ! m{<img src="(index.*?)" alt="Security Code"};
+ GET( $1 );
+
+ my $captcha = captcha( \$_ );
+ RESTART( 5, "Can't read captcha" ) unless $captcha;
+
+ my $rand = 1000 * time() + int rand 1000;
+ my $ajax = $-{ajax}
+ . (join "", map { '&rsargs[]=' . $_ }
+ ( $captcha, $-{random_num}, $-{passport_num}, "replace_sec_pprenewal" ) )
+ . "&rsrnd=$rand";
+
+ GET( $ajax );
+
+ RESTART( 10, "Passport reactivated" ) if m{Thank you for reactivating your passport};
+ RESTART( 10, "Wrong captcha ?" );
+
+ GET( "" );
+stage_download:
+
+ DOWNLOAD( $-{file_uri} );
+
+perl:
+
+sub run_ocr
+{
+ my $prog = shift;
+ my $png = shift;
+
+ IPC::Open2::open2( *READ, *WRITE, "pngtopnm | $prog - 2>/dev/null" );
+ print WRITE $$png;
+ close WRITE;
+ my $num = <READ> || "";
+ close READ;
+
+ my ($ret) = ($num =~ /([0-9]{4})/);
+ return $ret;
+}
+
+
+sub captcha
+{
+ my $png = shift;
+
+ foreach ( @ocr ) {
+ my $ret = run_ocr( $_, $png );
+ return $ret if $ret;
+ }
+
+ return undef;
+}
+
+# vim:ts=4:sw=4
Added: toys/rsget.pl/Get/MegaUpload
==============================================================================
--- (empty file)
+++ toys/rsget.pl/Get/MegaUpload Thu Aug 27 15:28:58 2009
@@ -0,0 +1,159 @@
+#!/usr/bin/perl
+
+name: MegaUpload
+short: MU
+uri: qr{mega(upload|porn|rotic)\.com/\?d=}
+status: OK 2009-08-24
+
+pre:
+ use Image::Magick;
+
+ my $mu_font_db = $main::data_path . "/mu_font_db.png";
+ die "Font DB '$mu_font_db' does not exist\n" unless -r $mu_font_db;
+
+start:
+ ( $-{uri} = $-{_uri} ) =~ s/megarotic/megaporn/;
+ GET( $-{uri} );
+stage_first:
+ $-{first_page} = $-{_referer};
+
+ ERROR( "file not found" ) if
+ /The file you are trying to access is temporarily unavailable/
+ or /Unfortunately, the link you have clicked is not available/
+ or /This file has expired due to inactivity/;
+ m{<TD valign="middle" align="left" .*?width="500">(.*?)</TD>}s;
+ my @f = map m#<font.*?>(.*?)</font>#g, $1;
+ INFO( name => de_ml( $f[1] ), size => $f[5] );
+
+ if ( /The file you're trying to download is password protected/ ) {
+ ERROR( "password required" ) unless exists $-{_opts}->{mu_pass};
+
+ GET_NEXT( stage_last, $-{uri},
+ post => { filepassword => $-{_opts}->{mu_pass} } );
+ }
+
+ SEARCH(
+ captcha_img => qr#<img src="(http://.*/gencap\.php\?[0-9a-f]+\.gif)"#,
+ s2icode => qr#<INPUT type="hidden" name="captchacode" value="(.*?)"#,
+ s2mevagar => qr#<INPUT type="hidden" name="megavar" value="(.*?)"#,
+ );
+
+ GET( $-{captcha_img} );
+
+ my $captcha = captcha( \$_ );
+ RESTART( 10, "Can't read captcha" ) unless defined $captcha;
+
+ $-{_referer} = $-{first_page};
+ GET( $-{uri}, post => {
+ captchacode => $-{s2icode},
+ megavar => $-{s2mevagar},
+ captcha => $captcha
+ } );
+
+stage_last:
+ if ( /id="captchaform"/ ) {
+ $self->print( "invalid captcha" );
+ return $self->stage_first();
+ }
+ ERROR( "invalid password" )
+ if /The file you're trying to download is password protected/;
+
+ ! /<a href="(.*?)".*IMG SRC=".*?but_dnld_regular.gif/;
+ $-{file_uri} = $1;
+
+ ! /count=([0-9]+);/;
+ WAIT( $1, "starting download" );
+
+ DOWNLOAD( $-{file_uri} );
+
+
+perl:
+
+my %size = (
+ A => 28, B => 22, C => 21, D => 27, E => 16,
+ F => 16, G => 26, H => 26, K => 20, M => 38,
+ N => 28, P => 21, Q => 30, R => 22, S => 18,
+ T => 19, U => 26, V => 22, W => 40, X => 23,
+ Y => 18, Z => 18
+);
+
+my @db;
+
+sub read_db()
+{
+ my $dbf = new Image::Magick;
+ $dbf->Read( $mu_font_db );
+ foreach my $pos ( 0..3 ) {
+ my @list = sort keys %size;
+ @list = (1..9) if $pos == 3;
+
+ my $height = 32;
+ my $width = 40;
+ my $left = $width * $pos;
+ $width = 22 if $pos == 3;
+ my $top = 0;
+
+ my %db;
+ foreach my $char ( @list ) {
+ my $db = $dbf->Clone();
+ $db->Crop( width => $width, height => $height, x => $left, y => $top );
+ $db{$char} = $db;
+ $top += 32;
+ }
+ push @db, \%db;
+ }
+}
+
+sub get_char
+{
+ my ($src, $db, $width, $x) = @_;
+
+ my $img = $src->Clone();
+ $img->Crop( width => $width, height => 32, x => $x, y => 0 );
+ $img->Extent( width => $width, height => 32, x => 0, y => 0 );
+
+ my $min = 1;
+ my $min_char = undef;
+ foreach my $n ( keys %$db ) {
+ my $x = $img->Compare( image => $db->{$n} );
+ my ($e, $em) = $img->Get( 'error', 'mean-error' );
+ if ( $em < $min ) {
+ $min = $em;
+ $min_char = $n;
+ }
+ }
+ return $min_char;
+}
+
+sub captcha
+{
+ my $data_ref = shift;
+
+ read_db() unless @db;
+
+ open IMAGE, '>', '.captcha.gif';
+ print IMAGE $$data_ref;
+ close IMAGE;
+
+ my $img = new Image::Magick;
+ my $x = $img->Read( '.captcha.gif' );
+ unlink '.captcha.gif';
+ return if length $x;
+
+ my ($width, $height) = $img->Get( 'columns', 'rows' );
+
+ my $bg = new Image::Magick;
+ $bg->Set( size => $width."x32" );
+ $bg->Read( "xc:white" );
+ $bg->Composite( image => $img );
+
+ my @cap;
+ push @cap, get_char( $bg, $db[0], 40, 0 );
+ push @cap, get_char( $bg, $db[1], 40, $size{$cap[0]} - 6 );
+ push @cap, get_char( $bg, $db[2], 40, $width - 56 );
+ push @cap, get_char( $bg, $db[3], 22, $width - 22 );
+
+ return join "", @cap;
+}
+
+# vim:ts=4:sw=4
Added: toys/rsget.pl/Get/NetLoad
==============================================================================
--- (empty file)
+++ toys/rsget.pl/Get/NetLoad Thu Aug 27 15:28:58 2009
@@ -0,0 +1,231 @@
+#!/usr/bin/perl
+
+name: NetLoad
+short: NL
+uri: qr{netload\.in/datei}
+cookie: nl
+status: OK 2009-08-24
+
+pre:
+ use IPC::Open2;
+ use GD;
+
+ die "Both ocrad and gocr are required\n" unless
+ require_prog( "ocrad" ) and require_prog( "gocr" );
+ die "pngtopnm is required\n" unless require_prog( "pngtopnm" );
+
+start:
+ GET( $-{_uri} );
+
+ ERROR( "file not found" )
+ if /(Sorry, we don't host the requested file|unknown_file_data)/;
+ ! m#<div class="dl_first_filename">\s*(.+?)<span.*?>, (\d+\.\d+ MB)</span></div>#s;
+ INFO( name => $1, size => $2 );
+
+ RESTART( 60 )
+ if /We will prepare your download/;
+
+ ! /href="(.*?captcha=1)"/;
+ GET( de_ml( $1 ) );
+ $-{dl_page} = $-{_referer};
+
+ RESTART( 1 ) if /"(.*?captcha=1)"/;
+
+ SEARCH(
+ action => qr#<form method="post" action="(.*?)">#,
+ captcha_img => qr#"(share/includes/captcha\.php\?t=[0-9]+)"#,
+ file_id => qr#input name="file_id" .*value="(.*?)"#,
+ s3wait => qr#please wait .*countdown\(([0-9]+),#,
+ );
+
+ GET( $-{captcha_img} );
+
+ $-{captcha} = Get::NetLoad::Captcha::resolve( \$_ );
+ RESTART( 1 ) unless defined $-{captcha};
+
+ WAIT( $-{s3wait} / 100, "checking" );
+
+ $-{_referer} = $-{dl_page};
+ GET( $-{action}, post => {
+ file_id => $-{file_id},
+ captcha_check => $-{captcha},
+ start => ''
+ } );
+
+ RESTART( 1 )
+ if /You may forgot the security code or it might be wrong/;
+ ERROR( "file not found" )
+ if /This file is currently unavailable/;
+ RESTART( $1 / 100, "free limit reached" )
+ if /You could download your next file in.*countdown\(([0-9]+)/;
+
+ ! /<a class="Orange_Link" href="(.*?)"/;
+ $-{file_uri} = $1;
+
+ ! /please wait .*countdown\(([0-9]+),/;
+ WAIT( $1 / 100, "starting download" );
+
+ DOWNLOAD( $-{file_uri} );
+
+perl:
+package Get::NetLoad::Captcha;
+
+sub blankline
+{
+ my $img = shift;
+ my $x = shift;
+ my $n = 0;
+ my $white = $img->colorClosest( 255, 255, 255 );
+ foreach my $y ( 0..28 ) {
+ my $ci = $img->getPixel( $x, $y );
+ next if $ci == $white;
+ $n++;
+ return 0 if $n > 1;
+ }
+ return 1;
+}
+
+sub blanklinev
+{
+ my $img = shift;
+ my $y = shift;
+ my $y2 = $y + shift;
+ my $xmin = shift;
+ my $xmax = shift;
+ my $n = 0;
+ my $white = $img->colorClosest( 255, 255, 255 );
+ foreach my $x ( $xmin..$xmax ) {
+ my $ci = $img->getPixel( $x, $y );
+ $n++ if $ci != $white;
+ $ci = $img->getPixel( $x, $y2 );
+ $n++ if $ci != $white;
+ return 0 if $n > 2;
+ }
+ return 1;
+}
+
+sub charat
+{
+ my $img = shift;
+ my $trimg = shift;
+ my $sx = shift;
+
+ my $xmin = $sx;
+ until( blankline( $img, $xmin ) ) {
+ $xmin--;
+ }
+ my $xmax = $sx+1;
+ until( blankline( $img, $xmax ) ) {
+ $xmax++;
+ }
+ my $ymin = 14;
+ until( blanklinev( $img, $ymin, -1, $xmin, $xmax ) ) {
+ $ymin--;
+ }
+ my $ymax = 15;
+ until( blanklinev( $img, $ymax, +1, $xmin, $xmax ) ) {
+ $ymax++;
+ }
+
+ my $w = $xmax - $xmin;
+ my $h = $ymax - $ymin;
+ my $nimg = new GD::Image( $w * 4 + 16, ($h > 12 ? $h : 12 ) + 4 );
+ my $nw = $nimg->colorAllocate( 255, 255, 255);
+ $nimg->copy( $trimg, 1, 1, $xmin, $ymin, $w, $h );
+ $nimg->copy( $trimg, 3 + 1*$w, 1, $xmin, $ymin, $w, $h );
+ $nimg->copy( $trimg, 13 + 2*$w, 1, $xmin, $ymin, $w, $h );
+ $nimg->copy( $trimg, 15 + 3*$w, 1, $xmin, $ymin, $w, $h );
+
+ IPC::Open2::open2( *READ, *WRITE, "pngtopnm | gocr -f ASCII -a 5 -m 56 -C 0123456789 - 2>/dev/null" );
+ print WRITE $nimg->png;
+ close WRITE;
+ my $num = <READ> || "";
+ close READ;
+
+ my ($gocr) = ($num =~ /^([0-9])/);
+
+ IPC::Open2::open2( *READ, *WRITE, "pngtopnm | ocrad --filter=numbers_only - 2>/dev/null" );
+ print WRITE $nimg->png;
+ close WRITE;
+ $num = <READ> || "";
+ close READ;
+
+ my ($ocrad) = ($num =~ /^([0-9])/);
+
+ #print "G: $gocr, O: $ocrad\n";
+ if ( defined $gocr ) {
+ return 7 if ( defined $ocrad and $ocrad == 7 and $gocr == 1 );
+ return $gocr;
+ } elsif ( defined $ocrad ) {
+ return $ocrad;
+ }
+ return undef;
+}
+
+sub resolve
+{
+ my $capdata = shift;
+
+ my $img = GD::Image->new( $$capdata );
+ my $white = $img->colorClosest( 255, 255, 255 );
+
+ foreach my $y ( 0..28 ) {
+ $img->setPixel( 0, $y, $white );
+ $img->setPixel( 73, $y, $white );
+ }
+ foreach my $x ( 0..73 ) {
+ $img->setPixel( $x, 0, $white );
+ $img->setPixel( $x, 28, $white );
+ }
+
+ foreach my $y ( 1..27 ) {
+ FORX: foreach my $x ( 1..72 ) {
+ my $ci = $img->getPixel( $x, $y );
+ next if $ci == $white;
+ my @xy = ( [0, 1], [0, -1], [1, 0], [-1, 0] );
+
+ my $wrong = 0;
+ foreach my $xy ( @xy ) {
+ my $c = $img->getPixel( $x + $xy->[0], $y + $xy->[1] );
+ if ( $c != $white ) {
+ $wrong++;
+ next FORX if $wrong > 1;
+ }
+ }
+
+ $img->setPixel( $x, $y, $white );
+ }
+ }
+
+
+ my $trimg = GD::Image->newTrueColor( 74, 29 );
+ my $trwhite = $trimg->colorAllocate( 255, 255, 255 );
+ $trimg->fill( 0, 0, $trwhite );
+ foreach my $y ( 0..28 ) {
+ foreach my $x ( 0..73 ) {
+ my $ci = $img->getPixel( $x, $y );
+ my ($r, $g, $b ) = $img->rgb( $ci );
+ $r = (256 - $r) / 256;
+ $g = (256 - $g) / 256;
+ $b = (256 - $b) / 256;
+ my $c = 256 - 256 * (($r * $g * $b) ** (1/3));
+
+ my $gray = $trimg->colorResolve( $c, $c, $c );
+
+ $trimg->setPixel( $x, $y, $gray );
+ }
+ }
+
+ my @n;
+ push @n, charat( $img, $trimg, 9 );
+ push @n, charat( $img, $trimg, 28 );
+ push @n, charat( $img, $trimg, 42 );
+ push @n, charat( $img, $trimg, 58 );
+ foreach (@n) {
+ return undef unless defined $_;
+ }
+
+ return join "", @n;
+}
+
+# vim:ts=4:sw=4
Added: toys/rsget.pl/Get/OdSiebie
==============================================================================
--- (empty file)
+++ toys/rsget.pl/Get/OdSiebie Thu Aug 27 15:28:58 2009
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+name: OdSiebie
+short: OS
+uri: qr{odsiebie\.com/pokaz/}
+cookie: os
+slots: 8
+status: OK 2009-08-25
+
+start:
+ GET( $-{_uri} );
+
+ ERROR( "some problem, file not found ?" )
+ if $-{_referer} =~ m{/(upload|error)\.html};
+
+ m{<dl class="file-info">.*?<dd>(.*?)</dd>.*?<dd>\s*(\d+\.\d+ MB)</dd>}s;
+ INFO( name => $1, size => $2 );
+
+ ! m{href="(/pobierz/\d+---.*?\.html)"};
+ GET( $1 );
+
+ ! m{href="(/download/\d+---.*?.html)"};
+ DOWNLOAD( $1 );
+
+# vim:ts=4:sw=4
Added: toys/rsget.pl/Get/RapidShare
==============================================================================
--- (empty file)
+++ toys/rsget.pl/Get/RapidShare Thu Aug 27 15:28:58 2009
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+
+name: RapidShare
+short: RS
+uri: qr{rapidshare\.com/}
+status: OK 2009-08-24
+
+start:
+ GET( $-{_uri} );
+
+ ERROR( "file not found" )
+ if /The file could not be found\. Please check the download link/;
+ ERROR( "file removed" ) if /file has been removed from the server/;
+
+ m#<p class="downloadlink">.*/(.+?) <font style=".*?">\| (\d+ KB)</font></p>#;
+ INFO( name => $1, size => $2, kilo => 1000 );
+
+ RESTART( $1 * 60, "servers overloaded" )
+ if /Unfortunately you will have to wait ([0-9]+) minutes,/;
+
+ ! /form id="ff" action="(.*?)"/;
+ GET( $1, post => 'dl.start=Free' );
+
+ MULTI() if /Please wait until the download is completed/;
+
+ RESTART( $1 * 60 + 10, "free limit reached" )
+ if /Instant download access! Or try again in about ([0-9]+) minutes\./;
+
+ RESTART( $1 * 60, "servers overloaded" )
+ if /Unfortunately you will have to wait ([0-9]+) minutes,/;
+
+ ! /form name="dlf" action="(.*?)"/;
+ $-{file_uri} = $1;
+
+ ! /var c=([0-9]+);/;
+ WAIT( $1, "starting download" );
+
+ DOWNLOAD( $-{file_uri}, post => { mirror => "on" } );
+
+# vim:ts=4:sw=4
Added: toys/rsget.pl/Get/RapidShark
==============================================================================
--- (empty file)
+++ toys/rsget.pl/Get/RapidShark Thu Aug 27 15:28:58 2009
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+name: RapidShark
+short: RK
+uri: qr{rapidshark\.pl/}
+status: OK 2009-08-26
+
+start:
+ GET( $-{_uri} );
+
+ ERROR( "file not found" )
+ if m{<b>(Plik nie został odnaleziony|File Not Found|Datei nicht gefunden)</b>};
+ ERROR( "file not found" )
+ if m{<font class="err">No such file};
+
+ m{<font style="font-size:12px;">Chcesz pobrac plik <font color="red">.*/(.*?)</font> \(([\d\.]+ ([MK])?b)\)</font>};
+ INFO( name => $1, size => $2 );
+
+ ! s/^.*?<Form method="POST" action=''>//s;
+ ! s/(.*?)<\/Form>.*$/$1/s;
+
+ my %opts;
+ $opts{$1} = $2 while s/<input type="hidden" name="(.*?)" value="(.*?)">//;
+
+ ! m{<input type="submit" name="method_free" value="(.*?)">};
+ $opts{method_free} = $1;
+
+ GET( "", post => \%opts );
+
+ if ( /You have to wait (.*) till next download/ ) {
+ $_ = $1;
+ my $wait = 0;
+ $wait += 60 * 60 * $1 if /(\d+) hour/;
+ $wait += 60 * $1 if /(\d+) minute/;
+ $wait += $1 if /(\d+) second/;
+ RESTART( $wait, "free limit reached" );
+ }
+
+ ! s/^.*?<Form name="F1" method="POST" action=""//s;
+ ! s/(.*?)<\/Form>.*$/$1/s;
+
+ ! m{<div .*?>(.*)</div>\s+</td><td align=left valign=middle><input type="text" name="code" class="captcha_code"></td></tr>}s;
+ my %opts = ( code => captcha( $1 ) );
+
+
+ $opts{$1} = $2 while s/<input type="hidden" name="(.*?)" value="(.*?)">//s;
+
+ ! m{<input type="submit" id="btn_download" value="(.*?)">};
+ $opts{btn_download} = $1;
+
+ $-{post} = \%opts;
+
+ ! m{<span id="countdown">(\d+)</span>};
+ WAIT( $1, "starting download" );
+
+ DOWNLOAD( $-{_referer}, post => $-{post} );
+
+perl:
+ sub captcha
+ {
+ my %c = map /<span.*?padding-left:\s*?(\d+)px;.*?>(\d)</g, shift;
+ my @c = map { $c{$_} } sort { $a <=> $b } keys %c;
+ return join "", @c;
+ }
+
+# vim:ts=4:sw=4
Added: toys/rsget.pl/Get/StorageTo
==============================================================================
--- (empty file)
+++ toys/rsget.pl/Get/StorageTo Thu Aug 27 15:28:58 2009
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+
+name: StorageTo
+short: ST
+uri: qr{storage\.to/}
+status: OK 2009-08-24
+
+start:
+ GET( $-{_uri} );
+
+ ! m{<span class="orange">.*?:</span> (.*?) <span class="light">\(([\d\.]+ [KM]B)\)</span>};
+ INFO( name => $1, size => $2 );
+
+ ! /onclick='javascript:startcountdown\("(.*?)", "(.*?)"\);'/;
+ GET( "/getlink/$2/" );
+
+ ! s/^.*?{\s+//;
+ ! s/\s+}.*?$//;
+
+ ! /'countdown'\s*:\s*(\d+)/;
+ my $wait = $1;
+ RESTART( $wait, "free limit reached" )
+ unless /'state'\s*:\s*'ok'/;
+
+ ! /'link'\s*:\s*'(.*?)'/ and $1;
+ $-{file_uri} = $1;
+
+ WAIT( $wait, "starting download" );
+
+ delete $-{_referer}; # started from ajax, there must be no referer
+ DOWNLOAD( $-{file_uri} );
+
+# vim:ts=4:sw=4
Added: toys/rsget.pl/Get/TurboUpload
==============================================================================
--- (empty file)
+++ toys/rsget.pl/Get/TurboUpload Thu Aug 27 15:28:58 2009
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+
+name: TurboUpload
+short: TU
+uri: qr{turboupload\.com/}
+status: OK 2009-08-24
+
+start:
+ GET( $-{_uri} );
+
+ ERROR( "file not found" ) if /File Not Found/;
+ ! m{<h2>\S* \S* (.*?)</h2>\s*<font .*?</font> \((\d+\.\d+ [MK]b)\)</font>}s;
+ INFO( name => $1, size => $2 );
+
+ ! s/^.*?<Form method="POST" action=''>//s;
+ ! s/(.*?)<\/Form>.*$/$1/s;
+
+ my %opts;
+ $opts{$1} = $2 while s/<input type="hidden" name="(.*?)" value="(.*?)">//;
+ $opts{method_free} = "Free Download";
+
+ GET( "", post => \%opts );
+
+ if ( /You have to wait (.*) till next download/ ) {
+ $_ = $1;
+ my $wait = 0;
+ $wait += 60 * 60 * $1 if /(\d+) hour/;
+ $wait += 60 * $1 if /(\d+) minute/;
+ $wait += $1 if /(\d+) second/;
+ RESTART( $wait, "free limit reached" );
+ }
+
+ ! m#Enter code below:[\S\s]*?<div.*?>(.*?)</div>#;
+ my %opts = ( code => captcha( $1 ) );
+
+ ! s/^.*?<Form name="F1" method="POST" action=""//s;
+ ! s/(.*?)<\/Form>.*$/$1/s;
+
+ $opts{$1} = $2 while s/<input type="hidden" name="(.*?)" value="(.*?)">//s;
+ $opts{btn_download} = "Download File";
+
+ $-{post} = \%opts;
+
+ WAIT( 60, "starting download" );
+
+ DOWNLOAD( $-{_referer}, post => $-{post} );
+
+perl:
+ sub captcha
+ {
+ my %c = map /<span.*?padding-left:\s*?(\d+)px;.*?>(\d)</g, shift;
+ my @c = map { $c{$_} } sort { $a <=> $b } keys %c;
+ return join "", @c;
+ }
+
+# vim:ts=4:sw=4
Added: toys/rsget.pl/Get/UploadedTo
==============================================================================
--- (empty file)
+++ toys/rsget.pl/Get/UploadedTo Thu Aug 27 15:28:58 2009
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+
+name: UploadedTo
+short: UT
+uri: qr{(uploaded|ul)\.to/}
+status: OK 2009-08-24
+
+start:
+ GET( $-{_uri} );
+
+ RESTART( $1 * 60, "free limit reached" )
+ if /Or wait (\d+) minutes/;
+
+ if ( $-{_referer} =~ m#/\?view=# ) {
+ ERROR( "file not found" ) if $-{_referer} =~ /fileremoved/;
+ ERROR( "unknown error" );
+ }
+
+ ! m{<title>(.*?) \.\.\. at uploaded\.to - };
+ my $name = $1;
+ ! m{<tr><td style="padding-left:4px;">Filesize: </td><td>\s*(\d+\.\d+ [KM]B)\s*</td></tr>};
+ INFO( name => $name, size => $1 );
+
+
+ ! m#<form name="download_form" method="post" action="(.*)">#;
+ $-{file_uri} = $1;
+
+ ! m#var secs = (\d+); // Wartezeit#;
+ WAIT( $1, "starting download" );
+
+ DOWNLOAD( $-{file_uri}, post => { download_submit => "Download" } );
+
+# vim:ts=4:sw=4
More information about the pld-cvs-commit
mailing list