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