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