our ($fexhome,$idf,$tmpdir,$windoof,$useragent);
our ($xv,%autoview);
our $bs = 2**16; # blocksize for tcp-reading and writing file
-our $version = 20150729;
+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;
$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';
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;
${'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+)/) {
$opt_m = 0
}
-print "Version: $version\n" if $opt_V;
+if ($opt_V) {
+ print "Version: $version\n";
+ unless (@ARGV) {
+ print "Upgrade fexget? ";
+ $_ = <STDIN>||'';
+ 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;
my @rcamel = (
'\e[A
-(_*) _ _
- \\\\/ \\/ \\
+ (_*p _ _
+ \\\\/ \/ \\
\ __ )=*
- //\\\\//\\\\
-',
-'\e[A \\\\/\\\\/
+ //\\\\//\\\\
',
-'\e[A //\\\\//\\\\
-');
+"\e[A \\\\/\\\\/ \n",
+"\e[A //\\\\//\\\\\n"
+);
# get fexlog
if ($opt_z) {
}
}
-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') {
}
if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/.*fop/\S+)}) {
+ $https = $1;
$server = $2;
$port = $4 || ($1?443:80);
$fop = $5;
exit if $opt_s eq '-';
unlink $download unless -s $download;
exit 2 unless -f $download;
-
+
if ($windoof) {
print "READY\n";
exit;
}
unless ($opt_X) {
-
+
foreach my $a (keys %autoview) {
if ($download =~ /$a$/i and $autoview{$a}) {
printf "run \"%s %s\" [Yn] ? ",$autoview{$a},basename($download);
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);
$_ = <STDIN>||'';
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;
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";
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 {
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/.+)}) {
"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
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";
}
}
close $list;
-
+
if ($n) {
$cmd = "fexsend -d $n >/dev/null 2>&1";
print "$cmd\n" if $opt_v;
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;
$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";
$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;
}
}
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'))
}
}
}
close $SH;
close X;
-
+
print $rcamel[2] if ${'opt_+'};
$tt = $t2-$t0;
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;
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($_ = <STDIN>||'');
} else {
- $prompt =~ s/([\?:=]\s*)/ [$default]$1/ or $prompt .= " [$default]";
+ $prompt =~ s/([\?:=]\s*)/ [$default]$1/ or $prompt .= " [$default] ";
print $prompt;
chomp($_ = <STDIN>||'');
$_ = $default unless length;
}
return $_;
- }
-}
+ }
+}
### common functions ###
$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);
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>;
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();
# }
}
# 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,
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";
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) {
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+/|;
projects / fex.git / blobdiff