X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/c65ee6f7429eff9a7f58aad7c0aec858ad473092..20160919:/htdocs/download/fexsend diff --git a/htdocs/download/fexsend b/htdocs/download/fexsend index 7e498dc..fae77e9 100755 --- a/htdocs/download/fexsend +++ b/htdocs/download/fexsend @@ -17,10 +17,10 @@ use IO::Handle; use IO::Socket::INET; use Getopt::Std; use File::Basename; -use Cwd qw'abs_path'; +use Cwd 'abs_path'; use Fcntl qw':flock :mode'; -use Digest::MD5 qw'md5_hex'; # encrypted ID / SID -use Time::HiRes qw'time'; +use Digest::MD5 'md5_hex'; # encrypted ID / SID +use Time::HiRes 'time'; # use Smart::Comments; use constant k => 2**10; use constant M => 2**20; @@ -37,7 +37,7 @@ our ($tpid,$frecipient); our ($FEXID,$FEXXX,$HOME); our (%alias); our $chunksize = 0; -our $version = 20160104; +our $version = 20160919; our $_0 = $0; our $DEBUG = $ENV{DEBUG}; @@ -45,6 +45,7 @@ my %SSL = (SSL_version => 'TLSv1'); my $sigpipe; if ($Config{osname} =~ /^mswin/i) { + # http://slu.livejournal.com/17395.html $windoof = $Config{osname}; $HOME = $ENV{USERPROFILE}; $fexhome = $ENV{FEXHOME} || $HOME.'\fex'; @@ -55,8 +56,8 @@ if ($Config{osname} =~ /^mswin/i) { $Config{osname},$Config{archname}); $SSL{SSL_verify_mode} = 0; } elsif ($Config{osname} =~ /^darwin/i or $ENV{MACOS}) { - $macos = $Config{osname}; # http://stackoverflow.com/questions/989349/running-a-command-in-a-new-mac-os-x-terminal-window + $macos = $Config{osname}; $HOME = (getpwuid($<))[7]||$ENV{HOME}; $fexhome = $HOME.'/.fex'; $tmpdir = $ENV{FEXTMP} || $ENV{TMPDIR} || "$fexhome/tmp"; @@ -142,10 +143,11 @@ special options: -I initialize ID file or show ID -d \# delete file on fex server -N \# resend notification e-mail -Q check quotas + -T up:down test internet speed with up and down MBs -A edit server address book (aliases) -S show server/user settings and auth-ID -H show hints, examples and more options - -V show version + -V show version and ask for upgrade (# is a file number, see output from $0 -l) examples: $0 visualization.mpg framstag\@rus.uni-stuttgart.de $0 -a images.zip *.jpg webmaster\@flupp.org,metoo @@ -231,7 +233,7 @@ whereas archive types zip and 7z need a temporary archive file on local disk. With option -s you can send any data coming from a pipe (STDIN) as a file without wasting local disc space. -With option -X you can specify any URL parameter, e.g.: +With option -X you can specify any URL parameter, e.g.: fexsend -X autodelete=yes ... fexsend -X 'autodelete=no&locale=german' ... @@ -246,6 +248,14 @@ Partner program xx is an internet clipboard. See: xx -h Partner program fexget is for downloading. See: fexget -h +fexsend stores the login data (server, user and auth-ID) in the file +$HOME/.fex/id +The format of this file is ([data] is optional): + +server-URL[!proxy[:port[:chunk-size]] +e-mail-address +auth-ID + For temporary usage of a HTTP proxy use: $0 -P your_proxy:port:chunksize_in_MB file recipient Example: @@ -286,11 +296,22 @@ my @rcamel = ( *=( __ / \\\\/\\\\/ ', -' \\\\/\\\\/ +" \\\\/\\\\/ \n", +" //\\\\//\\\\\n" +); + +my @rrcamel = ( +' + (_*p _ _ + \\\\/ \/ \\ + \ __ )=* + //\\\\//\\\\ ', -' //\\\\//\\\\ -'); +" \\\\/\\\\/ \n", +" //\\\\//\\\\\n" +); +autoflush STDOUT; autoflush STDERR; if ($windoof and not @ARGV and not $ENV{PROMPT}) { @@ -312,7 +333,7 @@ my @_ARGV = @ARGV; # save arguments our ($opt_q,$opt_h,$opt_H,$opt_v,$opt_m,$opt_c,$opt_k,$opt_d,$opt_l,$opt_I, $opt_K,$opt_D,$opt_u,$opt_f,$opt_a,$opt_C,$opt_R,$opt_M,$opt_L,$opt_Q, $opt_A,$opt_i,$opt_z,$opt_Z,$opt_b,$opt_P,$opt_x,$opt_X,$opt_V,$opt_U, - $opt_s,$opt_o,$opt_g,$opt_F,$opt_n,$opt_r,$opt_S,$opt_N); + $opt_s,$opt_o,$opt_g,$opt_F,$opt_n,$opt_r,$opt_S,$opt_N,$opt_T); if ($xx) { $opt_q = 1 if @ARGV and $ARGV[-1] eq '--' and pop @ARGV or not -t STDOUT; @@ -331,9 +352,9 @@ if ($xx) { ${'opt_@'} = ${'opt_!'} = ${'opt_+'} = ${'opt_.'} = ${'opt_/'} = 0; ${'opt_='} = ${'opt_#'} = ''; $opt_u = $opt_f = $opt_a = $opt_C = $opt_i = $opt_b = $opt_P = $opt_X = ''; - $opt_s = $opt_r = ''; + $opt_s = $opt_r = $opt_T = ''; $_ = "$fexhome/config.pl"; require if -f; - getopts('hHvcdognVDKlILUARWMFzZqQS@!+./r:m:k:u:f:a:s:C:i:b:P:x:X:N:=:#:') + getopts('hHvcdognVDKlILUARWMFzZqQS@!+./r:m:k:u:f:a:s:C:i:b:P:x:X:N:T:=:#:') or die $usage; if ($opt_H) { @@ -343,6 +364,29 @@ if ($xx) { if ($opt_V) { print "Version: $version\n"; + unless (@ARGV) { + print "Upgrade fexsend? "; + $_ = ||''; + if (/^y/i) { + my $new = `wget -nv -O- http://fex.belwue.de/download/fexsend`; + my $newversion = $1 if $new =~ /version = (\d+)/; + if ($new !~ /upgrade fexsend/ or not $newversion) { + die "$0: bad update\n"; + } + if ($newversion <= $version) { + die "$0: no newer version\n"; + } + $_0 = abs_path($_0); + system qw'rsync -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; + exit if "@ARGV" eq '.'; } if ($opt_K and $opt_D) { @@ -477,6 +521,29 @@ if ($opt_I) { exit; } +if ($opt_T) { + my ($up,$down); + + $usage = "usage: $0 -T MB_up[:MB_down] [fexserver]\n"; + if ($opt_T =~ /^(\d+)$/) { + $up = $down = $1; + } elsif ($opt_T =~ /^(\d+):(\d+)$/) { + $up = $1; + $down = $2; + } else { + die $usage; + } + + if (@ARGV) { + nettest($ARGV[0],$up,$down); + } elsif ($fexcgi) { + nettest($fexcgi,$up,$down); + } else { + nettest('fex.belwue.de',$up,$down); + } + exit; +} + if (@ARGV > 1 and $ARGV[-1] =~ /(^|\/)anonymous/) { $fexcgi = $1 if $ARGV[-1] =~ s:(.+)/::; die "usage: $0 [options] file FEXSERVER/anonymous\n" unless $fexcgi; @@ -805,7 +872,7 @@ sub menu { my $key; my $new; local $_; - + system 'clear'; print "\n"; print "fexsend-$version\n"; @@ -824,7 +891,7 @@ sub menu { print "\n"; print "$from on $fexcgi\n"; print "\n"; - + for (;;) { print "\n"; print "[s] send a file or directory\n"; @@ -835,15 +902,15 @@ sub menu { print "\n"; print "your choice: "; $key = ReadKey(0); - if ($key eq 'q') { + if ($key eq 'q') { print "$key\n"; print "\n"; print "Type [Cmd]W to close this window.\n"; exit; } - if ($key eq 'h') { + if ($key eq 'h') { print "$key\n"; - print + print "\n". "With fexsend you can send files of any size to any e-mail address.\n". "\n". @@ -855,10 +922,10 @@ sub menu { "\n". "Do not forget to terminate each input line with [RETURN].\n". "\n". - "See http://fex.rus.uni-stuttgart.de/ for more informations.\n"; + "See http://fex.rus.uni-stuttgart.de/ for more information.\n"; next; } - if ($key eq 'u') { + if ($key eq 'u') { print "$key\n"; if ($0 =~ m:(^/client/|/sw/):) { print "\n"; @@ -878,13 +945,13 @@ sub menu { } next; } - if ($key eq 'l') { + if ($key eq 'l') { print "$key\n"; system 'clear'; &set_ID; next; } - if ($key eq 's' or $key eq "\n") { + if ($key eq 's' or $key eq "\n") { print "s\n"; &ask_file; next; @@ -900,9 +967,9 @@ sub ask_file { my @files; my $qfiles; local $_; - + system 'clear'; - + &set_ID unless -s $idf; print "\n"; @@ -1021,7 +1088,7 @@ sub ask_file { sub set_ID { my ($server,$port,$user,$logo); local $_; - + print "\n"; for (;;) { print "F*EX server URL: "; @@ -1071,7 +1138,6 @@ sub set_ID { sendheader( "$server:$port", "GET /logo.jpg HTTP/1.0", - "User-Agent: $useragent", "Connection: close", ); $_ = <$SH>||''; @@ -1092,7 +1158,7 @@ sub set_ID { close $logo; last; } - + for (;;) { last if $user; print "Your login (e-mail address): "; @@ -1103,14 +1169,14 @@ sub set_ID { next; } } - + for (;;) { last if $id; print "Your auth-ID for this account: "; $id = ; $id =~ s/[\s\n]//g; } - + open $idf,'>',$idf or die "$0: cannot write to $idf - $!\n"; print {$idf} "$server\n", "$user\n", @@ -1131,11 +1197,111 @@ sub set_ID { } + +sub nettest { + my $url = shift; + my $up = shift; + my $down = shift; + my $bs = 2**16; + my ($length,$t0,$t1,$t2,$tt,$tb,$tc,$B,$kBs,$bt); + + my $nettest = $sid = 'nettest'; + + $port ||= 80; + if ($url =~ s:^https.//::) { + $https = $port = 443; + } else { + $url =~ s:^http.//::; + $port = $1 if $url =~ s/:(\d+)//; + } + $url =~ s/[\/:].*//; + $server = $url; + + if ($up) { + serverconnect($server,$port); + checkrecipient($nettest,$nettest); + warn "$0: send to $server:$port\n"; + formdatapost( + from => $nettest, + to => $nettest, + id => $nettest, + file => $nettest, + size => $up*M, + comment => 'NOSTORE', + ); + } + + if ($down) { + serverconnect($server,$port); + warn "$0: receive from $server:$port\n"; + sendheader("$server:$port","GET $proxy_prefix/ddd/$down HTTP/1.0"); + $_ = <$SH>; + die "$0: no response from fex server $server\n" unless $_; + s/\r//; + + if (/^HTTP\/[\d.]+ 2/) { + warn "<-- $_" if $opt_v; + while (<$SH>) { + s/\r//; + print "<-- $_" if $opt_v; + last if /^$/; + $length = $1 if /^Content-Length:\s*(\d+)/i; + } + } else { + s/HTTP\/[\d.]+ \d+ //; + die "$0: bad server reply: $_"; + } + + unless ($length) { + die "$0: no Content-Length header in server reply\n"; + } + + + if (${'opt_+'}) { + print $rrcamel[0]; + $tc = 0; + } + + $t0 = $t1 = $t2 = int(time); + $B = 0; + while ($B < $length) { + $b = read $SH,$_,$bs or die "$0: cannot read after $B bytes - $!\n"; + # defined($_ = <$SH>) or die "$0: cannot read after $B bytes - $!\n"; + # $b = length; + $B += $b; + $bt += $b; + $t2 = time; + if (${'opt_+'} and int($t2*10)>$tc) { + print $rrcamel[$tc%2+1]; + $tc = int($t2*10); + } + if (int($t2) > $t1) { + $kBs = int($bt/k/($t2-$t1)); + $t1 = $t2; + $bt = 0; + printf STDERR "nettest: %d MB (%d%%) %d kB/s \r", + int($B/M),int(100*$B/$length),$kBs; + } + } + close $SH; + + $tt = $t2-$t0; + $kBs = int($B/k/($tt||1)); + if (${'opt_+'}) { + print $rrcamel[1]; + print $rrcamel[2]; + } + printf STDERR "nettest: %d MB in %d s = %d kB/s \n", + int($B/M),$tt,$kBs; + } +} + + # read one key from terminal in raw mode sub ReadKey { my $key; local $SIG{INT} = sub { stty('reset'); exit }; - + stty('raw'); # loop necessary for ESXi support while (not defined $key) { @@ -1339,7 +1505,6 @@ sub list { sendheader( "$server:$port", "GET $proxy_prefix/fop/$2/$2?LIST HTTP/1.1", - "User-Agent: $useragent", ); $_ = <$SH>||''; s/\r//; @@ -1364,7 +1529,7 @@ sub list { die "$0: file \#$a not found in fexlist\n"; } } - + @r = formdatapost( from => $from, to => $opt_l ? '*' : $from, @@ -1391,7 +1556,7 @@ sub list { s/&/&/g; s/"/\"/g; s/</||''; s/\r//; @@ -1528,14 +1692,13 @@ sub delete_file { serverconnect($server,$port); query_sid($server,$port) unless $anonymous; } - + $file = urlencode($file); sendheader( "$server:$port", "GET $proxy_prefix/fop/$to/$from/$file?id=$sid&DELETE HTTP/1.1", - "User-Agent: $useragent", ); - + while (<$SH>) { s/\r//; printf "<-- $_"if $opt_v; @@ -1917,7 +2080,7 @@ sub send_fex { } } if ($from eq $to or $from =~ /^\Q$to\E@/i - or $nomail or $anonymous or $nonot) + or $nomail or $anonymous or $nonot) { print "$recipient\n" if $recipient; print "$location\n" if $location; @@ -2174,10 +2337,10 @@ sub get_xx { sub formdatapost { my %P = @_; - my ($boundary,$filename,$length,$buf,$file,$fpsize,$resume,$seek); + my ($boundary,$filename,$length,$buf,$file,$fpsize,$resume,$seek,$nettest); my ($flink); my (@hh,@hb,@r,@pv,$to); - my ($bytes,$t,$bt); + my ($bytes,$b,$t,$bt); my ($t0,$t1,$t2,$tt,$tc); my $bs = 2**16; # blocksize for reading and sending file my $fileid = int(time); @@ -2285,7 +2448,7 @@ sub formdatapost { } # print "calculating archive size... "; debug("cd $dittodir;$ditto -"); - open $ditto,"cd $dittodir;$ditto - 2>$error|" + open $ditto,"cd $dittodir;$ditto - 2>$error|" or die "$0: cannot run ditto - $!\n"; $t0 = int(time) if -t STDOUT; while ($b = read $ditto,$_,$bs) { @@ -2315,6 +2478,12 @@ sub formdatapost { undef $SH; # force reconnect (timeout!) } + elsif ($P{to} eq 'nettest') { + $filename = $nettest = 'nettest'; + $filesize = $P{size}; + $fileid = 0; + } + # single file else { $filename = encode_utf8(${'opt_='} || $file); @@ -2334,7 +2503,7 @@ sub formdatapost { $filename .= '.gpg' if $opt_g; - unless ($opt_d) { + unless ($opt_d or $nettest) { if ($opt_g) { $filesize = -1; $fileid = int(time); @@ -2363,7 +2532,7 @@ sub formdatapost { unless ($SH) { serverconnect($server,$port); - query_sid($server,$port) unless $anonymous; + query_sid($server,$port) unless $anonymous or $nettest; } $P{id} = $sid; # ugly hack! @@ -2371,7 +2540,7 @@ sub formdatapost { $filename =~ s/\\/_/g; # \ is a illegal character for fexsrv # ask server if this file has been already sent - if ($file and not $xx) { + if ($file and not $xx and not $nettest) { if (not $opt_d and $opt_o) { # delete before overwrite delete_file($from,$to,$filename); @@ -2548,6 +2717,8 @@ sub formdatapost { print "Fast forward to byte $seek (resuming)\n"; readahead($file,$seek); } + } elsif ($nettest) { + # } else { if ($opt_g) { my $fileq = quote($file); @@ -2564,8 +2735,17 @@ sub formdatapost { print $rcamel[0] if ${'opt_+'}; + $buf = '#' x $bs if $nettest; + $SIG{ALRM} = sub { retry("timed out") }; - while (my $b = read $file,$buf,$bs) { + + while ($bytes < $fpsize) { + if ($nettest) { + $b = $bs; + } else { + $b = read $file,$buf,$bs; + last if $b == 0; + } alarm($timeout*2); if ($https) { print {$SH} $buf or &sigpipehandler; @@ -2574,7 +2754,7 @@ sub formdatapost { } alarm(0); $bytes += $b; - if ($filesize > 0 and $bytes+$seek > $filesize) { + if (not $nettest and $filesize > 0 and $bytes+$seek > $filesize) { if ($tpid) { kill 9,$tpid; unlink $list; @@ -2619,7 +2799,9 @@ sub formdatapost { last if $filesize > 0 and $bytes >= $fpsize; sleep 1 while ($opt_m and $bytes/k/(time-$t0||1) > $opt_m); } - close $file; # or die "$0: error while reading $file - $!\n"; + + close $file unless $nettest; + $tt = ($t2-$t0)||1; print $rcamel[2] if ${'opt_+'}; @@ -2630,7 +2812,7 @@ sub formdatapost { kill 9,$tpid; unlink $list; } - + if ($fileid =~ /[a-z]/ and not ($opt_s or $opt_g)) { if ($opt_a) { if ($fileid ne md5_hex(fmd(@ARGV))) { @@ -2644,7 +2826,7 @@ sub formdatapost { } } } - + unless ($opt_q) { if (not $chunksize and $bytes+$seek < $filesize) { die "$0: \"$file\" filesize has shrunk while uploading\n"; @@ -2652,7 +2834,7 @@ sub formdatapost { if ($seek or $chunksize and $chunksize < $filesize) { if ($fpsize>2*M) { - printf STDERR "%s: %d MB in %d s (%d kB/s)", + printf STDERR "%s: %d MB in %d s = %d kB/s", $opt_s||$opt_a||$file, int($bytes/M), $tt, @@ -2664,7 +2846,7 @@ sub formdatapost { $chunk,int(($bytes+$seek)/M); } } else { - printf STDERR "%s: %d kB in %d s (%d kB/s)", + printf STDERR "%s: %d kB in %d s = %d kB/s", $opt_s||$opt_a||$file, int($bytes/k), $tt, @@ -2678,13 +2860,13 @@ sub formdatapost { } } else { if ($bytes>2*M) { - printf STDERR "%s: %d MB in %d s (%d kB/s) \n", + printf STDERR "%s: %d MB in %d s = %d kB/s \n", $opt_s||$opt_a||$file, int($bytes/M), $tt, int($bytes/k/$tt); } else { - printf STDERR "%s: %d kB in %d s (%d kB/s) \n", + printf STDERR "%s: %d kB in %d s = %d kB/s \n", $opt_s||$opt_a||$file, int($bytes/k), $tt, @@ -2692,7 +2874,7 @@ sub formdatapost { } } - if (-t STDOUT and not ($opt_s or $opt_g)) { + if (-t STDOUT and not ($opt_s or $opt_g or $nettest)) { print STDERR "waiting for server ok..." } } @@ -2700,6 +2882,7 @@ sub formdatapost { autoflush $SH 1; print {$SH} "\r\n--$boundary--\r\n"; + # return if $nettest; # special handling of streaming file because of stunnel tcp shutdown bug if ($opt_s or $opt_g) { @@ -2860,8 +3043,7 @@ sub query_file { my ($response,$fexsrv,$cc); local $_; - $to =~ s/,.*//; - $to =~ s/:\w+=.*//; + $to =~ s/[,:].*//; $to = $AB{$to} if $AB{$to}; $filename =~ s/([^_=:,;<>()+.\w\-])/'%'.uc(unpack("H2",$1))/ge; # urlencode if ($skey) { @@ -3038,14 +3220,15 @@ sub query_sid { $sid = $id; if ($port eq 443 or $proxy) { + return if $opt_d; return if $features; # early return if we know enough - $req = "OPTIONS /FEX HTTP/1.1"; - $req = "HEAD / HTTP/1.1"; + $req = "OPTIONS /FEX HTTP/1.1"; # does not work with (some) proxies + $req = "GET /SID HTTP/1.1"; # needed as FEATURES query } else { $req = "GET /SID HTTP/1.1"; } - sendheader("$server:$port",$req,"User-Agent: $useragent"); + sendheader("$server:$port",$req); $_ = <$SH>; unless (defined $_ and /\w/) { print "\n" if $opt_v; @@ -3059,7 +3242,7 @@ sub query_sid { close $SH; serverconnect($server,$port); $req = "GET /SID HTTP/1.0"; - sendheader("$server:$port",$req,"User-Agent: $useragent"); + sendheader("$server:$port",$req); $_ = <$SH>; unless (defined $_ and /\w/) { print "\n" if $opt_v; @@ -3129,7 +3312,7 @@ sub xxget { $xx =~ s:.*/::; $url = "$proxy_prefix/fop/$from/$from/$xx?ID=$id"; - sendheader("$server:$port","GET $url HTTP/1.0","User-Agent: $useragent"); + sendheader("$server:$port","GET $url HTTP/1.0"); http_response(); while (<$SH>) { s/\r//; @@ -3218,6 +3401,7 @@ sub checkrecipient { $_ = shift @r or die "$0: no reply from server\n"; if (/ 2\d\d /) { + return if $to eq 'nettest'; foreach (@r) { last if /^$/; if (s/X-(Recipient: .+)/$1\n/) { @@ -3300,8 +3484,9 @@ sub readahead { sub fileid { my $file = shift; - my @s = stat($file); - + my $dirmode = shift; + my @s = $dirmode ? lstat($file) : stat($file); + if (@s) { return md5_hex($file.$s[0].$s[1].$s[7].$s[9]); } else { @@ -3314,9 +3499,10 @@ sub fileid { sub get_mutt_alias { my $to = shift; my $ma = $HOME.'/.mutt/aliases'; - my $alias; + my ($alias,$options); local $_; + $to =~ s/(:.+)// and $options = $1; open $ma,$ma or return $to; while (<$ma>) { if (/^alias \Q$to\E\s/i) { @@ -3333,11 +3519,13 @@ sub get_mutt_alias { if (/@/) { $alias = $_; warn "$0: found mutt alias $to = $alias\n"; + $alias .= $options if $options; last; } } } close $ma; + $to = "$to:$options" if $options; return ($alias||$to); } @@ -3356,6 +3544,9 @@ sub fmd { next if $file eq '..'; if ($file eq '.') { $fmd .= fileid($dir); + } elsif (-l "$dir/$file") { + # hack for dangling symlinks: do not raise an error + $fmd .= fileid("$dir/$file",'dirmode'); } else { $fmd .= fmd("$dir/$file"); } @@ -3623,8 +3814,10 @@ sub sendheader { my $head; push @head,"Host: $sp"; + push @head,"User-Agent: $useragent"; foreach $head (@head) { + chomp $head; print "--> $head\n" if $opt_v; print {$SH} $head,"\r\n"; }