X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/7fa382617fbaccc0ce522b2b3adbbee9db5ad227..97b87610331f53e756d032ad21db786037f921a1:/htdocs/download/fexsend?ds=inline diff --git a/htdocs/download/fexsend b/htdocs/download/fexsend index 607d139..16235b7 100755 --- a/htdocs/download/fexsend +++ b/htdocs/download/fexsend @@ -37,7 +37,7 @@ our ($tpid,$frecipient); our ($FEXID,$FEXXX,$HOME); our (%alias); our $chunksize = 0; -our $version = 20150120; +our $version = 20150729; our $_0 = $0; our $DEBUG; @@ -81,7 +81,7 @@ my $atype = ''; # archive type my $fexcgi; # F*EX CGI URL my @files; # files to send my %AB = (); # server based address book -my ($server,$port,$sid); +my ($server,$port,$sid,$https); my $proxy = ''; my $proxy_prefix = ''; my $features = ''; @@ -108,7 +108,7 @@ usage: $0 [options] file(s) [@] recipient(s) or: $0 -x \# [-C -k -D -K -S] options: -v verbose mode -d delete file on fex server - -c compress file + -c compress file with gzip -g encrypt file with gpg -m limit limit throughput (kB/s) -i tag use ID data [tag] from ID file @@ -199,6 +199,10 @@ and then copy-forward it with: $0 -b # other\@address Where # is the file number. +You can list an uploaded file in more detail with + $0 -l # +Where # is the file number. + If you want to modify the keep time, comment or auto-delete behaviour of an already uploaded file then you first have to query the file number with: $0 -l @@ -494,9 +498,10 @@ $port = 80; $port = 443 if $server =~ s{https://}{}; $port = $1 if $server =~ s/:(\d+)//; -if (0 and $port == 443) { - $opt_s and die "$0: cannot use -s with https due to stunnel bug\n"; - $opt_g and die "$0: cannot use -g with https due to stunnel bug\n"; +if ($port == 443) { + # $opt_s and die "$0: cannot use -s with https due to stunnel bug\n"; + # $opt_g and die "$0: cannot use -g with https due to stunnel bug\n"; + $https = $port; } $server =~ s{http://}{}; @@ -625,8 +630,10 @@ sub init_id { if ($fexcgi =~ /\?/) { $from = $1 if $fexcgi =~ /\bfrom=(.+?)(&|$)/i; $id = $1 if $fexcgi =~ /\bid=(.+?)(&|$)/i; - $skey = $1 if $fexcgi =~ /\bskey=(.+?)(&|$)/i; - $gkey = $1 if $fexcgi =~ /\bgkey=(.+?)(&|$)/i; + # $skey = $1 if $fexcgi =~ /\bskey=(.+?)(&|$)/i; + # $gkey = $1 if $fexcgi =~ /\bgkey=(.+?)(&|$)/i; + die "$0: cannot use GKEY URL in ID file\n" if $fexcgi =~ /gkey=/i; + die "$0: cannot use SKEY URL in ID file\n" if $fexcgi =~ /skey=/i; $fexcgi =~ s/\?.*//; } unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) { @@ -1001,6 +1008,9 @@ sub list { else { $dkey = '' } # $_ = encode_utf8($_); s/<.*?>//g; + s/&/&/g; + s/"/\"/g; + s/</) { - if (/^alias \Q$to\E\s/i) { - chomp; - s/\s*#.*//; - s/\(.*?\)//; - s/\s+$//; - s/.*\s+//; - s/[<>]//g; - if (/,/) { - warn "$0: ignoring mutt multi-alias $to = $alias\n"; - last; - } - if (/@/) { - $alias = $_; - warn "$0: found mutt alias $to = $alias\n"; - last; - } - } - } - close $ma; - $to = $alias; + elsif ($to !~ /@/ and $to ne $from) { + $to = get_mutt_alias($to); } } } $to = join(',',grep /./,@to) or exit; - warn "Server/User: $fexcgi/$from\n" unless $opt_q; + # warn "Server/User: $fexcgi/$from\n" unless $opt_q; if ( not $skey and not $gkey + and $from ne $to and $features =~ /CHECKRECIPIENT/ and $opt_C !~ /^(DELETE|LIST|RECEIVEDLOG|SENDLOG|FOPLOG)$/ ) { @@ -1486,6 +1475,17 @@ sub send_fex { } } } + unless ($opt_d or $location) { + if (scalar(@r) == 1) { + die "$0: server error: @r\n"; + } else { + if ($r[0] !~ /HTTP.1.. 2/ and $r[0] =~ /HTTP.[\s\d.]+(.+)/) { + die "$0: server error: $1\n"; + } else { + die "$0: server error:\n".join("\n",@r)."\n"; + } + } + } } } @@ -1497,7 +1497,7 @@ sub send_fex { sub forward { my (@r); my ($to,$n,$dkey,$file,$req); - my $status = 1; + my ($status,$fp); local $_; # look for single @ in arguments @@ -1512,6 +1512,9 @@ sub forward { # if ($windoof and not @ARGV) { &inquire } $to = pop @ARGV or die $usage; $to = $from if $to eq '.'; + if ($to !~ /@/ and $to ne $from) { + $to = get_mutt_alias($to); + } open $fexlist,$fexlist or die "$0: $fexlist - $!\n"; while (<$fexlist>) { @@ -1545,16 +1548,12 @@ sub forward { $req .= " HTTP/1.1"; sendheader("$server:$port",$req); http_response(); + $fp = $file; + $fp =~ s/[^\w_.-]/.+/g; # because of UTF8 filename + $status = 1; while (<$SH>) { - if ($opt_v) { - print; - $status = 0 if /\Q"$file"/; - } else { - if (/\Q"$file"/) { - print; - $status = 0; - } - } + $status = 0 if /"$fp"/; + print if $opt_v or /"$fp"/; } if ($status) { @@ -1723,7 +1722,11 @@ sub get_xx { if (/^n/i) { print "keeping $transferfile\n"; } else { - system("tar xvf $transferfile && rm $transferfile"); + my $untar = "tar xvf"; + # if ($> == 0 and `tar --help 2>&1` =~ /gnu/) { + # $untar = "tar --no-same-owner -xvf"; + # } + system("$untar $transferfile && rm $transferfile"); die "$0: error while untaring, see $transferfile\n" if -f $transferfile; } } else { @@ -2058,8 +2061,15 @@ sub formdatapost { print $rcamel[0] if ${'opt_+'}; + $SIG{ALRM} = sub { retry("timed out") }; while (my $b = read $file,$buf,$bs) { - print {$SH} $buf or &sigpipehandler; + alarm($timeout*2); + if ($https) { + print {$SH} $buf or &sigpipehandler; + } else { + syswrite $SH,$buf or &sigpipehandler; + } + alarm(0); $bytes += $b; if ($filesize > 0 and $bytes+$seek > $filesize) { die "$0: $file filesize has grown while uploading\n"; @@ -2611,21 +2621,27 @@ sub ts { sub sigpipehandler { - $SIG{ALRM} = sub { }; + retry("died"); +} + +sub retry { + my $reason = shift; + local $SIG{ALRM} = sub { }; + if (fileno $SH) { alarm(1); - @_ = <$SH>; + my @r = <$SH>; alarm(0); kill 9,$tpid if $tpid; - if (@_ and $opt_v) { - die "\n$0: ($$) server error: @_\n"; + if (@r and $opt_v) { + die "\n$0: ($$) server error: @r\n"; } - if (@_ and $_[0] =~ /^HTTP.* \d+ (.*)/) { + if (@r and $r[0] =~ /^HTTP.* \d+ (.*)/) { die "\n$0: server error: $1\n"; } } $timeout *= 2; - warn "\n$0: connection to $server died\n"; + warn "\n$0: connection to $server $reason\n"; warn "retrying after $timeout seconds...\n"; sleep $timeout; if ($windoof) { exec $^X,$0,@_ARGV } @@ -2736,6 +2752,37 @@ sub fileid { } +sub get_mutt_alias { + my $to = shift; + my $ma = $HOME.'/.mutt/aliases'; + my $alias; + local $_; + + open $ma,$ma or return $to; + while (<$ma>) { + if (/^alias \Q$to\E\s/i) { + chomp; + s/\s*#.*//; + s/\(.*?\)//; + s/\s+$//; + s/.*\s+//; + s/[<>]//g; + if (/,/) { + warn "$0: ignoring mutt multi-alias $to = $alias\n"; + last; + } + if (/@/) { + $alias = $_; + warn "$0: found mutt alias $to = $alias\n"; + last; + } + } + } + close $ma; + return ($alias||$to); +} + + # collect file meta data (filename, inode, mtime) sub fmd { my @files = @_; @@ -2815,6 +2862,7 @@ sub http_response { unless (defined $_ and /\w/) { die "$0: no response from server\n"; } + print "<-- $_\n" if $opt_v; s/\r?\n//; # CGI fatalsToBrowser if (/^HTTP.* 500/) { @@ -2825,9 +2873,12 @@ sub http_response { unless (/^HTTP.* 200/) { $error = $_; $error =~ s/HTTP.[\s\d.]+//; - if ($opt_v) { - print "<-- $_"; - print "<-- $_" while <$SH>; + @r = <$SH> unless @r; + @r = () unless @r; + foreach (@r) { + chomp; + $error .= "\n".$_ if /^Location/; + print "<-- $_\n" if $opt_v; } die "$0: server error: $error\n"; } @@ -2937,15 +2988,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>; @@ -2954,14 +2999,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(); # } } @@ -2976,10 +3020,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, @@ -3004,6 +3047,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 = @_;