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