our ($FEXID,$FEXXX,$HOME);
our (%alias);
our $chunksize = 0;
-our $version = 20160104;
+our $version = 20160328;
our $_0 = $0;
our $DEBUG = $ENV{DEBUG};
my $sigpipe;
if ($Config{osname} =~ /^mswin/i) {
+ # http://slu.livejournal.com/17395.html
$windoof = $Config{osname};
$HOME = $ENV{USERPROFILE};
$fexhome = $ENV{FEXHOME} || $HOME.'\fex';
$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";
-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
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' ...
*=( __ /
\\\\/\\\\/
',
-'\e[A \\\\/\\\\/
+"\e[A \\\\/\\\\/ \n",
+"\e[A //\\\\//\\\\\n"
+);
+
+my @rrcamel = (
+'\e[A
+ (_*p _ _
+ \\\\/ \/ \\
+ \ __ )=*
+ //\\\\//\\\\
',
-'\e[A //\\\\//\\\\
-');
+"\e[A \\\\/\\\\/ \n",
+"\e[A //\\\\//\\\\\n"
+);
+autoflush STDOUT;
autoflush STDERR;
if ($windoof and not @ARGV and not $ENV{PROMPT}) {
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;
${'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) {
if ($opt_V) {
print "Version: $version\n";
+ unless (@ARGV) {
+ print "Upgrade fexsend? ";
+ $_ = <STDIN>||'';
+ if (/^y/i) {
+ my $new = `wget -nv -O- http://fex.belwue.de/download/fexsend`;
+ if ($new !~ /upgrade fexsend/) {
+ die "$0: bad update\n";
+ }
+ system qw'cp -aL',$_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 '.';
}
if ($opt_K and $opt_D) {
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;
my $key;
my $new;
local $_;
-
+
system 'clear';
print "\n";
print "fexsend-$version\n";
print "\n";
print "$from on $fexcgi\n";
print "\n";
-
+
for (;;) {
print "\n";
print "[s] send a file or directory\n";
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".
"\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";
}
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;
my @files;
my $qfiles;
local $_;
-
+
system 'clear';
-
+
&set_ID unless -s $idf;
print "\n";
sub set_ID {
my ($server,$port,$user,$logo);
local $_;
-
+
print "\n";
for (;;) {
print "F*EX server URL: ";
sendheader(
"$server:$port",
"GET /logo.jpg HTTP/1.0",
- "User-Agent: $useragent",
"Connection: close",
);
$_ = <$SH>||'';
close $logo;
last;
}
-
+
for (;;) {
last if $user;
print "Your login (e-mail address): ";
next;
}
}
-
+
for (;;) {
last if $id;
print "Your auth-ID for this account: ";
$id = <STDIN>;
$id =~ s/[\s\n]//g;
}
-
+
open $idf,'>',$idf or die "$0: cannot write to $idf - $!\n";
print {$idf} "$server\n",
"$user\n",
}
+
+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) {
sendheader(
"$server:$port",
"GET $proxy_prefix/fop/$2/$2?LIST HTTP/1.1",
- "User-Agent: $useragent",
);
$_ = <$SH>||'';
s/\r//;
die "$0: file \#$a not found in fexlist\n";
}
}
-
+
@r = formdatapost(
from => $from,
to => $opt_l ? '*' : $from,
s/&/&/g;
s/"/\"/g;
s/</</g;
- if (/^(to (.+) :)/) {
+ if (/^(to (.+) :)/) {
$s = $2 =~ /$a/;
print "\n$_\n" if $s;
print {$fexlist} "\n$_\n";
sendheader(
"$server:$port",
"GET $proxy_prefix/fop/$2/$2?DELETE HTTP/1.1",
- "User-Agent: $useragent",
);
$_ = <$SH>||'';
s/\r//;
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;
}
}
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;
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);
}
# 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) {
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);
$filename .= '.gpg' if $opt_g;
- unless ($opt_d) {
+ unless ($opt_d or $nettest) {
if ($opt_g) {
$filesize = -1;
$fileid = int(time);
unless ($SH) {
serverconnect($server,$port);
- query_sid($server,$port) unless $anonymous;
+ query_sid($server,$port) unless $anonymous or $nettest;
}
$P{id} = $sid; # ugly hack!
$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);
print "Fast forward to byte $seek (resuming)\n";
readahead($file,$seek);
}
+ } elsif ($nettest) {
+ #
} else {
if ($opt_g) {
my $fileq = quote($file);
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;
}
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;
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_+'};
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))) {
}
}
}
-
+
unless ($opt_q) {
if (not $chunksize and $bytes+$seek < $filesize) {
die "$0: \"$file\" filesize has shrunk while uploading\n";
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,
$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,
}
} 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,
}
}
- 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..."
}
}
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) {
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) {
if ($port eq 443 or $proxy) {
return if $features; # early return if we know enough
$req = "OPTIONS /FEX HTTP/1.1";
- $req = "HEAD / HTTP/1.1";
+ $req = "HEAD /index.html HTTP/1.1";
} 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;
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;
$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//;
$_ = 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/) {
sub fileid {
my $file = shift;
my @s = stat($file);
-
+
if (@s) {
return md5_hex($file.$s[0].$s[1].$s[7].$s[9]);
} else {
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) {
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);
}
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";
}