X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/7fa382617fbaccc0ce522b2b3adbbee9db5ad227..20160328:/htdocs/download/fexget diff --git a/htdocs/download/fexget b/htdocs/download/fexget index 034ced1..b0616a1 100755 --- a/htdocs/download/fexget +++ b/htdocs/download/fexget @@ -30,9 +30,11 @@ our $SH; our ($fexhome,$idf,$tmpdir,$windoof,$useragent); our ($xv,%autoview); our $bs = 2**16; # blocksize for tcp-reading and writing file -our $version = 20150120; +our $version = 20160328; our $CTYPE = 'ISO-8859-1'; our $fexsend = $ENV{FEXSEND} || 'fexsend'; +our $DEBUG = $ENV{DEBUG}; +our $_0 = $0; my %SSL = (SSL_version => 'TLSv1'); my $sigpipe; @@ -57,6 +59,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 +125,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; @@ -141,7 +151,7 @@ $opt_V = $opt_X = $opt_f = $opt_L = $opt_H = 0; ${'opt_+'} = 0; $opt_s = $opt_k = $opt_i = $opt_P = ''; $_ = "$fexhome/config.pl"; require if -f; -getopts('hvVHlLdkzoaXf+m:s:i:K:P:') or die $usage; +getopts('hvVHlLdkzoaXVf+m:s:i:K:P:') or die $usage; $opt_k = '?KEEP' if $opt_k; if ($opt_m =~ /(\d+)/) { @@ -150,69 +160,47 @@ if ($opt_m =~ /(\d+)/) { $opt_m = 0 } -print "Version: $version\n" if $opt_V; +if ($opt_V) { + print "Version: $version\n"; + unless (@ARGV) { + print "Upgrade fexget? "; + $_ = ||''; + if (/^y/i) { + my $new = `wget -nv -O- http://fex.belwue.de/download/fexget`; + if ($new !~ /upgrade fexget/) { + die "$0: bad update\n"; + } + system qw'cp -a',$_0,$_0.'_old'; + exit $? if $?; + open $_0,'>',$_0 or die "$0: cannot write $_0. - $!\n"; + print {$_0} $new; + close $_0; + exec $_0,qw'-V .'; + } + } + exit if "@ARGV" eq '.'; +} + die $usage if $opt_h; if ($opt_H) { print $hints; exit; } -# set SSL/TLS options -$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_ca_file) -) { - my $env = uc($opt); - $env =~ s/_//g; - $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); -} - -if ($SSL{SSL_verify_mode}) { - &search_ca; - unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { - die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; - } -} elsif (defined($SSL{SSL_verify_mode})) { - # user has set SSLVERIFY=0 ! -} else { - &search_ca; - $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; -} - -sub search_ca { - local $_; - return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; - foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { - if (-f) { - $SSL{SSL_ca_file} = $_; - return; - } - } - foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { - if (-f) { - $SSL{SSL_ca_path} = $_; - return; - } - } -} +&get_ssl_env; my $ffl = "$tmpdir/fexget"; # F*EX files list (cache) my @rcamel = ( ' -(_*) _ _ - \\\\/ \\/ \\ + (_*p _ _ + \\\\/ \/ \\ \ __ )=* - //\\\\//\\\\ + //\\\\//\\\\ ', -' \\\\/\\\\/ -', -' //\\\\//\\\\ -'); +" \\\\/\\\\/ \n", +" //\\\\//\\\\\n" +); # get fexlog if ($opt_z) { @@ -274,7 +262,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') { @@ -312,6 +300,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; @@ -365,7 +354,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; @@ -387,7 +376,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); @@ -396,9 +385,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); $_ = ||''; @@ -406,12 +396,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; @@ -429,21 +419,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"; @@ -461,8 +452,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 { @@ -494,7 +486,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/.+)}) { @@ -510,16 +502,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 @@ -527,8 +525,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"; @@ -542,7 +539,7 @@ sub forward { } } close $list; - + if ($n) { $cmd = "fexsend -d $n >/dev/null 2>&1"; print "$cmd\n" if $opt_v; @@ -589,7 +586,7 @@ sub keep { sub download { my ($server,$port,$fop,$nocheck) = @_; - my ($file,$download,$ssl,$pipe,$filesize,$checkstorage); + my ($file,$download,$ssl,$pipe,$filesize,$checkstorage,$dkey); my (@hh,@r); my ($t0,$t1,$t2,$tt,$tm,$ts,$kBs,$b,$bt,$tb,$B,$buf); my $length = 0; @@ -604,14 +601,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"; @@ -638,8 +639,11 @@ sub download { $seek = -s $download || 0; } + $fop =~ m:/fop/(\w+)/: and $dkey=$1 or $dkey=''; + push @hh,"GET $proxy_prefix$fop$opt_k HTTP/1.1", "User-Agent: $useragent", + "Cookie: dkey=$dkey", "Connection: close"; push @hh,"Range: bytes=$seek-" if $seek; @@ -685,28 +689,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')) } } @@ -762,7 +772,7 @@ sub download { } close $SH; close X; - + print $rcamel[2] if ${'opt_+'}; $tt = $t2-$t0; @@ -840,20 +850,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; @@ -871,10 +874,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; @@ -885,8 +889,8 @@ sub quote { } return $_; - } -} + } +} ### common functions ### @@ -910,9 +914,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); @@ -955,16 +959,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>; @@ -973,14 +971,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(); # } } @@ -989,16 +986,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, @@ -1012,24 +1008,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"; @@ -1041,12 +1050,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) { @@ -1054,17 +1063,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+/|;