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