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