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;
$| = 1;
-our ($SH,$fexhome,$idf,$tmpdir,$windoof,$useragent,$editor,$nomail);
+our ($SH,$fexhome,$idf,$tmpdir,$windoof,$macos,$useragent,$editor,$nomail);
our ($anonymous,$public);
our ($tpid,$frecipient);
our ($FEXID,$FEXXX,$HOME);
our (%alias);
our $chunksize = 0;
-our $version = 20150826;
+our $version = 20160919;
our $_0 = $0;
-our $DEBUG;
+our $DEBUG = $ENV{DEBUG};
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';
$useragent = sprintf("fexsend-$version (%s %s)",
$Config{osname},$Config{archname});
$SSL{SSL_verify_mode} = 0;
+} elsif ($Config{osname} =~ /^darwin/i or $ENV{MACOS}) {
+ # 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";
+ $tmpdir =~ s:/$::;
+ $idf = "$fexhome/id";
+ chmod 0600,$idf;
+ $editor = $ENV{EDITOR} || 'open -W -n -e';
+ $_ = `sw_vers -productVersion 2>/dev/null`||'';
+ chomp;
+ $useragent = "fexsend-$version (MacOS $_)";
} else {
$0 =~ s:.*/::;
$HOME = (getpwuid($<))[7]||$ENV{HOME};
$fexhome = $HOME.'/.fex';
$tmpdir = $ENV{FEXTMP} || "$fexhome/tmp";
$idf = "$fexhome/id";
+ chmod 0600,$idf;
$editor = $ENV{EDITOR} || 'vi';
$_ = `(lsb_release -d||uname -a)2>/dev/null`||'';
chomp;
s/^Description:\s+//;
$useragent = "fexsend-$version ($_)";
- chmod 0600,$idf;
}
if (-f ($_ = '/etc/fex/config.pl')) {
my $timeout = 30; # server timeout
my $fexlist = "$tmpdir/fexlist";
my ($usage,$hints);
-my $xx = $0 =~ /^xx/;
+my $xx = $0 =~ /\bxx$/;
if ($xx) {
$usage = "usage: send file(s): xx [:slot] file...\n".
$usage = <<EOD;
usage: $0 [options] file(s) [@] recipient(s)
or: $0 [special options]
+ or: $0 -l [recipient-regexp]
or: $0 -f \# recipient(s)
or: $0 -x \# [-C -k -D -K -S]
options: -v verbose mode
-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
+ -i account use ID data [account] from ID file
-C comment add comment to notification e-mail
-k max keep file max days on fex server
-D delay auto-delete after download
-o overwrite mode, do not resume
-a archive put files in archive (.zip .7z .tar .tgz)
-s stream read data from pipe and upload it with stream name
-special options: -I initialize ID file or show ID
- -I tag add alternate ID data (secondary logins) to ID file
- -l list sent files numbered (# needed for -f -x -d -N)
- -f \# forward already uploaded file to another recipient
- -x \# modify options -C -k -D -K for already uploaded file
- -d \# delete file on fex server
- -N \# resend notification e-mail
- -Q check quotas
- -A edit server address book (aliases)
- -S show server/user settings and auth-ID
- -H show hints, examples and more options
- -V show version
- (\# is a file number, see output from $0 -l)
+special options: -I initialize ID file or show ID
+ -I account add alternate ID data (secondary logins) to ID file
+ -l list sent files numbers (# needed for -f -x -d -N)
+ -f \# forward already uploaded file to another recipient
+ -x \# use -C -k -D -K for already uploaded file
+ -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 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
lshw | $0 -s hardware.list admin\@flupp.org
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 parameter, e.g.: -X autodelete=yes
+With option -X you can specify any URL parameter, e.g.:
+fexsend -X autodelete=yes ...
+fexsend -X 'autodelete=no&locale=german' ...
For HTTPS you can set the environment variables:
SSLVERIFY=1 # activate server identity verification
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:
*=( __ /
\\\\/\\\\/
',
-'\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;
$_ = "$fexhome/config.pl"; require if -f;
getopts('hvIm:') or die $usage;
} else {
+ if ($macos and not @ARGV) {
+ &ask_file;
+ }
$opt_h = $opt_v = $opt_m = $opt_c = $opt_k = $opt_d = $opt_l = $opt_I = 0;
$opt_H = $opt_K = $opt_D = $opt_R = $opt_M = $opt_L = $opt_Q = $opt_A = 0;
$opt_x = $opt_o = $opt_g = $opt_V = $opt_U = $opt_F = $opt_n = $opt_q = 0;
${'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`;
+ 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) {
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;
elsif ($opt_A) { edit_address_book($from) }
elsif (${'opt_@'}) { &show_address_book }
elsif ($opt_d and $anonymous) { &purge }
-elsif ($opt_d and $ARGV[-1] =~ /^\d+$/) { &delete }
+elsif ($opt_d and $ARGV[-1] =~ /^\d+$/) { &delete_file_number }
else { &send_fex }
exit;
my ($fexcgi,$from,$id);
if (open $idf,$idf) {
$fexcgi = <$idf>;
+ # $fexcgi = <$idf> if $fexcgi =~ /^\[.+\]/;
$from = <$idf>;
$id = <$idf>;
while (<$idf>) {
sendheader("$fs:$port","GET $proxy_prefix/fur?user=$mail&verify=no HTTP/1.1");
http_response();
+ # header
while (<$SH>) {
s/\r//;
printf "<-- $_"if $opt_v;
}
+# menu for MacOS users
+sub menu {
+ my $key;
+ my $new;
+ local $_;
+
+ system 'clear';
+ print "\n";
+ print "fexsend-$version\n";
+
+ for (;;) {
+ if (open $idf,$idf) {
+ $fexcgi = getline($idf) and
+ $from = getline($idf) and
+ $id = getline($idf);
+ close $idf;
+ last if $id;
+ }
+ &set_ID;
+ }
+
+ print "\n";
+ print "$from on $fexcgi\n";
+ print "\n";
+
+ for (;;) {
+ print "\n";
+ print "[s] send a file or directory\n";
+ print "[u] update fexsend\n";
+ print "[l] change login data (user, server, auth-ID)\n";
+ print "[h] help\n";
+ print "[q] quit\n";
+ print "\n";
+ print "your choice: ";
+ $key = ReadKey(0);
+ if ($key eq 'q') {
+ print "$key\n";
+ print "\n";
+ print "Type [Cmd]W to close this window.\n";
+ exit;
+ }
+ if ($key eq 'h') {
+ print "$key\n";
+ print
+ "\n".
+ "With fexsend you can send files of any size to any e-mail address.\n".
+ "\n".
+ "At the recipient or file prompt [RETURN] brings you to this option menu.\n".
+ "\n".
+ "To send more than one file:\n".
+ "When you enter * at the file prompt, you will be first asked for an archive name\n".
+ "and then you can drag+drop multiple files.\n".
+ "\n".
+ "Do not forget to terminate each input line with [RETURN].\n".
+ "\n".
+ "See http://fex.rus.uni-stuttgart.de/ for more information.\n";
+ next;
+ }
+ if ($key eq 'u') {
+ print "$key\n";
+ if ($0 =~ m:(^/client/|/sw/):) {
+ print "\n";
+ print "use swupdate to update fexsend!\n";
+ next;
+ }
+ $new = $0.'.new';
+ system "curl http://fex.belwue.de/download/fexsend>".quote($new);
+ chmod 0755,$new;
+ system qw'perl -c',$new;
+ if ($? == 0) {
+ rename $new,$0;
+ exec $0;
+ } else {
+ print "\n";
+ print "cannot install new fexsend\n";
+ }
+ next;
+ }
+ if ($key eq 'l') {
+ print "$key\n";
+ system 'clear';
+ &set_ID;
+ next;
+ }
+ if ($key eq 's' or $key eq "\n") {
+ print "s\n";
+ &ask_file;
+ next;
+ }
+ }
+ exit;
+}
+
+
+# for MacOS
+sub ask_file {
+ my ($file,$comment,$recipient,$archive,$size,$cmd,$key);
+ my @files;
+ my $qfiles;
+ local $_;
+
+ system 'clear';
+
+ &set_ID unless -s $idf;
+
+ print "\n";
+ print "Enter [RETURN] after each input line.\n";
+ print "\n";
+
+ for (;;) {
+ print "Recipient(s): ";
+ $recipient = <STDIN>;
+ chomp $recipient;
+ $recipient =~ s/^\s+//;
+ $recipient =~ s/\s+$//;
+ $recipient =~ s/[\s;,]+/,/g;
+ &menu unless $recipient;
+ last if $recipient =~ /\w/ or $recipient eq '.';
+ }
+
+ for (;;) {
+ print "\n";
+ print "Drag a file into this window or hit [RETURN] ";
+ print $archive ? "to continue.\n" : "for menu options.\n";
+ print "File to send: ";
+ $file = <STDIN>||'';
+ chomp $file;
+ $file =~ s/^\s+//;
+ $file =~ s/ $// if $file !~ /\\ $/;
+ &menu unless $file or $archive;
+ if ($file eq '*') {
+ print "Archive name: ";
+ $archive = <STDIN>||'';
+ chomp $archive;
+ next unless $archive;
+ $archive =~ s/^\s+//g;
+ $archive =~ s/\s+$//g;
+ $archive =~ s/[^\w=.+-]/_/g;
+ next;
+ }
+ if ($file) {
+ unless (-e $file) {
+ $file =~ s/\\\\/\000/g;
+ $file =~ s/\\//g;
+ $file =~ s/\000/\\/g;
+ }
+ unless (-r $file) {
+ print "\"$file\" is not readable\n";
+ next;
+ }
+ my $qf = quote($file);
+ if (`du -ms $qf` =~ /^(\d+)/) {
+ $size += $1;
+ printf "%d MB\n",$1;
+ }
+ if ($archive) {
+ push @files,$file;
+ next;
+ }
+ }
+ if ($archive) {
+ next unless @files;
+ $qfiles = join(' ',map(quote($_),@files));
+ if ($size < 2048) {
+ $archive .= '.zip';
+ } else {
+ $archive .= '.tar';
+ }
+ }
+ print "\n";
+ print "Comment: ";
+ $comment = <STDIN>||'';
+ chomp $comment;
+ print "\n";
+ if ($comment =~ s/^:\s*-/-/) {
+ $cmd = quote($0)." $comment ";
+ if ($archive) {
+ $cmd .= '-a '.quote($archive).' '.$qfiles;
+ } else {
+ $cmd .= quote($file);
+ }
+ $cmd .= ' '.quote($recipient);
+ print $cmd,"\n";
+ system $cmd;
+ } else {
+ print quote($0)." -C '$comment' ";
+ if ($archive) {
+ printf "-a %s %s %s\n",quote($archive),$qfiles,$recipient;
+ system $0,'-C',$comment,'-a',$archive,@files,$recipient;
+ } else {
+ printf "%s %s\n",quote($file),$recipient;
+ system $0,'-C',$comment,$file,$recipient;
+ }
+ }
+ print "\n";
+ print "[s] send another file to $recipient\n";
+ print "[n] send another file to another recipient\n";
+ print "[q] quit\n";
+ print "\n";
+ print "your choice: ";
+ for (;;) {
+ $key = ReadKey(0);
+ &ask_file if $key eq 'n';
+ if ($key eq 's' or $key eq "\n") {
+ print "s\n";
+ last;
+ }
+ if ($key eq 'q') {
+ print "$key\n";
+ exit;
+ }
+ }
+ $file = $comment = $archive = '';
+ @files = ();
+ }
+}
+
+
+sub set_ID {
+ my ($server,$port,$user,$logo);
+ local $_;
+
+ print "\n";
+ for (;;) {
+ print "F*EX server URL: ";
+ $server = <STDIN>;
+ $server =~ s/[\s\n]//g;
+ if ($server =~ s:/fup/(\w+)$::) {
+ $_ = decode_b64($1);
+ if (/(from|user)=(.+)&id=(.+)/) {
+ $user = $2;
+ $id = $3;
+ }
+ }
+ $server =~ s:/fup.*::;
+ $server =~ s:/+$::;
+ next if $server !~ /\w/;
+ if ($server =~ s/^https:..// or $server =~ /:443/) {
+ $server =~ s/:.*//;
+ $port = 443;
+ eval "use IO::Socket::SSL";
+ if ($@) {
+ print "\nno perl SSL modules installed - cannot use https\n\n";
+ next;
+ }
+ $SH = IO::Socket::SSL->new(
+ PeerAddr => $server,
+ PeerPort => $port,
+ Proto => 'tcp',
+ %SSL
+ );
+ } else {
+ $server =~ s:^http.//::;
+ if ($server =~ s/:(\d+)//) {
+ $port = $1;
+ } else {
+ $port = 80;
+ }
+ $SH = IO::Socket::INET->new(
+ PeerAddr => $server,
+ PeerPort => $port,
+ Proto => 'tcp',
+ );
+ }
+ unless ($SH) {
+ print "\ncannot connect to $server:$port - $!\n\n";
+ next;
+ }
+ sendheader(
+ "$server:$port",
+ "GET /logo.jpg HTTP/1.0",
+ "Connection: close",
+ );
+ $_ = <$SH>||'';
+ unless (/HTTP.1.1 200/) {
+ print "\nbad server reply: $_\n";
+ next;
+ }
+ while (<$SH>) { last if /^\s*$/ }
+ local $/;
+ $logo = <$SH>||'';
+ close $SH;
+ if (length $logo < 9999) {
+ print "\n$server is not a F*EX server!\n\n";
+ next;
+ }
+ open $logo,">$tmpdir/fex.jpg";
+ print {$logo} $logo;
+ close $logo;
+ last;
+ }
+
+ for (;;) {
+ last if $user;
+ print "Your login (e-mail address): ";
+ $user = <STDIN>;
+ $user =~ s/[\s\n]//g;
+ if ($user !~ /.@[\w.-]+$/) {
+ print "\"$user\" is not a valid e-mail address!\n";
+ 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",
+ "$id\n";
+ close $idf;
+ print "\n";
+ print "Login data written to $idf\n\n";
+ print "fexing test file to $user:\n\n";
+ system "$0 -o -M -C test $tmpdir/fex.jpg $user";
+ print "\n";
+ if ($? != 0) {
+ print "fexsend failed, login data is invalid, try again\n";
+ &set_ID;
+ } else {
+ print "fexsend test succeeded!\n";
+ sleep 3;
+ }
+}
+
+
+
+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) {
+ $key = getc(STDIN);
+ }
+ stty('reset');
+ return $key;
+}
+
+
+sub stty {
+ if (shift eq 'raw') {
+ system qw'stty -echo -icanon eol',"\001";
+ } else {
+ system qw'stty echo icanon eol',"\000";
+ }
+}
+
+
sub send_xx {
my $transferfile = shift;
my $file = '';
- my (@r,@tar);
+ my (@r,@tar,$dir);
$SIG{PIPE} = $SIG{INT} = sub {
unlink $transferfile;
print "making tar transfer file $transferfile :\n";
# single file? then add this directly
if (scalar @ARGV == 1) {
- my ($dir,$file);
# strip path if not ending with /
if ($ARGV[0] =~ m:(.+)/(.+): and $2 !~ m:/$:) {
($dir,$file) = ($1,$2);
# list spool
sub list {
my (@r,$r);
- my ($data,$dkey,$n);
+ my ($data,$dkey);
+ my $n = 0;
+ my $s = 1;
+ my $a = shift @ARGV || '.';
local $_;
female_mode("list spooled files?") if $opt_F;
- if ($opt_l and $n = shift @ARGV and $n =~ /^\d+$/) {
- open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
- while (<$fexlist>) {
- if (/^\s*(\d+)\) (\w+) (.+)/ and $1 eq $n) {
- serverconnect($server,$port) unless $SH;
- sendheader(
- "$server:$port",
- "GET $proxy_prefix/fop/$2/$2?LIST HTTP/1.1",
- "User-Agent: $useragent",
- );
- $_ = <$SH>||'';
- s/\r//;
- print "<-- $_" if $opt_v;
- if (/^HTTP.* 200/) {
+ if ($opt_l) {
+ if ($a =~ /^\d+$/) {
+ open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
+ while (<$fexlist>) {
+ if (/^\s*(\d+)\) (\w+) (.+)/ and $1 eq $a) {
+ serverconnect($server,$port) unless $SH;
+ sendheader(
+ "$server:$port",
+ "GET $proxy_prefix/fop/$2/$2?LIST HTTP/1.1",
+ );
+ $_ = <$SH>||'';
+ s/\r//;
print "<-- $_" if $opt_v;
- while (<$SH>) {
- s/\r//;
- if (/^\n/) {
- print;
- print while <$SH>;
+ if (/^HTTP.* 200/) {
+ print "<-- $_" if $opt_v;
+ while (<$SH>) {
+ s/\r//;
+ if (/^\n/) {
+ print;
+ print while <$SH>;
+ }
}
+ } elsif (s:HTTP/[\d\. ]+::) {
+ die "$0: server response: $_";
+ } else {
+ die "$0: no response from fex server $server\n";
}
- } elsif (s:HTTP/[\d\. ]+::) {
- die "$0: server response: $_";
- } else {
- die "$0: no response from fex server $server\n";
+ exit;
}
- exit;
}
+ die "$0: file \#$a not found in fexlist\n";
}
- die "$0: file \#$n not found in fexlist\n";
- } else {
- @r = formdatapost(
- from => $from,
- to => $opt_l ? '*' : $from,
- command => $opt_C,
- );
}
+
+ @r = formdatapost(
+ from => $from,
+ to => $opt_l ? '*' : $from,
+ command => $opt_C,
+ );
die "$0: no response from fex server $server\n" unless @r;
$_ = shift @r;
unless (/^HTTP.* 200/) {
s/&/&/g;
s/"/\"/g;
s/</</g;
- if (/^(to .* :)/) {
- print "\n$1\n";
- print {$fexlist} "\n$1\n";
+ if (/^(to (.+) :)/) {
+ $s = $2 =~ /$a/;
+ print "\n$_\n" if $s;
+ print {$fexlist} "\n$_\n";
} elsif (m/(\d+) MB (.+)/) {
$n++;
- printf "%4s) %8d MB %s\n","#$n",$1,$2;
+ printf "%4s) %8d MB %s\n","#$n",$1,$2 if $s;
printf {$fexlist} "%3d) %s %s\n",$n,$dkey,$2;
}
}
}
-sub delete {
+sub delete_file_number {
my ($to,$file);
while (@ARGV) {
$opt_d = shift @ARGV;
- die "$usage: $0 -d #\n" if $opt_d !~ /^\d+$/;
+ die "usage: $0 -d #\n" if $opt_d !~ /^\d+$/;
open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
while (<$fexlist>) {
sendheader(
"$server:$port",
"GET $proxy_prefix/fop/$2/$2?DELETE HTTP/1.1",
- "User-Agent: $useragent",
);
$_ = <$SH>||'';
s/\r//;
}
+sub delete_file {
+ my ($from,$to,$file) = @_;
+ local $_;
+
+ unless ($SH) {
+ 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",
+ );
+
+ while (<$SH>) {
+ s/\r//;
+ printf "<-- $_"if $opt_v;
+ last if /^\s*$/;
+ }
+}
+
+
+sub urlencode {
+ local $_ = shift;
+ s/([^_=:,;<>()+.\w\-])/'%'.uc(unpack("H2",$1))/ge;
+ return $_;
+}
+
+
sub send_fex {
my @to;
my $file = '';
if ($anonymous) {
my $aok;
- sendheader("$server:$port","OPTIONS FEX HTTP/1.1");
+ sendheader("$server:$port","OPTIONS /FEX HTTP/1.1");
$_ = <$SH>||'';
s/\r//;
die "$0: no response from fex server $server\n" unless $_;
}
if (@ARGV > 1 and not ($opt_a or $opt_s or $opt_d)) {
- print "Archive name (name.tar, name.tgz or name.zip) or [ENTER] to send file for file:\n";
+ print "Archive name (name.tar, name.tgz or name.zip) or [RETURN] to send file for file:\n";
$opt_a = <STDIN>;
$opt_a =~ s/^\s+//;
$opt_a =~ s/\s+$//;
+ $opt_a =~ s/\//_/g;
+ }
+
+ if ($macos and not $opt_a and -d "@ARGV") {
+ my $dir = "@ARGV";
+ my $qdir = quote($dir);
+ if (`du -s $qdir` =~ /^(\d+)/ and $1 < 2**21) {
+ $opt_a = "$dir.zip";
+ } else {
+ $opt_a = "$dir.tar";
+ }
}
if ($opt_s) {
$opt_a =~ s:.*/::g;
}
foreach my $file (@ARGV) {
- die "$0: cannot read $file\n" unless -l $file or -r $file;
+ die "$0: cannot read \"$file\"\n" unless -l $file or -r $file;
}
$opt_a .= ".$atype" if $opt_a !~ /\.$atype$/;
$transferfile = "$tmpdir/$opt_a";
# else { system(qw'7z a -tzip -mm=copy',$transferfile,@ARGV) }
system(qw'7z a -tzip',$transferfile,@ARGV);
@files = ($transferfile);
+ } elsif ($macos and scalar(@ARGV) == 1) {
+ ## ditto-zip is now handled by formdatapost()
+ system 'true';
+ @files = ($opt_a);
} else {
# zip archives must be < 2 GB, so split as necessary
@files = zipsplit($transferfile,@ARGV);
} else {
## tar is now handled by formdatapost()
# system(qw'tar cvf',$transferfile,@ARGV);
+ system 'true';
@files = ($opt_a);
}
} elsif ($atype eq 'tgz') {
unless ($opt_d) {
unless (-f $file) {
if (-e $file) {
- die "$0: $file is not a regular file, try option -a\n"
+ die "$0: \"$file\" is not a regular file, try option -a\n"
} else {
- die "$0: $file does not exist\n";
+ die "$0: \"$file\" does not exist\n";
}
}
- die "$0: cannot read $file\n" unless -r $file;
+ die "$0: cannot read \"$file\"\n" unless -r $file;
}
push @files,$file;
}
foreach my $file (@files) {
my @s = stat($file);
unless (@s and ($s[2] & S_IROTH) and -r $file) {
- die "$0: $file is not world readable\n";
+ die "$0: \"$file\" is not world readable\n";
}
}
}
foreach my $file (@files) {
sleep 1; # do not overrun server!
unless (-s $file or $opt_d or $opt_a or $opt_s) {
- die "$0: cannot send empty file $file\n";
+ die "$0: cannot send empty file \"$file\"\n";
}
female_mode("send file $file?") if $opt_F;
@r = formdatapost(
if (not @r or not grep /\w/,@r) {
die "$0: no response from server\n";
}
+ next if "@r" eq '0'; # already transfered
if (($r) = grep /^ERROR:/,@r) {
if ($anonymous and $r =~ /purge it/) {
die "$0: file is already on server for $to - use another anonymous recipent\n";
+ } elsif ($r =~ /timeout/i) {
+ close $SH;
+ retry("timed out");
} else {
$r =~ s/.*?:\s*//;
$r =~ s/<.+?>//g;
die "$0: server error: $r\n";
}
}
+ unless ($opt_d) {
+ if (scalar(@r) == 1) {
+ die "$0: server error: @r\n";
+ } else {
+ if ($r[0] !~ /HTTP.1.. 2/) {
+ if ($r[0] =~ /HTTP.[\s\d.]+(.+)/) {
+ die "$0: server error: $1\n";
+ } else {
+ die "$0: server error:\n".join("\n",@r)."\n";
+ }
+ }
+ }
+ }
if (($r) = grep /<h3>\Q$file/,@r) {
$r =~ s/<.+?>//g;
print "$r\n";
if ($opt_a !~ /^afex_\d+\.tar$/ and $file !~ /afex_\d+\.tar$/) {
# print grep({s/^(X-Recipient:.*\((.+)\))/Parameters: $2\n/i} @r);
my $nonot = 0;
- my ($recipient,$location);
+ my $recipient = '';
+ my $location = '';
foreach (@r) {
if (/^(X-)?(Recipient.*)/i) {
$recipient = $2;
}
if (/^(X-)?(Location.*)/i) {
$location = $2;
- if ($from eq $to or $from =~ /^\Q$to\E@/i
- or $nomail or $anonymous or $nonot) {
- print "$recipient\n";
- print "$location\n";
- }
}
}
- 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";
- }
- }
+ if ($from eq $to or $from =~ /^\Q$to\E@/i
+ or $nomail or $anonymous or $nonot)
+ {
+ print "$recipient\n" if $recipient;
+ print "$location\n" if $location;
}
}
}
open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
while (<$fexlist>) {
- if (/^\s*(\d+)\) (\w+) \[\d+ d\] (.+)/ and $1 eq $opt_f) {
+ if (/^\s*(\d+)\) (\w+) .\s*\d+ d. ([+-] )?(.+)/ and $1 eq $opt_f) {
$n = $1;
$dkey = $2;
- $file = $3;
+ $file = $4;
if ($file =~ s/ "(.*)"$//) {
$opt_C ||= $1 if $1 ne 'NOMAIL';
}
open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
while (<$fexlist>) {
- if (/^\s*(\d+)\) (\w+) \[\d+ d\] (.+)/ and $1 eq $opt_N) {
+ if (/^\s*(\d+)\) (\w+) .\s*\d+ d. (.+)/ and $1 eq $opt_N) {
$n = $1;
$dkey = $2;
last;
open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
while (<$fexlist>) {
- if (/^\s*(\d+)\) (\w+) \[\d+ d\] (.+)/ and $1 eq $opt_x) {
+ if (/^\s*(\d+)\) (\w+) .\s*\d+ d. (.+)/ and $1 eq $opt_x) {
$n = $1;
$dkey = $2;
$file = $3;
sub formdatapost {
my %P = @_;
- my ($boundary,$filename,$filesize,$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);
my $chunk = 0;
+ my $filesize = 0;
my $connection = '';
my $pct = '';
- my ($tar,$aname,$atype,$tarlist,$tarerror,$location,$transferfile);
+ my $dittodir = '.';
+ my ($tar,$ditto,$aname,$atype,$list,$error,$location,$transferfile);
local $_;
if (defined($file = $P{file})) {
$of =~ s/([^_\w\.\-])/\\$1/g;
shelldo("gzip <$if>$of");
$filesize = -s $transferfile;
- die "$0: cannot gzip $file\n" unless $filesize;
+ die "$0: cannot gzip \"$file\"\n" unless $filesize;
$file = $transferfile;
}
if (not $windoof and $opt_a and $file =~ /(.+)\.(tar|tgz)$/) {
$aname = $1;
$atype = $2;
- $tarlist = "$tmpdir/$aname.list";
- $tarerror = "$tmpdir/$aname.error";
+ $list = "$tmpdir/$aname.list";
+ $error = "$tmpdir/$aname.error";
$tar = 'tar -cv';
$tar .= 'z' if $atype eq 'tgz';
if (`tar --help 2>/dev/null` =~ /--index-file/) {
- $tar .= " --index-file=$tarlist -f-";
+ $tar .= " --index-file=$list -f-";
} else {
$tar .= " -f-";
}
}
}
foreach (@ARGV) {
- $file = $_;
- $file =~ s/([^\w\-\@\#%,.=+~_:])/\\$1/g;
- $tar .= ' '.$file;
+ $tar .= ' '.quote($_);
}
# print "calculating archive size... ";
- open $tar,"$tar 2>$tarerror|" or die "$0: cannot run tar - $!\n";
+ open $tar,"$tar 2>$error|" or die "$0: cannot run tar - $!\n";
$t0 = int(time) if -t STDOUT;
while ($b = read $tar,$_,$bs) {
$filesize += $b;
printf "Archive size: %d MB\n",int($filesize/M) if -t STDOUT;
unless (close $tar) {
$_ = '';
- if (open $tarerror,$tarerror) {
+ if (open $error,$error) {
local $/;
- $_ = <$tarerror>;
- close $tarerror;
+ $_ = <$error>;
+ close $error;
}
- unlink $tarlist,$tarerror;
+ unlink $list,$error;
die "$0: tar error:\n$_";
}
$file = "$aname.$atype";
undef $SH; # force reconnect (timeout!)
}
+ # special file: ditto-zip-on-the-fly
+ # ditto: Can't archive multiple sources
+ elsif ($macos and $opt_a and $file =~ /(.+)\.(zip)$/ and scalar(@ARGV) == 1) {
+ $aname = $1;
+ $atype = $2;
+ $list = "$tmpdir/$aname.list";
+ $error = "$tmpdir/$aname.error";
+ $ditto = 'ditto -c -k --sequesterRsrc --keepParent';
+ if (-d "@ARGV" and "@ARGV" =~ m:^(.+)/(.+):) {
+ $dittodir = $1;
+ $file = $2;
+ $file =~ s/([^\w\-\@\#%,.=+_:])/\\$1/g;
+ $ditto .= ' '.$file;
+ } else {
+ foreach (@ARGV) {
+ $file = $_;
+ $file =~ s/([^\w\-\@\#%,.=+_:])/\\$1/g;
+ $ditto .= ' '.$file;
+ }
+ }
+ # print "calculating archive size... ";
+ debug("cd $dittodir;$ditto -");
+ 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) {
+ $filesize += $b;
+ if ($t0) {
+ $t1 = int(time);
+ if ($t1>$t0) {
+ printf "Archive size: %d MB\r",int($filesize/M);
+ $t0 = $t1;
+ }
+ }
+ }
+ printf "Archive size: %d MB\n",int($filesize/M) if -t STDOUT;
+ unless (close $ditto) {
+ $_ = '';
+ if (-s $error and open $error,$error) {
+ local $/;
+ $_ = <$error>;
+ close $error;
+ }
+ unlink $list,$error;
+ die "$0: ditto-zip error:\n$_";
+ }
+ unlink $list,$error;
+ $file = "$aname.$atype";
+ $filename = encode_utf8($file);
+ 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);
if ($opt_d) {
$filesize = 0;
} elsif (not $opt_g and not $opt_s) {
- $filesize = -s $file or die "$0: $file is empty or not readable\n";
+ $filesize = -s $file or die "$0: \"$file\" is empty or not readable\n";
}
}
$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 and not
- ($opt_s or $opt_g or $opt_o or $opt_d or $opt_l or $opt_L or ${'opt_/'}))
- {
- ($seek,$location) = query_file($server,$port,$frecipient||$P{to},$P{from},
- $P{id},$filename,$fileid);
- if ($filesize == $seek) {
- print "Location: $location\n" if $location and $nomail;
- warn "$0: $file has been already transferred\n";
- return $file;
- } elsif ($seek and $seek < $filesize) {
- $resume = " (resuming at byte $seek)";
- } elsif ($filesize <= $seek) {
- $seek = 0;
+ if ($file and not $xx and not $nettest) {
+ if (not $opt_d and $opt_o) {
+ # delete before overwrite
+ delete_file($from,$to,$filename);
+ serverconnect($server,$port);
+ query_sid($server,$port) unless $anonymous;
+ $P{id} = $sid; # ugly hack!
+ } elsif (not($opt_s or $opt_g or $opt_d or $opt_l or $opt_L or ${'opt_/'})) {
+ ($seek,$location) = query_file($server,$port,
+ $frecipient||$P{to},$P{from},$P{id},$filename,$fileid);
+ if ($filesize == $seek) {
+ print "Location: $location\n" if $location and $nomail;
+ warn "$0: $file has been already transferred\n";
+ return 0;
+ } elsif ($seek and $seek < $filesize) {
+ $resume = " (resuming at byte $seek)";
+ } elsif ($filesize <= $seek) {
+ $seek = 0;
+ }
}
if ($proxy) {
sleep 1; # do not overrun proxy
push @hb,"--$boundary";
push @hb,"Content-Disposition: form-data; name=\"$name\"";
push @hb,"";
- push @hb,encode_utf8($P{$v});
+ # push @hb,encode_utf8($P{$v});
+ push @hb,$P{$v};
}
}
$tpid = fork();
if (defined $tpid and $tpid == 0) {
sleep 1;
- if (open $tarlist,$tarlist) {
- # print "\n$tar|\n"; system "ls -l $tarlist";
- while ($tarlist) {
- while (<$tarlist>) {
+ if (open $list,$list) {
+ # print "\n$tar|\n"; system "ls -l $list";
+ while ($list) {
+ while (<$list>) {
print ' 'x(length($file)+40),"\r",$_;
}
sleep 1;
print "Fast forward to byte $seek (resuming)\n";
readahead($file,$seek);
}
+ } elsif ($ditto) {
+ $ditto =~ s/ditto/ditto -V/;
+ open $file,"cd $dittodir;$ditto -|" or die "$0: cannot run ditto - $!\n";
+ if ($seek) {
+ print "Fast forward to byte $seek (resuming)\n";
+ readahead($file,$seek);
+ }
+ } elsif ($nettest) {
+ #
} else {
if ($opt_g) {
- my $fileq = $file;
- $fileq =~ s/([^\w\-\@\#%,.=+~_:])/\\$1/g;
+ my $fileq = quote($file);
open $file,"gpg -e -r $to <$fileq|" or die "$0: cannot run gpg - $!\n";
} else {
- open $file,$file or die "$0: cannot read $file - $!\n";
+ open $file,$file or die "$0: cannot read \"$file\" - $!\n";
seek $file,$seek,0;
}
binmode $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) {
- die "$0: $file filesize has grown while uploading\n";
+ if (not $nettest and $filesize > 0 and $bytes+$seek > $filesize) {
+ if ($tpid) {
+ kill 9,$tpid;
+ unlink $list;
+ }
+ die "$0: \"$file\" filesize has grown while uploading\n";
}
$bt += $b;
$t2 = time;
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_+'};
if ($tpid) {
sleep 2;
kill 9,$tpid;
- unlink $tarlist;
+ unlink $list;
+ }
+
+ if ($fileid =~ /[a-z]/ and not ($opt_s or $opt_g)) {
+ if ($opt_a) {
+ if ($fileid ne md5_hex(fmd(@ARGV))) {
+ print "\n" unless $opt_q;
+ die "$0: files have been modified while uploading\n";
+ }
+ } else {
+ if ($fileid ne fileid($file)) {
+ print "\n" unless $opt_q;
+ die "$0: file has been modified while uploading\n";
+ }
+ }
}
unless ($opt_q) {
if (not $chunksize and $bytes+$seek < $filesize) {
- die "$0: $file filesize has shrunk while uploading\n";
+ 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) {
$size = -s $file;
if ($size > 2147480000) {
unlink @zipfiles;
- die "$0: $file too big for zip\n";
+ die "$0: \"$file\" too big for zip\n";
}
if ($zsize + $size > 2147000000) {
push @zipfiles,zip($zipbase.'_'.$n.'.zip',@files);
my $seek = 0;
my $qfileid = '';
my ($head,$location);
- my ($response,$fexsrv);
+ 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 (/^X-File-ID:\s+(.+)/) { $qfileid = $1 }
if (/^X-Features:\s+(.+)/) { $features = $1 }
if (/^X-Location:\s+(.+)/) { $location = $1 }
+ if (/^Connection: close/) { $cc = $_ }
}
# return true seek only if file is identified
$seek = 0 if $qfileid and $qfileid ne $fileid;
+ if ($cc) {
+ serverconnect($server,$port);
+ $sid = $id;
+ }
+
return ($seek,$location);
}
print {$ab} $AB{ADDRESS_BOOK};
close $ab;
- system $editor,$ab;
+ system "$editor $ab";
exit unless -s $ab;
$opt_o = $opt_A;
$sid = $id;
- if ($port eq 443) {
- return if $features; # early return if we know enough
- $req = "OPTIONS FEX HTTP/1.1";
- } elsif ($proxy) {
+ if ($port eq 443 or $proxy) {
+ return if $opt_d;
return if $features; # early return if we know enough
- $req = "GET $proxy_prefix/SID 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";
+ $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;
s/\r//;
print "<-- $_" if $opt_v;
- if (/^HTTP.* [25]0[01] /) {
+ if ($req =~ /OPTIONS/ and /^HTTP.* 502 /) {
+ # (reverse) proxy error
+ close $SH;
+ serverconnect($server,$port);
+ $req = "GET /SID HTTP/1.0";
+ sendheader("$server:$port",$req);
+ $_ = <$SH>;
+ unless (defined $_ and /\w/) {
+ print "\n" if $opt_v;
+ die "$0: no response from server\n";
+ }
+ s/\r//;
+ print "<-- $_" if $opt_v;
+ while (<$SH>) {
+ s/\r//;
+ print "<-- $_" if $opt_v;
+ $features = $1 if /^X-Features: (.+)/;
+ $timeout = $1 if /^X-Timeout: (\d+)/;
+ last if /^\n/;
+ }
+ close $SH;
+ serverconnect($server,$port);
+ } elsif (/^HTTP.* [25]0[01] /) {
if (not $proxy and $port ne 443 and /^HTTP.* 201 (.+)/) {
$sid = 'MD5H:'.md5_hex($id.$1);
}
+ my $cc;
while (<$SH>) {
s/\r//;
print "<-- $_" if $opt_v;
$features = $1 if /^X-Features: (.+)/;
$timeout = $1 if /^X-Timeout: (\d+)/;
- last if /^\n/;
+ $cc = $_ if /^Connection: close/;
+ last if /^\n/;
+ }
+ if ($cc) {
+ serverconnect($server,$port);
+ $sid = $id;
}
} elsif (/^HTTP.* 301 /) {
while (<$SH>) { last if /Location/ }
$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//;
die "$0: no Content-Length in server-reply\n" unless $cl;
- open F,">$save" or die "$0: cannot write to $save - $!\n";
- binmode F;
+ open $save,">$save" or die "$0: cannot write to $save - $!\n";
+ binmode $save;
$t0 = $t1 = int(time);
$tso = '';
while ($b = read($SH,$_,$bs)) {
$B += $b;
- print F;
+ print {$save} $_;
if (int(time) > $t1) {
$t1 = int(time);
$ts = ts($B,$cl);
}
print STDERR ts($B,$cl),"\n";
- close F;
+ close $save;
}
$_ = 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/) {
}
-# fileid is inode and mtime
sub fileid {
- my @s = stat(shift);
- return @s ? $s[1].$s[9] : int(time);
+ my $file = shift;
+ 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 {
+ warn "$0: $file - $!\n";
+ return int(time);
+ }
}
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) {
s/.*\s+//;
s/[<>]//g;
if (/,/) {
- warn "$0: ignoring mutt multi-alias $to = $alias\n";
+ warn "$0: ignoring mutt multi-alias $to = $_\n";
last;
}
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);
}
-# collect file meta data (filename, inode, mtime)
+# collect (hashed) file meta data
sub fmd {
my @files = @_;
my ($file,$dir);
while (defined ($file = readdir($dir))) {
next if $file eq '..';
if ($file eq '.') {
- $fmd .= $file.fileid($dir);
+ $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");
}
closedir $dir;
}
} else {
- $fmd .= $file.fileid($file);
+ $fmd .= fileid($file);
}
}
unless (defined $_ and /\w/) {
die "$0: no response from server\n";
}
- print "<-- $_\n" if $opt_v;
s/\r?\n//;
+ print "<-- $_\n" if $opt_v;
# CGI fatalsToBrowser
if (/^HTTP.* 500/) {
@r = <$SH> unless @r;
die "$0: server error: $error\n";
}
- print "<-- $_\n" if $opt_v;
return $_;
}
local $/;
open $0,$0 or die "cannot read $0 - $!\n";
- $_ = <$0>;
+ $cfc = <$0>;
close $0;
- s/.*\n$cfb\n//s;
- $cfc = $_;
+ $cfc =~ s/.*\n$cfb\n//s;
- foreach my $p (qw(fexget sexsend)) {
+ foreach my $p (qw'fexget sexsend') {
open $p,$p or die "cannot read $p - $!\n";
$_ = <$p>;
close $p;
close $p;
}
- exec "l $0 fexget sexsend";
+ exec "l fexsend fexget sexsend";
exit;
}
if ($SH) {
autoflush $SH 1;
+ binmode $SH;
} else {
die "$0: cannot connect $server:$port - $@\n";
}
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";
}
}
+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 = "";
projects / fex.git / blobdiff