$| = 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 = 20150729;
+our $version = 20160328;
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 ($server,$port,$sid,$https);
my $proxy = '';
my $proxy_prefix = '';
-my $features = '';
+my $features = '';
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
$hints = <<EOD;
$0 hints and more options:
-
+
usage: $0 [options] file recipient(s)
Recipient can be a comma separated address list. Example:
$0 big.file framstag\@rus.uni-stuttgart.de,webmaster\@flupp.org
-Recipient can be an alias from your server address book
+Recipient can be an alias from your server address book
(use "$0 -A" to edit it). Example:
$0 big.file framstag
Recipient can be a SKEY URL, which you have received from a regular F*EX user.
-When using this URL you are a subuser of this full user and the file will be
+When using this URL you are a subuser of this full user and the file will be
sent to him. Example:
$0 big.file http://fex.rus.uni-stuttgart.de/fup?skey=4285f8cdd881626524fba686d5f0a83a
members of this group. Example:
$0 big.file http://fex.rus.uni-stuttgart.de/fup?gkey=50d26547b1e8c1110beb8748fc1d9444
-When you use "FEX-URL/anonymous" as recipient and your F*EX administrator has
+When you use "FEX-URL/anonymous" as recipient and your F*EX administrator has
allowed anonymous upload for your IP address then no auth-ID is needed.
-
-"." as recipient means fex to yourself and show immediately the download URL
+
+"." as recipient means fex to yourself and show immediately the download URL
(no notification e-mail will be sent). Example:
$0 software.tar .
-F activates female mode
-U show authorized URL
-+ is an undocumented feature - test it :-)
-
-To manage your subuser and groups or forward or redirect files, use a
+
+To manage your subuser and groups or forward or redirect files, use a
webbrowser with the URL from "$0 -U", e.g.: firefox \$($0 -U)
If you want to copy-forward an already uploaded file to another recipient,
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
Where # is the file number.
With option -a you can send several files or whole directories within a single
-archive file. The archive types tar and tgz are build on-the-fly (streaming)
+archive file. The archive types tar and tgz are build on-the-fly (streaming)
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 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
SSLCAPATH=/etc/ssl/certs # path to trusted (root) certificates
SSLCAFILE=/etc/ssl/cert.pem # file with trusted (root) certificates
SSLCIPHERLIST=HIGH:!3DES # see http://www.openssl.org/docs/apps/ciphers.html
-
+
Partner program xx is an internet clipboard. See: xx -h
-
+
Partner program fexget is for downloading. See: fexget -h
-
-For temporary usage of a HTTP proxy use:
+
+For temporary usage of a HTTP proxy use:
$0 -P your_proxy:port:chunksize_in_MB file recipient
Example:
$0 -P wwwproxy.uni-stuttgart.de.de:8080:1024 4GB.tar .
-
-For temporary usage of an alternative F*EX server or user use:
+
+For temporary usage of an alternative F*EX server or user use:
FEXID="FEXSERVER USER AUTHID" $0 file recipient
Example:
FEXID="fex.flupp.org gaga\@flupp.org blubb" $0 big.file framstag\@rus.uni-stuttgart.de
fexsend also respects aliases in $HOME/.mutt/aliases
The alias priority is (descending):
\$HOME/.fex/config.pl
-\$HOME/.mutt/aliases
-fexserver address book
+\$HOME/.mutt/aliases
+fexserver address book
In \$HOME/.fex/config.pl you can also set the SSL* environment variables and the
\$opt_* variables, e.g.:
-
+
\$ENV{SSLVERSION} = 'TLSv1';
\${'opt_+'} = 1;
\$opt_m = 200;
*=( __ /
\\\\/\\\\/
',
-'\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) {
print $hints;
exit;
}
-
+
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) {
die "$0: you cannot use both options -D and -K\n";
}
}
# $opt_C is COMMENT command in F*EX protocol
- $opt_C =
+ $opt_C =
($opt_d) ? 'DELETE':
($opt_l or $opt_L) ? 'LIST':
($opt_Q) ? 'CHECKQUOTA':
($opt_z) ? 'SENDLOG':
(${'opt_!'}) ? 'FOPLOG':
$opt_C;
-
- $opt_D =
+
+ $opt_D =
($opt_D) ? 'DELAY':
($opt_K) ? 'NO':
$opt_D;
die $usage if $opt_m and $opt_m !~ /^\d+/;
-if ($opt_P) {
+if ($opt_P) {
if ($opt_P =~ /^([\w.-]+:\d+)(:(\d+))?/) {
$proxy = $1;
$chunksize = $3 || 0;
unlink $idf.'xx';
}
}
-
+
# special xx ID?
if ($FEXXX = $ENV{FEXXX}) {
$FEXXX = decode_b64($FEXXX) if $FEXXX !~ /\s/;
}
close $idf;
}
-
+
} else {
# alternativ ID?
}
if ($opt_I) {
- if ($xx) { &show_id }
+ if ($xx) { &show_id }
else { &init_id }
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;
} else {
$fexcgi = $opt_u if $opt_u;
-
+
if (not -e $idf and not ($fexcgi and $from and $id)) {
die "$0: no ID file $idf found, use \"fexsend -I\" to create it\n";
}
-
+
unless ($fexcgi) {
die "$0: no FEX URL found, use \"$0 -u URL\" or \"$0 -I\"\n";
}
-
+
unless ($from and $id) {
die "$0: no sender found, use \"$0 -f FROM:ID\" or \"$0 -I\"\n";
}
$port = $1 if $server =~ s/:(\d+)//;
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";
+ # $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;
}
$transferfile = "$tmpdir/xx:$1";
shift @ARGV;
}
- open my $lock,'>>',$transferfile
+ open my $lock,'>>',$transferfile
or die "$0: cannot write $transferfile - $!\n";
flock($lock,LOCK_EX|LOCK_NB)
or die "$0: $transferfile is locked by another process\n";
&send_xx($transferfile);
}
exit;
-}
+}
# regular fexsend
}
if ($opt_V and not @ARGV) { exit }
-if ($opt_f) { &forward }
-elsif ($opt_x) { &modify }
-elsif ($opt_N) { &renotify }
-elsif ($opt_Q) { &query_quotas }
-elsif ($opt_S) { &query_settings }
-elsif ($opt_l or $opt_L) { &list }
-elsif ($opt_U) { &show_URL }
-elsif ($opt_z or $opt_Z or ${'opt_!'}) { &get_log }
+if ($opt_f) { &forward }
+elsif ($opt_x) { &modify }
+elsif ($opt_N) { &renotify }
+elsif ($opt_Q) { &query_quotas }
+elsif ($opt_S) { &query_settings }
+elsif ($opt_l or $opt_L) { &list }
+elsif ($opt_U) { &show_URL }
+elsif ($opt_z or $opt_Z or ${'opt_!'}) { &get_log }
elsif ($opt_A) { edit_address_book($from) }
-elsif (${'opt_@'}) { &show_address_book }
+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;
sub init_id {
my $tag;
my $proxy = '';
-
+
if ($opt_I) {
$tag = shift @ARGV;
die $usage if @ARGV;
}
-
+
$fexcgi = $from = $id = '';
-
+
unless (-d $fexhome) {
mkdir $fexhome,0700 or die "$0: cannot create FEXHOME $fexhome - $!\n";
}
}
if ($tag and $tag eq '.') { exec $ENV{EDITOR}||'vi',$idf }
-
+
if ($tag) { print "F*EX server URL for [$tag]: " }
else { print "F*EX server URL: " }
$fexcgi = <STDIN>;
print "proxy address (hostname:port or empty if none): ";
$proxy = <STDIN>;
$proxy =~ s/[\s\n]//g;
- if ($proxy =~ /^[\w.-]+:\d+$/) {
+ if ($proxy =~ /^[\w.-]+:\d+$/) {
$proxy = "!$proxy";
- } elsif ($proxy =~ /\S/) {
+ } elsif ($proxy =~ /\S/) {
die "wrong proxy address format\n";
- } else {
+ } else {
$proxy = "";
}
if ($proxy) {
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;
exit 3;
};
-
+
if ($0 eq 'xxx') { @tar = qw'tar -cv' }
else { @tar = qw'tar -cvz' }
shelldo("cat >> $transferfile");
} elsif (@ARGV) {
print "making tar transfer file $transferfile :\n";
- # single file? then add this directly
+ # 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);
}
die "$0: no transfer file\n" unless -s $transferfile;
-
+
serverconnect($server,$port);
query_sid($server,$port);
-
+
@r = formdatapost(
from => $from,
to => $from,
comment => 'NOMAIL',
autodelete => $transferfile =~ /STDFEX/ ? 'NO' : 'DELAY',
);
-
+
# open P,'|w3m -T text/html -dump' or die "$0: w3m - $!\n";
# print P @r;
http_response(@r);
print "wget -O- $2 | tar xvzf -\n";
}
}
-
+
unlink $transferfile;
}
from => $from,
to => $from,
id => $sid,
- command => $opt_C,
+ command => $opt_C,
);
die "$0: no response from fex server $server\n" unless @r;
$_ = shift @r;
print "auth-ID: $id\n";
print "login URL: ";
&show_URL;
-
+
@r = formdatapost(
from => $from,
to => $from,
id => $sid,
- command => $opt_C,
+ command => $opt_C,
);
die "$0: no response from fex server $server\n" unless @r;
$_ = shift @r;
# 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:HTTP/[\d\. ]+::;
die "$0: server response: $_\n";
}
-
+
# list sent files
if ($opt_l) {
open $fexlist,">$fexlist" or die "$0: cannot write $fexlist - $!\n";
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;
}
}
close $fexlist;
- }
-
+ }
+
# list received files
if ($opt_L) {
foreach (@r) {
sub get_log {
my (@r);
local $_;
-
+
@r = formdatapost(
from => $from,
to => $from,
id => $sid,
- command => $opt_C,
+ command => $opt_C,
);
die "$0: no response from fex server $server\n" unless @r;
$_ = shift @r;
my (%AB,@r);
my $alias;
local $_;
-
+
%AB = query_address_book($server,$port,$from);
foreach $alias (sort keys %AB) {
next if $alias eq 'ADDRESS_BOOK';
}
-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>) {
if (/^to (.+\@.+) :/) {
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 = '';
my $transferfile;
my @transferfiles;
local $_;
-
+
if ($from =~ /^SUBUSER|GROUPMEMBER$/) {
$to = '_';
} else {
}
}
@to = split(',',lc($to));
-
+
die $usage unless @ARGV or $opt_a or $opt_s;
die $usage if $opt_s and @ARGV;
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 $_;
}
} elsif ($public) {
} else {
-
+
query_sid($server,$port);
-
+
if ($from eq 'SUBUSER') {
$skey = $sid;
# die "skey=$skey\nid=$id\nsid=$sid\n";
if ($from eq 'GROUPMEMBER') {
$gkey = $sid;
}
-
+
if ($to eq '.') {
@to = ($from);
$opt_C ||= 'NOMAIL';
}
}
# alias in server address book?
- elsif ($AB{$to}) {
- # do not substitute alias with expanded addresses because then
+ elsif ($AB{$to}) {
+ # do not substitute alias with expanded addresses because then
# keep and autodelete options from address book will get lost
# $to = $AB{$to};
- }
+ }
# look for mutt aliases
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;
-
+
if (
not $skey and not $gkey
and $from ne $to
- and $features =~ /CHECKRECIPIENT/
+ and $features =~ /CHECKRECIPIENT/
and $opt_C !~ /^(DELETE|LIST|RECEIVEDLOG|SENDLOG|FOPLOG)$/
) {
checkrecipient($from,$to);
}
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') {
} else {
die "$0: unknown archive format \"$atype\"\n";
}
-
+
if (@transferfiles) {
-
+
# error in making transfer archive?
if ($?) {
unlink @transferfiles;
die "$0: $! - aborting upload\n";
}
-
+
# maybe timeout, so make new connect
if (time-$t0 >= $timeout) {
serverconnect($server,$port);
query_sid($server,$port) unless $anonymous;
}
-
+
}
-
+
} else {
-
+
unless (@ARGV) {
if ($windoof) {
&inquire;
die $usage;
}
}
-
+
foreach (@ARGV) {
my $file = $_;
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(
file => $file,
keep => $opt_k,
comment => $opt_C,
- autodelete => $opt_D,
+ autodelete => $opt_D,
);
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;
}
}
}
-
+
# delete transfer tmp file
unlink $transferfile if $transferfile;
}
my ($to,$n,$dkey,$file,$req);
my ($status,$fp);
local $_;
-
+
# look for single @ in arguments
for (my $i=1; $i<$#ARGV; $i++) {
if ($ARGV[$i] eq '@') {
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';
}
}
}
close $fexlist;
-
+
unless ($n) {
die "$0: file #$opt_f not found in fexlist\n";
}
serverconnect($server,$port);
query_sid($server,$port);
-
+
$req = "GET $proxy_prefix/fup?"
."from=$from&ID=$sid&to=$to&dkey=$dkey&command=FORWARD";
$req .= "&comment=$opt_C" if $opt_C;
$fp = $file;
$fp =~ s/[^\w_.-]/.+/g; # because of UTF8 filename
$status = 1;
- while (<$SH>) {
+ while (<$SH>) {
$status = 0 if /"$fp"/;
print if $opt_v or /"$fp"/;
}
-
+
if ($status) {
die "$0: server failed, rerun command with option -v\n";
}
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;
}
}
close $fexlist;
-
+
unless ($n) {
die "$0: file #$opt_N not found in fexlist\n";
}
serverconnect($server,$port);
query_sid($server,$port);
-
+
$req = "GET $proxy_prefix/fup?"
."from=$from&ID=$sid&dkey=$dkey&command=RENOTIFY"
." HTTP/1.1";
$file = $3;
}
}
-
+
if ($file) {
print "notification e-mail for $file has been resent to $recipient\n";
} else {
die "$0: server failed, rerun command with option -v\n";
}
}
-
+
exit;
}
my (@r);
my ($n,$dkey,$file,$req);
local $_;
-
+
die $usage if @ARGV;
die $usage unless $opt_C or $opt_k or $opt_D;
-
+
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;
}
}
close $fexlist;
-
+
unless ($n) {
die "$0: file #$opt_x not found in fexlist\n";
}
female_mode("modify file #$opt_x?") if $opt_F;
-
+
serverconnect($server,$port);
query_sid($server,$port);
-
+
$req = "GET $proxy_prefix/fup?"
."from=$from&ID=$sid&dkey=$dkey&command=MODIFY";
$req .= "&comment=$opt_C" if $opt_C;
$req .= " HTTP/1.1";
sendheader("$server:$port",$req);
http_response();
- while (<$SH>) {
+ while (<$SH>) {
if ($opt_v) {
print "<-- $_";
} else {
print if /\Q$file/;
}
}
-
+
exit;
}
my $transferfile = shift;
my $ft = '';
local $_;
-
+
# get transfer file from FEX server
unless ($SH) {
serverconnect($server,$port);
query_sid($server,$port);
}
-
+
xxget($from,$sid,$transferfile);
-
+
# empty file?
unless (-s $transferfile) {
unlink $transferfile;
exit;
}
-
+
# no further processing if delivering to pipe
exec 'cat',$transferfile unless -t STDOUT;
-
+
if ($ft = `file $transferfile 2>/dev/null`) {
if ($ft =~ /compressed/) {
rename $transferfile,"$transferfile.gz";
shelldo(ws("gunzip $transferfile.gz"));
}
$ft = `file $transferfile`;
- }
+ }
# file command failed, so we look ourself into the file...
elsif (open $transferfile,$transferfile) {
read $transferfile,$_,4;
sub formdatapost {
- my %P = @_;
- my ($boundary,$filename,$filesize,$length,$buf,$file,$fpsize,$resume,$seek);
+ my %P = @_;
+ 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})) {
-
+
$to = $AB{$P{to}} || $P{to}; # for gpg
-
+
# special file: stream from STDIN
if ($opt_s) {
$filename = encode_utf8($file);
$filesize = -1;
}
-
+
# compression?
if ($opt_c) {
my ($if,$of);
$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;
- }
-
+ }
+
# special file: tar-on-the-fly
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";
$filename = encode_utf8($file);
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 ($windoof) {
$filename =~ s/^[a-z]://;
$filename =~ s/.*\\//;
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);
}
}
}
-
+
} else {
$file = $filename = '';
$filesize = 0;
}
FORMDATAPOST:
-
+
@hh = (); # HTTP header
@hb = (); # HTTP body
@r = ();
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
serverconnect($server,$port);
}
}
-
+
# file part size
- if ($chunksize and $proxy and $port != 443
+ if ($chunksize and $proxy and $port != 443
and $filesize - $seek > $chunksize - $bs) {
if ($features !~ /MULTIPOST/) {
die sprintf("$0: server does not support chunked multi-POST needed for"
}
$boundary = randstring(48);
-
+
$P{seek} = $seek;
$P{filesize} = $filesize;
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};
}
}
-
+
# at last, POST the file
if ($file) {
push @hb,"--$boundary";
sleep 3;
goto FORMDATAPOST; # necessary: new $sid ==> new @hh
};
-
+
unless ($opt_d or $flink) {
-
+
$t0 = $t2 = int(time);
$tt = $t0-1;
$t1 = 0;
$tc = 0;
-
+
if ($opt_s) {
if ($opt_g) {
open $file,"gpg -e -r $to|" or die "$0: cannot run gpg - $!\n";
$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;
}
-
+
$bytes = 0;
autoflush $SH 0;
-
+
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_+'};
-
+
# terminate tar verbose output job
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,
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) {
}
return "X-Location: $location\n";
}
-
+
if ($flink) {
$bytes = -s $flink;
if ($bytes>2*M) {
}
# SuSe: Can't locate object method "BINMODE" via package "IO::Socket::SSL::SSL_HANDLE"
- # binmode $SH,':utf8';
-
+ # binmode $SH,':utf8';
+
if (not $opt_q and $file and -t STDOUT) {
print STDERR "\r \r";
}
last if @r and $r[0] =~ / 204 / and /^$/ or /<\/html>/i;
push @r,decode_utf8($_);
}
-
+
if ($file) {
close $SH;
undef $SH;
goto FORMDATAPOST;
}
}
-
+
return @r;
}
$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);
}
print $cmd,"\n" if $opt_v;
open $cmd,"|$cmd" or die "$0: cannot create $zip - $!\n";
- foreach (@_) {
+ foreach (@_) {
print {$cmd} $_."\n";
print " $_\n" if $opt_v;
}
sub getline {
my $file = shift;
local $_;
-
+
while (<$file>) {
chomp;
s/^#.*//;
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);
}
my $ab = "$fexhome/ADDRESS_BOOK";
my (%AB,@r);
local $_;
-
+
die "$0: address book not available for subusers\n" if $skey;
die "$0: address book not available for group members\n" if $gkey;
%AB = query_address_book($server,$port,$user);
if ($AB{ADDRESS_BOOK} !~ /\w/) {
- $AB{ADDRESS_BOOK} =
+ $AB{ADDRESS_BOOK} =
"# Format: alias e-mail-address # Comment\n".
"# Example:\n".
"framstag framstag\@rus.uni-stuttgart.de\n";
open $ab,">$ab" or die "$0: cannot write to $ab - $!\n";
print {$ab} $AB{ADDRESS_BOOK};
close $ab;
-
- system $editor,$ab;
+
+ system "$editor $ab";
exit unless -s $ab;
$opt_o = $opt_A;
-
+
serverconnect($server,$port);
query_sid($server,$port);
-
+
@r = formdatapost(
from => $user,
to => $user,
id => $sid,
file => $ab,
);
-
+
unlink $ab,$ab.'~';
}
serverconnect($server,$port);
query_sid($server,$port);
}
-
+
$req = "GET $proxy_prefix/fop/$user/$user/ADDRESS_BOOK?ID=$sid HTTP/1.1";
sendheader("$server:$port",$req);
$_ = <$SH>;
last if /^$/;
$cl = $1 if /^Content-Length: (\d+)/;
}
-
+
if ($cl) {
while (<$SH>) {
$b += length;
last if $b >= $cl;
}
}
-
+
$AB{ADDRESS_BOOK} = $ab;
-
+
return %AB;
}
$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 $features; # early return if we know enough
- $req = "GET $proxy_prefix/SID HTTP/1.1";
+ $req = "OPTIONS /FEX HTTP/1.1";
+ $req = "HEAD /index.html HTTP/1.1";
} 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/ }
serverconnect($server,$port);
$sid = $id;
}
-
+
# warn "proxy: $proxy\n";
if ($proxy) {
serverconnect($server,$port);
$sid = $id;
}
-
+
}
$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);
}
sleep 1 while ($opt_m and $B/k/(time-$t0||1) > $opt_m);
}
-
+
print STDERR ts($B,$cl),"\n";
- close F;
+ close $save;
}
my ($b,$tb) = @_;
return sprintf("transferred: %d MB (%d%%)",int($b/M),int($b/$tb*100));
}
-
+
sub sigpipehandler {
retry("died");
sub retry {
my $reason = shift;
local $SIG{ALRM} = sub { };
-
+
if (fileno $SH) {
alarm(1);
my @r = <$SH>;
my ($from,$to) = @_;
my @r;
local $_;
-
+
@r = formdatapost(
from => $from,
to => $to,
$_ = 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/) {
my $s = 0;
my $n;
local $_;
-
- while ($s < $ba) {
+
+ while ($s < $ba) {
$n = $ba-$s;
- $n = $bs if $n > $bs;
- $s += read $fh,$_,$n;
+ $n = $bs if $n > $bs;
+ $s += read $fh,$_,$n;
}
}
-# fileid is inode and mtime
sub fileid {
- my @s = stat(shift);
- return @s ? $s[1].$s[9] : int(time);
+ my $file = shift;
+ my @s = 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);
my $fmd = '';
-
+
foreach $file (@files) {
if (not -l $file and -d $file) {
$dir = $file;
while (defined ($file = readdir($dir))) {
next if $file eq '..';
if ($file eq '.') {
- $fmd .= $file.fileid($dir);
+ $fmd .= fileid($dir);
} else {
$fmd .= fmd("$dir/$file");
}
closedir $dir;
}
} else {
- $fmd .= $file.fileid($file);
+ $fmd .= fileid($file);
}
}
-
+
return $fmd;
}
local $_ = shift;
my $uu = '';
my ($i,$l);
-
+
tr|A-Za-z0-9+=/||cd;
s/=+$//;
tr|A-Za-z0-9+/| -_|;
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 $_;
}
sub update {
my $cfb = '### common functions ###';
my $cfc;
-
+
local $/;
-
+
open $0,$0 or die "cannot read $0 - $!\n";
- $_ = <$0>;
+ $cfc = <$0>;
close $0;
- s/.*\n$cfb\n//s;
- $cfc = $_;
-
- foreach my $p (qw(fexget sexsend)) {
+ $cfc =~ s/.*\n$cfb\n//s;
+
+ 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;
}
$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 ($proxy) {
tcpconnect(split(':',$proxy));
if ($https) {
# set up tcp/ip connection
sub tcpconnect {
my ($server,$port) = @_;
-
+
if ($SH) {
close $SH;
undef $SH;
}
-
+
if ($https) {
# eval "use IO::Socket::SSL qw(debug3)";
&enable_ssl;
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;
}
my $sp = shift;
my @head = @_;
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 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