X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/e5c93609849bda051fff54b5d5265af5608c6c69..c65ee6f7429eff9a7f58aad7c0aec858ad473092:/bin/fexget diff --git a/bin/fexget b/bin/fexget index 8e00119..c375cea 100755 --- a/bin/fexget +++ b/bin/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 = 20150826; +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'; @@ -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; @@ -358,6 +368,7 @@ URL: foreach my $url (@ARGV) { 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); $_ = ||''; @@ -367,10 +378,10 @@ URL: foreach my $url (@ARGV) { } 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,7 +399,7 @@ sub extract { my $l = shift; my $x = shift; my $d = $download; - my $xd = '.'; + my $xd = ''; local $_; if (-t and not $windoof) { @@ -396,9 +407,10 @@ sub extract { 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; @@ -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/.+)}) { @@ -474,7 +487,13 @@ sub forward { 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: $_"; } @@ -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"; @@ -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')) } } @@ -806,13 +834,6 @@ sub pathsearch { } -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; + # 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; @@ -915,15 +937,9 @@ sub serverconnect { 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(); # } } @@ -954,10 +969,9 @@ sub tcpconnect { 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, @@ -974,6 +988,7 @@ sub tcpconnect { if ($SH) { autoflush $SH 1; + binmode $SH; } else { die "$0: cannot connect $server:$port - $@\n"; } @@ -982,6 +997,18 @@ sub tcpconnect { } +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 = @_; @@ -1018,6 +1045,18 @@ sub nvtsend { } +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 = "";