htdocs/download/fexget

   1 #!/usr/bin/perl -w
   2
   3 # CLI client for the FEX service for retrieving files
   4 #
   5 # see also: fexsend
   6 #
   7 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
   8 #
   9 # Perl Artistic Licence
  10
  11 use 5.006;
  12 use strict qw'vars subs';
  13 use Config;
  14 use POSIX;
  15 use Encode;
  16 use Getopt::Std;
  17 use File::Basename;
  18 use Socket;
  19 use IO::Handle;
  20 use IO::Socket::INET;
  21 use Time::HiRes 'time';
  22 use constant k => 2**10;
  23 use constant M => 2**20;
  24
  25 eval 'use Net::INET6Glue::INET_is_INET6';
  26
  27 $| = 1;
  28
  29 our $SH;
  30 our ($fexhome,$idf,$tmpdir,$windoof,$useragent);
  31 our ($xv,%autoview);
  32 our $bs = 2**16; # blocksize for tcp-reading and writing file
  33 our $version = 20160104;
  34 our $CTYPE = 'ISO-8859-1';
  35 our $fexsend = $ENV{FEXSEND} || 'fexsend';
  36 our $DEBUG = $ENV{DEBUG};
  37
  38 my %SSL = (SSL_version => 'TLSv1');
  39 my $sigpipe;
  40
  41 # inquire default character set
  42 # cannot use "use I18N::Langinfo" because of no windows support!
  43 eval {
  44   local $^W = 0;
  45   require I18N::Langinfo;
  46   I18N::Langinfo->import(qw'langinfo CODESET');
  47   $CTYPE = langinfo(CODESET());
  48 };
  49
  50 if ($Config{osname} =~ /^mswin/i) {
  51   $windoof = $Config{osname};
  52   $ENV{HOME} = $ENV{USERPROFILE};
  53   $fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/fex';
  54   $tmpdir = $ENV{FEXTMP} || $ENV{TMP} || "$fexhome/tmp";
  55   $idf = "$fexhome/id";
  56   $useragent = sprintf("fexget-$version (%s %s)",
  57                        $Config{osname},$Config{archname});
  58   $SSL{SSL_verify_mode} = 0;
  59   chdir $ENV{USERPROFILE}.'\Desktop';
  60   # open XX,'>XXXXXX';close XX;
  61 } elsif ($Config{osname} =~ /^darwin/i or $ENV{MACOS}) {
  62   $0 =~ s:(.*)/:: and $ENV{PATH} .= ":$1";
  63   $fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/.fex';
  64   $tmpdir = $ENV{FEXTMP} || $ENV{TMPDIR} || "$fexhome/tmp";
  65   $idf = "$fexhome/id";
  66   $_ = `sw_vers -productVersion 2>/dev/null`||'';
  67   chomp;
  68   $useragent = "fexget-$version (MacOS $_)";
  69 } else {
  70   $0 =~ s:(.*)/:: and $ENV{PATH} .= ":$1";
  71   $fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/.fex';
  72   $tmpdir = $ENV{FEXTMP} || "$fexhome/tmp";
  73   $idf = "$fexhome/id";
  74   $_ = `(lsb_release -d||uname -a)2>/dev/null`||'';
  75   chomp;
  76   s/^Description:\s+//;
  77   $useragent = "fexget-$version ($_)";
  78 }
  79
  80 if (-f ($_ = '/etc/fex/config.pl')) {
  81   eval { require } or warn $@;
  82 }
  83
  84 my $usage = <<EOD;
  85 usage: $0 [-v] [-m limit] [-s filename] [-o] [-k] [-X] [-P proxy:port] F*EX-URL(s)
  86    or: $0 [-v] -d F*EX-URL(s)
  87    or: $0 [-v] -f F*EX-URL(s) e-mail-address
  88    or: $0 [-v] -a
  89    or: $0 -l [-i tag]
  90    or: $0 -H
  91 options: -v verbose mode
  92          -m limit kB/s
  93          -s save to filename (-s- means: write to STDOUT/pipe)
  94          -o overwrite existing file
  95          -k keep on server after download
  96          -X do not extract archive files or autoview file
  97          -d delete without download
  98          -f forward a file to another recipient
  99          -a get all files (implies -X)
 100          -l list files on server
 101          -i tag alternate server/account, see: $fexsend -h
 102          -P use Proxy for connection to the F*EX server
 103          -H show hints and examples
 104 argument: F*EX-URL may be file number (see: $0 -l)
 105 EOD
 106
 107 my $hints = <<'EOD';
 108 When you download a file with extension .jpg .gif .png or .tif an image viewer
 109 will be started. This can be xv or xdg-open.
 110 In $HOME/.fex/config.pl you can set your prefered autoview applications:
 111
 112 %autoview = (
 113   '\.(gif|jpg|png|tiff?)' => 'my_prefered_image_viewer',
 114   '\.(avi|mp4|mov)'       => 'vlc -f',
 115   '\.pdf'                 => 'evince',
 116 );
 117
 118 For HTTPS you can set the environment variables:
 119 SSLVERIFY=1                 # activate server identity verification
 120 SSLVERSION=TLSv1            # this is the default
 121 SSLCAPATH=/etc/ssl/certs    # path to trusted (root) certificates
 122 SSLCAFILE=/etc/ssl/cert.pem # file with trusted (root) certificates
 123 SSLCIPHERLIST=HIGH:!3DES    # see http://www.openssl.org/docs/apps/ciphers.html
 124
 125 You can set these environment variables also in $HOME/.fex/config.pl, as well as
 126 the $opt_* variables, e.g.:
 127
 128 $ENV{SSLVERSION} = 'TLSv1';
 129 ${'opt_+'} = 1;
 130 $opt_m = 200;
 131 EOD
 132
 133 if ($windoof and not @ARGV and not $ENV{PROMPT}) {
 134   # restart with cmd.exe to have mouse cut+paste
 135   my $cmd = "cmd /k \"$0\"";
 136   # print "$cmd\n";
 137   exec $cmd;
 138   exit;
 139 }
 140
 141 my $atype = '\.(tgz|tar|zip|7z)$';
 142 my $proxy = '';
 143 my $proxy_prefix = '';
 144 my $chunksize;
 145
 146 our ($opt_h,$opt_v,$opt_l,$opt_d,$opt_m,$opt_z,$opt_K,$opt_o,$opt_a);
 147 our ($opt_s,$opt_k,$opt_i,$opt_V,$opt_X,$opt_f,$opt_P,$opt_L,$opt_H);
 148 $opt_m = $opt_h = $opt_v = $opt_l = $opt_d = $opt_K = $opt_o = $opt_a = 0;
 149 $opt_V = $opt_X = $opt_f = $opt_L = $opt_H = 0;
 150 ${'opt_+'} = 0;
 151 $opt_s = $opt_k = $opt_i = $opt_P = '';
 152 $_ = "$fexhome/config.pl"; require if -f;
 153 getopts('hvVHlLdkzoaXf+m:s:i:K:P:') or die $usage;
 154 $opt_k = '?KEEP' if $opt_k;
 155
 156 if ($opt_m =~ /(\d+)/) {
 157   $opt_m = $1
 158 } else {
 159   $opt_m = 0
 160 }
 161
 162 print "Version: $version\n" if $opt_V;
 163 die $usage                  if $opt_h;
 164 if ($opt_H) {
 165   print $hints;
 166   exit;
 167 }
 168
 169 &get_ssl_env;
 170
 171 my $ffl = "$tmpdir/fexget";             # F*EX files list (cache)
 172
 173 my @rcamel = (
 174 '\e[A
 175 (_*)  _  _
 176    \\\\/ \\/ \\
 177     \  __  )=*
 178     //\\\\//\\\\
 179 ',
 180 '\e[A     \\\\/\\\\/
 181 ',
 182 '\e[A    //\\\\//\\\\
 183 ');
 184
 185 # get fexlog
 186 if ($opt_z) {
 187   my $cmd = "$fexsend -Z";
 188   $cmd .= " -i $opt_i" if $opt_i;
 189   warn "$cmd\n" if $opt_v;
 190   exec $cmd;
 191   die "$0: cannot run $cmd : $!\n";
 192 }
 193
 194 if ($opt_l) {
 195   &list;
 196   exit;
 197 }
 198
 199 if ($opt_L) {
 200   my $cmd = "$fexsend -L";
 201   $cmd .= " -i $opt_i" if $opt_i;
 202   warn "$cmd\n" if $opt_v;
 203   exec $cmd;
 204   die "$0: cannot run $cmd : $!\n";
 205 }
 206
 207 if ($opt_P) {
 208   if ($opt_P =~ /^([\w.-]+:\d+)(:(\d+))?/) {
 209     $proxy = $1;
 210     $chunksize = $3 || 0;
 211   } else {
 212     die "$0: proxy must be: SERVER:PORT\n";
 213   }
 214 }
 215
 216 if ($opt_a) {
 217   $opt_X = $opt_a;
 218   die $usage if @ARGV;
 219   &list;
 220   print "\n";
 221   if (open $ffl,$ffl) {
 222     while (<$ffl>) {
 223       push @ARGV,$1 if /^\s+(\d+)/;
 224     }
 225     close $ffl;
 226   }
 227 } else {
 228   unless (@ARGV) {
 229     if ($windoof) {
 230       my $url;
 231       for (;;) {
 232         print "download-URL: ";
 233         chomp($url = <STDIN>);
 234         if ($url =~ /^http/) {
 235           @ARGV = ($url);
 236           last;
 237         }
 238       }
 239     } else {
 240       die $usage;
 241     }
 242   }
 243 }
 244
 245 my ($file,%files,$download,$server,$port,$fop,$https);
 246
 247 if ($opt_f) {
 248   unless ($ENV{FEXID} or -f $ENV{HOME}.'/.fex/id') {
 249     die "$0: no local FEXID\n";
 250   }
 251   $opt_f = pop(@ARGV);
 252   if ($opt_f =~ /^\d+$|^https?:/) {
 253     die "$0: $opt_f is not an e-mail address\n";
 254   }
 255 }
 256
 257 URL: foreach my $url (@ARGV) {
 258
 259   # do not overrun server
 260   sleep 1 if $fop;
 261
 262   if ($url !~ /^http/) {
 263     unless (%files) {
 264       open $ffl,$ffl or die "$0: no $ffl, use first: $0 -l\n";
 265       my $from = '';
 266       while (<$ffl>) {
 267         if (/^from (.+) :$/) {
 268           $from = $1;
 269         } elsif (/^\s*(\d+)\)\s+\d+ MB.* (http\S+)/) {
 270           push @{$files{all}},$2;
 271           push @{$files{$from}},$2;
 272         }
 273       }
 274       close $ffl;
 275     }
 276
 277     if ($url =~ /^(\d+)$/) {
 278       $url = ${files{all}}[$1-1] or die "$0: unknown file number\n";
 279     }
 280   }
 281
 282   if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/.*fop/\S+)}) {
 283     $https  = $1;
 284     $server = $2;
 285     $port   = $4 || ($1?443:80);
 286     $fop    = $5;
 287   } else {
 288     die "$0: unknown F*EX URL $url\n";
 289   }
 290
 291   if ($proxy) {
 292     if    ($port == 80)   { $proxy_prefix = "http://$server" }
 293     elsif ($port == 443)  { $proxy_prefix = "" }
 294     else                  { $proxy_prefix = "http://$server:$port" }
 295   }
 296
 297   serverconnect($server,$port);
 298
 299   if ($opt_f) {
 300     forward($url);
 301     next;
 302   }
 303
 304   if ($opt_d) {
 305     my @r = del($url);
 306     $_ = shift @r;
 307     if (/^HTTP.* 200/) {
 308       ($file) = grep { $_ = $1 if /^X-File:\s+(.+)/ } @r;
 309       $file = $url unless $file;
 310       $file =~ s:.*/::;
 311       printf "%s deleted\n",urldecode($file);
 312     } else {
 313       s:HTTP/[\d\. ]+::;
 314       die "$0: server response: $_";
 315     }
 316     next;
 317   }
 318
 319   if ($opt_K) {
 320     my @r = keep($url);
 321     $_ = shift @r;
 322     if (/^HTTP.* 200/) {
 323       $file = $url;
 324       $file =~ s:.*/::;
 325       print "$file kept\n";
 326     } else {
 327       s:HTTP/[\d\. ]+::;
 328       die "$0: server response: $_";
 329     }
 330     next;
 331   }
 332
 333   $download = download($server,$port,$fop);
 334   exit if $opt_s eq '-';
 335   unlink $download unless -s $download;
 336   exit 2 unless -f $download;
 337
 338   if ($windoof) {
 339     print "READY\n";
 340     exit;
 341   }
 342
 343   if (not $opt_X and $download =~ /\.gpg$/) {
 344     if (-t) {
 345       print "decrypt \"$download\"? ";
 346       $_ = <STDIN>||'y';
 347       unless (/^[y\n]/i) {
 348         print "keeping \"$download\"\n";
 349         exit;
 350       }
 351     }
 352     if (system('gpg',$download) == 0) {
 353       unlink $download;
 354       $download =~ s/\.gpg$//;
 355     }
 356   }
 357
 358   unless ($opt_X) {
 359
 360     foreach my $a (keys %autoview) {
 361       if ($download =~ /$a$/i and $autoview{$a}) {
 362         printf "run \"%s %s\" [Yn] ? ",$autoview{$a},basename($download);
 363         $_ = <STDIN>||'';
 364         system sprintf("%s %s",$autoview{$a},quote($download)) if /^y|^$/i;
 365         next URL;
 366       }
 367     }
 368
 369     if ($ENV{DISPLAY} and $download =~ /\.(gif|jpg|png|tiff?)$/i) {
 370       # see also mimeopen and xdg-mime
 371       # http://unix.stackexchange.com/questions/144047/how-does-xdg-open-do-its-work
 372       if (my $xv = $xv || pathsearch('xv') || pathsearch('xdg-open')) {
 373         printf "run \"%s %s\" [Yn] ? ",basename($xv),basename($download);
 374         $_ = <STDIN>||'';
 375         system $xv,$download if /^y|^$/i;
 376         next URL;
 377       }
 378     }
 379
 380     if ($download =~ /$atype/) {
 381       if    ($download =~ /\.(tgz|tar.gz)$/) { extract('tar tvzf','tar xvzf') }
 382       elsif ($download =~ /\.tar$/)          { extract('tar tvf','tar xvf') }
 383       elsif ($download =~ /\.zip$/i)         { extract('unzip -l','unzip') }
 384       elsif ($download =~ /\.7z$/i)          { extract('7z l','7z x') }
 385       else { die "$0: unknown archive \"$download\"\n" }
 386       if ($? == 0) {
 387         unlink $download;
 388       } else {
 389         die "$0: keeping \"$download\"\n";
 390       }
 391     }
 392   }
 393
 394 }
 395
 396 exit;
 397
 398 sub extract {
 399   my $l = shift;
 400   my $x = shift;
 401   my $d = $download;
 402   my $xd = '';
 403   local $_;
 404
 405   if (-t and not $windoof) {
 406     print "Files in archive:\n";
 407     system(split(' ',$l),$download);
 408     $d =~ s:.*/:./:;
 409     $d =~ s/\.[^.]+$//;
 410     $d =~ s:/*$:/:;
 411     for (;;) {
 412       $xd = inquire("extract to directory (Ctrl-C to keep archive): ",$d);
 413       last if $xd =~ s:^(\./*)*!?$::;
 414       if ($xd eq '-') {
 415         print "keeping $download\n";
 416         exit;
 417       }
 418       if ($xd !~ s/!$//) {
 419         if (-d $xd) {
 420           print "directory $xd does already exist, add \"!\" to overwrite\n";
 421           redo;
 422         }
 423         unless (mkdir $xd) {
 424           print "cannot mkdir $xd - $!\n";
 425           redo;
 426         }
 427       }
 428       unless (chdir $xd) {
 429         print "cannot chdir $xd - $!\n";
 430         redo;
 431       }
 432       last;
 433     }
 434   }
 435   print "extracting to $xd :\n" if $xd;
 436   system(split(' ',$x),$download);
 437   print "extracted to $xd\n" if $xd;
 438 }
 439
 440 sub del {
 441   my $url = shift;
 442   my ($server,$port);
 443   my $del;
 444   my @r;
 445
 446   if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/fop/.+)}) {
 447     $server = $2;
 448     $port   = $4 || ($1?443:80);
 449     $del    = $5.'?DELETE';
 450   } else {
 451     die "$0: unknown F*EX URL $url\n";
 452   }
 453
 454   sendheader("$server:$port","GET $del HTTP/1.1","User-Agent: $useragent");
 455   while (<$SH>) {
 456     s/\r//;
 457     last if /^\n/; # ignore HTML output
 458     warn "<-- $_" if $opt_v;
 459     push @r,$_;
 460   }
 461   die "$0: no response from fex server $server\n" unless @r;
 462   return @r;
 463 }
 464
 465
 466 sub forward {
 467   my $url = shift;
 468   my ($server,$port);
 469   my ($uri,$dkey,$list,$cmd,$n,$copy);
 470   my @r;
 471
 472   if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/fop/.+)}) {
 473     $server = $2;
 474     $port   = $4 || ($1?443:80);
 475     $uri    = $5;
 476   } else {
 477     die "$0: unknown F*EX URL $url\n";
 478   }
 479
 480   sendheader(
 481     "$server:$port",
 482     "GET $uri?COPY HTTP/1.1",
 483     "User-Agent: $useragent",
 484   );
 485
 486   $_ = <$SH>;
 487   die "$0: no reply from fex server $server\n" unless $_;
 488   warn "<-- $_" if $opt_v;
 489
 490   if (/^HTTP.*already exists/) {
 491     if ($uri =~ m:/fop/(\w+)/:) {
 492       $dkey = $1;
 493     }
 494   } elsif (/^HTTP.*200/) {
 495     # ok!
 496   } else {
 497     s/^HTTP.... \d+ //;
 498     die "$0: $_";
 499   }
 500
 501   while (<$SH>) {
 502     s/\r//;
 503     last if /^\n/; # ignore HTML output
 504     $dkey = $1 if /^Location:.*\/(\w+)\/.+/;
 505     warn "<-- $_" if $opt_v;
 506   }
 507
 508   print "fexsend -l\n" if $opt_v;
 509   system 'fexsend -l >/dev/null 2>&1';
 510   $list = $ENV{HOME}.'/.fex/tmp/fexlist';
 511   open $list,$list or die "$0: cannot open $list - $!\n";
 512   while (<$list>) {
 513     if (/^\s+(\d+)\) (\w+)/ and $2 eq $dkey) {
 514       $n = $1;
 515       $cmd = "fexsend -b $n $opt_f";
 516       print "$cmd\n" if $opt_v;
 517       system $cmd;
 518       last;
 519     }
 520   }
 521   close $list;
 522
 523   if ($n) {
 524     $cmd = "fexsend -d $n >/dev/null 2>&1";
 525     print "$cmd\n" if $opt_v;
 526     system $cmd;
 527   } else {
 528     warn "$0: forwarding failed\n";
 529   }
 530 }
 531
 532
 533 sub keep {
 534   my $url = shift;
 535   my ($server,$port);
 536   my $keep;
 537   my (@hh,@r);
 538
 539   if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/fop/.+)}) {
 540     $server = $2;
 541     $port   = $4 || ($1?443:80);
 542     $keep    = "$5?KEEP=$opt_K";
 543   } else {
 544     die "$0: unknown F*EX URL $url\n";
 545   }
 546
 547   push @hh,"GET $keep HTTP/1.1",
 548            "Host: $server:$port",
 549            "User-Agent: $useragent",
 550            "";
 551
 552   foreach (@hh) {
 553     warn $_,"\n" if $opt_v;
 554     print $SH $_,"\r\n";
 555   }
 556   while (<$SH>) {
 557     s/\r//;
 558     last if /^\n/;
 559     push @r,$_;
 560   }
 561   die "$0: no response from fex server $server\n" unless @r;
 562   grep { warn "\t$_" } @r if $opt_v;
 563   return @r;
 564 }
 565
 566
 567 sub download {
 568   my ($server,$port,$fop,$nocheck) = @_;
 569   my ($file,$download,$ssl,$pipe,$filesize,$checkstorage);
 570   my (@hh,@r);
 571   my ($t0,$t1,$t2,$tt,$tm,$ts,$kBs,$b,$bt,$tb,$B,$buf);
 572   my $length = 0;
 573   my $seek = 0;
 574   my $tc = 0;
 575   local $_;
 576   local *X;
 577
 578   if ($opt_s) {
 579     $file = $opt_s;
 580     if ($opt_s eq '-') {
 581       $pipe = $download = $opt_s;
 582     } elsif (-p $opt_s or -c $opt_s) {
 583       $download = $opt_s;
 584       $nocheck = 'pipe or character device';
 585     } else {
 586       $download = $file.'.tmp';
 587       $seek = -s $download || 0;
 588     }
 589   } else {
 590     # ask server for real file name
 591     sendheader(
 592       "$server:$port",
 593       "HEAD $proxy_prefix$fop HTTP/1.1",
 594       "User-Agent: $useragent"
 595     );
 596     my $reply = $_ = <$SH>;
 597     unless (defined $_ and /\w/) {
 598       die "$0: no response from server\n";
 599     }
 600     warn "<-- $_" if $opt_v;
 601     unless (/^HTTP\/[\d.]+ 200/) {
 602       s:HTTP/[\d. ]+::;
 603       die "$0: server response: $_";
 604     }
 605     while (<$SH>) {
 606       s/\r//;
 607       warn "<-- $_" if $opt_v;
 608       last if /^\r?\n/;
 609       if (/^Content-Disposition: attachment; filename="(.+)"/i) {
 610         $file = locale(decode_utf8($1));
 611           $file =~ s:.*/::;
 612       }
 613     }
 614     unless ($file) {
 615       $file = $fop;
 616       $file =~ s:.*/::;
 617     }
 618     $download = $file.'.tmp';
 619     $seek = -s $download || 0;
 620   }
 621
 622   push @hh,"GET $proxy_prefix$fop$opt_k HTTP/1.1",
 623            "User-Agent: $useragent",
 624            "Connection: close";
 625   push @hh,"Range: bytes=$seek-" if $seek;
 626
 627   # HTTPS needs a new connection for actually downloading the file
 628   serverconnect($server,$port) if $opt_P and $port == 443;
 629   sendheader("$server:$port",@hh);
 630   $_ = <$SH>;
 631   die "$0: no response from fex server $server\n" unless $_;
 632   s/\r//;
 633
 634   if (/^HTTP\/[\d.]+ 2/) {
 635     warn "<-- $_" if $opt_v;
 636     while (<$SH>) {
 637       s/\r//;
 638       warn "<-- $_" if $opt_v;
 639       last if /^\r?\n/;
 640       if (/^Content-length:\s*(\d+)/i) {
 641         $length = $1;
 642       } elsif (/^X-Size: (\d+)/i) {
 643         $filesize = $1;
 644       }
 645     }
 646   } else {
 647     s/HTTP\/[\d.]+ \d+ //;
 648     die "$0: bad server reply: $_";
 649   }
 650
 651   if ($pipe) {
 652     *X = *STDOUT;
 653   } else {
 654     if ($opt_s and $opt_s eq $download) {
 655       open X,'>',$download or die "$0: cannot write to \"$download\" - $!\n";
 656       $checkstorage = $filesize unless $nocheck;
 657     } else {
 658       if (-e $file and not $opt_o) {
 659         die "$0: destination file \"$file\" does already exist\n";
 660       }
 661       if ($seek) {
 662         open X,'>>',$download or die "$0: cannot write to \"$download\" - $!\n";
 663       } else {
 664         open X,'>',$download or die "$0: cannot write to \"$download\" - $!\n";
 665         $checkstorage = $filesize unless $nocheck;
 666       }
 667     }
 668     if ($checkstorage and not $nocheck) {
 669       my $t0 = my $t1 = my $t2 = time;
 670       my $n = 0;
 671       my $buf = '.' x M;
 672       my $storagetest = $file.'.test';
 673       my $error = "$0: cannot write \"$storagetest\"";
 674       open $storagetest,'>',$storagetest or die "$error - $!\n";
 675       print STDERR "checking storage...\r";
 676       while (-s $storagetest < $checkstorage) {
 677         syswrite $storagetest,$buf or do {
 678           unlink $storagetest;
 679           die "\n$error - $!\n";
 680         };
 681         $n++;
 682         $t2 = int(time);
 683         if ($t2 > $t1) {
 684           print STDERR "checking storage... ".$n." MB\r";
 685           $t1 = $t2;
 686         }
 687       }
 688       close $storagetest or do {
 689         unlink $storagetest;
 690         die "\n$error - $!\n";
 691       };
 692       print STDERR "checking storage... ".$n." MB ok!\n";
 693       unlink $storagetest;
 694       if (time-$t0 > 25) {
 695         # retry after timeout
 696         serverconnect($server,$port);
 697         return(download($server,$port,$fop,'nocheck'))
 698       }
 699     }
 700   }
 701
 702   $t0 = $t1 = $t2 = int(time);
 703   $tb = $B = 0;
 704   printf STDERR "resuming at byte %s\n",$seek if $seek;
 705   print $rcamel[0] if ${'opt_+'};
 706   while ($B < $length and $b = read $SH,$buf,$bs) {
 707     syswrite X,$buf;
 708     $B += $b;
 709     $tb += $b;
 710     $bt += $b;
 711     $t2 = time;
 712     if (${'opt_+'} and int($t2*10)>$tc) {
 713       print $rcamel[$tc%2+1];
 714       $tc = int($t2*10);
 715     }
 716     if (int($t2) > $t1) {
 717       $kBs = int($bt/k/($t2-$t1));
 718       $kBs = int($tb/k/($t2-$t0)) if $kBs < 10;
 719       $t1 = $t2;
 720       $bt = 0;
 721       # smaller block size is better on slow links
 722       $bs = 4096 if $bs>4096 and $tb/($t2-$t0)<65536;
 723       if ($tb<10*M) {
 724         printf STDERR "%s: %d kB (%d%%) %d kB/s \r",
 725                       $download,
 726                       int(($tb+$seek)/k),
 727                       int(($tb+$seek)/($length+$seek)*100),
 728                       $kBs;
 729       } else {
 730         printf STDERR "%s: %d MB (%d%%) %d kB/s        \r",
 731                       $download,
 732                       int(($tb+$seek)/M),
 733                       int(($tb+$seek)/($length+$seek)*100),
 734                       $kBs;
 735       }
 736     }
 737     if ($opt_m) {
 738       if ($t2 == $t0 and $B > $opt_m*k) {
 739         print "\nsleeping...\r" if $opt_v;
 740         sleep 1;
 741       } else {
 742         while ($t2 > $t0 and $tb/k/($t2-$t0) > $opt_m) {
 743           print "\nsleeping...\r" if $opt_v;
 744           sleep 1;
 745           $t2 = time;
 746         }
 747       }
 748     }
 749   }
 750   close $SH;
 751   close X;
 752
 753   print $rcamel[2] if ${'opt_+'};
 754
 755   $tt = $t2-$t0;
 756   $tm = int($tt/60);
 757   $ts = $tt-$tm*60;
 758   $kBs = int($tb/k/($tt||1));
 759   if ($seek) {
 760     printf STDERR "$file: %d MB, last %d MB in %d s (%d kB/s)      \n",
 761                   int(($tb+$seek)/M),int($tb/M),$tt,$kBs;
 762   } else {
 763     printf STDERR "$file: %d MB in %d s (%d kB/s)      \n",
 764                   int($tb/M),$tt,$kBs;
 765   }
 766
 767   if ($tb != $length) {
 768     if ($windoof) {
 769       exec "\"$0\" @ARGV";
 770       exit;
 771     } else {
 772       die "$0: $server annouced $length bytes, but only $tb bytes has been read\n";
 773     }
 774   }
 775
 776   unless ($pipe or -p $download or -c $download) {
 777     my @s = stat $file if -e $file;
 778     rename $download,$file
 779       or die "$0: cannot rename \"$download\" to \"$file\" - $!\n";
 780     chmod $s[2],$file if @s;
 781   }
 782
 783   return sprintf("%s/%s",getcwd(),$file);
 784 }
 785
 786
 787 sub list {
 788   my $cmd = "$fexsend -L";
 789   $cmd .= " -i $opt_i" if $opt_i;
 790   if ($opt_v) {
 791     $cmd .= " -v";
 792     warn "$cmd\n";
 793   }
 794   open $cmd,"$cmd|" or die "$0: cannot run $cmd : $!\n";
 795   open $ffl,'>',$ffl or die "$0: cannot open $ffl : $!\n";
 796   my $n;
 797   while (<$cmd>) {
 798     if (/\d MB .*http/) {
 799       $n++;
 800       printf {$ffl} "%4d) %s",$n,$_;
 801       s:http[^\"]*/::;
 802       printf        "%4d) %s",$n,$_;
 803     } else {
 804       print;
 805       print {$ffl} $_;
 806     }
 807   }
 808 }
 809
 810
 811 sub locale {
 812   my $string = shift;
 813
 814   if ($CTYPE) {
 815     if ($CTYPE =~ /UTF-?8/i) {
 816       return $string;
 817     } elsif (grep { $CTYPE =~ /^$_$/i } Encode->encodings()) {
 818       return encode($CTYPE,$string);
 819     } else {
 820       return encode('ISO-8859-1',$string);
 821     }
 822   }
 823
 824   return $string;
 825 }
 826
 827
 828 sub pathsearch {
 829   my $prg = shift;
 830
 831   foreach my $dir (split(':',$ENV{PATH})) {
 832     return "$dir/$prg" if -x "$dir/$prg";
 833   }
 834 }
 835
 836
 837 {
 838   my $tty;
 839
 840   sub inquire {
 841     my $prompt = shift;
 842     my $default = shift;
 843     local $| = 1;
 844     local $_;
 845
 846     if (defined $default) {
 847       unless ($tty) {
 848         chomp($tty = `tty 2>/dev/null`);
 849         eval { local $^W; require "sys/ioctl.ph"; };
 850       }
 851
 852       if (defined(&TIOCSTI) and $tty and open($tty,'>',$tty)) {
 853         print $prompt;
 854         # push default answer into keyboard buffer
 855         foreach my $a (split("",$default)) { ioctl($tty,&TIOCSTI,$a) }
 856         chomp($_ = <STDIN>||'');
 857       } else {
 858         $prompt =~ s/([\?:=]\s*)/ [$default]$1/ or $prompt .= " [$default] ";
 859         print $prompt;
 860         chomp($_ = <STDIN>||'');
 861         $_ = $default unless length;
 862       }
 863     } else {
 864       print $prompt;
 865       chomp($_ = <STDIN>||'');
 866     }
 867
 868     return $_;
 869   }
 870 }
 871
 872
 873 ### common functions ###
 874
 875
 876 sub mtime {
 877   my @d = localtime((stat shift)[9]);
 878   return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]);
 879 }
 880
 881
 882 sub urldecode {
 883   local $_ = shift;
 884   s/\%([a-f\d]{2})/chr(hex($1))/ige;
 885   return $_;
 886 }
 887
 888
 889 sub get_ssl_env {
 890   # set SSL/TLS options
 891   $SSL{SSL_verify_mode} = $ENV{SSLVERIFY} if defined($ENV{SSLVERIFY});
 892   foreach my $opt (qw(
 893     SSL_version
 894     SSL_cipher_list
 895     SSL_verify_mode
 896     SSL_ca_path
 897     SSL_ca_file)
 898   ) {
 899     my $env = uc($opt);
 900     $env =~ s/_//g;
 901     $SSL{$opt} = $ENV{$env} if defined($ENV{$env});
 902   }
 903
 904   if ($SSL{SSL_verify_mode}) {
 905     &search_ca;
 906     unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) {
 907       die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n";
 908     }
 909   } elsif (defined($SSL{SSL_verify_mode})) {
 910     # user has set SSLVERIFY=0 !
 911   } else {
 912     &search_ca;
 913     $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file};
 914   }
 915 }
 916
 917 sub search_ca {
 918   local $_;
 919   return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path};
 920   foreach (qw(/etc/ssl/certs/ca-certificates.crt)) {
 921     if (-f) {
 922       $SSL{SSL_ca_file} = $_;
 923       return;
 924     }
 925   }
 926   foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) {
 927     if (-f) {
 928       $SSL{SSL_ca_path} = $_;
 929       return;
 930     }
 931   }
 932 }
 933
 934
 935 sub serverconnect {
 936   my ($server,$port) = @_;
 937   my $connect = "CONNECT $server:$port HTTP/1.1";
 938   local $_;
 939
 940   if ($proxy) {
 941     tcpconnect(split(':',$proxy));
 942     if ($https) {
 943       printf "--> %s\n",$connect if $opt_v;
 944       nvtsend($connect,"");
 945       $_ = <$SH>;
 946       s/\r//;
 947       printf "<-- $_"if $opt_v;
 948       unless (/^HTTP.1.. 200/) {
 949         die "$0: proxy error : $_";
 950       }
 951       &enable_ssl;
 952       $SH = IO::Socket::SSL->start_SSL($SH,%SSL);
 953     }
 954   } else {
 955     tcpconnect($server,$port);
 956   }
 957 #  if ($https and $opt_v) {
 958 #    printf "%s\n",$SH->get_cipher();
 959 #  }
 960 }
 961
 962
 963 # set up tcp/ip connection
 964 sub tcpconnect {
 965   my ($server,$port) = @_;
 966
 967   if ($SH) {
 968     close $SH;
 969     undef $SH;
 970   }
 971
 972   if ($https) {
 973     # eval "use IO::Socket::SSL qw(debug3)";
 974     &enable_ssl;
 975     $SH = IO::Socket::SSL->new(
 976       PeerAddr => $server,
 977       PeerPort => $port,
 978       Proto    => 'tcp',
 979       %SSL
 980     );
 981   } else {
 982     $SH = IO::Socket::INET->new(
 983       PeerAddr => $server,
 984       PeerPort => $port,
 985       Proto    => 'tcp',
 986     );
 987   }
 988
 989   if ($SH) {
 990     autoflush $SH 1;
 991     binmode $SH;
 992   } else {
 993     die "$0: cannot connect $server:$port - $@\n";
 994   }
 995
 996   print "TCPCONNECT to $server:$port\n" if $opt_v;
 997 }
 998
 999
