]> git.treefish.org Git - fex.git/blob - htdocs/download/fexget
8e001196d8cc13b1f0d4fc24c16b0f1c01268625
[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 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 }