our ($FEXID,$FEXXX,$HOME);
our (%alias);
our $chunksize = 0;
-our $version = 20150729;
+our $version = 20150826;
our $_0 = $0;
our $DEBUG;
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);
$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
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 = $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 }
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>;
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";
}
}
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 $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) {
$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);
} 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";
}
}
}
-
+
# 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 '@') {
}
}
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";
}
}
}
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;
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") };
}
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 {
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,
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;
}
}
my $ma = $HOME.'/.mutt/aliases';
my $alias;
local $_;
-
+
open $ma,$ma or return $to;
while (<$ma>) {
if (/^alias \Q$to\E\s/i) {
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+/| -_|;
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 ($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;
} 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";
-
+
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