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