X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/e5c93609849bda051fff54b5d5265af5608c6c69..HEAD:/bin/fexsend diff --git a/bin/fexsend b/bin/fexsend index e746b66..fae77e9 100755 --- a/bin/fexsend +++ b/bin/fexsend @@ -17,10 +17,10 @@ use IO::Handle; use IO::Socket::INET; use Getopt::Std; use File::Basename; -use Cwd qw'abs_path'; +use Cwd 'abs_path'; use Fcntl qw':flock :mode'; -use Digest::MD5 qw'md5_hex'; # encrypted ID / SID -use Time::HiRes qw'time'; +use Digest::MD5 'md5_hex'; # encrypted ID / SID +use Time::HiRes 'time'; # use Smart::Comments; use constant k => 2**10; use constant M => 2**20; @@ -31,20 +31,21 @@ eval 'use Net::INET6Glue::INET_is_INET6'; $| = 1; -our ($SH,$fexhome,$idf,$tmpdir,$windoof,$useragent,$editor,$nomail); +our ($SH,$fexhome,$idf,$tmpdir,$windoof,$macos,$useragent,$editor,$nomail); our ($anonymous,$public); our ($tpid,$frecipient); our ($FEXID,$FEXXX,$HOME); our (%alias); our $chunksize = 0; -our $version = 20150826; +our $version = 20160919; our $_0 = $0; -our $DEBUG; +our $DEBUG = $ENV{DEBUG}; my %SSL = (SSL_version => 'TLSv1'); my $sigpipe; if ($Config{osname} =~ /^mswin/i) { + # http://slu.livejournal.com/17395.html $windoof = $Config{osname}; $HOME = $ENV{USERPROFILE}; $fexhome = $ENV{FEXHOME} || $HOME.'\fex'; @@ -54,18 +55,31 @@ if ($Config{osname} =~ /^mswin/i) { $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')) { @@ -88,7 +102,7 @@ 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". @@ -104,6 +118,7 @@ if ($xx) { $usage = <||''; + if (/^y/i) { + my $new = `wget -nv -O- http://fex.belwue.de/download/fexsend`; + my $newversion = $1 if $new =~ /version = (\d+)/; + if ($new !~ /upgrade fexsend/ or not $newversion) { + die "$0: bad update\n"; + } + if ($newversion <= $version) { + die "$0: no newer version\n"; + } + $_0 = abs_path($_0); + system qw'rsync -a',$_0,$_0.'_old'; + exit $? if $?; + open $_0,'>',$_0 or die "$0: cannot write $_0. - $!\n"; + print {$_0} $new; + close $_0; + exec $_0,qw'-V .'; + } + } + exit; + exit if "@ARGV" eq '.'; } if ($opt_K and $opt_D) { @@ -458,6 +521,29 @@ if ($opt_I) { 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; @@ -571,7 +657,7 @@ elsif ($opt_z or $opt_Z or ${'opt_!'}) { &get_log } elsif ($opt_A) { edit_address_book($from) } elsif (${'opt_@'}) { &show_address_book } elsif ($opt_d and $anonymous) { &purge } -elsif ($opt_d and $ARGV[-1] =~ /^\d+$/) { &delete } +elsif ($opt_d and $ARGV[-1] =~ /^\d+$/) { &delete_file_number } else { &send_fex } exit; @@ -697,6 +783,7 @@ sub show_id { my ($fexcgi,$from,$id); if (open $idf,$idf) { $fexcgi = <$idf>; + # $fexcgi = <$idf> if $fexcgi =~ /^\[.+\]/; $from = <$idf>; $id = <$idf>; while (<$idf>) { @@ -745,6 +832,7 @@ sub register { 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; @@ -779,10 +867,464 @@ sub register { } +# 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 = ; + 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 = ||''; + chomp $file; + $file =~ s/^\s+//; + $file =~ s/ $// if $file !~ /\\ $/; + &menu unless $file or $archive; + if ($file eq '*') { + print "Archive name: "; + $archive = ||''; + 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 = ||''; + 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 = ; + $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 = ; + $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 = ; + $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; @@ -800,7 +1342,6 @@ sub send_xx { print "making tar transfer file $transferfile :\n"; # single file? then add this directly if (scalar @ARGV == 1) { - my ($dir,$file); # strip path if not ending with / if ($ARGV[0] =~ m:(.+)/(.+): and $2 !~ m:/$:) { ($dir,$file) = ($1,$2); @@ -947,49 +1488,53 @@ sub query_settings { # 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/) { @@ -1011,12 +1556,13 @@ sub list { s/&/&/g; s/"/\"/g; s/</) { @@ -1108,7 +1654,6 @@ sub delete { sendheader( "$server:$port", "GET $proxy_prefix/fop/$2/$2?DELETE HTTP/1.1", - "User-Agent: $useragent", ); $_ = <$SH>||''; s/\r//; @@ -1139,6 +1684,36 @@ sub delete { } +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 = ''; @@ -1194,7 +1769,7 @@ sub send_fex { 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 $_; @@ -1287,10 +1862,21 @@ sub send_fex { } 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 = ; $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) { @@ -1317,7 +1903,7 @@ sub send_fex { $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"; @@ -1329,6 +1915,10 @@ sub send_fex { # 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); @@ -1358,6 +1948,7 @@ sub send_fex { } else { ## tar is now handled by formdatapost() # system(qw'tar cvf',$transferfile,@ARGV); + system 'true'; @files = ($opt_a); } } elsif ($atype eq 'tgz') { @@ -1403,12 +1994,12 @@ sub send_fex { 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; } @@ -1418,7 +2009,7 @@ sub send_fex { 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"; } } } @@ -1426,7 +2017,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) { - 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( @@ -1443,15 +2034,32 @@ sub send_fex { 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 /

