our ($FEXID,$FEXXX,$HOME);
our (%alias);
our $chunksize = 0;
-our $version = 20150120;
+our $version = 20150826;
our $_0 = $0;
our $DEBUG;
my $fexcgi; # F*EX CGI URL
my @files; # files to send
my %AB = (); # server based address book
-my ($server,$port,$sid);
+my ($server,$port,$sid,$https);
my $proxy = '';
my $proxy_prefix = '';
-my $features = '';
+my $features = '';
my $timeout = 30; # server timeout
my $fexlist = "$tmpdir/fexlist";
my ($usage,$hints);
or: $0 -x \# [-C -k -D -K -S]
options: -v verbose mode
-d delete file on fex server
- -c compress file
+ -c compress file with gzip
-g encrypt file with gpg
-m limit limit throughput (kB/s)
-i tag use ID data [tag] from ID file
$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,
$0 -b # other\@address
Where # is the file number.
+You can list an uploaded file in more detail with
+ $0 -l #
+Where # is the file number.
+
If you want to modify the keep time, comment or auto-delete behaviour of an
already uploaded file then you first have to query the file number with:
$0 -l
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
For HTTPS you can set the environment variables:
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 \\\\/\\\\/
',
'\e[A //\\\\//\\\\
');
$opt_u = $opt_f = $opt_a = $opt_C = $opt_i = $opt_b = $opt_P = $opt_X = '';
$opt_s = $opt_r = '';
$_ = "$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:=:#:')
or die $usage;
if ($opt_H) {
print $hints;
exit;
}
-
+
if ($opt_V) {
print "Version: $version\n";
}
-
+
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;
}
} 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 = 443 if $server =~ s{https://}{};
$port = $1 if $server =~ s/:(\d+)//;
-if (0 and $port == 443) {
- $opt_s and die "$0: cannot use -s with https due to stunnel bug\n";
- $opt_g and die "$0: cannot use -g with https due to stunnel bug\n";
+if ($port == 443) {
+ # $opt_s and die "$0: cannot use -s with https due to stunnel bug\n";
+ # $opt_g and die "$0: cannot use -g with https due to stunnel bug\n";
+ $https = $port;
}
$server =~ s{http://}{};
$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 }
else { &send_fex }
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>;
if ($fexcgi =~ /\?/) {
$from = $1 if $fexcgi =~ /\bfrom=(.+?)(&|$)/i;
$id = $1 if $fexcgi =~ /\bid=(.+?)(&|$)/i;
- $skey = $1 if $fexcgi =~ /\bskey=(.+?)(&|$)/i;
- $gkey = $1 if $fexcgi =~ /\bgkey=(.+?)(&|$)/i;
+ # $skey = $1 if $fexcgi =~ /\bskey=(.+?)(&|$)/i;
+ # $gkey = $1 if $fexcgi =~ /\bgkey=(.+?)(&|$)/i;
+ die "$0: cannot use GKEY URL in ID file\n" if $fexcgi =~ /gkey=/i;
+ die "$0: cannot use SKEY URL in ID file\n" if $fexcgi =~ /skey=/i;
$fexcgi =~ s/\?.*//;
}
unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) {
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 $transferfile = shift;
my $file = '';
my (@r,@tar);
-
+
$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 /
}
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;
@r = formdatapost(
from => $from,
to => $opt_l ? '*' : $from,
- command => $opt_C,
+ command => $opt_C,
);
}
die "$0: no response from fex server $server\n" unless @r;
s:HTTP/[\d\. ]+::;
die "$0: server response: $_\n";
}
-
+
# list sent files
if ($opt_l) {
open $fexlist,">$fexlist" or die "$0: cannot write $fexlist - $!\n";
else { $dkey = '' }
# $_ = encode_utf8($_);
s/<.*?>//g;
+ s/&/&/g;
+ s/"/\"/g;
+ s/</</g;
if (/^(to .* :)/) {
print "\n$1\n";
print {$fexlist} "\n$1\n";
}
}
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';
while (@ARGV) {
$opt_d = shift @ARGV;
die "$usage: $0 -d #\n" if $opt_d !~ /^\d+$/;
-
+
open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
while (<$fexlist>) {
if (/^to (.+\@.+) :/) {
my @files = ();
my ($data,$aname,$alias);
my (@r,$r);
- my $ma = $HOME.'/.mutt/aliases';
my $t0 = time;
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;
}
} 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 and open $ma,$ma) {
- $alias = $to;
- while (<$ma>) {
- if (/^alias \Q$to\E\s/i) {
- chomp;
- s/\s*#.*//;
- s/\(.*?\)//;
- s/\s+$//;
- s/.*\s+//;
- s/[<>]//g;
- if (/,/) {
- warn "$0: ignoring mutt multi-alias $to = $alias\n";
- last;
- }
- if (/@/) {
- $alias = $_;
- warn "$0: found mutt alias $to = $alias\n";
- last;
- }
- }
- }
- close $ma;
- $to = $alias;
+ elsif ($to !~ /@/ and $to ne $from) {
+ $to = get_mutt_alias($to);
}
}
}
-
+
$to = join(',',grep /./,@to) or exit;
- warn "Server/User: $fexcgi/$from\n" unless $opt_q;
-
+ # warn "Server/User: $fexcgi/$from\n" unless $opt_q;
+
if (
not $skey and not $gkey
- and $features =~ /CHECKRECIPIENT/
+ and $from ne $to
+ and $features =~ /CHECKRECIPIENT/
and $opt_C !~ /^(DELETE|LIST|RECEIVEDLOG|SENDLOG|FOPLOG)$/
) {
checkrecipient($from,$to);
} 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) {
}
}
}
-
+
foreach my $file (@files) {
sleep 1; # do not overrun server!
unless (-s $file or $opt_d or $opt_a or $opt_s) {
file => $file,
keep => $opt_k,
comment => $opt_C,
- autodelete => $opt_D,
+ autodelete => $opt_D,
);
if (not @r or not grep /\w/,@r) {
}
if (/^(X-)?(Location.*)/i) {
$location = $2;
- if ($from eq $to or $from =~ /^\Q$to\E@/i
+ 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";
+ }
+ }
+ }
}
}
-
+
# delete transfer tmp file
unlink $transferfile if $transferfile;
}
sub forward {
my (@r);
my ($to,$n,$dkey,$file,$req);
- my $status = 1;
+ my ($status,$fp);
local $_;
-
+
# look for single @ in arguments
for (my $i=1; $i<$#ARGV; $i++) {
if ($ARGV[$i] eq '@') {
# if ($windoof and not @ARGV) { &inquire }
$to = pop @ARGV or die $usage;
$to = $from if $to eq '.';
+ if ($to !~ /@/ and $to ne $from) {
+ $to = get_mutt_alias($to);
+ }
open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
while (<$fexlist>) {
}
}
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;
$req .= " HTTP/1.1";
sendheader("$server:$port",$req);
http_response();
- while (<$SH>) {
- if ($opt_v) {
- print;
- $status = 0 if /\Q"$file"/;
- } else {
- if (/\Q"$file"/) {
- print;
- $status = 0;
- }
- }
+ $fp = $file;
+ $fp =~ s/[^\w_.-]/.+/g; # because of UTF8 filename
+ $status = 1;
+ while (<$SH>) {
+ $status = 0 if /"$fp"/;
+ print if $opt_v or /"$fp"/;
}
-
+
if ($status) {
die "$0: server failed, rerun command with option -v\n";
}
}
}
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) {
}
}
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;
if (/^n/i) {
print "keeping $transferfile\n";
} else {
- system("tar xvf $transferfile && rm $transferfile");
+ my $untar = "tar xvf";
+ # if ($> == 0 and `tar --help 2>&1` =~ /gnu/) {
+ # $untar = "tar --no-same-owner -xvf";
+ # }
+ system("$untar $transferfile && rm $transferfile");
die "$0: error while untaring, see $transferfile\n" if -f $transferfile;
}
} else {
sub formdatapost {
- my %P = @_;
+ my %P = @_;
my ($boundary,$filename,$filesize,$length,$buf,$file,$fpsize,$resume,$seek);
my ($flink);
my (@hh,@hb,@r,@pv,$to);
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);
$filesize = -s $transferfile;
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;
$file = "$aname.$atype";
$filename = encode_utf8($file);
undef $SH; # force reconnect (timeout!)
- }
-
+ }
+
# single file
else {
$filename = encode_utf8(${'opt_='} || $file);
-
+
if ($windoof) {
$filename =~ s/^[a-z]://;
$filename =~ s/.*\\//;
}
}
}
-
+
} else {
$file = $filename = '';
$filesize = 0;
}
FORMDATAPOST:
-
+
@hh = (); # HTTP header
@hb = (); # HTTP body
@r = ();
serverconnect($server,$port);
query_sid($server,$port) unless $anonymous;
}
-
+
$P{id} = $sid; # ugly hack!
-
+
# ask server if this file has been already sent
- if ($file and not $xx and not
+ 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},
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,encode_utf8($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";
}
binmode $file;
}
-
+
$bytes = 0;
autoflush $SH 0;
-
+
print $rcamel[0] if ${'opt_+'};
+ $SIG{ALRM} = sub { retry("timed out") };
while (my $b = read $file,$buf,$bs) {
- print {$SH} $buf or &sigpipehandler;
+ alarm($timeout*2);
+ if ($https) {
+ print {$SH} $buf or &sigpipehandler;
+ } else {
+ syswrite $SH,$buf or &sigpipehandler;
+ }
+ alarm(0);
$bytes += $b;
if ($filesize > 0 and $bytes+$seek > $filesize) {
die "$0: $file filesize has grown while uploading\n";
}
close $file; # or die "$0: error while reading $file - $!\n";
$tt = ($t2-$t0)||1;
-
+
print $rcamel[2] if ${'opt_+'};
-
+
# terminate tar verbose output job
if ($tpid) {
sleep 2;
kill 9,$tpid;
unlink $tarlist;
}
-
+
unless ($opt_q) {
if (not $chunksize and $bytes+$seek < $filesize) {
die "$0: $file filesize has shrunk while uploading\n";
}
-
+
if ($seek or $chunksize and $chunksize < $filesize) {
if ($fpsize>2*M) {
printf STDERR "%s: %d MB in %d s (%d kB/s)",
int($bytes/k/$tt);
}
}
-
+
if (-t STDOUT and not ($opt_s or $opt_g)) {
print STDERR "waiting for server ok..."
}
}
}
-
+
autoflush $SH 1;
print {$SH} "\r\n--$boundary--\r\n";
}
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;
}
}
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 ($head,$location);
my ($response,$fexsrv);
local $_;
-
+
$to =~ s/,.*//;
$to =~ s/:\w+=.*//;
$to = $AB{$to} if $AB{$to};
# return true seek only if file is identified
$seek = 0 if $qfileid and $qfileid ne $fileid;
-
+
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;
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;
}
}
s/\r//;
print "<-- $_" if $opt_v;
-
+
if (/^HTTP.* [25]0[01] /) {
if (not $proxy and $port ne 443 and /^HTTP.* 201 (.+)/) {
$sid = 'MD5H:'.md5_hex($id.$1);
serverconnect($server,$port);
$sid = $id;
}
-
+
# warn "proxy: $proxy\n";
if ($proxy) {
serverconnect($server,$port);
$sid = $id;
}
-
+
}
}
die "$0: no Content-Length in server-reply\n" unless $cl;
-
+
open F,">$save" or die "$0: cannot write to $save - $!\n";
binmode F;
-
+
$t0 = $t1 = int(time);
$tso = '';
-
+
while ($b = read($SH,$_,$bs)) {
$B += $b;
print F;
}
sleep 1 while ($opt_m and $B/k/(time-$t0||1) > $opt_m);
}
-
+
print STDERR ts($B,$cl),"\n";
close F;
}
my ($b,$tb) = @_;
return sprintf("transferred: %d MB (%d%%)",int($b/M),int($b/$tb*100));
}
-
+
sub sigpipehandler {
- $SIG{ALRM} = sub { };
+ retry("died");
+}
+
+sub retry {
+ my $reason = shift;
+ local $SIG{ALRM} = sub { };
+
if (fileno $SH) {
alarm(1);
- @_ = <$SH>;
+ my @r = <$SH>;
alarm(0);
kill 9,$tpid if $tpid;
- if (@_ and $opt_v) {
- die "\n$0: ($$) server error: @_\n";
+ if (@r and $opt_v) {
+ die "\n$0: ($$) server error: @r\n";
}
- if (@_ and $_[0] =~ /^HTTP.* \d+ (.*)/) {
+ if (@r and $r[0] =~ /^HTTP.* \d+ (.*)/) {
die "\n$0: server error: $1\n";
}
}
$timeout *= 2;
- warn "\n$0: connection to $server died\n";
+ warn "\n$0: connection to $server $reason\n";
warn "retrying after $timeout seconds...\n";
sleep $timeout;
if ($windoof) { exec $^X,$0,@_ARGV }
my ($from,$to) = @_;
my @r;
local $_;
-
+
@r = formdatapost(
from => $from,
to => $to,
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;
}
}
}
+sub get_mutt_alias {
+ my $to = shift;
+ my $ma = $HOME.'/.mutt/aliases';
+ my $alias;
+ local $_;
+
+ open $ma,$ma or return $to;
+ while (<$ma>) {
+ if (/^alias \Q$to\E\s/i) {
+ chomp;
+ s/\s*#.*//;
+ s/\(.*?\)//;
+ s/\s+$//;
+ s/.*\s+//;
+ s/[<>]//g;
+ if (/,/) {
+ warn "$0: ignoring mutt multi-alias $to = $alias\n";
+ last;
+ }
+ if (/@/) {
+ $alias = $_;
+ warn "$0: found mutt alias $to = $alias\n";
+ last;
+ }
+ }
+ }
+ close $ma;
+ return ($alias||$to);
+}
+
+
# collect file meta data (filename, inode, mtime)
sub fmd {
my @files = @_;
my ($file,$dir);
my $fmd = '';
-
+
foreach $file (@files) {
if (not -l $file and -d $file) {
$dir = $file;
$fmd .= $file.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//;
# CGI fatalsToBrowser
if (/^HTTP.* 500/) {
unless (/^HTTP.* 200/) {
$error = $_;
$error =~ s/HTTP.[\s\d.]+//;
- if ($opt_v) {
- print "<-- $_";
- print "<-- $_" while <$SH>;
+ @r = <$SH> unless @r;
+ @r = () unless @r;
+ foreach (@r) {
+ chomp;
+ $error .= "\n".$_ if /^Location/;
+ print "<-- $_\n" if $opt_v;
}
die "$0: server error: $error\n";
}
sub update {
my $cfb = '### common functions ###';
my $cfc;
-
+
local $/;
-
+
open $0,$0 or die "cannot read $0 - $!\n";
$_ = <$0>;
close $0;
s/.*\n$cfb\n//s;
$cfc = $_;
-
+
foreach my $p (qw(fexget sexsend)) {
open $p,$p or die "cannot read $p - $!\n";
$_ = <$p>;
$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 ($opt_v and $port == 443 and %SSL) {
- foreach my $v (keys %SSL) {
- printf "%s => %s\n",$v,$SSL{$v};
- }
- }
-
+
if ($proxy) {
tcpconnect(split(':',$proxy));
- if ($port == 443) {
+ if ($https) {
printf "--> %s\n",$connect if $opt_v;
nvtsend($connect,"");
$_ = <$SH>;
unless (/^HTTP.1.. 200/) {
die "$0: proxy error : $_";
}
- eval "use IO::Socket::SSL";
- die "$0: cannot load IO::Socket::SSL\n" if $@;
+ &enable_ssl;
$SH = IO::Socket::SSL->start_SSL($SH,%SSL);
}
} else {
tcpconnect($server,$port);
}
-# if ($port == 443 and $opt_v) {
+# if ($https and $opt_v) {
# printf "%s\n",$SH->get_cipher();
# }
}
# set up tcp/ip connection
sub tcpconnect {
my ($server,$port) = @_;
-
+
if ($SH) {
close $SH;
undef $SH;
}
-
- if ($port == 443) {
+
+ if ($https) {
# eval "use IO::Socket::SSL qw(debug3)";
- eval "use IO::Socket::SSL";
- die "$0: cannot load IO::Socket::SSL\n" if $@;
+ &enable_ssl;
$SH = IO::Socket::SSL->new(
PeerAddr => $server,
PeerPort => $port,
Proto => 'tcp',
);
}
-
+
if ($SH) {
autoflush $SH 1;
} else {
die "$0: cannot connect $server:$port - $@\n";
}
-
+
print "TCPCONNECT to $server:$port\n" if $opt_v;
}
+sub enable_ssl {
+ eval "use IO::Socket::SSL";
+ die "$0: cannot load IO::Socket::SSL\n" if $@;
+ eval '$SSL{SSL_verify_mode} = 0 if Net::SSLeay::SSLeay() <= 9470143';
+ if ($opt_v) {
+ foreach my $v (keys %SSL) {
+ printf "%s => %s\n",$v,$SSL{$v};
+ }
+ }
+}
+
+
sub sendheader {
my $sp = shift;
my @head = @_;
my $head;
-
+
push @head,"Host: $sp";
-
+
foreach $head (@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;
}
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