X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/e60096926213ce02293a261254ff065cae44c1c8..c65ee6f7429eff9a7f58aad7c0aec858ad473092:/htdocs/download/fexget diff --git a/htdocs/download/fexget b/htdocs/download/fexget index 6c0126f..c375cea 100755 --- a/htdocs/download/fexget +++ b/htdocs/download/fexget @@ -30,9 +30,10 @@ our $SH; our ($fexhome,$idf,$tmpdir,$windoof,$useragent); our ($xv,%autoview); our $bs = 2**16; # blocksize for tcp-reading and writing file -our $version = 20150615; +our $version = 20160104; our $CTYPE = 'ISO-8859-1'; our $fexsend = $ENV{FEXSEND} || 'fexsend'; +our $DEBUG = $ENV{DEBUG}; my %SSL = (SSL_version => 'TLSv1'); my $sigpipe; @@ -57,6 +58,14 @@ if ($Config{osname} =~ /^mswin/i) { $SSL{SSL_verify_mode} = 0; chdir $ENV{USERPROFILE}.'\Desktop'; # open XX,'>XXXXXX';close XX; +} elsif ($Config{osname} =~ /^darwin/i or $ENV{MACOS}) { + $0 =~ s:(.*)/:: and $ENV{PATH} .= ":$1"; + $fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/.fex'; + $tmpdir = $ENV{FEXTMP} || $ENV{TMPDIR} || "$fexhome/tmp"; + $idf = "$fexhome/id"; + $_ = `sw_vers -productVersion 2>/dev/null`||''; + chomp; + $useragent = "fexget-$version (MacOS $_)"; } else { $0 =~ s:(.*)/:: and $ENV{PATH} .= ":$1"; $fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/.fex'; @@ -115,7 +124,7 @@ SSLCIPHERLIST=HIGH:!3DES # see http://www.openssl.org/docs/apps/ciphers.html You can set these environment variables also in $HOME/.fex/config.pl, as well as the $opt_* variables, e.g.: - + $ENV{SSLVERSION} = 'TLSv1'; ${'opt_+'} = 1; $opt_m = 200; @@ -163,12 +172,12 @@ my $ffl = "$tmpdir/fexget"; # F*EX files list (cache) my @rcamel = ( ' -(_*) _ _ +(_*) _ _ \\\\/ \\/ \\ \ __ )=* - //\\\\//\\\\ + //\\\\//\\\\ ', -' \\\\/\\\\/ +' \\\\/\\\\/ ', ' //\\\\//\\\\ '); @@ -233,7 +242,7 @@ if ($opt_a) { } } -my ($file,%files,$download,$server,$port,$fop); +my ($file,%files,$download,$server,$port,$fop,$https); if ($opt_f) { unless ($ENV{FEXID} or -f $ENV{HOME}.'/.fex/id') { @@ -271,6 +280,7 @@ URL: foreach my $url (@ARGV) { } if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/.*fop/\S+)}) { + $https = $1; $server = $2; $port = $4 || ($1?443:80); $fop = $5; @@ -324,7 +334,7 @@ URL: foreach my $url (@ARGV) { exit if $opt_s eq '-'; unlink $download unless -s $download; exit 2 unless -f $download; - + if ($windoof) { print "READY\n"; exit; @@ -346,7 +356,7 @@ URL: foreach my $url (@ARGV) { } unless ($opt_X) { - + foreach my $a (keys %autoview) { if ($download =~ /$a$/i and $autoview{$a}) { printf "run \"%s %s\" [Yn] ? ",$autoview{$a},basename($download); @@ -355,9 +365,10 @@ URL: foreach my $url (@ARGV) { next URL; } } - + if ($ENV{DISPLAY} and $download =~ /\.(gif|jpg|png|tiff?)$/i) { # see also mimeopen and xdg-mime + # http://unix.stackexchange.com/questions/144047/how-does-xdg-open-do-its-work if (my $xv = $xv || pathsearch('xv') || pathsearch('xdg-open')) { printf "run \"%s %s\" [Yn] ? ",basename($xv),basename($download); $_ = ||''; @@ -365,12 +376,12 @@ URL: foreach my $url (@ARGV) { next URL; } } - + if ($download =~ /$atype/) { - if ($download =~ /\.(tgz|tar.gz)$/) { extract('tar tvzf','tar xvzf') } - elsif ($download =~ /\.tar$/) { extract('tar tvf','tar xvf') } - elsif ($download =~ /\.zip$/i) { extract('unzip -l','unzip') } - elsif ($download =~ /\.7z$/i) { extract('7z l','7z x') } + if ($download =~ /\.(tgz|tar.gz)$/) { extract('tar tvzf','tar xvzf') } + elsif ($download =~ /\.tar$/) { extract('tar tvf','tar xvf') } + elsif ($download =~ /\.zip$/i) { extract('unzip -l','unzip') } + elsif ($download =~ /\.7z$/i) { extract('7z l','7z x') } else { die "$0: unknown archive \"$download\"\n" } if ($? == 0) { unlink $download; @@ -388,21 +399,22 @@ sub extract { my $l = shift; my $x = shift; my $d = $download; - my $xd = '.'; + my $xd = ''; local $_; - + if (-t and not $windoof) { print "Files in archive:\n"; system(split(' ',$l),$download); $d =~ s:.*/:./:; $d =~ s/\.[^.]+$//; + $d =~ s:/*$:/:; for (;;) { $xd = inquire("extract to directory (Ctrl-C to keep archive): ",$d); - last if $xd =~ s:^(\./*)*!?$:./:; + last if $xd =~ s:^(\./*)*!?$::; if ($xd eq '-') { print "keeping $download\n"; exit; - } + } if ($xd !~ s/!$//) { if (-d $xd) { print "directory $xd does already exist, add \"!\" to overwrite\n"; @@ -420,8 +432,9 @@ sub extract { last; } } - print "extracting to $xd :\n"; + print "extracting to $xd :\n" if $xd; system(split(' ',$x),$download); + print "extracted to $xd\n" if $xd; } sub del { @@ -453,7 +466,7 @@ sub del { sub forward { my $url = shift; my ($server,$port); - my ($uri,$dkey,$list,$cmd,$n); + my ($uri,$dkey,$list,$cmd,$n,$copy); my @r; if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/fop/.+)}) { @@ -469,16 +482,22 @@ sub forward { "GET $uri?COPY HTTP/1.1", "User-Agent: $useragent", ); - + $_ = <$SH>; die "$0: no reply from fex server $server\n" unless $_; warn "<-- $_" if $opt_v; - - unless (/^HTTP.*200/) { + + if (/^HTTP.*already exists/) { + if ($uri =~ m:/fop/(\w+)/:) { + $dkey = $1; + } + } elsif (/^HTTP.*200/) { + # ok! + } else { s/^HTTP.... \d+ //; die "$0: $_"; } - + while (<$SH>) { s/\r//; last if /^\n/; # ignore HTML output @@ -486,8 +505,7 @@ sub forward { warn "<-- $_" if $opt_v; } - $cmd = 'fexsend -l >/dev/null 2>&1'; - print "$cmd\n" if $opt_v; + print "fexsend -l\n" if $opt_v; system 'fexsend -l >/dev/null 2>&1'; $list = $ENV{HOME}.'/.fex/tmp/fexlist'; open $list,$list or die "$0: cannot open $list - $!\n"; @@ -501,7 +519,7 @@ sub forward { } } close $list; - + if ($n) { $cmd = "fexsend -d $n >/dev/null 2>&1"; print "$cmd\n" if $opt_v; @@ -563,14 +581,18 @@ sub download { $pipe = $download = $opt_s; } elsif (-p $opt_s or -c $opt_s) { $download = $opt_s; + $nocheck = 'pipe or character device'; } else { $download = $file.'.tmp'; $seek = -s $download || 0; } } else { # ask server for real file name - serverconnect($server, $port); - sendheader("$server:$port","HEAD $proxy_prefix$fop HTTP/1.1","User-Agent: $useragent"); + sendheader( + "$server:$port", + "HEAD $proxy_prefix$fop HTTP/1.1", + "User-Agent: $useragent" + ); my $reply = $_ = <$SH>; unless (defined $_ and /\w/) { die "$0: no response from server\n"; @@ -644,28 +666,34 @@ sub download { } } if ($checkstorage and not $nocheck) { - $t0 = time; + my $t0 = my $t1 = my $t2 = time; my $n = 0; + my $buf = '.' x M; + my $storagetest = $file.'.test'; + my $error = "$0: cannot write \"$storagetest\""; + open $storagetest,'>',$storagetest or die "$error - $!\n"; print STDERR "checking storage...\r"; - $buf = '.' x M; - while (-s $download < $checkstorage) { - syswrite X,$buf or do { - unlink $download; - die "\n$0: cannot write $download - $!\n"; + while (-s $storagetest < $checkstorage) { + syswrite $storagetest,$buf or do { + unlink $storagetest; + die "\n$error - $!\n"; }; $n++; - print STDERR "checking storage... ".$n." MB\r"; + $t2 = int(time); + if ($t2 > $t1) { + print STDERR "checking storage... ".$n." MB\r"; + $t1 = $t2; + } } - close X or do { - unlink $download; - die "\n$0: cannot write $download - $!\n"; + close $storagetest or do { + unlink $storagetest; + die "\n$error - $!\n"; }; print STDERR "checking storage... ".$n." MB ok!\n"; - unlink $download; - if (time-$t0 < 25) { - open X,'>',$download or die "$0: cannot write to \"$download\" - $!\n"; - } else { + unlink $storagetest; + if (time-$t0 > 25) { # retry after timeout + serverconnect($server,$port); return(download($server,$port,$fop,'nocheck')) } } @@ -721,7 +749,7 @@ sub download { } close $SH; close X; - + print $rcamel[2] if ${'opt_+'}; $tt = $t2-$t0; @@ -799,20 +827,13 @@ sub locale { sub pathsearch { my $prg = shift; - + foreach my $dir (split(':',$ENV{PATH})) { return "$dir/$prg" if -x "$dir/$prg"; } } - -sub quote { - local $_ = shift; - s/([^\w¡-ÿ_%\/=~:.,-])/\\$1/g; - return $_; -} - { my $tty; @@ -830,10 +851,11 @@ sub quote { if (defined(&TIOCSTI) and $tty and open($tty,'>',$tty)) { print $prompt; - foreach my $a (split("",$default)) { ioctl($tty,&TIOCSTI,$a) } + # push default answer into keyboard buffer + foreach my $a (split("",$default)) { ioctl($tty,&TIOCSTI,$a) } chomp($_ = ||''); } else { - $prompt =~ s/([\?:=]\s*)/ [$default]$1/ or $prompt .= " [$default]"; + $prompt =~ s/([\?:=]\s*)/ [$default]$1/ or $prompt .= " [$default] "; print $prompt; chomp($_ = ||''); $_ = $default unless length; @@ -844,8 +866,8 @@ sub quote { } return $_; - } -} + } +} ### common functions ### @@ -869,9 +891,9 @@ sub get_ssl_env { $SSL{SSL_verify_mode} = $ENV{SSLVERIFY} if defined($ENV{SSLVERIFY}); foreach my $opt (qw( SSL_version - SSL_cipher_list - SSL_verify_mode - SSL_ca_path + SSL_cipher_list + SSL_verify_mode + SSL_ca_path SSL_ca_file) ) { my $env = uc($opt); @@ -914,16 +936,10 @@ sub serverconnect { my ($server,$port) = @_; my $connect = "CONNECT $server:$port HTTP/1.1"; local $_; - - if ($opt_v and $port == 443 and %SSL) { - foreach my $v (keys %SSL) { - printf "%s => %s\n",$v,$SSL{$v}; - } - } - + if ($proxy) { tcpconnect(split(':',$proxy)); - if ($port == 443) { + if ($https) { printf "--> %s\n",$connect if $opt_v; nvtsend($connect,""); $_ = <$SH>; @@ -932,14 +948,13 @@ sub serverconnect { unless (/^HTTP.1.. 200/) { die "$0: proxy error : $_"; } - eval "use IO::Socket::SSL"; - die "$0: cannot load IO::Socket::SSL\n" if $@; + &enable_ssl; $SH = IO::Socket::SSL->start_SSL($SH,%SSL); } } else { tcpconnect($server,$port); } -# if ($port == 443 and $opt_v) { +# if ($https and $opt_v) { # printf "%s\n",$SH->get_cipher(); # } } @@ -948,16 +963,15 @@ sub serverconnect { # set up tcp/ip connection sub tcpconnect { my ($server,$port) = @_; - + if ($SH) { close $SH; undef $SH; } - - if ($port == 443) { + + if ($https) { # eval "use IO::Socket::SSL qw(debug3)"; - eval "use IO::Socket::SSL"; - die "$0: cannot load IO::Socket::SSL\n" if $@; + &enable_ssl; $SH = IO::Socket::SSL->new( PeerAddr => $server, PeerPort => $port, @@ -971,24 +985,37 @@ sub tcpconnect { Proto => 'tcp', ); } - + if ($SH) { autoflush $SH 1; + binmode $SH; } else { die "$0: cannot connect $server:$port - $@\n"; } - + print "TCPCONNECT to $server:$port\n" if $opt_v; } +sub enable_ssl { + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + eval '$SSL{SSL_verify_mode} = 0 if Net::SSLeay::SSLeay() <= 9470143'; + if ($opt_v) { + foreach my $v (keys %SSL) { + printf "%s => %s\n",$v,$SSL{$v}; + } + } +} + + sub sendheader { my $sp = shift; my @head = @_; my $head; - + push @head,"Host: $sp"; - + foreach $head (@head) { print "--> $head\n" if $opt_v; print {$SH} $head,"\r\n"; @@ -1000,12 +1027,12 @@ sub sendheader { sub nvtsend { local $SIG{PIPE} = sub { $sigpipe = "@_" }; - + $sigpipe = ''; - + die "$0: internal error: no active network handle\n" unless $SH; die "$0: remote host has closed the link\n" unless $SH->connected; - + foreach my $line (@_) { print {$SH} $line,"\r\n"; if ($sigpipe) { @@ -1013,17 +1040,29 @@ sub nvtsend { return 0; } } - + return 1; } +sub quote { + local $_ = shift; + s/([^\w\@\/%^,.=+_:+-])/\\$1/g; + return $_; +} + + +sub debug { + print "## DEBUG: @_\n" if $DEBUG; +} + + # from MIME::Base64::Perl sub encode_b64 { my $res = ""; my $eol = "\n"; my $padding; - + pos($_[0]) = 0; $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); $res =~ tr|` -_|AA-Za-z0-9+/|;