\Q$file/,@r) { $r =~ s/<.+?>//g; print "$r\n"; @@ -1459,7 +2067,8 @@ sub send_fex { 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; @@ -1468,23 +2077,13 @@ sub send_fex { } 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; } } } @@ -1518,10 +2117,10 @@ sub forward { 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'; } @@ -1572,7 +2171,7 @@ sub renotify { 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; @@ -1628,7 +2227,7 @@ sub modify { 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; @@ -1738,17 +2337,19 @@ sub get_xx { sub formdatapost { my %P = @_; - my ($boundary,$filename,$filesize,$length,$buf,$file,$fpsize,$resume,$seek); + my ($boundary,$filename,$length,$buf,$file,$fpsize,$resume,$seek,$nettest); my ($flink); my (@hh,@hb,@r,@pv,$to); - my ($bytes,$t,$bt); + my ($bytes,$b,$t,$bt); my ($t0,$t1,$t2,$tt,$tc); my $bs = 2**16; # blocksize for reading and sending file my $fileid = int(time); my $chunk = 0; + my $filesize = 0; my $connection = ''; my $pct = ''; - my ($tar,$aname,$atype,$tarlist,$tarerror,$location,$transferfile); + my $dittodir = '.'; + my ($tar,$ditto,$aname,$atype,$list,$error,$location,$transferfile); local $_; if (defined($file = $P{file})) { @@ -1771,7 +2372,7 @@ sub formdatapost { $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; } @@ -1779,12 +2380,12 @@ sub formdatapost { 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-"; } @@ -1794,12 +2395,10 @@ sub formdatapost { } } 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; @@ -1814,12 +2413,12 @@ sub formdatapost { 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"; @@ -1827,6 +2426,64 @@ sub formdatapost { 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); @@ -1840,13 +2497,13 @@ sub formdatapost { 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); @@ -1875,25 +2532,33 @@ sub formdatapost { 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 @@ -1935,7 +2600,8 @@ sub formdatapost { 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}; } } @@ -2027,10 +2693,10 @@ sub formdatapost { $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; @@ -2044,13 +2710,21 @@ sub formdatapost { 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; @@ -2061,8 +2735,17 @@ sub formdatapost { 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; @@ -2071,8 +2754,12 @@ sub formdatapost { } 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; @@ -2112,7 +2799,9 @@ sub formdatapost { 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_+'}; @@ -2121,17 +2810,31 @@ sub formdatapost { 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, @@ -2143,7 +2846,7 @@ sub formdatapost { $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, @@ -2157,13 +2860,13 @@ sub formdatapost { } } 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, @@ -2171,7 +2874,7 @@ sub formdatapost { } } - 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..." } } @@ -2179,6 +2882,7 @@ sub formdatapost { 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) { @@ -2270,7 +2974,7 @@ sub zipsplit { $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); @@ -2336,11 +3040,10 @@ sub query_file { 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) { @@ -2377,11 +3080,17 @@ sub query_file { 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); } @@ -2409,7 +3118,7 @@ sub edit_address_book { print {$ab} $AB{ADDRESS_BOOK}; close $ab; - system $editor,$ab; + system "$editor $ab"; exit unless -s $ab; $opt_o = $opt_A; @@ -2510,17 +3219,16 @@ sub query_sid { $sid = $id; - if ($port eq 443) { - return if $features; # early return if we know enough - $req = "OPTIONS FEX HTTP/1.1"; - } elsif ($proxy) { + if ($port eq 443 or $proxy) { + return if $opt_d; return if $features; # early return if we know enough - $req = "GET $proxy_prefix/SID HTTP/1.1"; + $req = "OPTIONS /FEX HTTP/1.1"; # does not work with (some) proxies + $req = "GET /SID HTTP/1.1"; # needed as FEATURES query } else { - $req = "GET SID HTTP/1.1"; + $req = "GET /SID HTTP/1.1"; } - sendheader("$server:$port",$req,"User-Agent: $useragent"); + sendheader("$server:$port",$req); $_ = <$SH>; unless (defined $_ and /\w/) { print "\n" if $opt_v; @@ -2529,16 +3237,44 @@ sub query_sid { 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/ } @@ -2576,7 +3312,7 @@ sub xxget { $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//; @@ -2588,15 +3324,15 @@ 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; + 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); @@ -2609,7 +3345,7 @@ sub xxget { } print STDERR ts($B,$cl),"\n"; - close F; + close $save; } @@ -2665,6 +3401,7 @@ sub checkrecipient { $_ = 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/) { @@ -2745,19 +3482,27 @@ sub readahead { } -# fileid is inode and mtime sub fileid { - my @s = stat(shift); - return @s ? $s[1].$s[9] : int(time); + my $file = shift; + my $dirmode = shift; + my @s = $dirmode ? lstat($file) : stat($file); + + if (@s) { + return md5_hex($file.$s[0].$s[1].$s[7].$s[9]); + } else { + warn "$0: $file - $!\n"; + return int(time); + } } sub get_mutt_alias { my $to = shift; my $ma = $HOME.'/.mutt/aliases'; - my $alias; + my ($alias,$options); local $_; + $to =~ s/(:.+)// and $options = $1; open $ma,$ma or return $to; while (<$ma>) { if (/^alias \Q$to\E\s/i) { @@ -2768,22 +3513,24 @@ sub get_mutt_alias { 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); @@ -2796,7 +3543,10 @@ sub fmd { while (defined ($file = readdir($dir))) { next if $file eq '..'; if ($file eq '.') { - $fmd .= $file.fileid($dir); + $fmd .= fileid($dir); + } elsif (-l "$dir/$file") { + # hack for dangling symlinks: do not raise an error + $fmd .= fileid("$dir/$file",'dirmode'); } else { $fmd .= fmd("$dir/$file"); } @@ -2804,7 +3554,7 @@ sub fmd { closedir $dir; } } else { - $fmd .= $file.fileid($file); + $fmd .= fileid($file); } } @@ -2862,8 +3612,8 @@ sub http_response { 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; @@ -2883,7 +3633,6 @@ sub http_response { die "$0: server error: $error\n"; } - print "<-- $_\n" if $opt_v; return $_; } @@ -2901,12 +3650,11 @@ sub update { local $/; open $0,$0 or die "cannot read $0 - $!\n"; - $_ = <$0>; + $cfc = <$0>; close $0; - s/.*\n$cfb\n//s; - $cfc = $_; + $cfc =~ s/.*\n$cfb\n//s; - foreach my $p (qw(fexget sexsend)) { + foreach my $p (qw'fexget sexsend') { open $p,$p or die "cannot read $p - $!\n"; $_ = <$p>; close $p; @@ -2917,7 +3665,7 @@ sub update { close $p; } - exec "l $0 fexget sexsend"; + exec "l fexsend fexget sexsend"; exit; } @@ -3039,6 +3787,7 @@ sub tcpconnect { if ($SH) { autoflush $SH 1; + binmode $SH; } else { die "$0: cannot connect $server:$port - $@\n"; } @@ -3065,8 +3814,10 @@ sub sendheader { 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"; } @@ -3095,6 +3846,18 @@ sub nvtsend { } +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 = "";