X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/97b87610331f53e756d032ad21db786037f921a1..e5c93609849bda051fff54b5d5265af5608c6c69:/bin/fexsend diff --git a/bin/fexsend b/bin/fexsend index 16235b7..e746b66 100755 --- a/bin/fexsend +++ b/bin/fexsend @@ -37,7 +37,7 @@ our ($tpid,$frecipient); our ($FEXID,$FEXXX,$HOME); our (%alias); our $chunksize = 0; -our $version = 20150729; +our $version = 20150826; our $_0 = $0; our $DEBUG; @@ -84,7 +84,7 @@ my %AB = (); # server based address book 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); @@ -142,18 +142,18 @@ EOD $hints = < 1 and $ARGV[-1] =~ /(^|\/)anonymous/) { } 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"; } @@ -499,8 +499,8 @@ $port = 443 if $server =~ s{https://}{}; $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; } @@ -525,7 +525,7 @@ if ($xx) { $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"; @@ -536,7 +536,7 @@ if ($xx) { &send_xx($transferfile); } exit; -} +} # regular fexsend @@ -560,16 +560,16 @@ unless ($skey or $gkey or $anonymous) { } 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 } @@ -581,14 +581,14 @@ 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"; } @@ -621,7 +621,7 @@ sub init_id { } 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 = ; @@ -643,11 +643,11 @@ sub init_id { print "proxy address (hostname:port or empty if none): "; $proxy = ; $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) { @@ -783,12 +783,12 @@ sub send_xx { 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' } @@ -798,7 +798,7 @@ sub send_xx { 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 / @@ -831,10 +831,10 @@ sub send_xx { } die "$0: no transfer file\n" unless -s $transferfile; - + serverconnect($server,$port); query_sid($server,$port); - + @r = formdatapost( from => $from, to => $from, @@ -843,7 +843,7 @@ sub send_xx { 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); @@ -852,7 +852,7 @@ sub send_xx { print "wget -O- $2 | tar xvzf -\n"; } } - + unlink $transferfile; } @@ -867,7 +867,7 @@ sub query_quotas { 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; @@ -906,12 +906,12 @@ sub query_settings { 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; @@ -987,7 +987,7 @@ sub list { @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; @@ -996,7 +996,7 @@ sub list { s:HTTP/[\d\. ]+::; die "$0: server response: $_\n"; } - + # list sent files if ($opt_l) { open $fexlist,">$fexlist" or die "$0: cannot write $fexlist - $!\n"; @@ -1021,8 +1021,8 @@ sub list { } } close $fexlist; - } - + } + # list received files if ($opt_L) { foreach (@r) { @@ -1049,12 +1049,12 @@ sub show_URL { 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; @@ -1071,7 +1071,7 @@ sub show_address_book { my (%AB,@r); my $alias; local $_; - + %AB = query_address_book($server,$port,$from); foreach $alias (sort keys %AB) { next if $alias eq 'ADDRESS_BOOK'; @@ -1098,7 +1098,7 @@ sub delete { 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 (.+\@.+) :/) { @@ -1149,7 +1149,7 @@ sub send_fex { my $transferfile; my @transferfiles; local $_; - + if ($from =~ /^SUBUSER|GROUPMEMBER$/) { $to = '_'; } else { @@ -1185,7 +1185,7 @@ sub send_fex { } } @to = split(',',lc($to)); - + die $usage unless @ARGV or $opt_a or $opt_s; die $usage if $opt_s and @ARGV; @@ -1212,9 +1212,9 @@ sub send_fex { } } elsif ($public) { } else { - + query_sid($server,$port); - + if ($from eq 'SUBUSER') { $skey = $sid; # die "skey=$skey\nid=$id\nsid=$sid\n"; @@ -1223,7 +1223,7 @@ sub send_fex { if ($from eq 'GROUPMEMBER') { $gkey = $sid; } - + if ($to eq '.') { @to = ($from); $opt_C ||= 'NOMAIL'; @@ -1257,25 +1257,25 @@ sub send_fex { } } # 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); @@ -1371,25 +1371,25 @@ sub send_fex { } 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; @@ -1397,7 +1397,7 @@ sub send_fex { die $usage; } } - + foreach (@ARGV) { my $file = $_; unless ($opt_d) { @@ -1422,7 +1422,7 @@ sub send_fex { } } } - + foreach my $file (@files) { sleep 1; # do not overrun server! unless (-s $file or $opt_d or $opt_a or $opt_s) { @@ -1437,7 +1437,7 @@ sub send_fex { file => $file, keep => $opt_k, comment => $opt_C, - autodelete => $opt_D, + autodelete => $opt_D, ); if (not @r or not grep /\w/,@r) { @@ -1468,7 +1468,7 @@ sub send_fex { } 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"; @@ -1488,7 +1488,7 @@ sub send_fex { } } } - + # delete transfer tmp file unlink $transferfile if $transferfile; } @@ -1499,7 +1499,7 @@ sub forward { 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 '@') { @@ -1529,7 +1529,7 @@ sub forward { } } close $fexlist; - + unless ($n) { die "$0: file #$opt_f not found in fexlist\n"; } @@ -1538,7 +1538,7 @@ sub forward { 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; @@ -1551,11 +1551,11 @@ sub forward { $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"; } @@ -1579,7 +1579,7 @@ sub renotify { } } close $fexlist; - + unless ($n) { die "$0: file #$opt_N not found in fexlist\n"; } @@ -1588,7 +1588,7 @@ sub renotify { serverconnect($server,$port); query_sid($server,$port); - + $req = "GET $proxy_prefix/fup?" ."from=$from&ID=$sid&dkey=$dkey&command=RENOTIFY" ." HTTP/1.1"; @@ -1603,7 +1603,7 @@ sub renotify { $file = $3; } } - + if ($file) { print "notification e-mail for $file has been resent to $recipient\n"; } else { @@ -1613,7 +1613,7 @@ sub renotify { die "$0: server failed, rerun command with option -v\n"; } } - + exit; } @@ -1622,10 +1622,10 @@ sub modify { 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) { @@ -1637,16 +1637,16 @@ sub modify { } } 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; @@ -1655,14 +1655,14 @@ sub modify { $req .= " HTTP/1.1"; sendheader("$server:$port",$req); http_response(); - while (<$SH>) { + while (<$SH>) { if ($opt_v) { print "<-- $_"; } else { print if /\Q$file/; } } - + exit; } @@ -1671,31 +1671,31 @@ sub get_xx { 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; @@ -1737,7 +1737,7 @@ sub get_xx { sub formdatapost { - my %P = @_; + my %P = @_; my ($boundary,$filename,$filesize,$length,$buf,$file,$fpsize,$resume,$seek); my ($flink); my (@hh,@hb,@r,@pv,$to); @@ -1752,15 +1752,15 @@ sub formdatapost { 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); @@ -1773,8 +1773,8 @@ sub formdatapost { $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; @@ -1825,12 +1825,12 @@ sub formdatapost { $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/.*\\//; @@ -1858,14 +1858,14 @@ sub formdatapost { } } } - + } else { $file = $filename = ''; $filesize = 0; } FORMDATAPOST: - + @hh = (); # HTTP header @hb = (); # HTTP body @r = (); @@ -1877,11 +1877,11 @@ sub formdatapost { 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}, @@ -1900,9 +1900,9 @@ sub formdatapost { 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" @@ -1915,7 +1915,7 @@ sub formdatapost { } $boundary = randstring(48); - + $P{seek} = $seek; $P{filesize} = $filesize; @@ -1938,7 +1938,7 @@ sub formdatapost { push @hb,encode_utf8($P{$v}); } } - + # at last, POST the file if ($file) { push @hb,"--$boundary"; @@ -2003,14 +2003,14 @@ sub formdatapost { 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"; @@ -2055,10 +2055,10 @@ sub formdatapost { } binmode $file; } - + $bytes = 0; autoflush $SH 0; - + print $rcamel[0] if ${'opt_+'}; $SIG{ALRM} = sub { retry("timed out") }; @@ -2114,21 +2114,21 @@ sub formdatapost { } 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)", @@ -2170,13 +2170,13 @@ sub formdatapost { 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"; @@ -2193,7 +2193,7 @@ sub formdatapost { } return "X-Location: $location\n"; } - + if ($flink) { $bytes = -s $flink; if ($bytes>2*M) { @@ -2208,8 +2208,8 @@ sub formdatapost { } # 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"; } @@ -2219,7 +2219,7 @@ sub formdatapost { last if @r and $r[0] =~ / 204 / and /^$/ or /<\/html>/i; push @r,decode_utf8($_); } - + if ($file) { close $SH; undef $SH; @@ -2227,7 +2227,7 @@ sub formdatapost { goto FORMDATAPOST; } } - + return @r; } @@ -2305,7 +2305,7 @@ sub zip { } 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; } @@ -2318,7 +2318,7 @@ sub zip { sub getline { my $file = shift; local $_; - + while (<$file>) { chomp; s/^#.*//; @@ -2338,7 +2338,7 @@ sub query_file { my ($head,$location); my ($response,$fexsrv); local $_; - + $to =~ s/,.*//; $to =~ s/:\w+=.*//; $to = $AB{$to} if $AB{$to}; @@ -2381,7 +2381,7 @@ sub query_file { # return true seek only if file is identified $seek = 0 if $qfileid and $qfileid ne $fileid; - + return ($seek,$location); } @@ -2392,7 +2392,7 @@ sub edit_address_book { 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; @@ -2400,7 +2400,7 @@ sub edit_address_book { %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"; @@ -2408,22 +2408,22 @@ sub edit_address_book { 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.'~'; } @@ -2438,7 +2438,7 @@ sub query_address_book { 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>; @@ -2465,7 +2465,7 @@ sub query_address_book { last if /^$/; $cl = $1 if /^Content-Length: (\d+)/; } - + if ($cl) { while (<$SH>) { $b += length; @@ -2495,9 +2495,9 @@ sub query_address_book { last if $b >= $cl; } } - + $AB{ADDRESS_BOOK} = $ab; - + return %AB; } @@ -2528,7 +2528,7 @@ sub query_sid { } 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); @@ -2555,13 +2555,13 @@ sub query_sid { serverconnect($server,$port); $sid = $id; } - + # warn "proxy: $proxy\n"; if ($proxy) { serverconnect($server,$port); $sid = $id; } - + } @@ -2587,13 +2587,13 @@ sub xxget { } 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; @@ -2607,7 +2607,7 @@ sub xxget { } sleep 1 while ($opt_m and $B/k/(time-$t0||1) > $opt_m); } - + print STDERR ts($B,$cl),"\n"; close F; } @@ -2618,7 +2618,7 @@ sub ts { my ($b,$tb) = @_; return sprintf("transferred: %d MB (%d%%)",int($b/M),int($b/$tb*100)); } - + sub sigpipehandler { retry("died"); @@ -2627,7 +2627,7 @@ sub sigpipehandler { sub retry { my $reason = shift; local $SIG{ALRM} = sub { }; - + if (fileno $SH) { alarm(1); my @r = <$SH>; @@ -2654,7 +2654,7 @@ sub checkrecipient { my ($from,$to) = @_; my @r; local $_; - + @r = formdatapost( from => $from, to => $to, @@ -2736,11 +2736,11 @@ sub readahead { 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; } } @@ -2757,7 +2757,7 @@ sub get_mutt_alias { my $ma = $HOME.'/.mutt/aliases'; my $alias; local $_; - + open $ma,$ma or return $to; while (<$ma>) { if (/^alias \Q$to\E\s/i) { @@ -2788,7 +2788,7 @@ sub fmd { my @files = @_; my ($file,$dir); my $fmd = ''; - + foreach $file (@files) { if (not -l $file and -d $file) { $dir = $file; @@ -2807,7 +2807,7 @@ sub fmd { $fmd .= $file.fileid($file); } } - + return $fmd; } @@ -2817,7 +2817,7 @@ sub decode_b64 { local $_ = shift; my $uu = ''; my ($i,$l); - + tr|A-Za-z0-9+=/||cd; s/=+$//; tr|A-Za-z0-9+/| -_|; @@ -2897,15 +2897,15 @@ sub ws { 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>; @@ -2942,9 +2942,9 @@ sub get_ssl_env { $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); @@ -2987,7 +2987,7 @@ sub serverconnect { my ($server,$port) = @_; my $connect = "CONNECT $server:$port HTTP/1.1"; local $_; - + if ($proxy) { tcpconnect(split(':',$proxy)); if ($https) { @@ -3014,12 +3014,12 @@ sub serverconnect { # 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; @@ -3036,13 +3036,13 @@ sub tcpconnect { Proto => 'tcp', ); } - + if ($SH) { autoflush $SH 1; } else { die "$0: cannot connect $server:$port - $@\n"; } - + print "TCPCONNECT to $server:$port\n" if $opt_v; } @@ -3063,9 +3063,9 @@ 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"; @@ -3077,12 +3077,12 @@ sub sendheader { 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) { @@ -3090,7 +3090,7 @@ sub nvtsend { return 0; } } - + return 1; } @@ -3100,7 +3100,7 @@ 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+/|;