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