1000 sub enable_ssl {
1001   eval "use IO::Socket::SSL";
1002   die "$0: cannot load IO::Socket::SSL\n" if $@;
1003   eval '$SSL{SSL_verify_mode} = 0 if Net::SSLeay::SSLeay() <= 9470143';
1004   if ($opt_v) {
1005     foreach my $v (keys %SSL) {
1006       printf "%s => %s\n",$v,$SSL{$v};
1007     }
1008   }
1009 }
1010
1011
1012 sub sendheader {
1013   my $sp = shift;
1014   my @head = @_;
1015   my $head;
1016
1017   push @head,"Host: $sp";
1018
1019   foreach $head (@head) {
1020     print "--> $head\n" if $opt_v;
1021     print {$SH} $head,"\r\n";
1022   }
1023   print "-->\n" if $opt_v;
1024   print {$SH} "\r\n";
1025 }
1026
1027
1028 sub nvtsend {
1029   local $SIG{PIPE} = sub { $sigpipe = "@_" };
1030
1031   $sigpipe = '';
1032
1033   die "$0: internal error: no active network handle\n" unless $SH;
1034   die "$0: remote host has closed the link\n" unless $SH->connected;
1035
1036   foreach my $line (@_) {
1037     print {$SH} $line,"\r\n";
1038     if ($sigpipe) {
1039       undef $SH;
1040       return 0;
1041     }
1042   }
1043
1044   return 1;
1045 }
1046
1047
1048 sub quote {
1049   local $_ = shift;
1050   s/([^\w\@\/%^,.=+_:+-])/\\$1/g;
1051   return $_;
1052 }
1053
1054
1055 sub debug {
1056   print "## DEBUG: @_\n" if $DEBUG;
1057 }
1058
1059
1060 # from MIME::Base64::Perl
1061 sub encode_b64 {
1062   my $res = "";
1063   my $eol = "\n";
1064   my $padding;
1065
1066   pos($_[0]) = 0;
1067   $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
1068   $res =~ tr|` -_|AA-Za-z0-9+/|;
1069   $padding = (3-length($_[0])%3)%3;
1070   $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
1071   return $res;
1072 }