Package: release.debian.org Severity: normal User: release.debian.org@packages.debian.org Usertags: unblock Please unblock package fex Version 20150120-2 fixes a security race condition where the cleanup script would delete a state of a freshly registered user (if registration is allowed) granting full user privileges instead of restricted ones (if so configured). Also the version 20150120-2 fixes that the fex-utils by default don't connect to SSLv3 any more (and other SSL parameters are configurable). Attached is the (quite large) diff against the version in testing (20140917-2) which however has multiple copies of the same update (in every cli client) and does contain upstreams new copy of the cli tools in htdocs/download (as well as 3 scripts that upstream needs yet we don't ship in the deb). Stripping the diff down to what we need gives more or less this: bin/fac | 56 ++ bin/fbm | 58 ++ bin/fex_cleanup | 55 ++ bin/fexget | 400 +++++++++++++++----- bin/fexsend | 614 ++++++++++++++++++++++--------- bin/fexsrv | 19 bin/fexwall | 37 + bin/logwatch | 67 ++- bin/sexget | 211 +++++++++- bin/sexsend | 211 +++++++++- bin/sexxx | 211 +++++++++- bin/xx | 614 ++++++++++++++++++++++--------- cgi-bin/fac | 2 cgi-bin/foc | 14 cgi-bin/fop | 6 cgi-bin/fuc | 35 + cgi-bin/fup | 347 +++++++++-------- cgi-bin/fur | 29 + cgi-bin/rup | 38 - cgi-bin/sex | 16 debian/changelog | 29 + debian/control | 6 debian/fex.lintian-overrides | 3 debian/fex.postinst | 4 debian/htdocs.md5/20150120-2 | 26 + debian/patches/03_fexget_search_ca.patch | 123 ++++++ debian/patches/series | 1 debian/rules | 2 doc/Changes | 47 ++ doc/Contribs | 5 doc/SSL | 4 doc/concept | 45 +- doc/installation | 7 doc/newfeatures | 21 + doc/version | 2 htdocs/FAQ/admin.faq | 11 htdocs/FAQ/faq.pl | 31 + htdocs/FAQ/meta.faq | 4 htdocs/FAQ/user.faq | 40 +- htdocs/features.html | 1 htdocs/version | 2 lib/dop | 56 ++ lib/fex.ph | 5 lib/fex.pp | 112 ++++- lib/fup.pl | 6 locale/czech/htdocs/FAQ.html | 271 ------------- locale/german/htdocs/FAQ.html | 2 locale/italian/htdocs/FAQ.html | 3 locale/spanish/htdocs/FAQ.html | 6 locale/translations | 255 ++++++++---- 50 files changed, 3001 insertions(+), 1169 deletions(-) unblock fex/20150120-2 TIA! Best, Kilian
diff -Nru fex-20140917/bin/afex fex-20150120/bin/afex --- fex-20140917/bin/afex 2013-08-29 09:40:16.000000000 +0200 +++ fex-20150120/bin/afex 2014-12-24 01:17:15.000000000 +0100 @@ -4,7 +4,7 @@ # # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> # -# Copyright: Perl Artistic +# Perl Artistic Licence $fexserver = ''; diff -Nru fex-20140917/bin/asex fex-20150120/bin/asex --- fex-20140917/bin/asex 2013-08-29 09:40:16.000000000 +0200 +++ fex-20150120/bin/asex 2014-12-24 01:17:15.000000000 +0100 @@ -4,7 +4,7 @@ # # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> # -# Copyright: Perl Artistic +# Perl Artistic Licence $fexserver = ''; diff -Nru fex-20140917/bin/fac fex-20150120/bin/fac --- fex-20140917/bin/fac 2014-08-27 18:51:44.000000000 +0200 +++ fex-20150120/bin/fac 2014-12-08 16:02:19.000000000 +0100 @@ -57,8 +57,8 @@ $EDITOR = $ENV{EDITOR} || $ENV{VISUAL} || (-x '/usr/bin/editor' ? '/usr/bin/editor' : 'vi'); -$opt_c = $opt_v = $opt_l = $opt_h = $opt_w = $opt_u = $opt_R = $opt_M = 0; -$opt_E = 0; +$opt_c = $opt_v = $opt_l = $opt_L = $opt_h = $opt_w = $opt_u = $opt_R = 0; +$opt_M = $opt_E = 0; $opt_r = $opt_d = $opt_q = $opt_a = $opt_n = $opt_k = $opt_m = ''; $opt_y = $opt_S = $opt_C = $opt_D = $opt_A = $opt_V = $opt_P = ''; ${'opt_/'} = ''; @@ -80,9 +80,9 @@ warn "WARNING: \$spooldir differs from $FEXHOME/spool !\n"; } -getopts('hcvlwuMRE/q:r:d:a:n:k:m:y:S:C:A:V:D:P:') or usage(2); -usage(0) if $opt_h; -example() if $opt_E; +getopts('hcvlLwuMRE/q:r:d:a:n:k:m:y:S:C:A:V:D:P:') or usage(2); +usage(0) if $opt_h; +examples() if $opt_E; if (${'opt_/'}) { my $admin = shift; @@ -155,7 +155,7 @@ exit; } -# resend notification e-mails +# list files or resend notification e-mails if ($opt_M) { my ($mtime,$comment,$file,$keep); local $_; @@ -220,12 +220,40 @@ exit; } +# list files detailed +if ($opt_L) { + my $filter = shift; + my ($comment,$file,$keep,$old,$size,$download); + local $_; + + foreach $file (glob "*/*/*/data") { + next if $file =~ m:(.+?)/: and -l $1; + $size = -s $file or next; + $file =~ s:/data$::; + next if $filter and $file !~ /$filter/; + $comment = slurp("$file/comment")||''; + $dkey = readlink("$file/dkey")||''; + $keep = readlink("$file/keep")||$keep_default; + $old = int((time-mtime("$file/data"))/60/60/24); + $download = join(' & ',split("\n",(slurp("$file/download")||''))); + print "\n$file\n"; + printf " comment: %s\n",decode_utf8($comment); + printf " size: %s\n",d3($size); + printf " sender ip: %s\n",readlink("$file/ip")||''; + printf " expire in: %s days\n",$keep-$old; + printf " upload speed: %s kB/s\n",readlink("$file/speed")||0; + printf " URL: $durl/$dkey/%3\$s\n",split "/",$file; + printf " download: %s\n",$download; + } + exit; +} + # delete user if ($opt_d) { $idf = "$spooldir/$opt_d/\@"; die "$0: no such user $opt_d\n" unless -f $idf; unlink $idf or die "$0: cannot remove $idf - $!\n"; - unlink "$spooldir/$opt_d/\@ALLOWED_RECIPIENTS"; + foreach $rf (glob "$spooldir/$opt_d/\@*") { unlink $rf } print "$opt_d deleted\n"; exit; } @@ -809,6 +837,13 @@ } +sub d3 { + local $_ = shift; + while (s/(\d)(\d\d\d\b)/$1,$2/) {}; + return $_; +} + + sub usage { my $port = ''; my $proto = 'http'; @@ -839,14 +874,15 @@ $0 -y user [yn] # set user "fex yourself" web default (yes,no) $0 -S fup # file upload statistics $0 -S fop # file download statistics -$0 -A alias:hostname # add new virtual server $0 -v # show server config $0 -c # edit server config +$0 -w # watch fexsrv.log (continously) $0 -l # list pending files with download URLs +$0 -L [filter] # list pending files in detail $0 -M # list pending files with TO/FROM/FILE $0 -M TO/FROM/FILE # resend notification email -$0 -w # watch fexsrv.log (continously) $0 -m "reason" # enter maintenance mode (reason "exit" to leave) +$0 -A alias:hostname # add new virtual server $0 -V virtualhost ... # operations on virtualhost (alias or hostname) $0 -E # show usage examples EOD @@ -856,7 +892,7 @@ exit shift; } -sub example { +sub examples { $0 =~ s:.*/::; print <<EOD; create new user: diff -Nru fex-20140917/bin/fbm fex-20150120/bin/fbm --- fex-20140917/bin/fbm 2013-09-12 18:10:08.000000000 +0200 +++ fex-20150120/bin/fbm 2014-12-02 13:34:20.000000000 +0100 @@ -20,7 +20,7 @@ our ($SH,$windoof,$sigpipe,$useragent); our ($FEXSERVER); -our $version = 20140917; +our $version = 20150120; # server defaults my $server = 'fex.rus.uni-stuttgart.de'; @@ -150,9 +150,59 @@ serverconnect($server,$port); $boundary = randstring(48); - $filename = 'test_'.int(time*1000); + $P{command} = 'CHECKRECIPIENT'; - # send HTTP POST variables + # HTTP POST variables + @pv = qw'from to id command'; + foreach my $v (@pv) { + if ($P{$v}) { + my $name = uc($v); + push @hb,"--$boundary"; + push @hb,"Content-Disposition: form-data; name=\"$name\""; + push @hb,""; + push @hb,$P{$v}; + } + } + push @hb,"--$boundary--"; + + $length = length(join('',@hb)) + scalar(@hb)*2 + $mb*M; + + # HTTP header + push @hh,"POST $proxy_prefix/fup HTTP/1.1"; + push @hh,"Host: $server:$port"; + push @hh,"User-Agent: $useragent"; + push @hh,"Content-Length: $length"; + push @hh,"Content-Type: multipart/form-data; boundary=$boundary"; + push @hh,"Connection: close"; + push @hh,''; + + if ($opt_v) { + printf "--> $_\n" foreach (@hh,@hb); + } + + nvtsend(@hh,@hb) or die "$0: server has closed the connection\n"; + + while (<$SH>) { + s/[\r\n]+//; + print "<-- $_\n" if $opt_v; + push @r,$_; + last if /^$/; + } + + unless (@r and $r[0] =~ / 204 /) { + $_ = $r[0] || ''; + s/^HTTP.[.\d\s]+//; + die "$0: server error: $_\n"; + } + + @hh = (); # HTTP header + @hb = (); # HTTP body + @r = (); + $filename = 'test_'.int(time*1000); + + serverconnect($server,$port); + + # HTTP POST variables @pv = qw'from to id keep autodelete comment filesize'; foreach my $v (@pv) { if ($P{$v}) { @@ -164,7 +214,7 @@ } } - # at last, POST the file + # at last, the file push @hb,"--$boundary"; push @hb,"Content-Disposition: form-data; name=\"FILE\"; filename=\"$filename\""; push @hb,"Content-Type: application/octet-stream"; diff -Nru fex-20140917/bin/fex_cleanup fex-20150120/bin/fex_cleanup --- fex-20140917/bin/fex_cleanup 2014-09-14 01:20:17.000000000 +0200 +++ fex-20150120/bin/fex_cleanup 2014-12-19 00:16:27.000000000 +0100 @@ -106,9 +106,24 @@ } } closedir TO; - @glob = glob "$to/*/* $to/\@MAINUSER/* $to/\@GROUP/*"; - unless (@glob or -f "$to/\@") { - logdel($to,"$to deleted"); + unless (-f "$to/\@PERSISTENT" or $to eq $admin) { + @glob = glob "$to/*/* $to/\@MAINUSER/* $to/\@GROUP/*"; + unless (@glob or -f "$to/\@") { + logdel($to,"$to deleted"); + } + $user = $to; + if ($login_check and -l "$user/.login") { + my $lc = &$login_check(readlink("$user/.login")); + if ($lc) { + if (-f "$user/\@~" and not "$user/@") { + rename "$user/\@~","$user/@" unless $opt_d; + logv("$isodate $user reanimated (login_check)"); + } + } else { + rename "$user/@","$user/\@~" unless $opt_d; + logv("$user deactivated (login_check)"); + } + } } } } @@ -173,8 +188,9 @@ while ($file = readdir D) { if (-f $file) { $mtime = mtime($file); - if ($mtime and $today > 5*$keep_default*DS+$mtime) { - logdel($file,".error/$file deleted"); + if ($mtime and $today > 10*$keep_default*DS+$mtime) { + if ($opt_d) { print "unlink .error/$file\n" } + else { logdel($file,".error/$file deleted") } } } } @@ -328,8 +344,8 @@ next if -e "$user/\@PERSISTENT"; next if $user !~ /@/ or -l $user; next if $user =~ /^(fexmaster|fexmail)/ or $user eq $admin; - next if $login_check and &$login_check(readlink("$user/.login")); - + next if -l "$user/.login"; + if (time > mtime($user)+$expire*DS) { # print "$spooldir/$user\n"; my $locale = readlink "$user/\@LOCALE"; @@ -347,10 +363,11 @@ # vhosts exit if $opt_V; if (%vhost) { - foreach $vhost (values %vhost) { - if (-f "$vhost/lib/fex.ph") { - warn "run $0 on $vhost/spool :\n" if -t or $opt_v; - my $cmd = "FEXLIB=$vhost/lib $_0 -V @_ARGV"; + foreach $vhost (keys %vhost) { + my $fexlib = $vhost{$vhost}.'/lib'; + if (-f "$fexlib/fex.ph") { + warn "run $0 for $vhost :\n" if -t or $opt_v; + my $cmd = "HTTP_HOST=$vhost FEXLIB=$fexlib $_0 -V @_ARGV"; if ($opt_d) { print "$cmd\n" } else { system $cmd } } @@ -508,6 +525,7 @@ ); open $notify,'>',$notify; close $notify; + print "sent reminder for $file\n" if -t or $opt_v; } } } @@ -540,8 +558,7 @@ print "$msg\n"; } else { if ($status = rmrf($file)) { - print L "$isodate $msg\n"; - print "$msg\n" if -t or $opt_v; + logv($msg); } else { print L "$isodate $file DEL FAILED : $!\n"; warn "$file DEL FAILED : $!\n" if -t or $opt_v; @@ -551,12 +568,20 @@ return $status; } + +sub logv { + my $msg = shift; + print L "$isodate $msg\n" unless $opt_d; + print "$msg\n" if -t or $opt_v; +} + + sub verbose { local $_; if ($opt_v) { while ($_ = shift @_) { - s/\n//; - print "$_\n"; + s/\n*$/\n/; + print; } } } diff -Nru fex-20140917/bin/fexget fex-20150120/bin/fexget --- fex-20140917/bin/fexget 2014-08-15 14:31:24.000000000 +0200 +++ fex-20150120/bin/fexget 2015-01-19 13:59:57.000000000 +0100 @@ -6,7 +6,7 @@ # # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> # -# Copyright: Perl Artistic +# Perl Artistic Licence use 5.006; use strict qw'vars subs'; @@ -14,6 +14,7 @@ use POSIX; use Encode; use Getopt::Std; +use File::Basename; use Socket; use IO::Handle; use IO::Socket::INET; @@ -23,13 +24,19 @@ eval 'use Net::INET6Glue::INET_is_INET6'; +$| = 1; + our $SH; our ($fexhome,$idf,$tmpdir,$windoof,$useragent); +our ($xv,%autoview); our $bs = 2**16; # blocksize for tcp-reading and writing file -our $version = 20140917; +our $version = 20150120; our $CTYPE = 'ISO-8859-1'; our $fexsend = $ENV{FEXSEND} || 'fexsend'; +my %SSL = (SSL_version => 'TLSv1'); +my $sigpipe; + # inquire default character set # cannot use "use I18N::Langinfo" because of no windows support! eval { @@ -39,8 +46,6 @@ $CTYPE = langinfo(CODESET()); }; -$version = mtime($0) unless $version; - if ($Config{osname} =~ /^mswin/i) { $windoof = $Config{osname}; $ENV{HOME} = $ENV{USERPROFILE}; @@ -49,6 +54,7 @@ $idf = "$fexhome/id"; $useragent = sprintf("fexget-$version (%s %s)", $Config{osname},$Config{archname}); + $SSL{SSL_verify_mode} = 0; chdir $ENV{USERPROFILE}.'\Desktop'; # open XX,'>XXXXXX';close XX; } else { @@ -62,8 +68,9 @@ $useragent = "fexget-$version ($_)"; } -$| = 1; - +if (-f ($_ = '/etc/fex/config.pl')) { + eval { require } or warn $@; +} my $usage = <<EOD; usage: $0 [-v] [-m limit] [-s filename] [-o] [-k] [-X] [-P proxy:port] F*EX-URL(s) @@ -71,21 +78,49 @@ or: $0 [-v] -f F*EX-URL(s) e-mail-address or: $0 [-v] -a or: $0 -l [-i tag] + or: $0 -H options: -v verbose mode -m limit kB/s -s save to filename (-s- means: write to STDOUT/pipe) -o overwrite existing file -k keep on server after download - -X do not extract archive files + -X do not extract archive files or autoview file -d delete without download -f forward a file to another recipient -a get all files (implies -X) -l list files on server -i tag alternate server/account, see: $fexsend -h -P use Proxy for connection to the F*EX server + -H show hints and examples argument: F*EX-URL may be file number (see: $0 -l) EOD +my $hints = <<'EOD'; +When you download a file with extension .jpg .gif .png or .tif an image viewer +will be started. This can be xv or xdg-open. +In $HOME/.fex/config.pl you can set your prefered autoview applications: + +%autoview = ( + '\.(gif|jpg|png|tiff?)' => 'my_prefered_image_viewer', + '\.(avi|mp4|mov)' => 'vlc -f', + '\.pdf' => 'evince', +); + +For HTTPS you can set the environment variables: +SSLVERIFY=1 # activate server identity verification +SSLVERSION=TLSv1 # this is the default +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 + +You can set these environment variables also in $HOME/.fex/config.pl, as well as +the $opt_* variables, e.g.: + +$ENV{SSLVERSION} = 'TLSv1'; +${'opt_+'} = 1; +$opt_m = 200; +EOD + if ($windoof and not @ARGV and not $ENV{PROMPT}) { # restart with cmd.exe to have mouse cut+paste my $cmd = "cmd /k \"$0\""; @@ -100,12 +135,13 @@ my $chunksize; our ($opt_h,$opt_v,$opt_l,$opt_d,$opt_m,$opt_z,$opt_K,$opt_o,$opt_a); -our ($opt_s,$opt_k,$opt_i,$opt_V,$opt_X,$opt_f,$opt_P,$opt_L); +our ($opt_s,$opt_k,$opt_i,$opt_V,$opt_X,$opt_f,$opt_P,$opt_L,$opt_H); $opt_m = $opt_h = $opt_v = $opt_l = $opt_d = $opt_K = $opt_o = $opt_a = 0; -$opt_V = $opt_X = $opt_f = $opt_L = 0; +$opt_V = $opt_X = $opt_f = $opt_L = $opt_H = 0; ${'opt_+'} = 0; $opt_s = $opt_k = $opt_i = $opt_P = ''; -getopts('hvVlLdkzoaXf+m:s:i:K:P:') or die $usage; +$_ = "$fexhome/config.pl"; require if -f; +getopts('hvVHlLdkzoaXf+m:s:i:K:P:') or die $usage; $opt_k = '?KEEP' if $opt_k; if ($opt_m =~ /(\d+)/) { @@ -116,6 +152,53 @@ print "Version: $version\n" if $opt_V; die $usage if $opt_h; +if ($opt_H) { + print $hints; + exit; +} + +# set SSL/TLS options +$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_ca_file) +) { + my $env = uc($opt); + $env =~ s/_//g; + $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); +} + +if ($SSL{SSL_verify_mode}) { + &search_ca; + unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { + die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; + } +} elsif (defined($SSL{SSL_verify_mode})) { + # user has set SSLVERIFY=0 ! +} else { + &search_ca; + $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; +} + +sub search_ca { + local $_; + return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; + foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { + if (-f) { + $SSL{SSL_ca_file} = $_; + return; + } + } + foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { + if (-f) { + $SSL{SSL_ca_path} = $_; + return; + } + } +} my $ffl = "$tmpdir/fexget"; # F*EX files list (cache) @@ -203,7 +286,7 @@ } } -foreach my $url (@ARGV) { +URL: foreach my $url (@ARGV) { # do not overrun server sleep 1 if $fop; @@ -303,16 +386,38 @@ } } - if (not $opt_X and $download =~ /$atype/) { - if ($download =~ /\.(tgz|tar.gz)$/) { extract('tar tvzf','tar xvzf') } - elsif ($download =~ /\.tar$/) { extract('tar tvf','tar xvf') } - elsif ($download =~ /\.zip$/i) { extract('unzip -l','unzip') } - elsif ($download =~ /\.7z$/i) { extract('7z l','7z x') } - else { die "$0: unknown archive \"$download\"\n" } - if ($? == 0) { - unlink $download; - } else { - die "$0: keeping \"$download\"\n"; + unless ($opt_X) { + + foreach my $a (keys %autoview) { + if ($download =~ /$a$/i and $autoview{$a}) { + printf "run \"%s %s\" [Yn] ? ",$autoview{$a},basename($download); + $_ = <STDIN>||''; + system sprintf("%s %s",$autoview{$a},quote($download)) if /^y|^$/i; + next URL; + } + } + + if ($ENV{DISPLAY} and $download =~ /\.(gif|jpg|png|tiff?)$/i) { + # see also mimeopen and xdg-mime + if (my $xv = $xv || pathsearch('xv') || pathsearch('xdg-open')) { + printf "run \"%s %s\" [Yn] ? ",basename($xv),basename($download); + $_ = <STDIN>||''; + system $xv,$download if /^y|^$/i; + next URL; + } + } + + if ($download =~ /$atype/) { + if ($download =~ /\.(tgz|tar.gz)$/) { extract('tar tvzf','tar xvzf') } + elsif ($download =~ /\.tar$/) { extract('tar tvf','tar xvf') } + elsif ($download =~ /\.zip$/i) { extract('unzip -l','unzip') } + elsif ($download =~ /\.7z$/i) { extract('7z l','7z x') } + else { die "$0: unknown archive \"$download\"\n" } + if ($? == 0) { + unlink $download; + } else { + die "$0: keeping \"$download\"\n"; + } } } @@ -716,29 +821,6 @@ } -# set up tcp/ip connection -sub tcpconnect { - my ($server,$port) = @_; - - if ($port == 443) { - eval "use IO::Socket::SSL"; - $SH = IO::Socket::SSL->new( - PeerAddr => $server, - PeerPort => $port, - Proto => 'tcp', - ); - } else { - $SH = IO::Socket::INET->new( - PeerAddr => $server, - PeerPort => $port, - Proto => 'tcp', - ); - } - die "cannot connect $server:$port - $@\n" unless $SH; - warn "TCPCONNECT to $server:$port\n" if $opt_v; -} - - sub locale { my $string = shift; @@ -756,21 +838,59 @@ } -sub sendheader { - my $sp = shift; - my @head = @_; - my $head; - - push @head,"Host: $sp"; - - foreach $head (@head) { - warn "--> $head\n" if $opt_v; - print {$SH} $head,"\r\n"; +sub pathsearch { + my $prg = shift; + + foreach my $dir (split(':',$ENV{PATH})) { + return "$dir/$prg" if -x "$dir/$prg"; } - warn "-->\n" if $opt_v; - print {$SH} "\r\n"; } + +sub quote { + local $_ = shift; + s/([^\w¡-ÿ_%\/=~:.,-])/\\$1/g; + return $_; +} + + +{ + my $tty; + + sub inquire { + my $prompt = shift; + my $default = shift; + local $| = 1; + local $_; + + if (defined $default) { + unless ($tty) { + chomp($tty = `tty 2>/dev/null`); + eval { local $^W; require "sys/ioctl.ph"; }; + } + + if (defined(&TIOCSTI) and $tty and open($tty,'>',$tty)) { + print $prompt; + foreach my $a (split("",$default)) { ioctl($tty,&TIOCSTI,$a) } + chomp($_ = <STDIN>||''); + } else { + $prompt =~ s/([\?:=]\s*)/ [$default]$1/ or $prompt .= " [$default]"; + print $prompt; + chomp($_ = <STDIN>||''); + $_ = $default unless length; + } + } else { + print $prompt; + chomp($_ = <STDIN>||''); + } + + return $_; + } +} + + +### common functions ### + sub mtime { my @d = localtime((stat shift)[9]); @@ -784,11 +904,64 @@ return $_; } + +sub get_ssl_env { + # set SSL/TLS options + $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_ca_file) + ) { + my $env = uc($opt); + $env =~ s/_//g; + $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); + } + + if ($SSL{SSL_verify_mode}) { + &search_ca; + unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { + die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; + } + } elsif (defined($SSL{SSL_verify_mode})) { + # user has set SSLVERIFY=0 ! + } else { + &search_ca; + $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; + } +} + +sub search_ca { + local $_; + return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; + foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { + if (-f) { + $SSL{SSL_ca_file} = $_; + return; + } + } + foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { + if (-f) { + $SSL{SSL_ca_path} = $_; + return; + } + } +} + + sub serverconnect { 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) { @@ -802,23 +975,78 @@ } eval "use IO::Socket::SSL"; die "$0: cannot load IO::Socket::SSL\n" if $@; - $SH = IO::Socket::SSL->start_SSL($SH); + $SH = IO::Socket::SSL->start_SSL($SH,%SSL); } } else { tcpconnect($server,$port); } +# if ($port == 443 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) { + # eval "use IO::Socket::SSL qw(debug3)"; + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + %SSL + ); + } else { + $SH = IO::Socket::INET->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 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"; + } + print "-->\n" if $opt_v; + print {$SH} "\r\n"; } -my $sigpipe; 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) { @@ -826,39 +1054,21 @@ return 0; } } + + return 1; } -{ - my $tty; - - sub inquire { - my $prompt = shift; - my $default = shift; - local $| = 1; - local $_; - - if (defined $default) { - unless ($tty) { - chomp($tty = `tty 2>/dev/null`); - eval { local $^W; require "sys/ioctl.ph"; }; - } - - if (defined(&TIOCSTI) and $tty and open($tty,'>',$tty)) { - print $prompt; - foreach my $a (split("",$default)) { ioctl($tty,&TIOCSTI,$a) } - chomp($_ = <STDIN>||''); - } else { - $prompt =~ s/([\?:=]\s*)/ [$default]$1/ or $prompt .= " [$default]"; - print $prompt; - chomp($_ = <STDIN>||''); - $_ = $default unless length; - } - } else { - print $prompt; - chomp($_ = <STDIN>||''); - } - - return $_; - } -} +# from MIME::Base64::Perl +sub encode_b64 { + my $res = ""; + my $eol = "\n"; + my $padding; + + pos($_[0]) = 0; + $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); + $res =~ tr|` -_|AA-Za-z0-9+/|; + $padding = (3-length($_[0])%3)%3; + $res =~ s/.{$padding}$/'=' x $padding/e if $padding; + return $res; +} diff -Nru fex-20140917/bin/fexsend fex-20150120/bin/fexsend --- fex-20140917/bin/fexsend 2014-09-05 09:03:47.000000000 +0200 +++ fex-20150120/bin/fexsend 2015-01-16 15:52:53.000000000 +0100 @@ -6,7 +6,7 @@ # # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> # -# Copyright: Perl Artistic +# Perl Artistic Licence use 5.006; use strict qw'vars subs'; @@ -27,17 +27,23 @@ eval 'use Net::INET6Glue::INET_is_INET6'; -our ($SH,$fexhome,$idf,$tmpdir,$windoof,$sigpipe,$useragent,$editor,$nomail); +&update if "@ARGV" eq 'UPDATE'; + +$| = 1; + +our ($SH,$fexhome,$idf,$tmpdir,$windoof,$useragent,$editor,$nomail); our ($anonymous,$public); -our ($tpid); +our ($tpid,$frecipient); our ($FEXID,$FEXXX,$HOME); +our (%alias); our $chunksize = 0; -our $version = 20140917; +our $version = 20150120; our $_0 = $0; our $DEBUG; - -$version ||= mtime($0); - + +my %SSL = (SSL_version => 'TLSv1'); +my $sigpipe; + if ($Config{osname} =~ /^mswin/i) { $windoof = $Config{osname}; $HOME = $ENV{USERPROFILE}; @@ -47,6 +53,7 @@ $editor = $ENV{EDITOR} || 'notepad.exe'; $useragent = sprintf("fexsend-$version (%s %s)", $Config{osname},$Config{archname}); + $SSL{SSL_verify_mode} = 0; } else { $0 =~ s:.*/::; $HOME = (getpwuid($<))[7]||$ENV{HOME}; @@ -61,7 +68,9 @@ chmod 0600,$idf; } -$| = 1; +if (-f ($_ = '/etc/fex/config.pl')) { + eval { require } or warn $@; +} my $from = ''; my $to = ''; @@ -79,7 +88,6 @@ my $timeout = 30; # server timeout my $fexlist = "$tmpdir/fexlist"; my ($usage,$hints); - my $xx = $0 =~ /^xx/; if ($xx) { @@ -97,7 +105,7 @@ usage: $0 [options] file(s) [@] recipient(s) or: $0 [special options] or: $0 -f \# recipient(s) - or: $0 -x \# [-C -k -D -K] + or: $0 -x \# [-C -k -D -K -S] options: -v verbose mode -d delete file on fex server -c compress file @@ -114,13 +122,14 @@ -s stream read data from pipe and upload it with stream name special options: -I initialize ID file or show ID -I tag add alternate ID data (secondary logins) to ID file - -l list sent files numbered (# needed for -f -x -d) + -l list sent files numbered (# needed for -f -x -d -N) -f \# forward already uploaded file to another recipient -x \# modify options -C -k -D -K for already uploaded file -d \# delete file on fex server + -N \# resend notification e-mail -Q check quotas -A edit server address book (aliases) - -U show authorized URL + -S show server/user settings and auth-ID -H show hints, examples and more options -V show version (\# is a file number, see output from $0 -l) @@ -132,7 +141,7 @@ # -R FEX mail self-register your e-mail address at FEX server $hints = <<EOD; -$0 Hints and more options: +$0 hints and more options: usage: $0 [options] file recipient(s) @@ -167,7 +176,7 @@ If you want a Bcc of the notification e-mail then add '!bcc!' to the comment: fexsend -C '!bcc! for me and you' ... -Special options: +Additional special options: -. sends a short instead of a detailed notification e-mail -/ does not upload the file, but tells the server to link it @@ -177,6 +186,7 @@ -q is quiet mode -r ADDRESS sets e-mail Reply-To ADDRESS -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 @@ -204,6 +214,13 @@ 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: +SSLVERIFY=1 # activate server identity verification +SSLVERSION=TLSv1 # this is the default +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 @@ -218,7 +235,27 @@ FEXID="FEXSERVER USER AUTHID" $0 file recipient Example: FEXID="fex.flupp.org gaga\@flupp.org blubb" $0 big.file framstag\@rus.uni-stuttgart.de - + +You can define aliases (and optional fexsend options) in \$HOME/.fex/config.pl: + %alias = ( + 'alias1' => 'user1\@domain1.org', + 'alias2' => 'user2\@domain2.org', + 'both' => 'user1\@domain1.org,user2\@domain2.org', + 'extra' => 'extra\@special.net:-i other -K -k 30', + ); + +fexsend also respects aliases in $HOME/.mutt/aliases +The alias priority is (descending): +\$HOME/.fex/config.pl +\$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; EOD } @@ -255,22 +292,25 @@ our ($opt_q,$opt_h,$opt_H,$opt_v,$opt_m,$opt_c,$opt_k,$opt_d,$opt_l,$opt_I, $opt_K,$opt_D,$opt_u,$opt_f,$opt_a,$opt_C,$opt_R,$opt_M,$opt_L,$opt_Q, $opt_A,$opt_i,$opt_z,$opt_Z,$opt_b,$opt_P,$opt_x,$opt_X,$opt_V,$opt_U, - $opt_s,$opt_o,$opt_g,$opt_F,$opt_n,$opt_r); + $opt_s,$opt_o,$opt_g,$opt_F,$opt_n,$opt_r,$opt_S,$opt_N); if ($xx) { $opt_q = 1 if @ARGV and $ARGV[-1] eq '--' and pop @ARGV or not -t STDOUT; $opt_h = $opt_v = $opt_m = $opt_I = 0; $opt_X = ''; + $_ = "$fexhome/config.pl"; require if -f; getopts('hvIm:') or die $usage; } else { $opt_h = $opt_v = $opt_m = $opt_c = $opt_k = $opt_d = $opt_l = $opt_I = 0; $opt_H = $opt_K = $opt_D = $opt_R = $opt_M = $opt_L = $opt_Q = $opt_A = 0; $opt_x = $opt_o = $opt_g = $opt_V = $opt_U = $opt_F = $opt_n = $opt_q = 0; + $opt_S = $opt_N = 0; ${'opt_@'} = ${'opt_!'} = ${'opt_+'} = ${'opt_.'} = ${'opt_/'} = 0; ${'opt_='} = ${'opt_#'} = ''; $opt_u = $opt_f = $opt_a = $opt_C = $opt_i = $opt_b = $opt_P = $opt_X = ''; $opt_s = $opt_r = ''; - getopts('hHvcdognVDKlILUARWMFzZqQ@!+./r:m:k:u:f:a:s:C:i:b:P:x:X:=:#:') + $_ = "$fexhome/config.pl"; require if -f; + getopts('hHvcdognVDKlILUARWMFzZqQS@!+./r:m:k:u:f:a:s:C:i:b:P:x:X:N:=:#:') or die $usage; if ($opt_H) { @@ -307,16 +347,12 @@ die "$0: you cannot use both options -I and -R\n"; } - if ($opt_R) { - ®ister; - exit; - } - # $opt_C is COMMENT command in F*EX protocol $opt_C = ($opt_d) ? 'DELETE': ($opt_l or $opt_L) ? 'LIST': ($opt_Q) ? 'CHECKQUOTA': + ($opt_S) ? 'LISTSETTINGS': ($opt_Z) ? 'RECEIVEDLOG': ($opt_z) ? 'SENDLOG': (${'opt_!'}) ? 'FOPLOG': @@ -328,12 +364,21 @@ $opt_D; } +&get_ssl_env; + if ($opt_h) { female_mode("show help?") if $opt_F; print $usage; exit; } + +if ($opt_R) { + ®ister; + exit; +} + + die $usage if $opt_m and $opt_m !~ /^\d+/; if ($opt_P) { @@ -492,7 +537,7 @@ &inquire if $windoof and not @ARGV and not ($opt_l or $opt_L or $opt_Q or $opt_A or $opt_U or $opt_I or - $opt_f or $opt_x); + $opt_f or $opt_x or $opt_N); if (${'opt_.'}) { $opt_C = "!SHORTMAIL! $opt_C"; @@ -503,20 +548,18 @@ } unless ($skey or $gkey or $anonymous) { - if ($opt_v) { - if ($FEXID) { - warn "ID data from \$FEXID: $fexcgi $from $id\n"; - } elsif (-f $idf) { - warn "ID data from $idf: $fexcgi $from $id\n"; - } - } - warn "Server/User: $fexcgi/$from\n" unless $opt_q; + if (not $opt_q and ( + $opt_f||$opt_x||$opt_Q||$opt_l||$opt_L||$opt_U||$opt_z||$opt_Z||$opt_A + ||$opt_d||${'opt_!'}||${'opt_@'}) + ) { warn "Server/User: $fexcgi/$from\n" } } 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 } @@ -817,7 +860,51 @@ from => $from, to => $from, id => $sid, - comment => $opt_C, + command => $opt_C, + ); + die "$0: no response from fex server $server\n" unless @r; + $_ = shift @r; + unless (/^HTTP.* 2/) { + s:HTTP/[\d\. ]+::; + die "$0: server response: $_\n"; + } + if (($_) = grep(/^X-Sender-Quota/,@r) and /(\d+)\s+(\d+)/) { + print "sender quota (used): $1 ($2) MB\n"; + } else { + print "sender quota: unlimited\n"; + } + if (($_) = grep(/^X-Recipient-Quota/,@r) and /(\d+)\s+(\d+)/) { + print "recipient quota (used): $1 ($2) MB\n"; + } else { + print "recipient quota: unlimited\n"; + } +} + + +sub query_settings { + my (@r,$r); + local $_; + + female_mode("query settings?") if $opt_F; + + if ($FEXID) { + print "ID data from \$FEXID\n"; + } elsif (-f $idf) { + print "ID data from $idf\n"; + } else { + die "$0: found no ID\n"; + } + print "server: $fexcgi\n"; + print "user: $from\n"; + print "auth-ID: $id\n"; + print "login URL: "; + &show_URL; + + @r = formdatapost( + from => $from, + to => $from, + id => $sid, + command => $opt_C, ); die "$0: no response from fex server $server\n" unless @r; $_ = shift @r; @@ -825,6 +912,18 @@ s:HTTP/[\d\. ]+::; die "$0: server response: $_\n"; } + if (($_) = grep(/^X-Autodelete/,@r) and /:\s+(\w+)/) { + print "autodelete: $1\n"; + } + if (($_) = grep(/^X-Default-Keep/,@r) and /(\d+)/) { + print "default keep: $1 days\n"; + } + if (($_) = grep(/^X-Default-Locale/,@r) and /:\s+(\w+)/) { + print "default locale: $1\n"; + } + if (($_) = grep(/^X-MIME/,@r) and /:\s+(\w+)/) { + print "display file with browser: $1\n"; + } if (($_) = grep(/^X-Sender-Quota/,@r) and /(\d+)\s+(\d+)/) { print "sender quota (used): $1 ($2) MB\n"; } else { @@ -934,7 +1033,6 @@ sub show_URL { printf "%s/fup/%s\n",$fexcgi,encode_b64("from=$from&id=$id"); - exit; } @@ -946,7 +1044,7 @@ from => $from, to => $from, id => $sid, - comment => $opt_C, + command => $opt_C, ); die "$0: no response from fex server $server\n" unless @r; $_ = shift @r; @@ -1135,8 +1233,22 @@ query_sid($server,$port); } foreach $to (@to) { + # alias in local config? + if ($alias{$to}) { + if ($alias{$to} =~ /(.+?):(.+)/) { + my $ato = $1; + my $opt = $2; + my @argv = @_ARGV; + pop @argv; + # special extra upload + system $0,split(/\s/,$opt),@argv,$ato; + $to = ''; + } else { + $to = $alias{$to}; + } + } # alias in server address book? - if ($AB{$to}) { + 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}; @@ -1169,7 +1281,8 @@ } } - $to = join(',',@to); + $to = join(',',grep /./,@to) or exit; + warn "Server/User: $fexcgi/$from\n" unless $opt_q; if ( not $skey and not $gkey @@ -1356,10 +1469,21 @@ } 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); foreach (@r) { - if ($from eq $to or $from =~ /^\Q$to\E@/i or $nomail or $anonymous) { - print "$1\n" if /^X-(Recipient.*)/i; - print "$2\n" if /^(X-)?(Location:.*)/i; + if (/^(X-)?(Recipient.*)/i) { + $recipient = $2; + if (/notification=no/i) { $nonot = 1 } + else { $nonot = 0 } + } + 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"; + } } } } @@ -1440,6 +1564,61 @@ } +sub renotify { + my (@r); + my ($to,$n,$dkey,$file,$req,$recipient); + local $_; + + die $usage if @ARGV; + + open $fexlist,$fexlist or die "$0: $fexlist - $!\n"; + while (<$fexlist>) { + if (/^\s*(\d+)\) (\w+) \[\d+ d\] (.+)/ and $1 eq $opt_N) { + $n = $1; + $dkey = $2; + last; + } + } + close $fexlist; + + unless ($n) { + die "$0: file #$opt_N not found in fexlist\n"; + } + + female_mode("resend notification for file #$opt_N?") if $opt_F; + + serverconnect($server,$port); + query_sid($server,$port); + + $req = "GET $proxy_prefix/fup?" + ."from=$from&ID=$sid&dkey=$dkey&command=RENOTIFY" + ." HTTP/1.1"; + sendheader("$server:$port",$req); + http_response(); + while (<$SH>) { + s/\r//; + print "<-- $_" if $opt_v; + last if /^\s*$/; + if (/^X-Notify: (.+)\/(.+)\/(.+)/) { + $recipient = $1; + $file = $3; + } + } + + if ($file) { + print "notification e-mail for $file has been resent to $recipient\n"; + } else { + if ($opt_v) { + die "$0: server failed\n"; + } else { + die "$0: server failed, rerun command with option -v\n"; + } + } + + exit; +} + + sub modify { my (@r); my ($n,$dkey,$file,$req); @@ -1702,11 +1881,12 @@ 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,$P{to},$P{from},$P{id}, - $filename,$fileid); + ($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; - die "$0: $file has been already transferred\n"; + warn "$0: $file has been already transferred\n"; + return $file; } elsif ($seek and $seek < $filesize) { $resume = " (resuming at byte $seek)"; } elsif ($filesize <= $seek) { @@ -2063,7 +2243,7 @@ $zipbase =~ s/\.zip$//; map { s/([^_\w\+\-\.])/\\$1/g } @files; - open my $ff,"find @files -type f|" or die "$0: cannot search for @_ - $!\n"; + open my $ff,"find @files|" or die "$0: cannot search for @_ - $!\n"; @files = (); zipfile: for (;;) { @@ -2075,7 +2255,8 @@ $zsize = 0; while ($file = <$ff>) { chomp $file; - next if -l $file or not -f $file; + # next if -l $file or not -f $file; + next unless -f $file; $size = -s $file; if ($size > 2147480000) { unlink @zipfiles; @@ -2114,7 +2295,10 @@ } print $cmd,"\n" if $opt_v; open $cmd,"|$cmd" or die "$0: cannot create $zip - $!\n"; - foreach (@_) { print {$cmd} $_."\n" } + foreach (@_) { + print {$cmd} $_."\n"; + print " $_\n" if $opt_v; + } close $cmd or die "$0: zip failed - $!\n"; return $zip; @@ -2137,67 +2321,6 @@ } -sub serverconnect { - my ($server,$port) = @_; - my $connect = "CONNECT $server:$port HTTP/1.1"; - local $_; - - if ($proxy) { - tcpconnect(split(':',$proxy)); - if ($port == 443) { - printf "--> %s\n",$connect if $opt_v; - nvtsend($connect,""); - $_ = <$SH>; - s/\r//; - printf "<-- $_"if $opt_v; - unless (/^HTTP.1.. 200/) { - die "$0: proxy error : $_"; - } - eval "use IO::Socket::SSL"; - die "$0: cannot load IO::Socket::SSL\n" if $@; - $SH = IO::Socket::SSL->start_SSL($SH); - } - } else { - tcpconnect($server,$port); - } -} - - -# set up tcp/ip connection -sub tcpconnect { - my ($server,$port) = @_; - - if ($SH) { - close $SH; - undef $SH; - } - - if ($port == 443) { - eval "use IO::Socket::SSL"; - die "$0: cannot load IO::Socket::SSL\n" if $@; - $SH = IO::Socket::SSL->new( - PeerAddr => $server, - PeerPort => $port, - Proto => 'tcp', - ); - } else { - $SH = IO::Socket::INET->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 query_file { my ($server,$port,$to,$from,$id,$filename,$fileid) = @_; my $seek = 0; @@ -2480,42 +2603,6 @@ } -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"; - } - print "-->\n" if $opt_v; - print {$SH} "\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) { - undef $SH; - return 0; - } - } - - return 1; -} - - # transfer status sub ts { my ($b,$tb) = @_; @@ -2568,6 +2655,7 @@ s/autodelete=\w+/autodelete=$opt_D/ if $opt_D; s/keep=\d+/keep=$opt_k/ if $opt_k; print; + $frecipient ||= (split)[1]; } } } else { @@ -2624,12 +2712,6 @@ } -sub mtime { - my @d = localtime((stat shift)[9]); - return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); -} - - # emulate seek on a pipe sub readahead { my $fh = shift; # filehandle @@ -2706,21 +2788,6 @@ } -# from MIME::Base64::Perl -sub encode_b64 { - my $res = ""; - my $eol = "\n"; - my $padding; - - pos($_[0]) = 0; - $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); - $res =~ tr|` -_|AA-Za-z0-9+/|; - $padding = (3-length($_[0])%3)%3; - $res =~ s/.{$padding}$/'=' x $padding/e if $padding; - return $res; -} - - sub female_mode { local $_; if (open my $tty,'/dev/tty') { @@ -2742,6 +2809,7 @@ sub http_response { local $_ = shift || <$SH>; my @r = @_; + my $error; $_ = <$SH> unless $_; unless (defined $_ and /\w/) { @@ -2755,8 +2823,13 @@ die "$0: server error: $_\n@r\n"; } unless (/^HTTP.* 200/) { - s/HTTP.[\s\d.]+//; - die "$0: server error: $_\n"; + $error = $_; + $error =~ s/HTTP.[\s\d.]+//; + if ($opt_v) { + print "<-- $_"; + print "<-- $_" while <$SH>; + } + die "$0: server error: $error\n"; } print "<-- $_\n" if $opt_v; @@ -2764,6 +2837,48 @@ } +sub ws { + local $_ = shift; + return split; +} + + +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>; + close $p; + s/\n$cfb.*/\n$cfb\n$cfc/s; + system "vv -s $p"; + open $p,'>',$p or die "cannot write $p - $!\n"; + print {$p} $_; + close $p; + } + + exec "l $0 fexget sexsend"; + exit; +} + +### common functions ### + + +sub mtime { + my @d = localtime((stat shift)[9]); + return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); +} + + sub urldecode { local $_ = shift; s/\%([a-f\d]{2})/chr(hex($1))/ige; @@ -2771,7 +2886,170 @@ } -sub ws { - local $_ = shift; - return split; +sub get_ssl_env { + # set SSL/TLS options + $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_ca_file) + ) { + my $env = uc($opt); + $env =~ s/_//g; + $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); + } + + if ($SSL{SSL_verify_mode}) { + &search_ca; + unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { + die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; + } + } elsif (defined($SSL{SSL_verify_mode})) { + # user has set SSLVERIFY=0 ! + } else { + &search_ca; + $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; + } +} + +sub search_ca { + local $_; + return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; + foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { + if (-f) { + $SSL{SSL_ca_file} = $_; + return; + } + } + foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { + if (-f) { + $SSL{SSL_ca_path} = $_; + return; + } + } +} + + +sub serverconnect { + 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) { + printf "--> %s\n",$connect if $opt_v; + nvtsend($connect,""); + $_ = <$SH>; + s/\r//; + printf "<-- $_"if $opt_v; + unless (/^HTTP.1.. 200/) { + die "$0: proxy error : $_"; + } + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->start_SSL($SH,%SSL); + } + } else { + tcpconnect($server,$port); + } +# if ($port == 443 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) { + # eval "use IO::Socket::SSL qw(debug3)"; + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + %SSL + ); + } else { + $SH = IO::Socket::INET->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 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"; + } + print "-->\n" if $opt_v; + print {$SH} "\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) { + undef $SH; + return 0; + } + } + + return 1; +} + + +# from MIME::Base64::Perl +sub encode_b64 { + my $res = ""; + my $eol = "\n"; + my $padding; + + pos($_[0]) = 0; + $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); + $res =~ tr|` -_|AA-Za-z0-9+/|; + $padding = (3-length($_[0])%3)%3; + $res =~ s/.{$padding}$/'=' x $padding/e if $padding; + return $res; } diff -Nru fex-20140917/bin/fexsrv fex-20150120/bin/fexsrv --- fex-20140917/bin/fexsrv 2014-09-16 11:32:41.000000000 +0200 +++ fex-20150120/bin/fexsrv 2014-12-16 15:20:32.000000000 +0100 @@ -77,11 +77,6 @@ SID CHECKRECIPIENT GROUPS QUOTA FILEID MULTIPOST XKEY FILEQUERY FILESTREAM JUP NOSTORE AXEL FEXMAIL FILELINK )); - -# ignore bullshit requests -my $ignore = join('|',( - '^GET /w00tw00t\.at\.ISC\.SANS', -)); $port = 0; @@ -219,11 +214,6 @@ if ($ENV{PROTO} eq 'https') { $port = 443 } else { $port = 80 } } - - if (/$ignore/) { - fexlog($connect,@log,'IGNORED'); - exit; - } } exit unless @header; @@ -241,6 +231,7 @@ $request = shift @header; if ($request !~ /^(GET|HEAD|POST|OPTIONS).*HTTP\/\d\.\d$/i) { fexlog($connect,$request,"DISCONNECT: no HTTP request"); + badlog("no HTTP request: $request"); exit; } @@ -341,7 +332,7 @@ exit; } - if (/^User-Agent: (FDM)/ and $header =~ /\nRange:/) { + if ($header =~ /\nRange:/ and /^User-Agent: (FDM)/) { disconnect($1,"499 Download Manager $1 Not Supported",30); } @@ -776,7 +767,7 @@ sub badlog { my $request = shift; - my $n = 1; + my @n; my $ed = "$spooldir/.error"; local $_; @@ -792,10 +783,10 @@ if (open $ra,"+>>$ed/$ra") { flock($ra,LOCK_EX); seek $ra,0,SEEK_SET; - $n++ while <$ra>; + @n = <$ra>; printf {$ra} "%s %s\n",isodate(time),$request; close $ra; - &$max_error_handler($ra,$n) if $n > $max_error; + &$max_error_handler($ra,@n) if scalar(@n) > $max_error; } } } diff -Nru fex-20140917/bin/fexwall fex-20150120/bin/fexwall --- fex-20140917/bin/fexwall 2014-07-24 15:45:39.000000000 +0200 +++ fex-20150120/bin/fexwall 2015-01-15 09:36:20.000000000 +0100 @@ -62,12 +62,43 @@ close $sig; } +local $/ = "\n"; + chdir $spooldir or die "$0: $spooldir - $!\n"; -@users = grep { s:/@:: } glob("*/@"); +# @users = grep { chomp;s:/@:: } glob("*/@"); +foreach $user (glob("*@*")) { + if (-f "$user/@" and (readlink "$user/\@NOTIFICATION"||'') !~ /no/i) { + push @users,$user; + } +} + +foreach $group (glob "*/\@GROUP/*") { + if (open $group,$group) { + while (<$group>) { + s/#.*//; + s/:.*\n//; + push @users,$_ if /@/; + } + close $group; + } +} + +foreach $subuser (glob "*/\@SUBUSER") { + if (open $subuser,$subuser) { + while (<$subuser>) { + s/#.*//; + s/:.*\n//; + push @users,$_ if /@/; + } + close $subuser; + } +} + # @users = qw'framstag@fex'; die "$0: no users found\n" unless @users or grep /@/,@users; push @users,$bcc; +@users = uniq(@users); open $sendmail,'|-',$sendmail,@users or die "$0: $sendmail - $!\n"; @@ -82,6 +113,10 @@ print "mail sent to:\n",map { "$_\n" } @users; exit; +sub uniq { + my %x; + grep !$x{$_}++,@_; +} sub usage { print "usage: $0 \"SUBJECT\" < mail.text\n"; diff -Nru fex-20140917/bin/l fex-20150120/bin/l --- fex-20140917/bin/l 1970-01-01 01:00:00.000000000 +0100 +++ fex-20150120/bin/l 2014-12-09 12:31:43.000000000 +0100 @@ -0,0 +1,597 @@ +#!/usr/bin/perl -w +# +# l / ll / lf / llf - substitute of the classic ls command +# +# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> +# +# Copyright: GNU General Public License + +use Cwd qw'abs_path'; +use File::Basename; +use Getopt::Std; + +# the name of the game +$0 =~ s:.*/::; + +$ENV{LC_CTYPE} = 'C'; + +# unshift @ARGV,split /\s+/,$ENV{'l_opt'} if $ENV{'l_opt'}; + +@ARGV = grep { chomp } <STDIN> if "@ARGV" eq '-'; + +# parse CLI arguments +$opt_l = $opt_i = $opt_t = $opt_s = $opt_a = $opt_r = $opt_d = $opt_n = 0; +$opt_L = $opt_N = $opt_c = $opt_u = $opt_S = $opt_R = $opt_z = $opt_h = 0; +$opt_U = 0; +${'opt_*'} = ${'opt_?'} = 0; +$opt_m = $opt_f = $opt_F = $opt_D = ''; +&usage if !getopts('hdnlLNitcuarsUSRz*?m:f:D:F:') || $opt_h; +$opt_z = 1 unless $opt_R; +$opt_l = 1 if $0 eq 'll'; +$opt_l = $opt_i = $opt_a = $opt_S = 1 if $0 eq 'lll'; +if ($0 eq 'lf' or $0 eq 'llf') { + unless ($opt_F) { + $opt_F = shift; + unless (length $opt_F) { + print "find regexp: "; + chomp($opt_F = <STDIN>||''); + } + } + $opt_l = $0 if $0 eq 'llf'; + $opt_F = '.' unless length $opt_F; + $opt_R = $opt_F; +} + +$postsort = $opt_t||$opt_s; +$postproc = $postsort||$opt_z; + +&examples if ${'opt_?'}; + +# mark for squeeze operation +$z = $opt_z ? "\0" : ''; + +# default sorting methode +if ($opt_U) { $lcsort = sub { return @_ } } +elsif ($opt_r) { $lcsort = sub { sort { lc $b cmp lc $a } @_ } } +else { $lcsort = sub { sort { lc $a cmp lc $b } @_ } } + +# default: list only files not beginning with a dot +unless ($opt_m) { + if ($opt_a) { $opt_m = '.' } + else { $opt_m = '^[^\.]' } +} + +$older = $newer = 0; + +if ($opt_D) { + if ($opt_D =~ /:(\d+)([mhd])/) { + $older = $1; + my $z = $2 || 's'; + if ($z =~ /m/) { $older *= 60 } + elsif ($z =~ /h/) { $older *= 60*60 } + elsif ($z =~ /d/) { $older *= 60*60*24 } + } elsif ($opt_D =~ /:(\d\d\d\d-\d\d-\d\d)$/) { + $older = $1; + } + if ($opt_D =~ /(\d+)([mhd]):/) { + $newer = $1; + my $z = $2 || 's'; + if ($z =~ /m/) { $newer *= 60 } + elsif ($z =~ /h/) { $newer *= 60*60 } + elsif ($z =~ /d/) { $newer *= 60*60*24 } + } elsif ($opt_D =~ /^(\d\d\d\d-\d\d-\d\d):/) { + $newer = $1; + } +} + +# preselect date field number +if ($opt_c) { $sdf = 'c' } +elsif ($opt_u) { $sdf = 'a' } +else { $sdf = 'm' } + +# any arguments? +if (@ARGV) { @ARGV = &$lcsort(@ARGV) } +else { @ARGV = &getfiles('.') } + +# build files list +&collect(@ARGV); + +# post process files list? +# remark: if no postprocessing, files list has been already printed in list() +if (@LIST && $postproc) { + + # on -t or -s option sort list on date or size + # and then strip of leading sorting pre-string + @LIST = grep { s/.{21}// } reverse sort @LIST if $postsort; + + # squeeze size field (= remove unnecessary spaces) + if ($opt_z and not $opt_f) { + $opt_z = '%'.$opt_z.'s '; + @LIST = grep { s/\0 *([,\d\.\-]+) /sprintf($opt_z,$1)/e } @LIST; + } + + @LIST = reverse @LIST if $opt_r; + + if (not ($opt_t or $opt_U) and grep /^d[rR-][wW-][xX-]/,@LIST) { + foreach (@LIST) { print if /^d/ } + foreach (@LIST) { print unless /^d/ } + } else { + print @LIST; + } +} + +# print statistics summary? +if ($opt_S && $SS) { + print "$SS file(s):"; + printf " r=%d (%s Bytes)",$SS{'-'},&d3($Ss) if $SS{'-'}; + delete $SS{'-'}; + foreach my $type (qw(l d c b p s ?)) { + printf " %s=%d",$type,$SS{$type} if $SS{$type}; + delete $SS{$type}; + } + foreach my $type (keys %SS) { printf " %s=%d",$type,$SS{$type} } + print "\n"; +} + +exit ($found ? 0 : 1); + + +# collect files and build file lists +# +# INPUT: filenames +# +# GLOBAL: @LIST +sub collect { + my @files = @_; + my $f; + + # loop over all argument files/directories + foreach $f (@files) { + + # skip jed and emacs backup files + # next if $f =~ /~$/ and not $opt_a and not $opt_l; + + # recursive? + if ($opt_R) { + + # list single file + if ($opt_L) { + unless (-e $f) { + warn "$0: dangling symlink $f\n"; + next; + } + $f = abs_path($f); + } + list($f); + + # traverse real subdirs + if (-d $f and not -l $f) { + $f =~ s:/*$:/:; + collect(getfiles($f)); + } + + } else { + + # suppress trailing / on -d option + $f =~ s:/$:: if $opt_d; + + # on trailing / list subdirs, too + if ($f =~ m:/$:) { &list(&getfiles($f)) } + elsif ($f eq '') { &list('/') } + else { + if ($opt_L) { + unless (-e $f) { + warn "$0: dangling symlink $f\n"; + next; + } + $f = abs_path($f); + } + list($f); + } + + } + } +} + + +# list file(s) +# +# INPUT: filenames +# +# GLOBAL: @LIST (filenames-list) +sub list { + my @files = @_; + my ($file,$line,$linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates); + my ($day); + + foreach $file (@files) { + + next if $opt_F and not fmatch($file); + next if $opt_N and (not -f $file or -l $file); + + # get file information + # if ($opt_L and stat $file or not $opt_L and lstat $file) { + if (lstat $file) { + ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates) = &info($file); + } elsif ($! eq "Permission denied") { + $linkname = $file; + $inode = $links = $size = $uid = $gid = '?'; + $mode = $opt_l ? '?---------' : '?---'; + $date = '????-??-?? ??:??:??'; + %dates = ('m' => 0, 'a' => 0, 'c' => 0); + } else { + warn "$0: ".quote($file)." - $!\n"; + next; + } + + $day = $date; + $day =~ s/\s.*//; + + if ($older) { + next if $older =~ /-/ and $day gt $older; + next if $older !~ /-/ and $dates{m} > time-$older; + } + if ($newer) { + next if $newer =~ /-/ and $day lt $newer; + next if $newer !~ /-/ and $dates{m} < time-$newer; + } + + if (defined $linkname) { + + # prepend sorting string + $line = ''; + $line = sprintf '%21s',$date if $opt_t; + $line = sprintf '%21s',$size if $opt_s; + + unless ($opt_n) { + $uid = substr($uid,0,8); + $gid = substr($gid,0,8); + } + + # user defined format? + if ($opt_f) { + foreach my $i (split '',$opt_f) { + if ($opt_n) { + $i =~ tr/AD/ad/; + if ($i eq 'm') { $line .= sprintf '%06o ', $mode } + elsif ($i eq 'u') { $line .= sprintf '%6d ', $uid } + elsif ($i eq 'g') { $line .= sprintf '%6d ', $gid } + elsif ($i eq 's') { $line .= sprintf "$z%16s ",$size } + elsif ($i eq 'l') { $line .= sprintf '%3s ', $links } + elsif ($i eq 'i') { $line .= sprintf '%14s ', $inode } + elsif ($i eq 'd') { $line .= sprintf '%10s ', $date } + elsif ($i eq 'a') { $line .= sprintf '%10s %10s %10s ', + $dates{'a'},$dates{'m'},$dates{'c'} } + } else { + if ($i eq 'm') { $line .= $mode.' ' } + elsif ($i eq 'u') { $line .= sprintf '%-8s ', $uid } + elsif ($i eq 'g') { $line .= sprintf '%-8s ', $gid } + elsif ($i eq 's') { $line .= sprintf "$z%19s ",$size } + elsif ($i eq 'l') { $line .= sprintf '%3s ', $links } + elsif ($i eq 'i') { $line .= sprintf '%14s ', $inode } + elsif ($i eq 'd') { $line .= $date.' ' } + elsif ($i eq 'D') { $line .= $date.' ' } + elsif ($i eq 'a') { $line .= &isodate($dates{'a'}).' '. + &isodate($dates{'m'}).' '. + &isodate($dates{'c'}).' ' } + elsif ($i eq 'A') { $line .= &isodate($dates{'a'}).' '. + &isodate($dates{'m'}).' '. + &isodate($dates{'c'}).' ' } + } + } + + # predefined formats + } else { + + if ($opt_n) { + if ($opt_l) { $line .= sprintf "%06o %6d %6d $z%15s %10d ", + $mode,$uid,$gid,$size,$date } + else { $line .= sprintf "%06o $z%15s %10d ", + $mode,$size,$date } + } else { + if ($opt_l) { $line .= sprintf "%s %-8s %-8s $z%19s %s ", + $mode,$uid,$gid,$size,$date } + else { $line .= sprintf "%s $z%19s %s ", + $mode,$size,substr($date,0,-3) } + } + + if ($opt_i) { $line .= sprintf '%3s %10s ',$links,$inode } + } + + $line .= $linkname."\n"; + + if ($postproc) { + push @LIST,$line; + } else { + $line =~ s/\0//; + print $line; + } + $found++; + + } else { + lstat $file; + warn "$0: cannot get dir-info for ".quote($file)." - $!\n"; + } + + } +} + +# get file information +# +# INPUT: file name +# +# OUTPUT: filename with linkname, inode, hard link count, size, mode string, +# UID, GID, isodate +sub info { + my $file = shift; + my ($linkname,$links,$mode,$bmode,$uid,$gid,$date,%dates,@stat); + my $size = '-'; + my $inode = '?'; + my @rwx = qw/--- --x -w- -wx r-- r-x rw- rwx/; + my $type; + + if ($opt_L) { @stat = stat $file } + else { @stat = lstat $file } + + if (@stat) { + + $inode = $stat[1]; + $bmode = $stat[2]; + $links = $stat[3]; + %dates = ('m' => $stat[9], + 'a' => $stat[8], + 'c' => $stat[10]); + + if ($opt_n) { + $uid = $stat[4]; + $gid = $stat[5]; + $date = $dates{$sdf}; + } else { + $uid = getpwuid($stat[4]) || $stat[4]; + $gid = getgrgid($stat[5]) || $stat[5]; + $date = &isodate($dates{$sdf}); + } + + if (-f _) { $type = '-'; $size = $stat[7]; } + elsif (!$opt_L && -l _) { $type = 'l'; } + elsif (-d _) { $type = 'd'; } + elsif (-c _) { $type = 'c'; $size = &nodes($stat[6]); } + elsif (-b _) { $type = 'b'; $size = &nodes($stat[6]); } + elsif (-p _) { $type = 'p'; } + elsif (-S _) { $type = 's'; } + else { $type = '?'; } + + if ($opt_n) { + $mode = $stat[2]; + $size = $stat[7] if $size eq '-'; + } else { + if ($opt_l) { + $mode = $rwx[$bmode & 7]; + $bmode >>= 3; + $mode = $rwx[$bmode & 7] . $mode; + $bmode >>= 3; + $mode = $rwx[$bmode & 7] . $mode; + substr($mode,2,1) =~ tr/-x/Ss/ if -u _; + substr($mode,5,1) =~ tr/-x/Ss/ if -g _; + substr($mode,8,1) =~ tr/-x/Tt/ if -k _; + $mode = $type.$mode; + } else { + # with short list display only effektive file access modes + $mode = $type + . (-r _ ? 'R' : '-') + . (-w _ ? 'W' : '-') + . (-x _ ? 'X' : '-'); + substr($mode,2,1) =~ tr/-x/Ss/ if -u _ or -g _; + substr($mode,3,1) =~ tr/-x/Tt/ if -k _; + } + } + + # fall back to ls command if perl lstat failed + } else { + if ($opt_L) { + return; + } else { + ($mode,$links,$uid,$gid,$size) = split /\s+/,`ls -ld $file 2>/dev/null`; + return undef unless defined $mode; + $type = substr($mode,0,1); + # for (my $i=0;$i<3;$i++) { push @dates,'????-??-?? ??:??:??' } + # $date = `gfind $dir -maxdepth 1 -name $file -printf '%Ty-%Tm-%Td %TT\n'`; + } + } + + # summarize statistics + if ($opt_S) { + $SS++; + $SS{$type}++; + $Ss += $size if $type eq '-'; + } + + $size = &d3($size); + + # determine longest size field + if ($opt_z) { + my $x = length $size; + $opt_z = $x if $x>$opt_z; + } + $linkname = ${'opt_*'} ? $file : quote($file) ; + if ($type eq 'l' and $opt_f !~ /n/) { + my $link = readlink($file); + if (defined $link) { + $linkname .= ' -> ' . (${'opt_*'} ? $link : quote($link)); + } + } + $mode =~ s/\+$//; + #$mode .= ' ' unless $mode =~ /\+$/; + + return ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates); +} + + +# reformat integer into 3-digit doted format +# (when non-numerical mode is set) +# +# INPUT: integer or '-' +# +# OUTPUT: d3-string +sub d3 { + local $_ = shift; + if ($opt_n) { s/-/0/ } + else { while (s/(\d)(\d\d\d\b)/$1,$2/) {} } + return $_; +} + + +# get all files matching pattern $opt_m +# +# INPUT: directory to scan +# +# OUTPUT: files which match (sorted, directories first) +sub getfiles { + my $dir = shift; + my @files = (); + my @dirs = (); + my $f; + + if (opendir D,$dir) { + $dir = '' if $dir eq '.'; + while (defined($f = readdir D)) { + + # skip . and .. pseudo-subdirs + next if $f =~ m:(^|/)\.\.?/*$:; + # skip ONTAP snapshot dir + next if $f =~ m:(^|/)\.snapshot/*$:; + + + # skip jed and emacs backup files + # next if $f =~ /~$/ and not $opt_a and not $opt_l; + + if ($f =~ /$opt_m/) { + my $x = $dir.$f; + if (not -l $x and -d $x and not ($opt_R or $postsort or $opt_U)) { + push @dirs,$x; + } else { + push @files,$x; + } + } + } + closedir D; + unless ($postsort) { + @files = &$lcsort(@files); + @dirs = &$lcsort(@dirs); + } + } else { + warn "$0: cannot read $dir : $!\n"; + } + + return (@dirs,@files); +} + + +# reformat integer to string node +# +# INPUT: integer node +# +# OUTPUT: string node +sub nodes { + my $rdev = shift; + return sprintf("%03d,%03d", ($rdev >> 8) & 255, $rdev & 255); +} + + +# reformat timetick to ISO date string +# +# INPUT: timetick +# +# OUTPUT: ISO date string +sub isodate { + my @d = localtime shift; + return sprintf('%d-%02d-%02d %02d:%02d:%02d', + $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]); +} + + +# quote file name to printable name and escape shell meta chars +# +# INPUT: original file name +# +# OUTPUT: printable file name +sub quote { + local $_ = shift; + my $mc = '\'\[\]\\\\ `"$?&<>$*()|{};'; + + unless (defined $_) { + die "@_"; + @x = caller; + die "@x"; + } + if (s/[\000-\037\200-\237\241-\250]/?/g or /\'/) { + s/([$mc])/\\$1/g; + s/^~/\\~/; +# } elsif (/[$mc]/ or -d and /:/) { + } elsif (/[$mc]/) { + $_ = "'$_'"; + } + return $_; +} + + +sub fmatch { + my $file = shift; + my $link = readlink($file)||''; + + return $file if basename($file) =~ /$opt_F/i; + return $link if basename($link) =~ /$opt_F/i; +} + + +sub usage { + my $opts = '[-lastcuidnrzLRNS*] [-f format] [-D X:Y]'; + if ($0 ne 'lf') { + print "usage: $0 $opts [-F regexp] [file...]\n"; + } + $opts =~ s/R//; + print "usage: lf $opts regexp [directory...]\n"; + print <<EOD; +options: -l long list + -a list also .* files + -s sort by size + -t sort by time + -U sort by nothing (original i-node order) + -c list status change time instead of modification time + -u list last access time instead of modification time + -i list also inode and hard links numbers + -d do not list contents of diretories + -n numerical output + -r reverse list + -z squeeze size field (slows down output) + -L derefernce symbolic links + -R recursive into subdirs + -F find files matching case insensitive regexp + -N show only normal (regular) files + -S print statistics summary at end + -* list plain file names (without masking \\) + -f user defined format output, format characters are: + m=mode, u=user, g=group, s=size, l=hard links count, i=inode + n=name only, d=date, a=access+modification+inodechange dates + -D list only files newer than X and older than Y + XY format: NUMBER[smhd] (s=seconds, m=minutes, h=hours, d=days) + XY format: YYYY-MM-DD (Y=year, M=month, D=day) + -? show examples +EOD + exit 2; +} + +sub examples { + print <<EOD; +l *.c # list files ending with .c +l -la # list all files in long format +l -Rrs # list files recursive reverse sorted by size +l -*f mus # list files native names with format: mode+user+size +l -D 10d: # list files newer than 10 days +ll # list files long format (equal to: l -l) +lll # list files extra long format (equal to: l -liS) +lf 'status.*mp3' # list files recursive matching regexp (equal to: l -RF) +lf sda3 /dev # list devices matching sda3 (equal to: l -RF sd3 /dev) +EOD + exit; +} diff -Nru fex-20140917/bin/lf fex-20150120/bin/lf --- fex-20140917/bin/lf 1970-01-01 01:00:00.000000000 +0100 +++ fex-20150120/bin/lf 2014-12-09 12:31:43.000000000 +0100 @@ -0,0 +1,597 @@ +#!/usr/bin/perl -w +# +# l / ll / lf / llf - substitute of the classic ls command +# +# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> +# +# Copyright: GNU General Public License + +use Cwd qw'abs_path'; +use File::Basename; +use Getopt::Std; + +# the name of the game +$0 =~ s:.*/::; + +$ENV{LC_CTYPE} = 'C'; + +# unshift @ARGV,split /\s+/,$ENV{'l_opt'} if $ENV{'l_opt'}; + +@ARGV = grep { chomp } <STDIN> if "@ARGV" eq '-'; + +# parse CLI arguments +$opt_l = $opt_i = $opt_t = $opt_s = $opt_a = $opt_r = $opt_d = $opt_n = 0; +$opt_L = $opt_N = $opt_c = $opt_u = $opt_S = $opt_R = $opt_z = $opt_h = 0; +$opt_U = 0; +${'opt_*'} = ${'opt_?'} = 0; +$opt_m = $opt_f = $opt_F = $opt_D = ''; +&usage if !getopts('hdnlLNitcuarsUSRz*?m:f:D:F:') || $opt_h; +$opt_z = 1 unless $opt_R; +$opt_l = 1 if $0 eq 'll'; +$opt_l = $opt_i = $opt_a = $opt_S = 1 if $0 eq 'lll'; +if ($0 eq 'lf' or $0 eq 'llf') { + unless ($opt_F) { + $opt_F = shift; + unless (length $opt_F) { + print "find regexp: "; + chomp($opt_F = <STDIN>||''); + } + } + $opt_l = $0 if $0 eq 'llf'; + $opt_F = '.' unless length $opt_F; + $opt_R = $opt_F; +} + +$postsort = $opt_t||$opt_s; +$postproc = $postsort||$opt_z; + +&examples if ${'opt_?'}; + +# mark for squeeze operation +$z = $opt_z ? "\0" : ''; + +# default sorting methode +if ($opt_U) { $lcsort = sub { return @_ } } +elsif ($opt_r) { $lcsort = sub { sort { lc $b cmp lc $a } @_ } } +else { $lcsort = sub { sort { lc $a cmp lc $b } @_ } } + +# default: list only files not beginning with a dot +unless ($opt_m) { + if ($opt_a) { $opt_m = '.' } + else { $opt_m = '^[^\.]' } +} + +$older = $newer = 0; + +if ($opt_D) { + if ($opt_D =~ /:(\d+)([mhd])/) { + $older = $1; + my $z = $2 || 's'; + if ($z =~ /m/) { $older *= 60 } + elsif ($z =~ /h/) { $older *= 60*60 } + elsif ($z =~ /d/) { $older *= 60*60*24 } + } elsif ($opt_D =~ /:(\d\d\d\d-\d\d-\d\d)$/) { + $older = $1; + } + if ($opt_D =~ /(\d+)([mhd]):/) { + $newer = $1; + my $z = $2 || 's'; + if ($z =~ /m/) { $newer *= 60 } + elsif ($z =~ /h/) { $newer *= 60*60 } + elsif ($z =~ /d/) { $newer *= 60*60*24 } + } elsif ($opt_D =~ /^(\d\d\d\d-\d\d-\d\d):/) { + $newer = $1; + } +} + +# preselect date field number +if ($opt_c) { $sdf = 'c' } +elsif ($opt_u) { $sdf = 'a' } +else { $sdf = 'm' } + +# any arguments? +if (@ARGV) { @ARGV = &$lcsort(@ARGV) } +else { @ARGV = &getfiles('.') } + +# build files list +&collect(@ARGV); + +# post process files list? +# remark: if no postprocessing, files list has been already printed in list() +if (@LIST && $postproc) { + + # on -t or -s option sort list on date or size + # and then strip of leading sorting pre-string + @LIST = grep { s/.{21}// } reverse sort @LIST if $postsort; + + # squeeze size field (= remove unnecessary spaces) + if ($opt_z and not $opt_f) { + $opt_z = '%'.$opt_z.'s '; + @LIST = grep { s/\0 *([,\d\.\-]+) /sprintf($opt_z,$1)/e } @LIST; + } + + @LIST = reverse @LIST if $opt_r; + + if (not ($opt_t or $opt_U) and grep /^d[rR-][wW-][xX-]/,@LIST) { + foreach (@LIST) { print if /^d/ } + foreach (@LIST) { print unless /^d/ } + } else { + print @LIST; + } +} + +# print statistics summary? +if ($opt_S && $SS) { + print "$SS file(s):"; + printf " r=%d (%s Bytes)",$SS{'-'},&d3($Ss) if $SS{'-'}; + delete $SS{'-'}; + foreach my $type (qw(l d c b p s ?)) { + printf " %s=%d",$type,$SS{$type} if $SS{$type}; + delete $SS{$type}; + } + foreach my $type (keys %SS) { printf " %s=%d",$type,$SS{$type} } + print "\n"; +} + +exit ($found ? 0 : 1); + + +# collect files and build file lists +# +# INPUT: filenames +# +# GLOBAL: @LIST +sub collect { + my @files = @_; + my $f; + + # loop over all argument files/directories + foreach $f (@files) { + + # skip jed and emacs backup files + # next if $f =~ /~$/ and not $opt_a and not $opt_l; + + # recursive? + if ($opt_R) { + + # list single file + if ($opt_L) { + unless (-e $f) { + warn "$0: dangling symlink $f\n"; + next; + } + $f = abs_path($f); + } + list($f); + + # traverse real subdirs + if (-d $f and not -l $f) { + $f =~ s:/*$:/:; + collect(getfiles($f)); + } + + } else { + + # suppress trailing / on -d option + $f =~ s:/$:: if $opt_d; + + # on trailing / list subdirs, too + if ($f =~ m:/$:) { &list(&getfiles($f)) } + elsif ($f eq '') { &list('/') } + else { + if ($opt_L) { + unless (-e $f) { + warn "$0: dangling symlink $f\n"; + next; + } + $f = abs_path($f); + } + list($f); + } + + } + } +} + + +# list file(s) +# +# INPUT: filenames +# +# GLOBAL: @LIST (filenames-list) +sub list { + my @files = @_; + my ($file,$line,$linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates); + my ($day); + + foreach $file (@files) { + + next if $opt_F and not fmatch($file); + next if $opt_N and (not -f $file or -l $file); + + # get file information + # if ($opt_L and stat $file or not $opt_L and lstat $file) { + if (lstat $file) { + ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates) = &info($file); + } elsif ($! eq "Permission denied") { + $linkname = $file; + $inode = $links = $size = $uid = $gid = '?'; + $mode = $opt_l ? '?---------' : '?---'; + $date = '????-??-?? ??:??:??'; + %dates = ('m' => 0, 'a' => 0, 'c' => 0); + } else { + warn "$0: ".quote($file)." - $!\n"; + next; + } + + $day = $date; + $day =~ s/\s.*//; + + if ($older) { + next if $older =~ /-/ and $day gt $older; + next if $older !~ /-/ and $dates{m} > time-$older; + } + if ($newer) { + next if $newer =~ /-/ and $day lt $newer; + next if $newer !~ /-/ and $dates{m} < time-$newer; + } + + if (defined $linkname) { + + # prepend sorting string + $line = ''; + $line = sprintf '%21s',$date if $opt_t; + $line = sprintf '%21s',$size if $opt_s; + + unless ($opt_n) { + $uid = substr($uid,0,8); + $gid = substr($gid,0,8); + } + + # user defined format? + if ($opt_f) { + foreach my $i (split '',$opt_f) { + if ($opt_n) { + $i =~ tr/AD/ad/; + if ($i eq 'm') { $line .= sprintf '%06o ', $mode } + elsif ($i eq 'u') { $line .= sprintf '%6d ', $uid } + elsif ($i eq 'g') { $line .= sprintf '%6d ', $gid } + elsif ($i eq 's') { $line .= sprintf "$z%16s ",$size } + elsif ($i eq 'l') { $line .= sprintf '%3s ', $links } + elsif ($i eq 'i') { $line .= sprintf '%14s ', $inode } + elsif ($i eq 'd') { $line .= sprintf '%10s ', $date } + elsif ($i eq 'a') { $line .= sprintf '%10s %10s %10s ', + $dates{'a'},$dates{'m'},$dates{'c'} } + } else { + if ($i eq 'm') { $line .= $mode.' ' } + elsif ($i eq 'u') { $line .= sprintf '%-8s ', $uid } + elsif ($i eq 'g') { $line .= sprintf '%-8s ', $gid } + elsif ($i eq 's') { $line .= sprintf "$z%19s ",$size } + elsif ($i eq 'l') { $line .= sprintf '%3s ', $links } + elsif ($i eq 'i') { $line .= sprintf '%14s ', $inode } + elsif ($i eq 'd') { $line .= $date.' ' } + elsif ($i eq 'D') { $line .= $date.' ' } + elsif ($i eq 'a') { $line .= &isodate($dates{'a'}).' '. + &isodate($dates{'m'}).' '. + &isodate($dates{'c'}).' ' } + elsif ($i eq 'A') { $line .= &isodate($dates{'a'}).' '. + &isodate($dates{'m'}).' '. + &isodate($dates{'c'}).' ' } + } + } + + # predefined formats + } else { + + if ($opt_n) { + if ($opt_l) { $line .= sprintf "%06o %6d %6d $z%15s %10d ", + $mode,$uid,$gid,$size,$date } + else { $line .= sprintf "%06o $z%15s %10d ", + $mode,$size,$date } + } else { + if ($opt_l) { $line .= sprintf "%s %-8s %-8s $z%19s %s ", + $mode,$uid,$gid,$size,$date } + else { $line .= sprintf "%s $z%19s %s ", + $mode,$size,substr($date,0,-3) } + } + + if ($opt_i) { $line .= sprintf '%3s %10s ',$links,$inode } + } + + $line .= $linkname."\n"; + + if ($postproc) { + push @LIST,$line; + } else { + $line =~ s/\0//; + print $line; + } + $found++; + + } else { + lstat $file; + warn "$0: cannot get dir-info for ".quote($file)." - $!\n"; + } + + } +} + +# get file information +# +# INPUT: file name +# +# OUTPUT: filename with linkname, inode, hard link count, size, mode string, +# UID, GID, isodate +sub info { + my $file = shift; + my ($linkname,$links,$mode,$bmode,$uid,$gid,$date,%dates,@stat); + my $size = '-'; + my $inode = '?'; + my @rwx = qw/--- --x -w- -wx r-- r-x rw- rwx/; + my $type; + + if ($opt_L) { @stat = stat $file } + else { @stat = lstat $file } + + if (@stat) { + + $inode = $stat[1]; + $bmode = $stat[2]; + $links = $stat[3]; + %dates = ('m' => $stat[9], + 'a' => $stat[8], + 'c' => $stat[10]); + + if ($opt_n) { + $uid = $stat[4]; + $gid = $stat[5]; + $date = $dates{$sdf}; + } else { + $uid = getpwuid($stat[4]) || $stat[4]; + $gid = getgrgid($stat[5]) || $stat[5]; + $date = &isodate($dates{$sdf}); + } + + if (-f _) { $type = '-'; $size = $stat[7]; } + elsif (!$opt_L && -l _) { $type = 'l'; } + elsif (-d _) { $type = 'd'; } + elsif (-c _) { $type = 'c'; $size = &nodes($stat[6]); } + elsif (-b _) { $type = 'b'; $size = &nodes($stat[6]); } + elsif (-p _) { $type = 'p'; } + elsif (-S _) { $type = 's'; } + else { $type = '?'; } + + if ($opt_n) { + $mode = $stat[2]; + $size = $stat[7] if $size eq '-'; + } else { + if ($opt_l) { + $mode = $rwx[$bmode & 7]; + $bmode >>= 3; + $mode = $rwx[$bmode & 7] . $mode; + $bmode >>= 3; + $mode = $rwx[$bmode & 7] . $mode; + substr($mode,2,1) =~ tr/-x/Ss/ if -u _; + substr($mode,5,1) =~ tr/-x/Ss/ if -g _; + substr($mode,8,1) =~ tr/-x/Tt/ if -k _; + $mode = $type.$mode; + } else { + # with short list display only effektive file access modes + $mode = $type + . (-r _ ? 'R' : '-') + . (-w _ ? 'W' : '-') + . (-x _ ? 'X' : '-'); + substr($mode,2,1) =~ tr/-x/Ss/ if -u _ or -g _; + substr($mode,3,1) =~ tr/-x/Tt/ if -k _; + } + } + + # fall back to ls command if perl lstat failed + } else { + if ($opt_L) { + return; + } else { + ($mode,$links,$uid,$gid,$size) = split /\s+/,`ls -ld $file 2>/dev/null`; + return undef unless defined $mode; + $type = substr($mode,0,1); + # for (my $i=0;$i<3;$i++) { push @dates,'????-??-?? ??:??:??' } + # $date = `gfind $dir -maxdepth 1 -name $file -printf '%Ty-%Tm-%Td %TT\n'`; + } + } + + # summarize statistics + if ($opt_S) { + $SS++; + $SS{$type}++; + $Ss += $size if $type eq '-'; + } + + $size = &d3($size); + + # determine longest size field + if ($opt_z) { + my $x = length $size; + $opt_z = $x if $x>$opt_z; + } + $linkname = ${'opt_*'} ? $file : quote($file) ; + if ($type eq 'l' and $opt_f !~ /n/) { + my $link = readlink($file); + if (defined $link) { + $linkname .= ' -> ' . (${'opt_*'} ? $link : quote($link)); + } + } + $mode =~ s/\+$//; + #$mode .= ' ' unless $mode =~ /\+$/; + + return ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates); +} + + +# reformat integer into 3-digit doted format +# (when non-numerical mode is set) +# +# INPUT: integer or '-' +# +# OUTPUT: d3-string +sub d3 { + local $_ = shift; + if ($opt_n) { s/-/0/ } + else { while (s/(\d)(\d\d\d\b)/$1,$2/) {} } + return $_; +} + + +# get all files matching pattern $opt_m +# +# INPUT: directory to scan +# +# OUTPUT: files which match (sorted, directories first) +sub getfiles { + my $dir = shift; + my @files = (); + my @dirs = (); + my $f; + + if (opendir D,$dir) { + $dir = '' if $dir eq '.'; + while (defined($f = readdir D)) { + + # skip . and .. pseudo-subdirs + next if $f =~ m:(^|/)\.\.?/*$:; + # skip ONTAP snapshot dir + next if $f =~ m:(^|/)\.snapshot/*$:; + + + # skip jed and emacs backup files + # next if $f =~ /~$/ and not $opt_a and not $opt_l; + + if ($f =~ /$opt_m/) { + my $x = $dir.$f; + if (not -l $x and -d $x and not ($opt_R or $postsort or $opt_U)) { + push @dirs,$x; + } else { + push @files,$x; + } + } + } + closedir D; + unless ($postsort) { + @files = &$lcsort(@files); + @dirs = &$lcsort(@dirs); + } + } else { + warn "$0: cannot read $dir : $!\n"; + } + + return (@dirs,@files); +} + + +# reformat integer to string node +# +# INPUT: integer node +# +# OUTPUT: string node +sub nodes { + my $rdev = shift; + return sprintf("%03d,%03d", ($rdev >> 8) & 255, $rdev & 255); +} + + +# reformat timetick to ISO date string +# +# INPUT: timetick +# +# OUTPUT: ISO date string +sub isodate { + my @d = localtime shift; + return sprintf('%d-%02d-%02d %02d:%02d:%02d', + $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]); +} + + +# quote file name to printable name and escape shell meta chars +# +# INPUT: original file name +# +# OUTPUT: printable file name +sub quote { + local $_ = shift; + my $mc = '\'\[\]\\\\ `"$?&<>$*()|{};'; + + unless (defined $_) { + die "@_"; + @x = caller; + die "@x"; + } + if (s/[\000-\037\200-\237\241-\250]/?/g or /\'/) { + s/([$mc])/\\$1/g; + s/^~/\\~/; +# } elsif (/[$mc]/ or -d and /:/) { + } elsif (/[$mc]/) { + $_ = "'$_'"; + } + return $_; +} + + +sub fmatch { + my $file = shift; + my $link = readlink($file)||''; + + return $file if basename($file) =~ /$opt_F/i; + return $link if basename($link) =~ /$opt_F/i; +} + + +sub usage { + my $opts = '[-lastcuidnrzLRNS*] [-f format] [-D X:Y]'; + if ($0 ne 'lf') { + print "usage: $0 $opts [-F regexp] [file...]\n"; + } + $opts =~ s/R//; + print "usage: lf $opts regexp [directory...]\n"; + print <<EOD; +options: -l long list + -a list also .* files + -s sort by size + -t sort by time + -U sort by nothing (original i-node order) + -c list status change time instead of modification time + -u list last access time instead of modification time + -i list also inode and hard links numbers + -d do not list contents of diretories + -n numerical output + -r reverse list + -z squeeze size field (slows down output) + -L derefernce symbolic links + -R recursive into subdirs + -F find files matching case insensitive regexp + -N show only normal (regular) files + -S print statistics summary at end + -* list plain file names (without masking \\) + -f user defined format output, format characters are: + m=mode, u=user, g=group, s=size, l=hard links count, i=inode + n=name only, d=date, a=access+modification+inodechange dates + -D list only files newer than X and older than Y + XY format: NUMBER[smhd] (s=seconds, m=minutes, h=hours, d=days) + XY format: YYYY-MM-DD (Y=year, M=month, D=day) + -? show examples +EOD + exit 2; +} + +sub examples { + print <<EOD; +l *.c # list files ending with .c +l -la # list all files in long format +l -Rrs # list files recursive reverse sorted by size +l -*f mus # list files native names with format: mode+user+size +l -D 10d: # list files newer than 10 days +ll # list files long format (equal to: l -l) +lll # list files extra long format (equal to: l -liS) +lf 'status.*mp3' # list files recursive matching regexp (equal to: l -RF) +lf sda3 /dev # list devices matching sda3 (equal to: l -RF sd3 /dev) +EOD + exit; +} diff -Nru fex-20140917/bin/ll fex-20150120/bin/ll --- fex-20140917/bin/ll 1970-01-01 01:00:00.000000000 +0100 +++ fex-20150120/bin/ll 2014-12-09 12:31:43.000000000 +0100 @@ -0,0 +1,597 @@ +#!/usr/bin/perl -w +# +# l / ll / lf / llf - substitute of the classic ls command +# +# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> +# +# Copyright: GNU General Public License + +use Cwd qw'abs_path'; +use File::Basename; +use Getopt::Std; + +# the name of the game +$0 =~ s:.*/::; + +$ENV{LC_CTYPE} = 'C'; + +# unshift @ARGV,split /\s+/,$ENV{'l_opt'} if $ENV{'l_opt'}; + +@ARGV = grep { chomp } <STDIN> if "@ARGV" eq '-'; + +# parse CLI arguments +$opt_l = $opt_i = $opt_t = $opt_s = $opt_a = $opt_r = $opt_d = $opt_n = 0; +$opt_L = $opt_N = $opt_c = $opt_u = $opt_S = $opt_R = $opt_z = $opt_h = 0; +$opt_U = 0; +${'opt_*'} = ${'opt_?'} = 0; +$opt_m = $opt_f = $opt_F = $opt_D = ''; +&usage if !getopts('hdnlLNitcuarsUSRz*?m:f:D:F:') || $opt_h; +$opt_z = 1 unless $opt_R; +$opt_l = 1 if $0 eq 'll'; +$opt_l = $opt_i = $opt_a = $opt_S = 1 if $0 eq 'lll'; +if ($0 eq 'lf' or $0 eq 'llf') { + unless ($opt_F) { + $opt_F = shift; + unless (length $opt_F) { + print "find regexp: "; + chomp($opt_F = <STDIN>||''); + } + } + $opt_l = $0 if $0 eq 'llf'; + $opt_F = '.' unless length $opt_F; + $opt_R = $opt_F; +} + +$postsort = $opt_t||$opt_s; +$postproc = $postsort||$opt_z; + +&examples if ${'opt_?'}; + +# mark for squeeze operation +$z = $opt_z ? "\0" : ''; + +# default sorting methode +if ($opt_U) { $lcsort = sub { return @_ } } +elsif ($opt_r) { $lcsort = sub { sort { lc $b cmp lc $a } @_ } } +else { $lcsort = sub { sort { lc $a cmp lc $b } @_ } } + +# default: list only files not beginning with a dot +unless ($opt_m) { + if ($opt_a) { $opt_m = '.' } + else { $opt_m = '^[^\.]' } +} + +$older = $newer = 0; + +if ($opt_D) { + if ($opt_D =~ /:(\d+)([mhd])/) { + $older = $1; + my $z = $2 || 's'; + if ($z =~ /m/) { $older *= 60 } + elsif ($z =~ /h/) { $older *= 60*60 } + elsif ($z =~ /d/) { $older *= 60*60*24 } + } elsif ($opt_D =~ /:(\d\d\d\d-\d\d-\d\d)$/) { + $older = $1; + } + if ($opt_D =~ /(\d+)([mhd]):/) { + $newer = $1; + my $z = $2 || 's'; + if ($z =~ /m/) { $newer *= 60 } + elsif ($z =~ /h/) { $newer *= 60*60 } + elsif ($z =~ /d/) { $newer *= 60*60*24 } + } elsif ($opt_D =~ /^(\d\d\d\d-\d\d-\d\d):/) { + $newer = $1; + } +} + +# preselect date field number +if ($opt_c) { $sdf = 'c' } +elsif ($opt_u) { $sdf = 'a' } +else { $sdf = 'm' } + +# any arguments? +if (@ARGV) { @ARGV = &$lcsort(@ARGV) } +else { @ARGV = &getfiles('.') } + +# build files list +&collect(@ARGV); + +# post process files list? +# remark: if no postprocessing, files list has been already printed in list() +if (@LIST && $postproc) { + + # on -t or -s option sort list on date or size + # and then strip of leading sorting pre-string + @LIST = grep { s/.{21}// } reverse sort @LIST if $postsort; + + # squeeze size field (= remove unnecessary spaces) + if ($opt_z and not $opt_f) { + $opt_z = '%'.$opt_z.'s '; + @LIST = grep { s/\0 *([,\d\.\-]+) /sprintf($opt_z,$1)/e } @LIST; + } + + @LIST = reverse @LIST if $opt_r; + + if (not ($opt_t or $opt_U) and grep /^d[rR-][wW-][xX-]/,@LIST) { + foreach (@LIST) { print if /^d/ } + foreach (@LIST) { print unless /^d/ } + } else { + print @LIST; + } +} + +# print statistics summary? +if ($opt_S && $SS) { + print "$SS file(s):"; + printf " r=%d (%s Bytes)",$SS{'-'},&d3($Ss) if $SS{'-'}; + delete $SS{'-'}; + foreach my $type (qw(l d c b p s ?)) { + printf " %s=%d",$type,$SS{$type} if $SS{$type}; + delete $SS{$type}; + } + foreach my $type (keys %SS) { printf " %s=%d",$type,$SS{$type} } + print "\n"; +} + +exit ($found ? 0 : 1); + + +# collect files and build file lists +# +# INPUT: filenames +# +# GLOBAL: @LIST +sub collect { + my @files = @_; + my $f; + + # loop over all argument files/directories + foreach $f (@files) { + + # skip jed and emacs backup files + # next if $f =~ /~$/ and not $opt_a and not $opt_l; + + # recursive? + if ($opt_R) { + + # list single file + if ($opt_L) { + unless (-e $f) { + warn "$0: dangling symlink $f\n"; + next; + } + $f = abs_path($f); + } + list($f); + + # traverse real subdirs + if (-d $f and not -l $f) { + $f =~ s:/*$:/:; + collect(getfiles($f)); + } + + } else { + + # suppress trailing / on -d option + $f =~ s:/$:: if $opt_d; + + # on trailing / list subdirs, too + if ($f =~ m:/$:) { &list(&getfiles($f)) } + elsif ($f eq '') { &list('/') } + else { + if ($opt_L) { + unless (-e $f) { + warn "$0: dangling symlink $f\n"; + next; + } + $f = abs_path($f); + } + list($f); + } + + } + } +} + + +# list file(s) +# +# INPUT: filenames +# +# GLOBAL: @LIST (filenames-list) +sub list { + my @files = @_; + my ($file,$line,$linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates); + my ($day); + + foreach $file (@files) { + + next if $opt_F and not fmatch($file); + next if $opt_N and (not -f $file or -l $file); + + # get file information + # if ($opt_L and stat $file or not $opt_L and lstat $file) { + if (lstat $file) { + ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates) = &info($file); + } elsif ($! eq "Permission denied") { + $linkname = $file; + $inode = $links = $size = $uid = $gid = '?'; + $mode = $opt_l ? '?---------' : '?---'; + $date = '????-??-?? ??:??:??'; + %dates = ('m' => 0, 'a' => 0, 'c' => 0); + } else { + warn "$0: ".quote($file)." - $!\n"; + next; + } + + $day = $date; + $day =~ s/\s.*//; + + if ($older) { + next if $older =~ /-/ and $day gt $older; + next if $older !~ /-/ and $dates{m} > time-$older; + } + if ($newer) { + next if $newer =~ /-/ and $day lt $newer; + next if $newer !~ /-/ and $dates{m} < time-$newer; + } + + if (defined $linkname) { + + # prepend sorting string + $line = ''; + $line = sprintf '%21s',$date if $opt_t; + $line = sprintf '%21s',$size if $opt_s; + + unless ($opt_n) { + $uid = substr($uid,0,8); + $gid = substr($gid,0,8); + } + + # user defined format? + if ($opt_f) { + foreach my $i (split '',$opt_f) { + if ($opt_n) { + $i =~ tr/AD/ad/; + if ($i eq 'm') { $line .= sprintf '%06o ', $mode } + elsif ($i eq 'u') { $line .= sprintf '%6d ', $uid } + elsif ($i eq 'g') { $line .= sprintf '%6d ', $gid } + elsif ($i eq 's') { $line .= sprintf "$z%16s ",$size } + elsif ($i eq 'l') { $line .= sprintf '%3s ', $links } + elsif ($i eq 'i') { $line .= sprintf '%14s ', $inode } + elsif ($i eq 'd') { $line .= sprintf '%10s ', $date } + elsif ($i eq 'a') { $line .= sprintf '%10s %10s %10s ', + $dates{'a'},$dates{'m'},$dates{'c'} } + } else { + if ($i eq 'm') { $line .= $mode.' ' } + elsif ($i eq 'u') { $line .= sprintf '%-8s ', $uid } + elsif ($i eq 'g') { $line .= sprintf '%-8s ', $gid } + elsif ($i eq 's') { $line .= sprintf "$z%19s ",$size } + elsif ($i eq 'l') { $line .= sprintf '%3s ', $links } + elsif ($i eq 'i') { $line .= sprintf '%14s ', $inode } + elsif ($i eq 'd') { $line .= $date.' ' } + elsif ($i eq 'D') { $line .= $date.' ' } + elsif ($i eq 'a') { $line .= &isodate($dates{'a'}).' '. + &isodate($dates{'m'}).' '. + &isodate($dates{'c'}).' ' } + elsif ($i eq 'A') { $line .= &isodate($dates{'a'}).' '. + &isodate($dates{'m'}).' '. + &isodate($dates{'c'}).' ' } + } + } + + # predefined formats + } else { + + if ($opt_n) { + if ($opt_l) { $line .= sprintf "%06o %6d %6d $z%15s %10d ", + $mode,$uid,$gid,$size,$date } + else { $line .= sprintf "%06o $z%15s %10d ", + $mode,$size,$date } + } else { + if ($opt_l) { $line .= sprintf "%s %-8s %-8s $z%19s %s ", + $mode,$uid,$gid,$size,$date } + else { $line .= sprintf "%s $z%19s %s ", + $mode,$size,substr($date,0,-3) } + } + + if ($opt_i) { $line .= sprintf '%3s %10s ',$links,$inode } + } + + $line .= $linkname."\n"; + + if ($postproc) { + push @LIST,$line; + } else { + $line =~ s/\0//; + print $line; + } + $found++; + + } else { + lstat $file; + warn "$0: cannot get dir-info for ".quote($file)." - $!\n"; + } + + } +} + +# get file information +# +# INPUT: file name +# +# OUTPUT: filename with linkname, inode, hard link count, size, mode string, +# UID, GID, isodate +sub info { + my $file = shift; + my ($linkname,$links,$mode,$bmode,$uid,$gid,$date,%dates,@stat); + my $size = '-'; + my $inode = '?'; + my @rwx = qw/--- --x -w- -wx r-- r-x rw- rwx/; + my $type; + + if ($opt_L) { @stat = stat $file } + else { @stat = lstat $file } + + if (@stat) { + + $inode = $stat[1]; + $bmode = $stat[2]; + $links = $stat[3]; + %dates = ('m' => $stat[9], + 'a' => $stat[8], + 'c' => $stat[10]); + + if ($opt_n) { + $uid = $stat[4]; + $gid = $stat[5]; + $date = $dates{$sdf}; + } else { + $uid = getpwuid($stat[4]) || $stat[4]; + $gid = getgrgid($stat[5]) || $stat[5]; + $date = &isodate($dates{$sdf}); + } + + if (-f _) { $type = '-'; $size = $stat[7]; } + elsif (!$opt_L && -l _) { $type = 'l'; } + elsif (-d _) { $type = 'd'; } + elsif (-c _) { $type = 'c'; $size = &nodes($stat[6]); } + elsif (-b _) { $type = 'b'; $size = &nodes($stat[6]); } + elsif (-p _) { $type = 'p'; } + elsif (-S _) { $type = 's'; } + else { $type = '?'; } + + if ($opt_n) { + $mode = $stat[2]; + $size = $stat[7] if $size eq '-'; + } else { + if ($opt_l) { + $mode = $rwx[$bmode & 7]; + $bmode >>= 3; + $mode = $rwx[$bmode & 7] . $mode; + $bmode >>= 3; + $mode = $rwx[$bmode & 7] . $mode; + substr($mode,2,1) =~ tr/-x/Ss/ if -u _; + substr($mode,5,1) =~ tr/-x/Ss/ if -g _; + substr($mode,8,1) =~ tr/-x/Tt/ if -k _; + $mode = $type.$mode; + } else { + # with short list display only effektive file access modes + $mode = $type + . (-r _ ? 'R' : '-') + . (-w _ ? 'W' : '-') + . (-x _ ? 'X' : '-'); + substr($mode,2,1) =~ tr/-x/Ss/ if -u _ or -g _; + substr($mode,3,1) =~ tr/-x/Tt/ if -k _; + } + } + + # fall back to ls command if perl lstat failed + } else { + if ($opt_L) { + return; + } else { + ($mode,$links,$uid,$gid,$size) = split /\s+/,`ls -ld $file 2>/dev/null`; + return undef unless defined $mode; + $type = substr($mode,0,1); + # for (my $i=0;$i<3;$i++) { push @dates,'????-??-?? ??:??:??' } + # $date = `gfind $dir -maxdepth 1 -name $file -printf '%Ty-%Tm-%Td %TT\n'`; + } + } + + # summarize statistics + if ($opt_S) { + $SS++; + $SS{$type}++; + $Ss += $size if $type eq '-'; + } + + $size = &d3($size); + + # determine longest size field + if ($opt_z) { + my $x = length $size; + $opt_z = $x if $x>$opt_z; + } + $linkname = ${'opt_*'} ? $file : quote($file) ; + if ($type eq 'l' and $opt_f !~ /n/) { + my $link = readlink($file); + if (defined $link) { + $linkname .= ' -> ' . (${'opt_*'} ? $link : quote($link)); + } + } + $mode =~ s/\+$//; + #$mode .= ' ' unless $mode =~ /\+$/; + + return ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates); +} + + +# reformat integer into 3-digit doted format +# (when non-numerical mode is set) +# +# INPUT: integer or '-' +# +# OUTPUT: d3-string +sub d3 { + local $_ = shift; + if ($opt_n) { s/-/0/ } + else { while (s/(\d)(\d\d\d\b)/$1,$2/) {} } + return $_; +} + + +# get all files matching pattern $opt_m +# +# INPUT: directory to scan +# +# OUTPUT: files which match (sorted, directories first) +sub getfiles { + my $dir = shift; + my @files = (); + my @dirs = (); + my $f; + + if (opendir D,$dir) { + $dir = '' if $dir eq '.'; + while (defined($f = readdir D)) { + + # skip . and .. pseudo-subdirs + next if $f =~ m:(^|/)\.\.?/*$:; + # skip ONTAP snapshot dir + next if $f =~ m:(^|/)\.snapshot/*$:; + + + # skip jed and emacs backup files + # next if $f =~ /~$/ and not $opt_a and not $opt_l; + + if ($f =~ /$opt_m/) { + my $x = $dir.$f; + if (not -l $x and -d $x and not ($opt_R or $postsort or $opt_U)) { + push @dirs,$x; + } else { + push @files,$x; + } + } + } + closedir D; + unless ($postsort) { + @files = &$lcsort(@files); + @dirs = &$lcsort(@dirs); + } + } else { + warn "$0: cannot read $dir : $!\n"; + } + + return (@dirs,@files); +} + + +# reformat integer to string node +# +# INPUT: integer node +# +# OUTPUT: string node +sub nodes { + my $rdev = shift; + return sprintf("%03d,%03d", ($rdev >> 8) & 255, $rdev & 255); +} + + +# reformat timetick to ISO date string +# +# INPUT: timetick +# +# OUTPUT: ISO date string +sub isodate { + my @d = localtime shift; + return sprintf('%d-%02d-%02d %02d:%02d:%02d', + $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]); +} + + +# quote file name to printable name and escape shell meta chars +# +# INPUT: original file name +# +# OUTPUT: printable file name +sub quote { + local $_ = shift; + my $mc = '\'\[\]\\\\ `"$?&<>$*()|{};'; + + unless (defined $_) { + die "@_"; + @x = caller; + die "@x"; + } + if (s/[\000-\037\200-\237\241-\250]/?/g or /\'/) { + s/([$mc])/\\$1/g; + s/^~/\\~/; +# } elsif (/[$mc]/ or -d and /:/) { + } elsif (/[$mc]/) { + $_ = "'$_'"; + } + return $_; +} + + +sub fmatch { + my $file = shift; + my $link = readlink($file)||''; + + return $file if basename($file) =~ /$opt_F/i; + return $link if basename($link) =~ /$opt_F/i; +} + + +sub usage { + my $opts = '[-lastcuidnrzLRNS*] [-f format] [-D X:Y]'; + if ($0 ne 'lf') { + print "usage: $0 $opts [-F regexp] [file...]\n"; + } + $opts =~ s/R//; + print "usage: lf $opts regexp [directory...]\n"; + print <<EOD; +options: -l long list + -a list also .* files + -s sort by size + -t sort by time + -U sort by nothing (original i-node order) + -c list status change time instead of modification time + -u list last access time instead of modification time + -i list also inode and hard links numbers + -d do not list contents of diretories + -n numerical output + -r reverse list + -z squeeze size field (slows down output) + -L derefernce symbolic links + -R recursive into subdirs + -F find files matching case insensitive regexp + -N show only normal (regular) files + -S print statistics summary at end + -* list plain file names (without masking \\) + -f user defined format output, format characters are: + m=mode, u=user, g=group, s=size, l=hard links count, i=inode + n=name only, d=date, a=access+modification+inodechange dates + -D list only files newer than X and older than Y + XY format: NUMBER[smhd] (s=seconds, m=minutes, h=hours, d=days) + XY format: YYYY-MM-DD (Y=year, M=month, D=day) + -? show examples +EOD + exit 2; +} + +sub examples { + print <<EOD; +l *.c # list files ending with .c +l -la # list all files in long format +l -Rrs # list files recursive reverse sorted by size +l -*f mus # list files native names with format: mode+user+size +l -D 10d: # list files newer than 10 days +ll # list files long format (equal to: l -l) +lll # list files extra long format (equal to: l -liS) +lf 'status.*mp3' # list files recursive matching regexp (equal to: l -RF) +lf sda3 /dev # list devices matching sda3 (equal to: l -RF sd3 /dev) +EOD + exit; +} diff -Nru fex-20140917/bin/logwatch fex-20150120/bin/logwatch --- fex-20140917/bin/logwatch 2014-09-12 17:00:29.000000000 +0200 +++ fex-20150120/bin/logwatch 2014-12-12 17:15:45.000000000 +0100 @@ -35,13 +35,15 @@ GET.*(favicon|robots\.txt) GET./organization\.gif GET./small_logo\.jpg + GET./logo\.jpg + GET./action-fex-camel\.gif + GET./fup\?showstatus GET./FAQ/faq\.css GET./FAQ/jquery\.js GET./10+.B GET.*Arrow\.gif GET./apple-touch - User-Agent:.*(Webnote|FeedFetcher|\w+bot|bot/|Website.Watcher|crawler|spider|searchme|Yandex|Slurp|ScoutJet|findlinks|urlmon) - User-Agent:.ichiro + User-Agent:.*(Webnote|FeedFetcher|\w+bot|bot/|Website.Watcher|crawler|spider|searchme|Yandex|Slurp|ScoutJet|findlinks|urlmon|nagios) User-Agent:.fnb.*quak From:.*(msnbot|yandex|googlebot|webcrawler) Referer:.*sex.*stream @@ -69,6 +71,7 @@ http\. NOKIA_ GPRS + X-Proxy-ID X-Moz X.Wap X-FH @@ -97,7 +100,7 @@ } else { *L = *STDIN; } -binmode(L,":encoding(UTF-8)"); +# binmode(L,":encoding(UTF-8)"); for (;;) { while (<L>) { @@ -116,7 +119,11 @@ } s/[\s\n]*$/\n\n/; print or exit; - if (m:\nGET /fop/(\w+)/:) { + $from = ''; + if (m:\nGET /fup/(\w{40,}):) { + $_ = decode_b64($1); + printf " FROM=\"%s\"\n\n",$1 if /from=([\w\@.-]+)/; + } elsif (m:\nGET /fop/(\w+)/:) { $dkey = $1; my $ddir = "$spooldir/.dkeys/$dkey"; $_ = readlink $ddir or next; @@ -125,21 +132,23 @@ printf " TO=\"%s\"\n",$to; $cgi = ''; if ($comment = slurp("$ddir/comment")) { - printf " COMMENT=\"%s\"\n",decode_utf8($comment)||''; + printf " COMMENT=\"%s\"\n",decode_utf8($comment,0)||''; } if (not -f "$ddir/data" and $_ = slurp("$ddir/error")) { s/\n.*//s; print " ERROR=\"$_\"\n"; } - elsif ($size = readlink("$ddir/size")) { + elsif ($size = -s "$ddir/data") { printf " SIZE=%s MB\n",int($size/1024/1024); } - print "\n" if $_; + print "\n"; + } elsif (m:\nGET /fup.*skey=(\w+):) { + read_skey($1); + print "\n"; } } sleep 1; if ($debug and $pid and $cgi) { - sleep 1; &read_debug_log; $pid = $cgi = ''; }; @@ -149,28 +158,54 @@ sub read_debug_log { my (@log,$log); local $/ = "\n"; + local $_; + local $^W; # no warnings "all"; - - if (@log = glob "$logdir/.debug/*_$pid.$cgi") { - $log = pop @log; - if (open $log,$log) { - binmode($log,":encoding(UTF-8)"); + + for (1..2) { + sleep 1; + @log = `ls -rt $logdir/.debug/*_${pid}.$cgi 2>/dev/null`; + if ($log = $log[-1] and open $log,$log) { + # binmode($log,":encoding(UTF-8)"); while (<$log>) { s/\r//; if (/^Content-Disposition:.*name="FILE".*filename="(.+)"/i) { print " FILE=\"$1\"\n"; } elsif (/^Content-Disposition:.*name="(\w+)"/i) { - $p = $1; + my $p = uc($1); $_ = <$log>; - $v = <$log>; + my $v = <$log>||''; $v =~ s/[\r\n]+//; - printf " %s=\"%s\"\n",$p,decode_utf8($v) if $v; + printf " %s=\"%s\"\n",$p,decode_utf8($v,0)||$v if $v; + read_akey($v) if $p eq 'AKEY'; + read_skey($v) if $p eq 'SKEY'; } elsif (/^(Param|Exp): (\w+=".+")/) { print " $2\n"; } } close $log; print "\n"; + return; + } + } +} + +sub read_akey { + my $akey = "$spooldir/.akeys/" . shift; + if (my $user = readlink($akey)) { + $user =~ s:../::; + printf " USER=\"%s\"\n",$user; + } +} + + +sub read_skey { + my $skey = "$spooldir/.skeys/" . shift; + if (open $skey,$skey) { + while (<$skey>) { + printf " FROM=\"%s\"\n",$1 if /from=(.+)/; + printf " TO=\"%s\"\n",$1 if /to=(.+)/; } + close $skey; } } diff -Nru fex-20140917/bin/sexget fex-20150120/bin/sexget --- fex-20140917/bin/sexget 2014-07-26 16:43:02.000000000 +0200 +++ fex-20150120/bin/sexget 2015-01-19 13:59:57.000000000 +0100 @@ -4,7 +4,7 @@ # # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> # -# Copyright: Perl Artistic +# Perl Artistic Licence # sexsend / sexget / sexxx @@ -19,9 +19,14 @@ eval 'use Net::INET6Glue::INET_is_INET6'; -our $version = 20140917; +our $version = 20150120; -$version = mtime($0) unless $version; +my %SSL = (SSL_version => 'TLSv1'); +my $sigpipe; + +if (-f ($_ = '/etc/fex/config.pl')) { + eval { require } or warn $@; +} $0 =~ s:.*/::; $| = 1; @@ -30,6 +35,7 @@ $usage = "usage: ... | $0 [options] [SEX-URL/]recipient [stream]\n". "options: -v verbose mode\n". + " -g show transfer rate\n". " -V show version\n". " -t timeout timeout in s (waiting for recipient)\n". "special: recipient may be \"public\" or \"anonymous\" or \".\"\n". @@ -39,8 +45,8 @@ if ($0 eq 'sexget' or $0 eq 'fuckme') { $usage = "usage: $0 [options] [[SEX-URL/]user:ID] [stream]\n". - "options: -g show transfer rate\n". - " -v verbose mode\n". + "options: -v verbose mode\n". + " -g show transfer rate\n". " -V show version\n". "arguments: user:ID use this user & ID\n". " (ID may be \"public\" or user:ID may be \"anonymous\")\n". @@ -53,8 +59,8 @@ $usage = "usage: $0 [-v] [-g] [-c] [-u [SEX-URL/]user] [-s stream] [files...]\n". "usage: $0 [-v] [-g] [-u [SEX-URL/]user] [-s stream] | ...\n". - "options: -g show transfer rate\n". - " -v verbose mode\n". + "options: -v verbose mode\n". + " -g show transfer rate\n". " -q quiet mode\n". " -c compress files\n". " -u SEX-URL/user SEX-URL and user (default: use FEXID/FEXXX)\n". @@ -93,6 +99,8 @@ $opt_h = $opt_v = $opt_V = $opt_q = 0; $opt_u = $opt_s = $opt_c = $opt_t = ''; +$_ = "$fexhome/config.pl"; require if -f; + if ($0 eq 'sexxx') { # xx server URL, user and auth-ID @@ -206,6 +214,8 @@ } +&get_ssl_env; + $fexcgi =~ s(^http://)()i; $fexcgi =~ s(/fup.*)(); $server = $fexcgi; @@ -223,12 +233,18 @@ # connect(SH,sockaddr_in($port,$iaddr)) or die "$0: connect $!\n"; # warn "connecting $server:$port user=$user\n"; if ($port == 443) { + if ($opt_v and %SSL) { + foreach my $v (keys %SSL) { + printf "%s => %s\n",$v,$SSL{$v}; + } + } eval "use IO::Socket::SSL"; die "$0: cannot load IO::Socket::SSL\n" if $@; $SH = IO::Socket::SSL->new( PeerAddr => $server, PeerPort => $port, - Proto => 'tcp', + Proto => 'tcp', + %SSL ); } else { $SH = IO::Socket::INET->new( @@ -499,11 +515,6 @@ return $line; } -sub mtime { - my @d = localtime((stat shift)[9]); - return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); -} - # from MIME::Base64::Perl sub decode_b64 { local $_ = shift; @@ -527,12 +538,182 @@ } +### common functions ### + + +sub mtime { + my @d = localtime((stat shift)[9]); + return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); +} + + +sub urldecode { + local $_ = shift; + s/\%([a-f\d]{2})/chr(hex($1))/ige; + return $_; +} + + +sub get_ssl_env { + # set SSL/TLS options + $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_ca_file) + ) { + my $env = uc($opt); + $env =~ s/_//g; + $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); + } + + if ($SSL{SSL_verify_mode}) { + &search_ca; + unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { + die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; + } + } elsif (defined($SSL{SSL_verify_mode})) { + # user has set SSLVERIFY=0 ! + } else { + &search_ca; + $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; + } +} + +sub search_ca { + local $_; + return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; + foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { + if (-f) { + $SSL{SSL_ca_file} = $_; + return; + } + } + foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { + if (-f) { + $SSL{SSL_ca_path} = $_; + return; + } + } +} + + +sub serverconnect { + 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) { + printf "--> %s\n",$connect if $opt_v; + nvtsend($connect,""); + $_ = <$SH>; + s/\r//; + printf "<-- $_"if $opt_v; + unless (/^HTTP.1.. 200/) { + die "$0: proxy error : $_"; + } + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->start_SSL($SH,%SSL); + } + } else { + tcpconnect($server,$port); + } +# if ($port == 443 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) { + # eval "use IO::Socket::SSL qw(debug3)"; + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + %SSL + ); + } else { + $SH = IO::Socket::INET->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 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"; + } + print "-->\n" if $opt_v; + print {$SH} "\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) { + undef $SH; + return 0; + } + } + + return 1; +} + + +# from MIME::Base64::Perl sub encode_b64 { my $res = ""; - my $eol = $_[1]; + my $eol = "\n"; my $padding; - $eol = "\n" unless defined $eol; pos($_[0]) = 0; $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); $res =~ tr|` -_|AA-Za-z0-9+/|; diff -Nru fex-20140917/bin/sexsend fex-20150120/bin/sexsend --- fex-20140917/bin/sexsend 2014-07-26 16:43:02.000000000 +0200 +++ fex-20150120/bin/sexsend 2015-01-19 13:59:57.000000000 +0100 @@ -4,7 +4,7 @@ # # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> # -# Copyright: Perl Artistic +# Perl Artistic Licence # sexsend / sexget / sexxx @@ -19,9 +19,14 @@ eval 'use Net::INET6Glue::INET_is_INET6'; -our $version = 20140917; +our $version = 20150120; -$version = mtime($0) unless $version; +my %SSL = (SSL_version => 'TLSv1'); +my $sigpipe; + +if (-f ($_ = '/etc/fex/config.pl')) { + eval { require } or warn $@; +} $0 =~ s:.*/::; $| = 1; @@ -30,6 +35,7 @@ $usage = "usage: ... | $0 [options] [SEX-URL/]recipient [stream]\n". "options: -v verbose mode\n". + " -g show transfer rate\n". " -V show version\n". " -t timeout timeout in s (waiting for recipient)\n". "special: recipient may be \"public\" or \"anonymous\" or \".\"\n". @@ -39,8 +45,8 @@ if ($0 eq 'sexget' or $0 eq 'fuckme') { $usage = "usage: $0 [options] [[SEX-URL/]user:ID] [stream]\n". - "options: -g show transfer rate\n". - " -v verbose mode\n". + "options: -v verbose mode\n". + " -g show transfer rate\n". " -V show version\n". "arguments: user:ID use this user & ID\n". " (ID may be \"public\" or user:ID may be \"anonymous\")\n". @@ -53,8 +59,8 @@ $usage = "usage: $0 [-v] [-g] [-c] [-u [SEX-URL/]user] [-s stream] [files...]\n". "usage: $0 [-v] [-g] [-u [SEX-URL/]user] [-s stream] | ...\n". - "options: -g show transfer rate\n". - " -v verbose mode\n". + "options: -v verbose mode\n". + " -g show transfer rate\n". " -q quiet mode\n". " -c compress files\n". " -u SEX-URL/user SEX-URL and user (default: use FEXID/FEXXX)\n". @@ -93,6 +99,8 @@ $opt_h = $opt_v = $opt_V = $opt_q = 0; $opt_u = $opt_s = $opt_c = $opt_t = ''; +$_ = "$fexhome/config.pl"; require if -f; + if ($0 eq 'sexxx') { # xx server URL, user and auth-ID @@ -206,6 +214,8 @@ } +&get_ssl_env; + $fexcgi =~ s(^http://)()i; $fexcgi =~ s(/fup.*)(); $server = $fexcgi; @@ -223,12 +233,18 @@ # connect(SH,sockaddr_in($port,$iaddr)) or die "$0: connect $!\n"; # warn "connecting $server:$port user=$user\n"; if ($port == 443) { + if ($opt_v and %SSL) { + foreach my $v (keys %SSL) { + printf "%s => %s\n",$v,$SSL{$v}; + } + } eval "use IO::Socket::SSL"; die "$0: cannot load IO::Socket::SSL\n" if $@; $SH = IO::Socket::SSL->new( PeerAddr => $server, PeerPort => $port, - Proto => 'tcp', + Proto => 'tcp', + %SSL ); } else { $SH = IO::Socket::INET->new( @@ -499,11 +515,6 @@ return $line; } -sub mtime { - my @d = localtime((stat shift)[9]); - return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); -} - # from MIME::Base64::Perl sub decode_b64 { local $_ = shift; @@ -527,12 +538,182 @@ } +### common functions ### + + +sub mtime { + my @d = localtime((stat shift)[9]); + return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); +} + + +sub urldecode { + local $_ = shift; + s/\%([a-f\d]{2})/chr(hex($1))/ige; + return $_; +} + + +sub get_ssl_env { + # set SSL/TLS options + $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_ca_file) + ) { + my $env = uc($opt); + $env =~ s/_//g; + $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); + } + + if ($SSL{SSL_verify_mode}) { + &search_ca; + unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { + die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; + } + } elsif (defined($SSL{SSL_verify_mode})) { + # user has set SSLVERIFY=0 ! + } else { + &search_ca; + $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; + } +} + +sub search_ca { + local $_; + return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; + foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { + if (-f) { + $SSL{SSL_ca_file} = $_; + return; + } + } + foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { + if (-f) { + $SSL{SSL_ca_path} = $_; + return; + } + } +} + + +sub serverconnect { + 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) { + printf "--> %s\n",$connect if $opt_v; + nvtsend($connect,""); + $_ = <$SH>; + s/\r//; + printf "<-- $_"if $opt_v; + unless (/^HTTP.1.. 200/) { + die "$0: proxy error : $_"; + } + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->start_SSL($SH,%SSL); + } + } else { + tcpconnect($server,$port); + } +# if ($port == 443 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) { + # eval "use IO::Socket::SSL qw(debug3)"; + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + %SSL + ); + } else { + $SH = IO::Socket::INET->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 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"; + } + print "-->\n" if $opt_v; + print {$SH} "\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) { + undef $SH; + return 0; + } + } + + return 1; +} + + +# from MIME::Base64::Perl sub encode_b64 { my $res = ""; - my $eol = $_[1]; + my $eol = "\n"; my $padding; - $eol = "\n" unless defined $eol; pos($_[0]) = 0; $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); $res =~ tr|` -_|AA-Za-z0-9+/|; diff -Nru fex-20140917/bin/sexxx fex-20150120/bin/sexxx --- fex-20140917/bin/sexxx 2014-07-26 16:43:02.000000000 +0200 +++ fex-20150120/bin/sexxx 2015-01-19 13:59:57.000000000 +0100 @@ -4,7 +4,7 @@ # # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> # -# Copyright: Perl Artistic +# Perl Artistic Licence # sexsend / sexget / sexxx @@ -19,9 +19,14 @@ eval 'use Net::INET6Glue::INET_is_INET6'; -our $version = 20140917; +our $version = 20150120; -$version = mtime($0) unless $version; +my %SSL = (SSL_version => 'TLSv1'); +my $sigpipe; + +if (-f ($_ = '/etc/fex/config.pl')) { + eval { require } or warn $@; +} $0 =~ s:.*/::; $| = 1; @@ -30,6 +35,7 @@ $usage = "usage: ... | $0 [options] [SEX-URL/]recipient [stream]\n". "options: -v verbose mode\n". + " -g show transfer rate\n". " -V show version\n". " -t timeout timeout in s (waiting for recipient)\n". "special: recipient may be \"public\" or \"anonymous\" or \".\"\n". @@ -39,8 +45,8 @@ if ($0 eq 'sexget' or $0 eq 'fuckme') { $usage = "usage: $0 [options] [[SEX-URL/]user:ID] [stream]\n". - "options: -g show transfer rate\n". - " -v verbose mode\n". + "options: -v verbose mode\n". + " -g show transfer rate\n". " -V show version\n". "arguments: user:ID use this user & ID\n". " (ID may be \"public\" or user:ID may be \"anonymous\")\n". @@ -53,8 +59,8 @@ $usage = "usage: $0 [-v] [-g] [-c] [-u [SEX-URL/]user] [-s stream] [files...]\n". "usage: $0 [-v] [-g] [-u [SEX-URL/]user] [-s stream] | ...\n". - "options: -g show transfer rate\n". - " -v verbose mode\n". + "options: -v verbose mode\n". + " -g show transfer rate\n". " -q quiet mode\n". " -c compress files\n". " -u SEX-URL/user SEX-URL and user (default: use FEXID/FEXXX)\n". @@ -93,6 +99,8 @@ $opt_h = $opt_v = $opt_V = $opt_q = 0; $opt_u = $opt_s = $opt_c = $opt_t = ''; +$_ = "$fexhome/config.pl"; require if -f; + if ($0 eq 'sexxx') { # xx server URL, user and auth-ID @@ -206,6 +214,8 @@ } +&get_ssl_env; + $fexcgi =~ s(^http://)()i; $fexcgi =~ s(/fup.*)(); $server = $fexcgi; @@ -223,12 +233,18 @@ # connect(SH,sockaddr_in($port,$iaddr)) or die "$0: connect $!\n"; # warn "connecting $server:$port user=$user\n"; if ($port == 443) { + if ($opt_v and %SSL) { + foreach my $v (keys %SSL) { + printf "%s => %s\n",$v,$SSL{$v}; + } + } eval "use IO::Socket::SSL"; die "$0: cannot load IO::Socket::SSL\n" if $@; $SH = IO::Socket::SSL->new( PeerAddr => $server, PeerPort => $port, - Proto => 'tcp', + Proto => 'tcp', + %SSL ); } else { $SH = IO::Socket::INET->new( @@ -499,11 +515,6 @@ return $line; } -sub mtime { - my @d = localtime((stat shift)[9]); - return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); -} - # from MIME::Base64::Perl sub decode_b64 { local $_ = shift; @@ -527,12 +538,182 @@ } +### common functions ### + + +sub mtime { + my @d = localtime((stat shift)[9]); + return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); +} + + +sub urldecode { + local $_ = shift; + s/\%([a-f\d]{2})/chr(hex($1))/ige; + return $_; +} + + +sub get_ssl_env { + # set SSL/TLS options + $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_ca_file) + ) { + my $env = uc($opt); + $env =~ s/_//g; + $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); + } + + if ($SSL{SSL_verify_mode}) { + &search_ca; + unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { + die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; + } + } elsif (defined($SSL{SSL_verify_mode})) { + # user has set SSLVERIFY=0 ! + } else { + &search_ca; + $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; + } +} + +sub search_ca { + local $_; + return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; + foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { + if (-f) { + $SSL{SSL_ca_file} = $_; + return; + } + } + foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { + if (-f) { + $SSL{SSL_ca_path} = $_; + return; + } + } +} + + +sub serverconnect { + 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) { + printf "--> %s\n",$connect if $opt_v; + nvtsend($connect,""); + $_ = <$SH>; + s/\r//; + printf "<-- $_"if $opt_v; + unless (/^HTTP.1.. 200/) { + die "$0: proxy error : $_"; + } + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->start_SSL($SH,%SSL); + } + } else { + tcpconnect($server,$port); + } +# if ($port == 443 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) { + # eval "use IO::Socket::SSL qw(debug3)"; + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + %SSL + ); + } else { + $SH = IO::Socket::INET->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 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"; + } + print "-->\n" if $opt_v; + print {$SH} "\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) { + undef $SH; + return 0; + } + } + + return 1; +} + + +# from MIME::Base64::Perl sub encode_b64 { my $res = ""; - my $eol = $_[1]; + my $eol = "\n"; my $padding; - $eol = "\n" unless defined $eol; pos($_[0]) = 0; $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); $res =~ tr|` -_|AA-Za-z0-9+/|; diff -Nru fex-20140917/bin/xx fex-20150120/bin/xx --- fex-20140917/bin/xx 2014-09-05 09:03:47.000000000 +0200 +++ fex-20150120/bin/xx 2015-01-16 15:52:53.000000000 +0100 @@ -6,7 +6,7 @@ # # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> # -# Copyright: Perl Artistic +# Perl Artistic Licence use 5.006; use strict qw'vars subs'; @@ -27,17 +27,23 @@ eval 'use Net::INET6Glue::INET_is_INET6'; -our ($SH,$fexhome,$idf,$tmpdir,$windoof,$sigpipe,$useragent,$editor,$nomail); +&update if "@ARGV" eq 'UPDATE'; + +$| = 1; + +our ($SH,$fexhome,$idf,$tmpdir,$windoof,$useragent,$editor,$nomail); our ($anonymous,$public); -our ($tpid); +our ($tpid,$frecipient); our ($FEXID,$FEXXX,$HOME); +our (%alias); our $chunksize = 0; -our $version = 20140917; +our $version = 20150120; our $_0 = $0; our $DEBUG; - -$version ||= mtime($0); - + +my %SSL = (SSL_version => 'TLSv1'); +my $sigpipe; + if ($Config{osname} =~ /^mswin/i) { $windoof = $Config{osname}; $HOME = $ENV{USERPROFILE}; @@ -47,6 +53,7 @@ $editor = $ENV{EDITOR} || 'notepad.exe'; $useragent = sprintf("fexsend-$version (%s %s)", $Config{osname},$Config{archname}); + $SSL{SSL_verify_mode} = 0; } else { $0 =~ s:.*/::; $HOME = (getpwuid($<))[7]||$ENV{HOME}; @@ -61,7 +68,9 @@ chmod 0600,$idf; } -$| = 1; +if (-f ($_ = '/etc/fex/config.pl')) { + eval { require } or warn $@; +} my $from = ''; my $to = ''; @@ -79,7 +88,6 @@ my $timeout = 30; # server timeout my $fexlist = "$tmpdir/fexlist"; my ($usage,$hints); - my $xx = $0 =~ /^xx/; if ($xx) { @@ -97,7 +105,7 @@ usage: $0 [options] file(s) [@] recipient(s) or: $0 [special options] or: $0 -f \# recipient(s) - or: $0 -x \# [-C -k -D -K] + or: $0 -x \# [-C -k -D -K -S] options: -v verbose mode -d delete file on fex server -c compress file @@ -114,13 +122,14 @@ -s stream read data from pipe and upload it with stream name special options: -I initialize ID file or show ID -I tag add alternate ID data (secondary logins) to ID file - -l list sent files numbered (# needed for -f -x -d) + -l list sent files numbered (# needed for -f -x -d -N) -f \# forward already uploaded file to another recipient -x \# modify options -C -k -D -K for already uploaded file -d \# delete file on fex server + -N \# resend notification e-mail -Q check quotas -A edit server address book (aliases) - -U show authorized URL + -S show server/user settings and auth-ID -H show hints, examples and more options -V show version (\# is a file number, see output from $0 -l) @@ -132,7 +141,7 @@ # -R FEX mail self-register your e-mail address at FEX server $hints = <<EOD; -$0 Hints and more options: +$0 hints and more options: usage: $0 [options] file recipient(s) @@ -167,7 +176,7 @@ If you want a Bcc of the notification e-mail then add '!bcc!' to the comment: fexsend -C '!bcc! for me and you' ... -Special options: +Additional special options: -. sends a short instead of a detailed notification e-mail -/ does not upload the file, but tells the server to link it @@ -177,6 +186,7 @@ -q is quiet mode -r ADDRESS sets e-mail Reply-To ADDRESS -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 @@ -204,6 +214,13 @@ 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: +SSLVERIFY=1 # activate server identity verification +SSLVERSION=TLSv1 # this is the default +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 @@ -218,7 +235,27 @@ FEXID="FEXSERVER USER AUTHID" $0 file recipient Example: FEXID="fex.flupp.org gaga\@flupp.org blubb" $0 big.file framstag\@rus.uni-stuttgart.de - + +You can define aliases (and optional fexsend options) in \$HOME/.fex/config.pl: + %alias = ( + 'alias1' => 'user1\@domain1.org', + 'alias2' => 'user2\@domain2.org', + 'both' => 'user1\@domain1.org,user2\@domain2.org', + 'extra' => 'extra\@special.net:-i other -K -k 30', + ); + +fexsend also respects aliases in $HOME/.mutt/aliases +The alias priority is (descending): +\$HOME/.fex/config.pl +\$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; EOD } @@ -255,22 +292,25 @@ our ($opt_q,$opt_h,$opt_H,$opt_v,$opt_m,$opt_c,$opt_k,$opt_d,$opt_l,$opt_I, $opt_K,$opt_D,$opt_u,$opt_f,$opt_a,$opt_C,$opt_R,$opt_M,$opt_L,$opt_Q, $opt_A,$opt_i,$opt_z,$opt_Z,$opt_b,$opt_P,$opt_x,$opt_X,$opt_V,$opt_U, - $opt_s,$opt_o,$opt_g,$opt_F,$opt_n,$opt_r); + $opt_s,$opt_o,$opt_g,$opt_F,$opt_n,$opt_r,$opt_S,$opt_N); if ($xx) { $opt_q = 1 if @ARGV and $ARGV[-1] eq '--' and pop @ARGV or not -t STDOUT; $opt_h = $opt_v = $opt_m = $opt_I = 0; $opt_X = ''; + $_ = "$fexhome/config.pl"; require if -f; getopts('hvIm:') or die $usage; } else { $opt_h = $opt_v = $opt_m = $opt_c = $opt_k = $opt_d = $opt_l = $opt_I = 0; $opt_H = $opt_K = $opt_D = $opt_R = $opt_M = $opt_L = $opt_Q = $opt_A = 0; $opt_x = $opt_o = $opt_g = $opt_V = $opt_U = $opt_F = $opt_n = $opt_q = 0; + $opt_S = $opt_N = 0; ${'opt_@'} = ${'opt_!'} = ${'opt_+'} = ${'opt_.'} = ${'opt_/'} = 0; ${'opt_='} = ${'opt_#'} = ''; $opt_u = $opt_f = $opt_a = $opt_C = $opt_i = $opt_b = $opt_P = $opt_X = ''; $opt_s = $opt_r = ''; - getopts('hHvcdognVDKlILUARWMFzZqQ@!+./r:m:k:u:f:a:s:C:i:b:P:x:X:=:#:') + $_ = "$fexhome/config.pl"; require if -f; + getopts('hHvcdognVDKlILUARWMFzZqQS@!+./r:m:k:u:f:a:s:C:i:b:P:x:X:N:=:#:') or die $usage; if ($opt_H) { @@ -307,16 +347,12 @@ die "$0: you cannot use both options -I and -R\n"; } - if ($opt_R) { - ®ister; - exit; - } - # $opt_C is COMMENT command in F*EX protocol $opt_C = ($opt_d) ? 'DELETE': ($opt_l or $opt_L) ? 'LIST': ($opt_Q) ? 'CHECKQUOTA': + ($opt_S) ? 'LISTSETTINGS': ($opt_Z) ? 'RECEIVEDLOG': ($opt_z) ? 'SENDLOG': (${'opt_!'}) ? 'FOPLOG': @@ -328,12 +364,21 @@ $opt_D; } +&get_ssl_env; + if ($opt_h) { female_mode("show help?") if $opt_F; print $usage; exit; } + +if ($opt_R) { + ®ister; + exit; +} + + die $usage if $opt_m and $opt_m !~ /^\d+/; if ($opt_P) { @@ -492,7 +537,7 @@ &inquire if $windoof and not @ARGV and not ($opt_l or $opt_L or $opt_Q or $opt_A or $opt_U or $opt_I or - $opt_f or $opt_x); + $opt_f or $opt_x or $opt_N); if (${'opt_.'}) { $opt_C = "!SHORTMAIL! $opt_C"; @@ -503,20 +548,18 @@ } unless ($skey or $gkey or $anonymous) { - if ($opt_v) { - if ($FEXID) { - warn "ID data from \$FEXID: $fexcgi $from $id\n"; - } elsif (-f $idf) { - warn "ID data from $idf: $fexcgi $from $id\n"; - } - } - warn "Server/User: $fexcgi/$from\n" unless $opt_q; + if (not $opt_q and ( + $opt_f||$opt_x||$opt_Q||$opt_l||$opt_L||$opt_U||$opt_z||$opt_Z||$opt_A + ||$opt_d||${'opt_!'}||${'opt_@'}) + ) { warn "Server/User: $fexcgi/$from\n" } } 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 } @@ -817,7 +860,51 @@ from => $from, to => $from, id => $sid, - comment => $opt_C, + command => $opt_C, + ); + die "$0: no response from fex server $server\n" unless @r; + $_ = shift @r; + unless (/^HTTP.* 2/) { + s:HTTP/[\d\. ]+::; + die "$0: server response: $_\n"; + } + if (($_) = grep(/^X-Sender-Quota/,@r) and /(\d+)\s+(\d+)/) { + print "sender quota (used): $1 ($2) MB\n"; + } else { + print "sender quota: unlimited\n"; + } + if (($_) = grep(/^X-Recipient-Quota/,@r) and /(\d+)\s+(\d+)/) { + print "recipient quota (used): $1 ($2) MB\n"; + } else { + print "recipient quota: unlimited\n"; + } +} + + +sub query_settings { + my (@r,$r); + local $_; + + female_mode("query settings?") if $opt_F; + + if ($FEXID) { + print "ID data from \$FEXID\n"; + } elsif (-f $idf) { + print "ID data from $idf\n"; + } else { + die "$0: found no ID\n"; + } + print "server: $fexcgi\n"; + print "user: $from\n"; + print "auth-ID: $id\n"; + print "login URL: "; + &show_URL; + + @r = formdatapost( + from => $from, + to => $from, + id => $sid, + command => $opt_C, ); die "$0: no response from fex server $server\n" unless @r; $_ = shift @r; @@ -825,6 +912,18 @@ s:HTTP/[\d\. ]+::; die "$0: server response: $_\n"; } + if (($_) = grep(/^X-Autodelete/,@r) and /:\s+(\w+)/) { + print "autodelete: $1\n"; + } + if (($_) = grep(/^X-Default-Keep/,@r) and /(\d+)/) { + print "default keep: $1 days\n"; + } + if (($_) = grep(/^X-Default-Locale/,@r) and /:\s+(\w+)/) { + print "default locale: $1\n"; + } + if (($_) = grep(/^X-MIME/,@r) and /:\s+(\w+)/) { + print "display file with browser: $1\n"; + } if (($_) = grep(/^X-Sender-Quota/,@r) and /(\d+)\s+(\d+)/) { print "sender quota (used): $1 ($2) MB\n"; } else { @@ -934,7 +1033,6 @@ sub show_URL { printf "%s/fup/%s\n",$fexcgi,encode_b64("from=$from&id=$id"); - exit; } @@ -946,7 +1044,7 @@ from => $from, to => $from, id => $sid, - comment => $opt_C, + command => $opt_C, ); die "$0: no response from fex server $server\n" unless @r; $_ = shift @r; @@ -1135,8 +1233,22 @@ query_sid($server,$port); } foreach $to (@to) { + # alias in local config? + if ($alias{$to}) { + if ($alias{$to} =~ /(.+?):(.+)/) { + my $ato = $1; + my $opt = $2; + my @argv = @_ARGV; + pop @argv; + # special extra upload + system $0,split(/\s/,$opt),@argv,$ato; + $to = ''; + } else { + $to = $alias{$to}; + } + } # alias in server address book? - if ($AB{$to}) { + 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}; @@ -1169,7 +1281,8 @@ } } - $to = join(',',@to); + $to = join(',',grep /./,@to) or exit; + warn "Server/User: $fexcgi/$from\n" unless $opt_q; if ( not $skey and not $gkey @@ -1356,10 +1469,21 @@ } 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); foreach (@r) { - if ($from eq $to or $from =~ /^\Q$to\E@/i or $nomail or $anonymous) { - print "$1\n" if /^X-(Recipient.*)/i; - print "$2\n" if /^(X-)?(Location:.*)/i; + if (/^(X-)?(Recipient.*)/i) { + $recipient = $2; + if (/notification=no/i) { $nonot = 1 } + else { $nonot = 0 } + } + 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"; + } } } } @@ -1440,6 +1564,61 @@ } +sub renotify { + my (@r); + my ($to,$n,$dkey,$file,$req,$recipient); + local $_; + + die $usage if @ARGV; + + open $fexlist,$fexlist or die "$0: $fexlist - $!\n"; + while (<$fexlist>) { + if (/^\s*(\d+)\) (\w+) \[\d+ d\] (.+)/ and $1 eq $opt_N) { + $n = $1; + $dkey = $2; + last; + } + } + close $fexlist; + + unless ($n) { + die "$0: file #$opt_N not found in fexlist\n"; + } + + female_mode("resend notification for file #$opt_N?") if $opt_F; + + serverconnect($server,$port); + query_sid($server,$port); + + $req = "GET $proxy_prefix/fup?" + ."from=$from&ID=$sid&dkey=$dkey&command=RENOTIFY" + ." HTTP/1.1"; + sendheader("$server:$port",$req); + http_response(); + while (<$SH>) { + s/\r//; + print "<-- $_" if $opt_v; + last if /^\s*$/; + if (/^X-Notify: (.+)\/(.+)\/(.+)/) { + $recipient = $1; + $file = $3; + } + } + + if ($file) { + print "notification e-mail for $file has been resent to $recipient\n"; + } else { + if ($opt_v) { + die "$0: server failed\n"; + } else { + die "$0: server failed, rerun command with option -v\n"; + } + } + + exit; +} + + sub modify { my (@r); my ($n,$dkey,$file,$req); @@ -1702,11 +1881,12 @@ 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,$P{to},$P{from},$P{id}, - $filename,$fileid); + ($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; - die "$0: $file has been already transferred\n"; + warn "$0: $file has been already transferred\n"; + return $file; } elsif ($seek and $seek < $filesize) { $resume = " (resuming at byte $seek)"; } elsif ($filesize <= $seek) { @@ -2063,7 +2243,7 @@ $zipbase =~ s/\.zip$//; map { s/([^_\w\+\-\.])/\\$1/g } @files; - open my $ff,"find @files -type f|" or die "$0: cannot search for @_ - $!\n"; + open my $ff,"find @files|" or die "$0: cannot search for @_ - $!\n"; @files = (); zipfile: for (;;) { @@ -2075,7 +2255,8 @@ $zsize = 0; while ($file = <$ff>) { chomp $file; - next if -l $file or not -f $file; + # next if -l $file or not -f $file; + next unless -f $file; $size = -s $file; if ($size > 2147480000) { unlink @zipfiles; @@ -2114,7 +2295,10 @@ } print $cmd,"\n" if $opt_v; open $cmd,"|$cmd" or die "$0: cannot create $zip - $!\n"; - foreach (@_) { print {$cmd} $_."\n" } + foreach (@_) { + print {$cmd} $_."\n"; + print " $_\n" if $opt_v; + } close $cmd or die "$0: zip failed - $!\n"; return $zip; @@ -2137,67 +2321,6 @@ } -sub serverconnect { - my ($server,$port) = @_; - my $connect = "CONNECT $server:$port HTTP/1.1"; - local $_; - - if ($proxy) { - tcpconnect(split(':',$proxy)); - if ($port == 443) { - printf "--> %s\n",$connect if $opt_v; - nvtsend($connect,""); - $_ = <$SH>; - s/\r//; - printf "<-- $_"if $opt_v; - unless (/^HTTP.1.. 200/) { - die "$0: proxy error : $_"; - } - eval "use IO::Socket::SSL"; - die "$0: cannot load IO::Socket::SSL\n" if $@; - $SH = IO::Socket::SSL->start_SSL($SH); - } - } else { - tcpconnect($server,$port); - } -} - - -# set up tcp/ip connection -sub tcpconnect { - my ($server,$port) = @_; - - if ($SH) { - close $SH; - undef $SH; - } - - if ($port == 443) { - eval "use IO::Socket::SSL"; - die "$0: cannot load IO::Socket::SSL\n" if $@; - $SH = IO::Socket::SSL->new( - PeerAddr => $server, - PeerPort => $port, - Proto => 'tcp', - ); - } else { - $SH = IO::Socket::INET->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 query_file { my ($server,$port,$to,$from,$id,$filename,$fileid) = @_; my $seek = 0; @@ -2480,42 +2603,6 @@ } -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"; - } - print "-->\n" if $opt_v; - print {$SH} "\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) { - undef $SH; - return 0; - } - } - - return 1; -} - - # transfer status sub ts { my ($b,$tb) = @_; @@ -2568,6 +2655,7 @@ s/autodelete=\w+/autodelete=$opt_D/ if $opt_D; s/keep=\d+/keep=$opt_k/ if $opt_k; print; + $frecipient ||= (split)[1]; } } } else { @@ -2624,12 +2712,6 @@ } -sub mtime { - my @d = localtime((stat shift)[9]); - return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); -} - - # emulate seek on a pipe sub readahead { my $fh = shift; # filehandle @@ -2706,21 +2788,6 @@ } -# from MIME::Base64::Perl -sub encode_b64 { - my $res = ""; - my $eol = "\n"; - my $padding; - - pos($_[0]) = 0; - $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); - $res =~ tr|` -_|AA-Za-z0-9+/|; - $padding = (3-length($_[0])%3)%3; - $res =~ s/.{$padding}$/'=' x $padding/e if $padding; - return $res; -} - - sub female_mode { local $_; if (open my $tty,'/dev/tty') { @@ -2742,6 +2809,7 @@ sub http_response { local $_ = shift || <$SH>; my @r = @_; + my $error; $_ = <$SH> unless $_; unless (defined $_ and /\w/) { @@ -2755,8 +2823,13 @@ die "$0: server error: $_\n@r\n"; } unless (/^HTTP.* 200/) { - s/HTTP.[\s\d.]+//; - die "$0: server error: $_\n"; + $error = $_; + $error =~ s/HTTP.[\s\d.]+//; + if ($opt_v) { + print "<-- $_"; + print "<-- $_" while <$SH>; + } + die "$0: server error: $error\n"; } print "<-- $_\n" if $opt_v; @@ -2764,6 +2837,48 @@ } +sub ws { + local $_ = shift; + return split; +} + + +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>; + close $p; + s/\n$cfb.*/\n$cfb\n$cfc/s; + system "vv -s $p"; + open $p,'>',$p or die "cannot write $p - $!\n"; + print {$p} $_; + close $p; + } + + exec "l $0 fexget sexsend"; + exit; +} + +### common functions ### + + +sub mtime { + my @d = localtime((stat shift)[9]); + return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); +} + + sub urldecode { local $_ = shift; s/\%([a-f\d]{2})/chr(hex($1))/ige; @@ -2771,7 +2886,170 @@ } -sub ws { - local $_ = shift; - return split; +sub get_ssl_env { + # set SSL/TLS options + $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_ca_file) + ) { + my $env = uc($opt); + $env =~ s/_//g; + $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); + } + + if ($SSL{SSL_verify_mode}) { + &search_ca; + unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { + die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; + } + } elsif (defined($SSL{SSL_verify_mode})) { + # user has set SSLVERIFY=0 ! + } else { + &search_ca; + $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; + } +} + +sub search_ca { + local $_; + return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; + foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { + if (-f) { + $SSL{SSL_ca_file} = $_; + return; + } + } + foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { + if (-f) { + $SSL{SSL_ca_path} = $_; + return; + } + } +} + + +sub serverconnect { + 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) { + printf "--> %s\n",$connect if $opt_v; + nvtsend($connect,""); + $_ = <$SH>; + s/\r//; + printf "<-- $_"if $opt_v; + unless (/^HTTP.1.. 200/) { + die "$0: proxy error : $_"; + } + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->start_SSL($SH,%SSL); + } + } else { + tcpconnect($server,$port); + } +# if ($port == 443 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) { + # eval "use IO::Socket::SSL qw(debug3)"; + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + %SSL + ); + } else { + $SH = IO::Socket::INET->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 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"; + } + print "-->\n" if $opt_v; + print {$SH} "\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) { + undef $SH; + return 0; + } + } + + return 1; +} + + +# from MIME::Base64::Perl +sub encode_b64 { + my $res = ""; + my $eol = "\n"; + my $padding; + + pos($_[0]) = 0; + $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); + $res =~ tr|` -_|AA-Za-z0-9+/|; + $padding = (3-length($_[0])%3)%3; + $res =~ s/.{$padding}$/'=' x $padding/e if $padding; + return $res; } diff -Nru fex-20140917/cgi-bin/fac fex-20150120/cgi-bin/fac --- fex-20140917/cgi-bin/fac 2014-08-18 12:32:32.000000000 +0200 +++ fex-20150120/cgi-bin/fac 2015-01-17 00:17:28.000000000 +0100 @@ -816,7 +816,7 @@ } $user .= '@'.$mdomain if $mdomain and $user !~ /@/; - open my $mail,"|$sendmail -f '$admin' '$user' '$bcc'" + open my $mail,'|-',$sendmail,'-f',$admin,$user,$bcc or http_die("cannot start sendmail - $!\n"); pq($mail,qq( 'From: $admin' diff -Nru fex-20140917/cgi-bin/foc fex-20150120/cgi-bin/foc --- fex-20140917/cgi-bin/foc 2014-05-26 14:08:41.000000000 +0200 +++ fex-20150120/cgi-bin/foc 2015-01-11 11:58:09.000000000 +0100 @@ -10,6 +10,9 @@ use Fcntl qw(:flock); use Digest::MD5 qw(md5_hex); +$CGI::LIST_CONTEXT_WARN = 0; +$CGI::LIST_CONTEXT_WARN = 0; + # add fex lib ($FEXLIB) = $ENV{FEXLIB} =~ /(.+)/; die "$0: no $FEXLIB\n" unless -d $FEXLIB; @@ -208,6 +211,17 @@ ' Get <a href="/fuc?reminder=no&akey=$akey">no reminder</a> notification e-mails (current setting: <em>send reminders</em>).' )); } + if (-e "$user/\@MIME") { + pq(qq( + ' <p><hr><p>' + ' <a href="/fuc?mime=no&akey=$akey">Save</a> files after download (current setting: <em>display</em>).' + )); + } else { + pq(qq( + ' <p><hr><p>' + ' <a href="/fuc?mime=yes&akey=$akey">Display</a> files when downloading with web browser (current setting: <em>save</em>).' + )); + } pq(qq( ' <p><hr><p>' ' <a href="/fup?akey=$akey">Back to fup (upload page)</a>' diff -Nru fex-20140917/cgi-bin/fop fex-20150120/cgi-bin/fop --- fex-20140917/cgi-bin/fop 2014-09-11 23:54:12.000000000 +0200 +++ fex-20150120/cgi-bin/fop 2015-01-13 14:03:50.000000000 +0100 @@ -307,7 +307,7 @@ } } - + if ($qs =~ /\&?KEEP=(\d+)/i) { $keep = $1; $filename = filename($file); @@ -692,8 +692,10 @@ $fileid = readlink "$file/id" || ''; # determine own MIME entity header for download + my $mime = $file; + $mime =~ s:/.*:/\@MIME:; my $mt = $ENV{FEXHOME}.'/etc/mime.types'; - if ($http_client !~ /MSIE/ and $type =~ /x-mime/i and open $mt,'<',$mt) { + if (($type =~ /x-mime/i or -e $mime) and open $mt,'<',$mt) { $type = 'application/octet-stream'; MIMETYPES: while (<$mt>) { chomp; diff -Nru fex-20140917/cgi-bin/fuc fex-20150120/cgi-bin/fuc --- fex-20140917/cgi-bin/fuc 2014-06-03 10:51:57.000000000 +0200 +++ fex-20150120/cgi-bin/fuc 2015-01-09 21:55:57.000000000 +0100 @@ -1,7 +1,7 @@ #!/usr/bin/perl -wT # FEX CGI for user control -# (subuser, groups, address book, one time upload key, auth-ID) +# (subuser, groups, address book, one time upload key, auth-ID, etc) # # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> # @@ -11,6 +11,9 @@ use Fcntl qw(:flock); use Digest::MD5 qw(md5_hex); +$CGI::LIST_CONTEXT_WARN = 0; +$CGI::LIST_CONTEXT_WARN = 0; + # add fex lib ($FEXLIB) = $ENV{FEXLIB} =~ /(.+)/; die "$0: no $FEXLIB\n" unless -d $FEXLIB; @@ -36,7 +39,7 @@ my $user = my $id = my $nid = my $ssid = my $comment = ''; my $notification = my $reminder = my $disclaimer = ''; -my $encryption = my $pubkey = ''; +my $encryption = my $pubkey = my $mime = ''; $akey = ''; # delete akey cookie @@ -64,6 +67,7 @@ $v =~ /^encryption$/i ? $encryption = checkchars('parameter',$vv): $v =~ /^pubkey$/i ? $pubkey = $vv: $v =~ /^reminder$/i ? $reminder = checkchars('parameter',$vv): + $v =~ /^mime$/i ? $mime = checkchars('parameter',$vv): $v =~ /^comment$/i ? $comment = decode_utf8(normalize($vv)): $v =~ /^id$/i ? $id = checkchars('auth-ID',$vv): $v =~ /^nid$/i ? $nid = checkchars('auth-ID',$vv): @@ -327,7 +331,7 @@ my $rows = ($ab =~ tr/\n//) + 5; pq(qq( '<h2>Edit address book</h2>' - '<table border=1>' + '<table border=0>' ' <tr align="left"><th>Entry:<th>alias<th>e-mail address<th># optional comment</tr>' ' <tr align="left"><td>Example:<td><code>Framstag</code><td><code>framstag\@rus.uni-stuttgart.de</code><td><code># Ulli Horlacher</code></tr>' '</table>' @@ -336,7 +340,7 @@ ' accept-charset="UTF-8"' ' enctype="multipart/form-data">' ' <input type="hidden" name="akey" value="$akey">' - ' <textarea name="ab" cols="80" rows="$rows">$ab</textarea><br>' + ' <textarea name="ab" cols="160" rows="$rows">$ab</textarea><br>' ' <input type="submit" value="submit">' '</form>' '<p>' @@ -414,6 +418,29 @@ '<p>' '<a href="/foc?akey=$akey">back to F*EX operation control</a>' '</body></html>' + )); + &reexec; +} + +if ($user and $mime eq 'yes') { + open $mime,'>',"$user/\@MIME" or http_die("cannot write $user/\@MIME - $!\n"); + close $mime; + pq(qq( + '<h3>Downloads will now be displayed (if possible).<h3>' + '<p>' + '<a href="/foc?akey=$akey">back to F*EX operation control</a>' + '</body></html>' + )); + &reexec; +} + +if ($user and $mime eq 'no') { + unlink "$user/\@MIME"; + pq(qq( + '<h3>Downloads will now be saved.<h3>' + '<p>' + '<a href="/foc?akey=$akey">back to F*EX operation control</a>' + '</body></html>' )); &reexec; } diff -Nru fex-20140917/cgi-bin/fup fex-20150120/cgi-bin/fup --- fex-20140917/cgi-bin/fup 2014-09-17 21:16:08.000000000 +0200 +++ fex-20150120/cgi-bin/fup 2015-01-18 01:22:56.000000000 +0100 @@ -16,6 +16,7 @@ use Cwd qw'abs_path'; use constant DS => 60*60*24; +use constant M => 1024*1024; # add fex lib die "$0: no \$FEXLIB\n" unless $ENV{FEXLIB}; @@ -40,7 +41,7 @@ our ($FEXHOME); our ($spooldir,$durl,$tmpdir,$logdir,$docdir,$hostname,$admin,$fra); our ($keep_default,$recipient_quota,$sender_quota); -our ($sendmail,$mdomain,$fop_auth,$faillog); +our ($sendmail,$mdomain,$fop_auth,$mail_auth,$faillog); our ($dkeydir,$ukeydir,$akeydir,$skeydir,$gkeydir,$xkeydir); our $akey = ''; our $dkey = ''; @@ -118,8 +119,8 @@ $uid = randstring(8) unless $uid; # upload ID # user requests for forgotten ID -$id_forgotten = $id if $id =~ /^"?\?"?/; -if ($from and $id_forgotten and not $fop_auth and not $nomail) { +$id_forgotten = $id if $id =~ /^"?\?"?$/; +if ($from and $id_forgotten and $mail_authid and not ($fop_auth or $nomail)) { &check_status($from); &id_forgotten; exit; @@ -154,10 +155,6 @@ $nomail = $anonymous; } -if ($to and (readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) { - $nomail = 'recipient'; -} - $comment = 'NOMAIL' if $nomail and not $comment; # one time token @@ -315,7 +312,6 @@ if ($command eq 'CHECKQUOTA') { http_die("illegal command \"$command\"") if $public or $anonymous; - my ($quota,$du); nvt_print('HTTP/1.1 204 OK'); # nvt_print("X-SID: $ENV{SID}") if $ENV{SID}; ($quota,$du) = check_sender_quota($muser||$from); @@ -326,36 +322,45 @@ exit; } + if ($command eq 'LISTSETTINGS') { + http_die("illegal command \"$command\"") if $public or $anonymous; + nvt_print('HTTP/1.1 204 OK'); + # nvt_print("X-SID: $ENV{SID}") if $ENV{SID}; + ($quota,$du) = check_sender_quota($muser||$from); + nvt_print("X-Sender-Quota: $quota $du") if $quota; + ($quota,$du) = check_recipient_quota($muser||$from); + nvt_print("X-Recipient-Quota: $quota $du") if $quota; + $autodelete = lc(readlink "$from/\@AUTODELETE" || $autodelete); + nvt_print("X-Autodelete: $autodelete"); + $keep = readlink "$from/\@KEEP" || $keep; + nvt_print("X-Default-Keep: $keep"); + $locale = readlink "$from/\@LOCALE" || $default_locale || 'english'; + nvt_print("X-Default-Locale: $locale"); + $mime = -e "$from/\@MIME" ? 'yes' : 'no'; + nvt_print("X-MIME: $mime"); + nvt_print(''); + exit; + } + if ($command eq 'RENOTIFY') { http_die("illegal command \"$command\"") if $public or $anonymous; - my ($file,$filename,$mtime,$comment,$keep); my $nfile = ''; if ($dkey) { # resend notification e-mail - $file = readlink(".dkeys/$dkey") + $file = readlink("$dkeydir/$dkey") or html_error($error,"illegal DKEY $dkey"); $file =~ s:^../::; - $nfile = $file; - $mtime = mtime("$file/data") - or html_error($error,"illegal DKEY $dkey"); - $comment = slurp("$file/comment")||''; - $keep = untaint( - readlink "$file/keep" || - readlink "$file/../../\@KEEP" || - $keep_default - ); - $filename = filename($file); - - notify( - status => 'new', - dkey => $dkey, - filename => $filename, - keep => $keep-int((time-$mtime)/DS), - comment => $comment, - autodelete => readlink "$file/autodelete" || $autodelete, + $file = untaint($file); + unlink "$file/download"; # re-allow download from any ip address + notify_locale($dkey,'new'); + http_header( + '200 OK', + "X-Notify: $file", ); - } - http_header('200 OK'); + $nfile = $file; + } else { + http_header('200 OK'); + } print html_header($head); # list sent files print "<h3>Files from $from, ", @@ -366,7 +371,7 @@ next if $file =~ m:(.+?)/: and -l $1; $size = -s "$file/data"; next unless $size; - $size = int($size/1024/1024+0.5); + $size = int($size/M+0.5); $filename = $comment = ''; my $rto = $file; $rto =~ s:/.*::; @@ -390,7 +395,8 @@ } my $rkeep = untaint(readlink "$file/keep"||$keep_default) - int((time-mtime("$file/filename"))/DS); - if ($comment =~ /NOMAIL/) { + if ($comment =~ /NOMAIL/ or + (readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) { printf "%8s MB [%s d] %s/%s/%s\n", $size, $rkeep, @@ -432,7 +438,7 @@ next if $file =~ m:(.+?)/: and -l $1; $size = -s "$file/data"; next unless $size; - $size = int($size/1024/1024+0.5); + $size = int($size/M+0.5); $filename = $comment = ''; my $rto = $file; $rto =~ s:/.*::; @@ -487,7 +493,7 @@ $filename = $comment = ''; $size = -s "$file/data"; next unless $size; - $size = int($size/1024/1024+0.5); + $size = int($size/M+0.5); if ($dkey = readlink "$file/dkey") { print "\nfrom $from :\n" unless $url; $file =~ m:.*/(.+):; @@ -611,14 +617,17 @@ if (@to and $command eq 'CHECKRECIPIENT') { http_die("illegal command \"$command\"") if $public or $anonymous; + check_rr($from,@to); nvt_print('HTTP/1.1 204 OK'); nvt_print("X-SID: $sid") if $sid; foreach my $to (@group?@group:@to) { # my $options = sprintf "(autodelete=%s,keep=%s,locale=%s)", # readlink "$to/\@LOCALE"||$locale||$locale{$to}||$default_locale; - my $options = sprintf "(autodelete=%s,keep=%s)", - $autodelete{$to}||$autodelete, - $keep{$to}||$keep_default; + my $options = sprintf "(autodelete=%s,keep=%s,locale=%s,notification=%s)", + $autodelete{$to}||$autodelete, + $keep{$to}||$keep_default, + readlink("$to/\@LOCALE")||$default_locale, + readlink("$to/\@NOTIFICATION")||'full'; nvt_print("X-Recipient: $to $options"); } nvt_print(''); @@ -680,19 +689,19 @@ } # quotas -if ($from and $id and $rid eq $id and @to and not $flink) { +if ($from and $id and $rid eq $id and @to and not $flink and not $seek) { my ($quota,$du); # check sender quota ($quota,$du) = check_sender_quota($muser||$from); - if ($quota and $du+$cl/1024/1024 > $quota) { + if ($quota and $du+$cl/M > $quota) { http_die("you are overquota"); } # check recipient quota foreach my $to (@to) { ($quota,$du) = check_recipient_quota($to); - if ($quota and $du+$cl/1024/1024 > $quota) { + if ($quota and $du+$cl/M > $quota) { http_die("$to cannot receive files: is overquota"); } } @@ -822,6 +831,8 @@ elsif ($from and $id and $id eq $rid and ($addto or not $submit or not @to) and not ($gkey or $skey or $okey or $public or $anonymous)) { + present_locales('/fup'); + @ab = ("<option></option>"); # select menu from server address book @@ -840,12 +851,14 @@ unless (@to) { unless ($nomail) { foreach (glob "$from/\@GROUP/*") { - s:.*/::; - push @ab,"<option>\@$_</option>" unless /~$/; + if (-f and not -l) { + s:.*/::; + push @ab,"<option>\@$_</option>" unless /~$/; + } } } } - + my $ab64 = b64("from=$from&id=$id"); # '<form class="uploadform" name="upload"' pq(qq( @@ -949,8 +962,12 @@ ' }' ' return false;' ' }' - '</script>' - '<script type="text/javascript">' + '' + ' function checkupload() {' + ' var file = document.forms["upload"].elements["file"].value;' + ' if (file == "") { alert("No file selected"); }' + ' }' + '' ' function reportsize() {' ' var form = document.forms["upload"];' ' var filesize = form.file.files[0].size;' @@ -1005,13 +1022,15 @@ )); } my $toh = "group $group:<ul>"; + my $toc = join(',',@group); foreach my $gm (@group) { $toh .= "<li>$gm" } $toh .= "</ul>"; pq(qq( ' <input type="hidden" name="id" value="$id">' ' <table border="1">' ' <tr><td>sender:<td>$from</tr>' - ' <tr><td>recipient(s):<td>$toh</tr>' + ' <tr><td>recipient(s):' + ' <td><input type="hidden" name="to" value="$toc">$toh</tr>' )); } else { my $toc = join(',',@to); @@ -1106,11 +1125,12 @@ ' </tr>' ' <tr title="If you want to send more than one file, then put them in a zip or tar archive">' ' <td>file:' - ' <td><input type="file" name="file" size="80" value="$file" onchange="reportsize();">' + ' <td><input type="file" name="file" size="80" value="$file" onchange="reportsize();">' ' </tr>' ' <tr><td>file size:<td id="filesize"></td></tr>' ' </table>' - ' <p><input type="submit" value="upload">' + ' <p> + ' <input type="submit" value="upload" onclick="checkupload()">' '<p>' '</form>' )); @@ -1139,7 +1159,7 @@ exit; } - present_locales('fup'); + present_locales('/fup'); if ($ENV{REQUEST_METHOD} eq 'POST') { pq(qq( @@ -1148,23 +1168,22 @@ '</h3></font>' )); } - + pq(qq( - '<form action="/fup" ' - ' method="post" ' - ' accept-charset="ISO-8859-1" ' + '<form action="/fup"' + ' method="post"' + ' accept-charset="ISO-8859-1"' ' enctype="multipart/form-data">' ' <table>' ' <tr><td>sender:' ' <td><input type="text" name="from" size="40" value="$from"></tr>' - ' <tr><td>auth-ID: ' + ' <tr><td>auth-ID:' ' <td><input type="password" name="id" size="16" value="$id" autocomplete="off"></tr>' - ' </table> ' + ' </table>' )); - unless ($fop_auth or $nomail) { + if ($mail_authid and not ($fop_auth or $nomail)) { # pq(qq( -# 'If you have lost your auth-ID use "?"' -# 'and your auth-ID will be sent by e-mail to you.' +# 'If you enter "?" as your auth-ID then it will be sent by e-mail to you.' # '<p>' # )); pq(qq( @@ -1277,6 +1296,12 @@ } } +# additional last check +foreach $to (@to) { + checkaddress($to) or + http_die("<code>$to</code> is not a valid e-mail address"); +} + $to = join(',',@to); # file overwriting for anonymous is only possible if his client has the @@ -1318,12 +1343,13 @@ foreach (@group?@group:@to) { my $to = $_; $to =~ s/:\w+=.*//; # remove options from address - $filed = "$to/$from/$fkey"; - $save = "$filed/data"; - $upload = "$filed/upload"; + $filed = "$to/$from/$fkey"; + $save = "$filed/data"; + $upload = "$filed/upload"; + $download = "$filed/download"; $dkey{$to} = readlink "$filed/dkey"; - unlink $save unless -s $save; - unlink $save and $overwrite{$to}++; + $overwrite{$to}++ if -f $save and not -f $download; + unlink $save,$download; rename $upload,$save or http_die("cannot rename $upload to $save - $!\n"); # log dkey @@ -1337,27 +1363,9 @@ } # send notification e-mails if necessary - if (not $nomail and ($comment or not $overwrite{$to})) { - my $locale = readlink "$to/\@LOCALE" || readlink "$filed/locale" - || $default_locale; - my $lf = untaint("$FEXHOME/locale/$locale/lib/lf.pl"); - require $lf if -f $lf; - unless ($notify{$locale}) { - $locale = 'english'; - $lf = "$FEXHOME/lib/lf.pl"; - if (-f $lf) { require $lf } - else { $notify{$locale} = \¬ify } - } - &{$notify{$locale}}( -# notify( - status => "new", - dkey => $dkey{$to}, - filename => $filename, - keep => $keep{$to}||$keep||$keep_default, - comment => $comment, - replyto => $replyto, - autodelete => $autodelete{$to}||$autodelete, - ); + if (not $nomail and (readlink "$to/\@NOTIFICATION"||'') !~ /^no/i + and ($comment or not $overwrite{$to})) { + notify_locale($dkey{$to},'new'); debuglog("notify $filed [$filename] '$comment'"); } } @@ -1384,14 +1392,17 @@ $cookie = $1 if $ENV{HTTP_COOKIE} =~ /anonymous=([\w:]+)/; $cookie .= ':'.$dkey if $cookie !~ /$dkey/; nvt_print("Set-Cookie: anonymous=$cookie"); + $keep{$to} = readlink("$to/\@KEEP")||$keep_default; } foreach (@group?@group:@to) { my $to = $_; $to =~ s/:\w+=.*//; # remove options from address - my $options = sprintf "(autodelete=%s,keep=%s,locale=%s)", - readlink "$to/$from/$fkey/autodelete"||$autodelete, - readlink "$to/$from/$fkey/keep"||$keep_default, - readlink "$to/$from/$fkey/locale"||$locale; + my $file = "$to/$from/$fkey"; + my $options = sprintf "(autodelete=%s,keep=%s,locale=%s,notification=%s)", + readlink("$file/autodelete")||$autodelete, + readlink("$file/keep")||readlink("$to/\@KEEP")||$keep_default, + readlink("$to/\@LOCALE")||readlink("$file/locale")||$default_locale, + readlink("$to/\@NOTIFICATION")||'full'; nvt_print("X-Recipient: $to $options"); nvt_print("X-Location: $durl/$dkey{$to}/$fkey") unless $restricted; } @@ -1407,50 +1418,66 @@ print html_header($head); if ($nostore) { - printf "%s (%s MB) received\n",$file,$ndata/1024/1024; -} elsif (not $restricted and ($anonymous or $nomail or $from eq $to)) { - my $size = $ndata<2*1024 ? sprintf "%s B",$ndata: - $ndata<2*1024*1024 ? sprintf "%s kB",int($ndata/1024): - sprintf "%s MB",int($ndata/1024/1024); + printf "%s (%s MB) received\n",$file,$ndata/M; +} elsif (not $restricted and ($anonymous or $from eq $to)) { + my $size = $ndata<2*1024 ? sprintf "%s B",$ndata: + $ndata<2*M ? sprintf "%s kB",int($ndata/1024): + sprintf "%s MB",int($ndata/M); pq(qq( - '$file ($size) received and saved<p>' + '<code>$file</code> ($size) received and saved<p>' 'Download URL for copy & paste:' + '<h2>$durl/$dkey{$to}/$fkey</h2>' + 'Link is valid for $keep{$to} days!<p>' )); - if ($xkey) { - my $x = "$durl//$xkey"; - $x =~ s:/fop::; - print "<h2><code>$x</code></h2>\n"; - } else { - foreach my $to (@to) { - print "<h2><code>$to</code>:<br></h2>\n" if $to !~ /^anonymous/; - print "<h2>$durl/$dkey{$to}/$fkey</h2>\n"; - } - } - print "Link is valid for $keep days!<p>\n"; } else { if ($ndata<2*1024) { - print "$file ($ndata B) received and saved<p>\n"; + print "<code>$file</code> ($ndata B) received and saved<p>\n"; if (not $boring and not $seek) { print "Ehh... $ndata <b>BYTES</b>?! You are kidding?<p>\n"; } - } elsif ($ndata<2*1024*1024) { + } elsif ($ndata<2*M) { $ndata = int($ndata/1024); - print "$file ($ndata kB) received and saved<p>\n"; + print "<code>$file</code> ($ndata kB) received and saved<p>\n"; if ($ndata<1024 and not ($boring or $seek)) { print "Using F*EX for less than 1 MB: ", - "ever heard of MIME e-mail? :-)<p>\n"; + "ever heard of MIME e-mail? ☺<p>\n"; } } else { - $ndata = int($ndata/1024/1024); - print "$file ($ndata MB) received and saved<p>\n"; + $ndata = int($ndata/M); + print "<code>$file</code> ($ndata MB) received and saved<p>\n"; } + print "<ul>\n"; foreach $to (@to) { - if ($overwrite{$to}) { - print "(old $file for $to overwritten)<p>\n" + print "<li>"; + if ($nomail or $nomail{$to}) { + if ($restricted) { + rmrf("$to/$from/$fkey"); + print "<code>$file</code> removed because you are a restricted user ". + "and recipient $to cannot receive e-mail<p>\n"; + } else { + pq(qq( + '$to cannot receive e-mail →' + '<h3><font color="red">' + ' No notification e-mail has been sent to $to!' + '</font></h3>' + 'Download URL for copy & paste:' + )); + if ($xkey) { + my $x = "$durl{$to}//$xkey"; + $x =~ s:/fop::; + print "<h2><code>$x</code></h2>\n"; + } else { + print "<h2>$durl/$dkey{$to}/$fkey</h2>\n"; + print "Link is valid for $keep{$to} days!<p>\n"; + } + } + } elsif ($overwrite{$to} and not $comment) { + print "(old <code>$file</code> for $to overwritten)<p>\n" } else { - print "$to notified<p>\n" + print "$to notified<p>\n" } } + print "</ul>\n"; } if ($okey) { @@ -1463,6 +1490,9 @@ elsif ($akey) { print "&akey=$akey&to=$to" } print "&bwlimit=$bwlimit&autodelete=$autodelete&keep=$keep\">"; print "send another file</a>\n"; + if ($http_client !~ /fexsend/ and $http_client =~ /Linux/i) { + print qq'<p>Hi Linux-user, try <a href="/FAQ/user.html#Why_should_I_use_a_special_F_EX_client">fexsend</a>! ☺<p>\n'; + } print &logout; } @@ -1959,10 +1989,9 @@ symlink untaint($flink),$upload; } else { unlink $upload if -l $upload; - open $upload,'>>',$upload or http_die("cannot create $upload - $!"); - unless (flock($upload,LOCK_EX|LOCK_NB)) { + open $upload,'>>',$upload or http_die("cannot write $upload - $!"); + flock($upload,LOCK_EX|LOCK_NB) or http_die("<code>$file</code> locked: a transfer is already in progress"); - } unless ($seek) { seek $upload,0,0; truncate $upload,0; @@ -1976,7 +2005,6 @@ unlink "$filed/autodelete", "$filed/error", - "$filed/download", "$filed/restrictions", "$filed/locale", "$filed/keep", @@ -1984,6 +2012,8 @@ "$filed/id", "$filed/ip", "$filed/speed", + "$filed/replyto", + "$filed/useragent", "$filed/comment", "$filed/notify"; unlink "$filed/size" unless $seek; @@ -2021,13 +2051,20 @@ } mksymlink("$filed/id",$fileid) if $fileid; mksymlink("$filed/ip",$ra) if $ra; + if ($http_client and open $http_client,'>',"$filed/useragent") { + print {$http_client} $http_client,"\n"; + close $http_client; + } if ($_ = readlink "$to/\@LOCALE") { - mksymlink("$filed/locale",$_); + # mksymlink("$filed/locale",$_); } elsif ($locale{$to}) { mksymlink("$filed/locale",$locale{$to}); - } elsif ($locale) { + } elsif ($locale and $locale ne $default_locale) { mksymlink("$filed/locale",$locale); } + if ($replyto and $replyto =~ /.@./) { + mksymlink("$filed/replyto",$replyto); + } my $arh = "$from/\@ALLOWED_RHOSTS"; if (-s $arh) { @@ -2039,6 +2076,10 @@ close $fh; } + if ((readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) { + $nomail{$to} = 'NOTIFICATION'; + } + if ($nomail) { open $fh,'>',"$filed/notify" and close $fh; } @@ -2053,7 +2094,8 @@ unless ($dkey = readlink("$filed/dkey") and -l "$dkeydir/$dkey") { $dkey = randstring(8); unlink "$dkeydir/$dkey"; - symlink "../$filed","$dkeydir/$dkey" or die "cannot symlink $dkeydir/$dkey"; + symlink "../$filed","$dkeydir/$dkey" + or http_die("cannot symlink $dkeydir/$dkey ($!)"); unlink "$filed/dkey"; symlink $dkey,"$filed/dkey"; } @@ -2085,7 +2127,7 @@ # upload link has been already created, no data to read any more $to = join(',',@to); fuplog($to,$fkey,0); - debuglog("upload successfull, dkey=$dkey"); + debuglog("upload link successfull, dkey=$dkey"); } # regular file @@ -2292,8 +2334,11 @@ $u = "$u\@$hostname"; } if ($u eq 'nettest') { - $u = "$u\@$mdomain" if -d "$u\@$mdomain"; - $u = "$u\@$hostname" if -d "$u\@$hostname"; + if ($mdomain and -d "$u\@$mdomain") { + $u .= "\@$mdomain" + } elsif (-d "$u\@$hostname") { + $u .= "\@$hostname" + } } if ($u =~ /@/) { push @ua,$u } elsif ($mdomain) { push @ua,"$u\@$mdomain" } @@ -2363,15 +2408,16 @@ http_die("cannot create directory $nfile") unless -d $nfile; unlink "$nfile/data", "$nfile/upload", + "$nfile/download", "$nfile/autodelete", "$nfile/error", - "$nfile/download", "$nfile/restrictions", "$nfile/keep", "$nfile/header", "$nfile/id", "$nfile/speed", "$nfile/comment", + "$nfile/replyto", "$nfile/notify"; if ($comment) { open $comment,'>',"$nfile/comment"; @@ -2384,18 +2430,22 @@ symlink($keep||$keep_default, "$nfile/keep"); copy("$file/id", "$nfile/id"); copy("$file/ip", "$nfile/ip"); - $filename = copy("$file/filename", "$nfile/filename",'NEW:'); + copy("$file/speed", "$nfile/speed"); + copy("$file/replyto", "$nfile/replyto"); + $filename = copy("$file/filename", "$nfile/filename"); link "$file/data", "$nfile/data" or die http_die("cannot create $nfile/data - $!"); unless ($dkey = readlink("$nfile/dkey") and -l "$dkeydir/$dkey") { $dkey = randstring(8); unlink "$dkeydir/$dkey"; - symlink "../$nfile","$dkeydir/$dkey" or die "cannot symlink $dkeydir/$dkey"; + symlink "../$nfile","$dkeydir/$dkey" + or http_die("cannot symlink $dkeydir/$dkey"); unlink "$nfile/dkey"; - symlink $dkey,"$nfile/dkey"; + symlink $dkey,"$nfile/dkey" + or http_die("cannot create $nfile/dkey - $!"); } - if ($nomail) { + if ($nomail or $nomail{$to}) { if ($filename) { my $url = "$durl/$dkey/".normalize_filename($filename); pq(qq( @@ -2405,24 +2455,7 @@ )); } } else { - my $locale = readlink "$to/\@LOCALE" || $::locale - || readlink "$file/locale" || 'english'; - my $lf = untaint("$FEXHOME/locale/$locale/lib/lf.pl"); - require $lf if -f $lf; - if ($notify{$locale}) { - mksymlink("$nfile/locale",$locale); - } else { - $locale = 'english'; - $notify{$locale} = \¬ify unless $notify{$locale}; - } - &{$notify{$locale}}( - status => "new", - dkey => $dkey, - filename => $filename, - keep => $keep||$keep_default, - comment => $comment||'', - autodelete => $autodelete, - ); + notify_locale($dkey,'new'); fuplog($to,urlencode($filename),"(forwarded)"); if ($filename) { pq(qq( @@ -2462,6 +2495,7 @@ sub modify { my $file = shift; my $filename = filename($file); + my $dkey = readlink "$file/$dkey"; my $to; my @parameter; @@ -2483,14 +2517,7 @@ print {$comment} $comment; close $comment; } - notify( - status => "new", - dkey => $dkey, - filename => $filename, - keep => $keep||$keep_default, - comment => $comment, - autodelete => $autodelete, - ); + notify_locale($dkey,'new'); push @parameter,'COMMENT'; } http_header('200 OK'); @@ -2864,7 +2891,7 @@ while (<$df>) { if (/^.+?\s+\d+\s+\d+\s+(\d+)/ and $req/1024 > $1) { $free = int($1/1024); - $uprq = int($req/1024/1024); + $uprq = int($req/M); if (not $nomail and open P,"|$sendmail -t") { pq(P,qq( 'From: $admin' @@ -2924,7 +2951,10 @@ my ($sig) = @_; my $msg; my $to = join(',',@to); - + + $SIG{__DIE__} = 'DEFAULT'; + foreach (keys %SIG) { $SIG{$_} = 'DEFAULT' } + $msg = @_ ? "@_" : '???'; $msg =~ s/\n/ /g; $msg =~ s/\s+$//; @@ -2941,7 +2971,6 @@ $rb?"(after $rb bytes)":""; close $log; } - $SIG{__DIE__} = ''; if ($sig eq 'DIE') { shift; die "$msg\n"; @@ -2997,7 +3026,7 @@ sub check_camel { my ($logo,$camel); - local $\; + local $/; if (open $logo,"$docdir/logo.jpg") { $camel = md5_hex(<$logo>) eq 'ad8a95bba8dd1a61d70bd38611bc2059'; diff -Nru fex-20140917/cgi-bin/fur fex-20150120/cgi-bin/fur --- fex-20140917/cgi-bin/fur 2014-09-15 16:00:08.000000000 +0200 +++ fex-20150120/cgi-bin/fur 2014-12-19 10:17:59.000000000 +0100 @@ -9,6 +9,9 @@ use CGI::Carp qw(fatalsToBrowser); use Fcntl qw(:flock :seek :mode); +$CGI::LIST_CONTEXT_WARN = 0; +$CGI::LIST_CONTEXT_WARN = 0; + # import from fex.ph our (@local_hosts,@local_domains,@local_rhosts,@local_rdomains); our (@registration_hosts,@registration_domains); @@ -39,6 +42,13 @@ &check_maint; +unless (@local_domains or @local_rdomains) { + html_error($error, + "No domains for registrations are defined.", + "Contact $ENV{SERVER_ADMIN} for details." + ); +} + # look for CGI parameters foreach my $v (param) { my $vv = despace(param($v)); @@ -67,8 +77,8 @@ unless ($user and $id) { http_die("no registration data for key $confirm"); } - unless (-d $user) { - mkdir $user,0770 or http_die("mkdir $user - $!\n"); + unless (-f "$user/.auto") { + http_die("registration expired"); } # if (-f "$user/@") { http_die("$user is already activated") } open $user,'>',"$user/@" or http_die("open $user/@ - $!\n"); @@ -98,6 +108,7 @@ exit; } + unless ($user or $exuser or $demouser) { http_header("200 OK"); print html_header($head); @@ -211,13 +222,16 @@ } else { html_error($error,"<code>$exuser</code> is not an email address"); } - if (-f "$exuser/@") { - html_error($error,"<code>$exuser</code> does already exist"); - } $user = $exuser; } elsif ($demouser) { $user = $demouser; -} elsif (@local_domains) { +} elsif ($user) { + unless (@local_domains) { + html_error($error, + "No local domains for registration are defined.", + "Contact $ENV{SERVER_ADMIN} for details." + ); + } my $mydomains = join('|',@local_domains); $mydomains =~ s/\./\\./g; $mydomains =~ s/\*/.*/g; @@ -237,6 +251,8 @@ "Contact $ENV{SERVER_ADMIN} for details." ); } +} else { + html_error($error,"No user type found."); } unless (checkforbidden($user)) { @@ -265,6 +281,7 @@ $rf = "$exuser/\@ALLOWED_RECIPIENTS"; open $rf,'>',$rf or http_die("cannot write $rf - $!\n"); print {$rf} "\@LOCAL_RDOMAINS\n"; + print {$rf} "# See also file \@ALLOWED_RHOSTS\n"; close $rf; # recipients ip restrictions $rf = "$exuser/\@ALLOWED_RHOSTS"; diff -Nru fex-20140917/cgi-bin/rup fex-20150120/cgi-bin/rup --- fex-20140917/cgi-bin/rup 2014-05-26 18:16:07.000000000 +0200 +++ fex-20150120/cgi-bin/rup 2015-01-15 17:15:54.000000000 +0100 @@ -128,12 +128,8 @@ foreach my $file (glob "$oto/$from/*/data") { next if $file =~ m:/STDFEX/:; $file =~ s:/data$::; - if (open $file,'<',"$file/filename") { - my $filename = <$file> || ''; - close $file; - if ($filename) { - print "\t<option>$filename</option>\n"; - } + if ($filename = filename($file)) { + print "\t<option>$filename</option>\n"; } } } @@ -205,34 +201,14 @@ unlink "$nto/$from/$fkey/notify"; unlink "$nto/$from/$fkey/error"; unlink "$nto/$from/$fkey/download"; + if (slurp("$oto/$from/$fkey/$comment") =~ 'NOMAIL') { + unlink "$nto/$from/$fkey/comment"; + } $dkey = randstring(8); symlink $dkey,"$nto/$from/$fkey/dkey"; symlink "../$nto/$from/$fkey","$dkeydir/$dkey"; - if (open $fkey,'<',"$nto/$from/$fkey/filename") { - chomp($filename = <$fkey>||''); - close $fkey; - } - $filename = $fkey unless $filename; - $keep = readlink "$nto/$from/$fkey/keep" || 0; - if (not $keep and open $fkey,'<',"$nto/$from/$fkey/keep") { - chomp($keep = <$fkey>||''); - close $fkey; - } - if (open $fkey,'<',"$nto/$from/$fkey/comment") { - chomp($comment = <$fkey>||''); - close $fkey; - if ($comment eq 'NOMAIL') { - $comment = ''; - unlink "$nto/$from/$fkey/comment"; - } - } - notify( - status => "new", - dkey => $dkey, - filename => $filename, - keep => $keep||$keep_default, - comment => $comment||'', - ); + $filename = filename("$nto/$from/$fkey") || $fkey; + notify_locale($dkey,'new'); ruplog("$oto/$from/$fkey ==> $nto"); http_header("200 OK"); print html_header('F*EX redirect'); diff -Nru fex-20140917/cgi-bin/sex fex-20150120/cgi-bin/sex --- fex-20140917/cgi-bin/sex 2013-08-31 22:32:26.000000000 +0200 +++ fex-20150120/cgi-bin/sex 2014-09-19 11:09:12.000000000 +0200 @@ -66,7 +66,9 @@ unless (-p $fifo) { mkfifo($fifo,0600) or error(503,"Cannot create $fifo : $!"); } - + + sexlog($mode); + my $lock = "$stream/lock"; open $lock,'>>',$lock or error(503,"Cannot open $lock : $!"); flock $lock,LOCK_EX|LOCK_NB or error(409,"$stream already in use"); @@ -104,17 +106,17 @@ } header('200 OK'); - sexlog($mode); - $SIG{PIPE} = sub { sleep 1; rmrf($stream); exit; }; + $B = 0; + $shutdown = sub { sexlog($B); rmrf($stream); exit; }; + $SIG{PIPE} = sub { sleep 1; &$shutdown; }; # syswrite $fifo,$data if $data; - while (sysread(STDIN,$_,$bs)) { + while ($b = sysread(STDIN,$_,$bs)) { + $B += $b; syswrite $fifo,$_ or die $!; } - - rmrf($stream); - exit; + &$shutdown; } elsif ($mode eq 'POP') { $stream =~ s:/STDSTR:/PUBLIC: if $id eq 'public'; diff -Nru fex-20140917/debian/changelog fex-20150120/debian/changelog --- fex-20140917/debian/changelog 2014-12-15 10:17:32.000000000 +0100 +++ fex-20150120/debian/changelog 2015-01-21 10:20:40.000000000 +0100 @@ -1,3 +1,32 @@ +fex (20150120-2) unstable; urgency=medium + + * Fix fexget perl warning with upstream fix + + -- Kilian Krause <kilian@debian.org> Wed, 21 Jan 2015 10:20:03 +0100 + +fex (20150120-1) unstable; urgency=high + + * New upstream release: 20150120 (Closes: #773751) + - SECURITY FIX: race condition between fur and fex_cleanup may create + internal instead of external user + - several small bugs are fixed + - fexwall also mails to sub and group users + - optional HTTP basic authentication for htdoc/ directory + - several SSL/TLS related fixes including default TLS for https connections + - locale selection in upload form, too + - better SSL configuration for fexsend,fexget,sexsend + - autoview option for fexget + - save-or-display (MIME) option for download + - new config variable $mail_authid to (dis)allow mailing of forgotten + auth-IDs + * Update lintian override to ignore :sexsend:sexget: symlink which is + interpreted by fexsrv directly + * Recommend ca-certificates to verify remote server in fex-utils + * Don't fail in postinst while looking up fex in trusted_users + (Closes: #774854) + + -- Kilian Krause <kilian@debian.org> Tue, 20 Jan 2015 15:56:05 +0100 + fex (20140917-2) unstable; urgency=high * Re-add symlinks in htdocs/download - avoid otherwise broken symlinks in diff -Nru fex-20140917/debian/control fex-20150120/debian/control --- fex-20140917/debian/control 2014-12-15 10:17:32.000000000 +0100 +++ fex-20150120/debian/control 2015-01-21 10:20:40.000000000 +0100 @@ -10,7 +10,8 @@ Package: fex Architecture: all -Depends: ${misc:Depends}, ${perl:Depends}, adduser, xinetd | inet-superserver, libdigest-md5-file-perl, ucf, libjs-jquery, exim4 | postfix | mail-transport-agent +Depends: ${misc:Depends}, ${perl:Depends}, adduser, xinetd | inet-superserver, + libdigest-md5-file-perl, ucf, libjs-jquery, exim4 | postfix | mail-transport-agent Recommends: perl-modules, libnet-dns-perl, fex-utils, libsocket6-perl, wget Description: web service for transferring very large files F*EX (Frams's Fast File EXchange) is a service that can be used to allow @@ -46,7 +47,8 @@ Package: fex-utils Architecture: all Depends: ${misc:Depends}, ${perl:Depends} -Recommends: libdigest-md5-file-perl, libnet-sslglue-perl, libnet-inet6glue-perl +Recommends: libdigest-md5-file-perl, libnet-sslglue-perl, + libnet-inet6glue-perl, ca-certificates Suggests: wget, fex Description: web service for transferring very large files (utils) F*EX (Frams's Fast File EXchange) is a service that can be used to allow diff -Nru fex-20140917/debian/fex.lintian-overrides fex-20150120/debian/fex.lintian-overrides --- fex-20140917/debian/fex.lintian-overrides 2014-12-15 10:17:32.000000000 +0100 +++ fex-20150120/debian/fex.lintian-overrides 2015-01-21 10:20:40.000000000 +0100 @@ -2,3 +2,6 @@ # the default configuration without any localisation # Thus the recursive symlink is required and cannot be avoided fex binary: symlink-is-self-recursive usr/share/fex/locale/english .. +# This symlink is interpreted by the fexsrv daemon and therefore not usable as +# file system path +fex binary: file-in-unusual-dir :sexsend:sexget: diff -Nru fex-20140917/debian/fex.postinst fex-20150120/debian/fex.postinst --- fex-20140917/debian/fex.postinst 2014-12-15 10:17:32.000000000 +0100 +++ fex-20150120/debian/fex.postinst 2015-01-21 10:20:40.000000000 +0100 @@ -200,8 +200,8 @@ fi if [ -f /etc/exim/exim.conf -o -f /var/lib/exim4/config.autogenerated ]; then # exim4 found... - [ ! -f /var/lib/exim4/config.autogenerated ]||ISTRUSTED=$(egrep '^\s*(MAIN_TRUSTED_USERS|trusted_users)\s*=.*fex' /var/lib/exim4/config.autogenerated) - [ ! -f /etc/exim/exim.conf ]||ISTRUSTED=$(egrep '^\s*(MAIN_TRUSTED_USERS|trusted_users)\s*=.*fex' /etc/exim/exim.conf) + [ ! -f /var/lib/exim4/config.autogenerated ]||ISTRUSTED=$(egrep '^\s*(MAIN_TRUSTED_USERS|trusted_users)\s*=.*fex' /var/lib/exim4/config.autogenerated||true) + [ ! -f /etc/exim/exim.conf ]||ISTRUSTED=$(egrep '^\s*(MAIN_TRUSTED_USERS|trusted_users)\s*=.*fex' /etc/exim/exim.conf||true) [ -z "$ISTRUSTED" ]||echo "You're running exim4 and fex isn't in the trusted_users list. Consider adding or email notifications may not work!" fi diff -Nru fex-20140917/debian/htdocs.md5/20141219-1 fex-20150120/debian/htdocs.md5/20141219-1 --- fex-20140917/debian/htdocs.md5/20141219-1 1970-01-01 01:00:00.000000000 +0100 +++ fex-20150120/debian/htdocs.md5/20141219-1 2015-01-21 10:20:40.000000000 +0100 @@ -0,0 +1,24 @@ +89b404d0404eb3b0eba54a662e04c8ce htdocs/FAQ/admin.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/admin.html +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/all.html +91e99f12ccb9f7cc3c399d5c3b0de1aa htdocs/FAQ/faq.pl +18ea97a73b75ac6a09cd6176405575c9 htdocs/FAQ/local.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/local.html +9957852ccdef1f1196b55abf18fe5f61 htdocs/FAQ/meta.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/meta.html +8efac8c29f2493f7cf587397a3383573 htdocs/FAQ/misc.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/misc.html +736fe1c5be22c469b1bb973230cdd29d htdocs/FAQ/user.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/user.html +8fef1010d65fcae7afcc991d0a889378 htdocs/SEX.html +1f3d7acc70377496f95c5adddaf4ca7b htdocs/action-fex-camel.gif +9518c02523c765d590465393659bfa13 htdocs/dynamic.html +d41d8cd98f00b204e9800998ecf8427e htdocs/favicon.ico +0341cffa891dc5bb3221fbf3edf95202 htdocs/features.html +54c81afa02df999d3f096685caa5258a htdocs/fup_template.html +bdf9506feb34a5f22eb302e48ba9d9df htdocs/index.html +ad8a95bba8dd1a61d70bd38611bc2059 htdocs/logo.jpg +f71d20196d4caf35b6a670db8c70b03d htdocs/robots.txt +968a8facfcdd185ad696b86b67ec63ff htdocs/small_logo.jpg +863744e12ec319a227c113b3c189c41f htdocs/sup.html +9c4136f2a7158d704e9999f052104377 htdocs/tools.html diff -Nru fex-20140917/debian/htdocs.md5/20150120-1 fex-20150120/debian/htdocs.md5/20150120-1 --- fex-20140917/debian/htdocs.md5/20150120-1 1970-01-01 01:00:00.000000000 +0100 +++ fex-20150120/debian/htdocs.md5/20150120-1 2015-01-21 10:20:40.000000000 +0100 @@ -0,0 +1,26 @@ +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/FAQ.html +bcb051e62706c3e156077b9368de91cd htdocs/FAQ/admin.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/admin.html +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/all.html +91e99f12ccb9f7cc3c399d5c3b0de1aa htdocs/FAQ/faq.pl +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/index.html +6f7e1a56ba9a8e5a42def936729e2089 htdocs/FAQ/local.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/local.html +9957852ccdef1f1196b55abf18fe5f61 htdocs/FAQ/meta.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/meta.html +8efac8c29f2493f7cf587397a3383573 htdocs/FAQ/misc.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/misc.html +736fe1c5be22c469b1bb973230cdd29d htdocs/FAQ/user.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/user.html +8fef1010d65fcae7afcc991d0a889378 htdocs/SEX.html +1f3d7acc70377496f95c5adddaf4ca7b htdocs/action-fex-camel.gif +9518c02523c765d590465393659bfa13 htdocs/dynamic.html +d41d8cd98f00b204e9800998ecf8427e htdocs/favicon.ico +0341cffa891dc5bb3221fbf3edf95202 htdocs/features.html +54c81afa02df999d3f096685caa5258a htdocs/fup_template.html +bdf9506feb34a5f22eb302e48ba9d9df htdocs/index.html +ad8a95bba8dd1a61d70bd38611bc2059 htdocs/logo.jpg +f71d20196d4caf35b6a670db8c70b03d htdocs/robots.txt +968a8facfcdd185ad696b86b67ec63ff htdocs/small_logo.jpg +863744e12ec319a227c113b3c189c41f htdocs/sup.html +9c4136f2a7158d704e9999f052104377 htdocs/tools.html diff -Nru fex-20140917/debian/htdocs.md5/20150120-2 fex-20150120/debian/htdocs.md5/20150120-2 --- fex-20140917/debian/htdocs.md5/20150120-2 1970-01-01 01:00:00.000000000 +0100 +++ fex-20150120/debian/htdocs.md5/20150120-2 2015-01-21 10:20:40.000000000 +0100 @@ -0,0 +1,26 @@ +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/FAQ.html +bcb051e62706c3e156077b9368de91cd htdocs/FAQ/admin.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/admin.html +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/all.html +91e99f12ccb9f7cc3c399d5c3b0de1aa htdocs/FAQ/faq.pl +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/index.html +6f7e1a56ba9a8e5a42def936729e2089 htdocs/FAQ/local.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/local.html +9957852ccdef1f1196b55abf18fe5f61 htdocs/FAQ/meta.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/meta.html +8efac8c29f2493f7cf587397a3383573 htdocs/FAQ/misc.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/misc.html +736fe1c5be22c469b1bb973230cdd29d htdocs/FAQ/user.faq +6d3b691d1e3b1786c0bf735604fb9817 htdocs/FAQ/user.html +8fef1010d65fcae7afcc991d0a889378 htdocs/SEX.html +1f3d7acc70377496f95c5adddaf4ca7b htdocs/action-fex-camel.gif +9518c02523c765d590465393659bfa13 htdocs/dynamic.html +d41d8cd98f00b204e9800998ecf8427e htdocs/favicon.ico +0341cffa891dc5bb3221fbf3edf95202 htdocs/features.html +54c81afa02df999d3f096685caa5258a htdocs/fup_template.html +bdf9506feb34a5f22eb302e48ba9d9df htdocs/index.html +ad8a95bba8dd1a61d70bd38611bc2059 htdocs/logo.jpg +f71d20196d4caf35b6a670db8c70b03d htdocs/robots.txt +968a8facfcdd185ad696b86b67ec63ff htdocs/small_logo.jpg +863744e12ec319a227c113b3c189c41f htdocs/sup.html +9c4136f2a7158d704e9999f052104377 htdocs/tools.html diff -Nru fex-20140917/debian/patches/03_fexget_search_ca.patch fex-20150120/debian/patches/03_fexget_search_ca.patch --- fex-20140917/debian/patches/03_fexget_search_ca.patch 1970-01-01 01:00:00.000000000 +0100 +++ fex-20150120/debian/patches/03_fexget_search_ca.patch 2015-01-21 10:20:40.000000000 +0100 @@ -0,0 +1,123 @@ +Backported from http://fex.rus.uni-stuttgart.de:8080/download/fexget to avoid perl warning +--- a/bin/fexget ++++ b/bin/fexget +@@ -30,7 +30,7 @@ our $SH; + our ($fexhome,$idf,$tmpdir,$windoof,$useragent); + our ($xv,%autoview); + our $bs = 2**16; # blocksize for tcp-reading and writing file +-our $version = 20150120; ++our $version = 20150121; + our $CTYPE = 'ISO-8859-1'; + our $fexsend = $ENV{FEXSEND} || 'fexsend'; + +@@ -157,48 +157,7 @@ if ($opt_H) { + exit; + } + +-# set SSL/TLS options +-$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_ca_file) +-) { +- my $env = uc($opt); +- $env =~ s/_//g; +- $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); +-} +- +-if ($SSL{SSL_verify_mode}) { +- &search_ca; +- unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { +- die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; +- } +-} elsif (defined($SSL{SSL_verify_mode})) { +- # user has set SSLVERIFY=0 ! +-} else { +- &search_ca; +- $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; +-} +- +-sub search_ca { +- local $_; +- return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; +- foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { +- if (-f) { +- $SSL{SSL_ca_file} = $_; +- return; +- } +- } +- foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { +- if (-f) { +- $SSL{SSL_ca_path} = $_; +- return; +- } +- } +-} ++&get_ssl_env; + + my $ffl = "$tmpdir/fexget"; # F*EX files list (cache) + +--- a/htdocs/download/fexget ++++ b/htdocs/download/fexget +@@ -30,7 +30,7 @@ our $SH; + our ($fexhome,$idf,$tmpdir,$windoof,$useragent); + our ($xv,%autoview); + our $bs = 2**16; # blocksize for tcp-reading and writing file +-our $version = 20150120; ++our $version = 20150121; + our $CTYPE = 'ISO-8859-1'; + our $fexsend = $ENV{FEXSEND} || 'fexsend'; + +@@ -157,48 +157,7 @@ if ($opt_H) { + exit; + } + +-# set SSL/TLS options +-$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_ca_file) +-) { +- my $env = uc($opt); +- $env =~ s/_//g; +- $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); +-} +- +-if ($SSL{SSL_verify_mode}) { +- &search_ca; +- unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { +- die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; +- } +-} elsif (defined($SSL{SSL_verify_mode})) { +- # user has set SSLVERIFY=0 ! +-} else { +- &search_ca; +- $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; +-} +- +-sub search_ca { +- local $_; +- return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; +- foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { +- if (-f) { +- $SSL{SSL_ca_file} = $_; +- return; +- } +- } +- foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { +- if (-f) { +- $SSL{SSL_ca_path} = $_; +- return; +- } +- } +-} ++&get_ssl_env; + + my $ffl = "$tmpdir/fexget"; # F*EX files list (cache) + diff -Nru fex-20140917/debian/patches/series fex-20150120/debian/patches/series --- fex-20140917/debian/patches/series 2014-12-15 10:17:32.000000000 +0100 +++ fex-20150120/debian/patches/series 2015-01-21 10:20:40.000000000 +0100 @@ -1,2 +1,3 @@ 01_xinetd.patch 02_fex.ph_no_newrelease.patch +03_fexget_search_ca.patch diff -Nru fex-20140917/debian/rules fex-20150120/debian/rules --- fex-20140917/debian/rules 2014-12-15 10:17:32.000000000 +0100 +++ fex-20150120/debian/rules 2015-01-21 10:20:40.000000000 +0100 @@ -47,6 +47,8 @@ dh_installdocs cp doc/new debian/fex/usr/share/doc/fex/NEWS echo "fex_$(DEBVERSION)" >debian/fex/usr/share/fex/htdocs/version + # update file system paths in FAQ + sed -i -e 's,/home/fex/,/var/lib/fex/,g' debian/fex/usr/share/fex/htdocs/FAQ/* @(cd debian/fex/usr/share/fex/;find htdocs/ -type f|grep -v -e version -e FAQ/jquery.js -e download/ |LC_ALL=C sort|xargs -n 1 md5sum >../../../../fex.md5.check) if diff -q debian/fex.md5.check debian/htdocs.md5/$(DEB_NOEPOCH_VERSION) >/dev/null;then \ echo "Correct htdocs md5sum found."; \ diff -Nru fex-20140917/doc/Changes fex-20150120/doc/Changes --- fex-20140917/doc/Changes 2014-09-17 21:34:21.000000000 +0200 +++ fex-20150120/doc/Changes 2015-01-17 11:44:54.000000000 +0100 @@ -1,5 +1,50 @@ +2015-01-17 new fex.ph config variable $mail_authid (default yes) +2015-01-16 fixed bug no notfication for still existing file (overwrite) +2015-01-15 fixed bug no locale reminder notfication + fixed bug wrong result for recipients with NOTIFICATION=no +2015-01-13 fexsend: added option -N resend notification email + resending notification email deletes download ip restriction + fup: fixed bug sending to groups broken +2015-01-10 fexsend: added option -S show server/user settings + fup: added command LISTSETTINGS +2015-01-09 foc: added save-or-display (MIME) option for download +2015-01-04 fexsend: fixed bug dies too early on multiple files and one + file has been already transfered +2014-12-25 fexget,fexsend,sexsend: use default SSL_cipher_list + DEFAULT:!3DES:!MD5 +2014-12-24 fexget,fexsend,sexsend: evaluate environment variables SSLVERIFY + SSLVERSION SSLCAPATH SSLCAFILE SSLCIPHERLIST + fexget,fexsend,sexsend: use TLS, not SSL +2014-12-23 fexsend: $HOME/.fex/config with $opt_* and %alias variables + fexget: $HOME/.fex/config with $opt_* and %autoview variables +2014-12-19 fur: fixed bug race condition with fex_cleanup (external->internal) +2014-12-17 install/update: fixed bug some spool files are owned by user root +2014-12-16 fexsrv: fixed bug handling of User-Agent FDM +2014-12-09 added l ll lf to distribution + fexwall: also mail to sub and group users +2014-12-03 fup: remove file after upload if restricted user has set NOMAIL + fup: fixed bug wrong message "user notified" if NOMAIL +2014-12-02 fup: also check recipient restrictions on command CHECKRECIPIENT +2014-11-24 fexget: autoview gif jpg png tif after download +2014-11-20 count unfinished upload size into quota, too + fixed bug wrong quota calculation on SysV UNIX like Solaris +2014-11-18 fexsend: added environment variables SSLVERIFY SSLCAPATH SSLCAFILE +2014-11-18 dop: added HTTP basic authentication for htdoc directory with + .htauth file +2014-11-14 ignore @forbidden_recipients if $SPOOL/$USER exists + (admin has created user) +2014-11-11 fup: fixed bug groups from other users in address book selection + fup: added useragent to $SPOOL/$TO/$FROM/$FILE/ +2014-11-10 fup: present locales in recipient query form, too +2014-11-07 FAQ: added text anchor URLs +2014-11-03 added missing fexget fexsend sexget sexsend for tools.html +2014-10-23 fexsend: on multiple recipients check only the first for resume +2014-10-14 fac: added option -L (list files detailed) +2014-10-01 fex_cleanup: fixed bug wrong default spool for virtual hosts +2014-09-19 sex: added transfered bytes to sex.log 2014-09-17 fup: fixed bug no locales presentation 2014-09-14 fex_cleanup: send new release notification to $admin +2014-09-11 dop: exclude .* and *~ from stream files 2014-09-01 fup: upload status bar waits longer, until $timeout 2014-08-27 fex_cleanup: use wget for new release dedection 2014-08-18 fexsend: workaround for stunnel bug (options -s and -g) @@ -32,7 +77,7 @@ 2014-05-25 fup: fixed bug insecure dependency when forwarding a file to a user which has set a default keep value 2014-05-23 fexget: fixed bug download fails on big file and slow disk -2014-05-12 set Reply-To in notification e-mails for @remote_domains +2014-05-12 set Reply-To in notification emails for @remote_domains 2014-05-03 fup: fixed bug wrong (old) keep time on forword-copy (bounce) 2014-04-10 fexsend: added "exclude from archive" option -# 2014-03-28 fexsend: do not copy "NOMAIL" comment in forward diff -Nru fex-20140917/doc/concept fex-20150120/doc/concept --- fex-20140917/doc/concept 2014-09-11 11:05:43.000000000 +0200 +++ fex-20150120/doc/concept 2015-01-17 11:29:28.000000000 +0100 @@ -132,11 +132,13 @@ option -D means "delay autodelete": do not delete the the file directly after download, but with the nightly fex_cleanup cronjob. More downloads -are possible only from the same client (identified by cookie). +are possible only from the same client (identified by cookie or ip +address). option -K means "keep file": do not delete the file after download, but only after expiration date (normally 5 days). More downloads are possible -only from the same client (identified by cookie). +only from the same client (identified by cookie or ip address). + If you fex a file to yourself (sender = recipient), then the resulting download link is valid for any client and can be downloaded everywhere @@ -155,8 +157,8 @@ These options are also possible in the server address book (see CGI fuc). If you need more security, then set in fex.ph: -$fop_auth = 1; -$force_https = 1; +$fop_auth = 'yes'; +$force_https = 'yes'; With $fop_auth upload is restricted to registered users and download requires (HTTP) authorization. The credentials are the F*EX user email @@ -225,22 +227,26 @@ fup.log log of file uploads fur.log log of user self registrations sex.log log of stream exchanges - $from/@ regular user auth-ID - $from/@SUBUSER subuser addresses and IDs - $from/@ALLOWED_RECIPIENTS recipients restrictions for this user - $from/@ADDRESS_BOOK users recipient address book - $from/@GROUP directory of F*EX user groups - $from/@OKEY directory with one time upload keys - $from/@QUOTA sender and recipient quotas - $from/@AUTODELETE autodelete default - $from/@KEEP keep default - $from/@LOCALE locale default + $user/@ regular user auth-ID + $user/@SUBUSER subuser addresses and IDs + $user/@ALLOWED_RECIPIENTS recipients restrictions for this user + $user/@ALLOWED_RHOSTS recipient's hosts restrictions + $user/@UPLOAD_HOSTS upload hosts restrictions + $user/@DOWNLOAD_HOSTS download hosts restrictions + $user/@ADDRESS_BOOK users recipient address book + $user/@GROUP directory of F*EX user groups + $user/@OKEY directory with one time upload keys + $user/@QUOTA sender and recipient quotas + $user/@AUTODELETE autodelete default + $user/@KEEP keep default + $user/@LOCALE locale default $user/@CAPTIVE user must not change his settings $user/@FEXYOURSELF user can only fex to himself via web interface $to/$from/$file/upload file data in upload progress $to/$from/$file/filename original file name $to/$from/$file/size original file size + $to/$from/$file/useragent HTTP header User-Agent $to/$from/$file/data file data after complete upload $to/$from/$file/keep keep time (autoexpire) in days $to/$from/$file/autodelete autodelete option: YES NO or DELAY @@ -251,6 +257,7 @@ $to/$from/$file/error error message if file has gone $to/$from/$file/download log of successful downloads $to/$from/$file/restrictions IP based download restrictions + (see $user/@ALLOWED_RHOSTS) $to/$from/$file/dkey download key $to/$from/$file/locale locale @@ -287,7 +294,7 @@ The download key (DKEY) is a unique identifier for - guess what - downloading. It also prevents an attacker to get the file, because only the recipient knows the DKEY as part of the download URL from the -notification email. +notification email. XKEY is an optional extra download key to have a short download URL in shape http://YOURFEXSERVER//XKEY @@ -366,6 +373,10 @@ - the filename must not contain a "@" - the filename must not end with "~" +To enable HTTP basic authentication, write your access token to a file +named .htauth which will protect all files in this directory. An user will +be prompted for this password by his web browser. + To restrict the access to specific client IP addresses, put these IPs into a file named .htaccessfrom which will protect all files below this directory. You can name single IPs, also as IP ranges (example: @@ -433,8 +444,12 @@ It is also possible to create this stream file as a regular file. Then the content must be the file names you want in the streaming archive. + Note: you may only use relative paths and without "../" elements. +Note: Files beginning with a . or ending with ~ will not be included in +the download stream. + cronjob fex_cleanup is run once a day and deletes expired uploads, removes inactive accounts and does some other spool houskeeping. See: crontab -l diff -Nru fex-20140917/doc/Contribs fex-20150120/doc/Contribs --- fex-20140917/doc/Contribs 2013-07-09 17:59:00.000000000 +0200 +++ fex-20150120/doc/Contribs 2014-12-26 00:18:59.000000000 +0100 @@ -26,6 +26,11 @@ Daniel Dieckmann <Daniel_Dieckmann@genua.de> - fexget proxy support +Kilian Krause <kilian@debian.org> + - Debian package maintainer + - SSL security enhancements + - annoying, but useful requests ;-) + Hanno Hirsch <superhanno@gmx.de>: - bug hunting diff -Nru fex-20140917/doc/installation fex-20150120/doc/installation --- fex-20140917/doc/installation 2014-08-28 23:21:51.000000000 +0200 +++ fex-20150120/doc/installation 2014-09-23 23:19:46.000000000 +0200 @@ -45,12 +45,13 @@ echo "fex 80/tcp" >> /etc/services echo "fex stream tcp nowait fex /home/fex/bin/fexsrv fexsrv" >> /etc/inetd.conf -# now restart inetd +# restart inetd or reboot useradd -s /bin/bash -c "File EXchange" -m fex -pwd # --> FEXSOURCEDIR +cd FEXSOURCEDIR +chown -R fex . su - fex cd FEXSOURCEDIR -cp -av bin cgi-bin lib etc htdocs doc $HOME +rsync -av bin cgi-bin lib etc htdocs doc $HOME cd $HOME mkdir spool chmod 700 spool diff -Nru fex-20140917/doc/newfeatures fex-20150120/doc/newfeatures --- fex-20140917/doc/newfeatures 2014-08-06 00:37:11.000000000 +0200 +++ fex-20150120/doc/newfeatures 2015-01-14 08:53:59.000000000 +0100 @@ -1,6 +1,27 @@ New features for users ---------------------- +2015-01-12: + +- user configuration: save-or-display (MIME) for download + +- fexsend has new option -S show server/user settings + +- fexsend has new option -N resend notification email + + +2014-12-24: + +- the CLI clients respect the environment variables SSLVERIFY SSLVERSION + SSLCAPATH SSLCAFILE SSLCIPHERLIST to enhance HTTPS security + +- new $HOME/.fex/config for the CLI clients, you can set there the variables + $opt_* %autoview %alias + see "fexsend -H" and "fexget -H" for details + +- fexget autoviews images after download + + 2014-08-06: - you as the sender can download the file, too, without auto-deleting it diff -Nru fex-20140917/doc/SSL fex-20150120/doc/SSL --- fex-20140917/doc/SSL 2013-06-20 20:44:26.000000000 +0200 +++ fex-20150120/doc/SSL 2015-01-07 15:15:10.000000000 +0100 @@ -19,6 +19,10 @@ execargs = perl -T /home/fex/bin/fexsrv stunnel EOD +case $(lsb_release -a 2>/dev/null) in + *CentOS*) echo 'fips = no' >>stunnel.conf;; +esac + chown -R fex . stunnel=$(which stunnel4) diff -Nru fex-20140917/doc/version fex-20150120/doc/version --- fex-20140917/doc/version 2014-09-17 22:07:21.000000000 +0200 +++ fex-20150120/doc/version 2015-01-20 10:59:25.000000000 +0100 @@ -1 +1 @@ -fex-20140917 +fex-20150120 diff -Nru fex-20140917/htdocs/download/fexget fex-20150120/htdocs/download/fexget --- fex-20140917/htdocs/download/fexget 1970-01-01 01:00:00.000000000 +0100 +++ fex-20150120/htdocs/download/fexget 2015-01-19 13:59:57.000000000 +0100 @@ -0,0 +1,1074 @@ +#!/usr/bin/perl -w + +# CLI client for the FEX service for retrieving files +# +# see also: fexsend +# +# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> +# +# Perl Artistic Licence + +use 5.006; +use strict qw'vars subs'; +use Config; +use POSIX; +use Encode; +use Getopt::Std; +use File::Basename; +use Socket; +use IO::Handle; +use IO::Socket::INET; +use Time::HiRes 'time'; +use constant k => 2**10; +use constant M => 2**20; + +eval 'use Net::INET6Glue::INET_is_INET6'; + +$| = 1; + +our $SH; +our ($fexhome,$idf,$tmpdir,$windoof,$useragent); +our ($xv,%autoview); +our $bs = 2**16; # blocksize for tcp-reading and writing file +our $version = 20150120; +our $CTYPE = 'ISO-8859-1'; +our $fexsend = $ENV{FEXSEND} || 'fexsend'; + +my %SSL = (SSL_version => 'TLSv1'); +my $sigpipe; + +# inquire default character set +# cannot use "use I18N::Langinfo" because of no windows support! +eval { + local $^W = 0; + require I18N::Langinfo; + I18N::Langinfo->import(qw'langinfo CODESET'); + $CTYPE = langinfo(CODESET()); +}; + +if ($Config{osname} =~ /^mswin/i) { + $windoof = $Config{osname}; + $ENV{HOME} = $ENV{USERPROFILE}; + $fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/fex'; + $tmpdir = $ENV{FEXTMP} || $ENV{TMP} || "$fexhome/tmp"; + $idf = "$fexhome/id"; + $useragent = sprintf("fexget-$version (%s %s)", + $Config{osname},$Config{archname}); + $SSL{SSL_verify_mode} = 0; + chdir $ENV{USERPROFILE}.'\Desktop'; + # open XX,'>XXXXXX';close XX; +} else { + $0 =~ s:(.*)/:: and $ENV{PATH} .= ":$1"; + $fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/.fex'; + $tmpdir = $ENV{FEXTMP} || "$fexhome/tmp"; + $idf = "$fexhome/id"; + $_ = `(lsb_release -d||uname -a)2>/dev/null`||''; + chomp; + s/^Description:\s+//; + $useragent = "fexget-$version ($_)"; +} + +if (-f ($_ = '/etc/fex/config.pl')) { + eval { require } or warn $@; +} + +my $usage = <<EOD; +usage: $0 [-v] [-m limit] [-s filename] [-o] [-k] [-X] [-P proxy:port] F*EX-URL(s) + or: $0 [-v] -d F*EX-URL(s) + or: $0 [-v] -f F*EX-URL(s) e-mail-address + or: $0 [-v] -a + or: $0 -l [-i tag] + or: $0 -H +options: -v verbose mode + -m limit kB/s + -s save to filename (-s- means: write to STDOUT/pipe) + -o overwrite existing file + -k keep on server after download + -X do not extract archive files or autoview file + -d delete without download + -f forward a file to another recipient + -a get all files (implies -X) + -l list files on server + -i tag alternate server/account, see: $fexsend -h + -P use Proxy for connection to the F*EX server + -H show hints and examples +argument: F*EX-URL may be file number (see: $0 -l) +EOD + +my $hints = <<'EOD'; +When you download a file with extension .jpg .gif .png or .tif an image viewer +will be started. This can be xv or xdg-open. +In $HOME/.fex/config.pl you can set your prefered autoview applications: + +%autoview = ( + '\.(gif|jpg|png|tiff?)' => 'my_prefered_image_viewer', + '\.(avi|mp4|mov)' => 'vlc -f', + '\.pdf' => 'evince', +); + +For HTTPS you can set the environment variables: +SSLVERIFY=1 # activate server identity verification +SSLVERSION=TLSv1 # this is the default +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 + +You can set these environment variables also in $HOME/.fex/config.pl, as well as +the $opt_* variables, e.g.: + +$ENV{SSLVERSION} = 'TLSv1'; +${'opt_+'} = 1; +$opt_m = 200; +EOD + +if ($windoof and not @ARGV and not $ENV{PROMPT}) { + # restart with cmd.exe to have mouse cut+paste + my $cmd = "cmd /k \"$0\""; + # print "$cmd\n"; + exec $cmd; + exit; +} + +my $atype = '\.(tgz|tar|zip|7z)$'; +my $proxy = ''; +my $proxy_prefix = ''; +my $chunksize; + +our ($opt_h,$opt_v,$opt_l,$opt_d,$opt_m,$opt_z,$opt_K,$opt_o,$opt_a); +our ($opt_s,$opt_k,$opt_i,$opt_V,$opt_X,$opt_f,$opt_P,$opt_L,$opt_H); +$opt_m = $opt_h = $opt_v = $opt_l = $opt_d = $opt_K = $opt_o = $opt_a = 0; +$opt_V = $opt_X = $opt_f = $opt_L = $opt_H = 0; +${'opt_+'} = 0; +$opt_s = $opt_k = $opt_i = $opt_P = ''; +$_ = "$fexhome/config.pl"; require if -f; +getopts('hvVHlLdkzoaXf+m:s:i:K:P:') or die $usage; +$opt_k = '?KEEP' if $opt_k; + +if ($opt_m =~ /(\d+)/) { + $opt_m = $1 +} else { + $opt_m = 0 +} + +print "Version: $version\n" if $opt_V; +die $usage if $opt_h; +if ($opt_H) { + print $hints; + exit; +} + +# set SSL/TLS options +$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_ca_file) +) { + my $env = uc($opt); + $env =~ s/_//g; + $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); +} + +if ($SSL{SSL_verify_mode}) { + &search_ca; + unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { + die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; + } +} elsif (defined($SSL{SSL_verify_mode})) { + # user has set SSLVERIFY=0 ! +} else { + &search_ca; + $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; +} + +sub search_ca { + local $_; + return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; + foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { + if (-f) { + $SSL{SSL_ca_file} = $_; + return; + } + } + foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { + if (-f) { + $SSL{SSL_ca_path} = $_; + return; + } + } +} + +my $ffl = "$tmpdir/fexget"; # F*EX files list (cache) + +my @rcamel = ( +'[A +(_*) _ _ + \\\\/ \\/ \\ + \ __ )=* + //\\\\//\\\\ +', +'[A \\\\/\\\\/ +', +'[A //\\\\//\\\\ +'); + +# get fexlog +if ($opt_z) { + my $cmd = "$fexsend -Z"; + $cmd .= " -i $opt_i" if $opt_i; + warn "$cmd\n" if $opt_v; + exec $cmd; + die "$0: cannot run $cmd : $!\n"; +} + +if ($opt_l) { + &list; + exit; +} + +if ($opt_L) { + my $cmd = "$fexsend -L"; + $cmd .= " -i $opt_i" if $opt_i; + warn "$cmd\n" if $opt_v; + exec $cmd; + die "$0: cannot run $cmd : $!\n"; +} + +if ($opt_P) { + if ($opt_P =~ /^([\w.-]+:\d+)(:(\d+))?/) { + $proxy = $1; + $chunksize = $3 || 0; + } else { + die "$0: proxy must be: SERVER:PORT\n"; + } +} + +if ($opt_a) { + $opt_X = $opt_a; + die $usage if @ARGV; + &list; + print "\n"; + if (open $ffl,$ffl) { + while (<$ffl>) { + push @ARGV,$1 if /^\s+(\d+)/; + } + close $ffl; + } +} else { + unless (@ARGV) { + if ($windoof) { + my $url; + for (;;) { + print "download-URL: "; + chomp($url = <STDIN>); + if ($url =~ /^http/) { + @ARGV = ($url); + last; + } + } + } else { + die $usage; + } + } +} + +my ($file,%files,$download,$server,$port,$fop); + +if ($opt_f) { + unless ($ENV{FEXID} or -f $ENV{HOME}.'/.fex/id') { + die "$0: no local FEXID\n"; + } + $opt_f = pop(@ARGV); + if ($opt_f =~ /^\d+$|^https?:/) { + die "$0: $opt_f is not an e-mail address\n"; + } +} + +URL: foreach my $url (@ARGV) { + + # do not overrun server + sleep 1 if $fop; + + if ($url !~ /^http/) { + unless (%files) { + open $ffl,$ffl or die "$0: no $ffl, use first: $0 -l\n"; + my $from = ''; + while (<$ffl>) { + if (/^from (.+) :$/) { + $from = $1; + } elsif (/^\s*(\d+)\)\s+\d+ MB.* (http\S+)/) { + push @{$files{all}},$2; + push @{$files{$from}},$2; + } + } + close $ffl; + } + + if ($url =~ /^(\d+)$/) { + $url = ${files{all}}[$1-1] or die "$0: unknown file number\n"; + } + } + + if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/.*fop/\S+)}) { + $server = $2; + $port = $4 || ($1?443:80); + $fop = $5; + } else { + die "$0: unknown F*EX URL $url\n"; + } + + if ($proxy) { + if ($port == 80) { $proxy_prefix = "http://$server" } + elsif ($port == 443) { $proxy_prefix = "" } + else { $proxy_prefix = "http://$server:$port" } + } + + serverconnect($server,$port); + + if ($opt_f) { + forward($url); + next; + } + + if ($opt_d) { + my @r = del($url); + $_ = shift @r; + if (/^HTTP.* 200/) { + ($file) = grep { $_ = $1 if /^X-File:\s+(.+)/ } @r; + $file = $url unless $file; + $file =~ s:.*/::; + printf "%s deleted\n",urldecode($file); + } else { + s:HTTP/[\d\. ]+::; + die "$0: server response: $_"; + } + next; + } + + if ($opt_K) { + my @r = keep($url); + $_ = shift @r; + if (/^HTTP.* 200/) { + $file = $url; + $file =~ s:.*/::; + print "$file kept\n"; + } else { + s:HTTP/[\d\. ]+::; + die "$0: server response: $_"; + } + next; + } + + $download = download($server,$port,$fop); + exit if $opt_s eq '-'; + unlink $download unless -s $download; + exit 2 unless -f $download; + + if ($windoof) { + print "READY\n"; + exit; + } + + if (not $opt_X and $download =~ /\.gpg$/) { + if (-t) { + print "decrypt \"$download\"? "; + $_ = <STDIN>||'y'; + unless (/^[y\n]/i) { + print "keeping \"$download\"\n"; + exit; + } + } + if (system('gpg',$download) == 0) { + unlink $download; + $download =~ s/\.gpg$//; + } + } + + unless ($opt_X) { + + foreach my $a (keys %autoview) { + if ($download =~ /$a$/i and $autoview{$a}) { + printf "run \"%s %s\" [Yn] ? ",$autoview{$a},basename($download); + $_ = <STDIN>||''; + system sprintf("%s %s",$autoview{$a},quote($download)) if /^y|^$/i; + next URL; + } + } + + if ($ENV{DISPLAY} and $download =~ /\.(gif|jpg|png|tiff?)$/i) { + # see also mimeopen and xdg-mime + if (my $xv = $xv || pathsearch('xv') || pathsearch('xdg-open')) { + printf "run \"%s %s\" [Yn] ? ",basename($xv),basename($download); + $_ = <STDIN>||''; + system $xv,$download if /^y|^$/i; + next URL; + } + } + + if ($download =~ /$atype/) { + if ($download =~ /\.(tgz|tar.gz)$/) { extract('tar tvzf','tar xvzf') } + elsif ($download =~ /\.tar$/) { extract('tar tvf','tar xvf') } + elsif ($download =~ /\.zip$/i) { extract('unzip -l','unzip') } + elsif ($download =~ /\.7z$/i) { extract('7z l','7z x') } + else { die "$0: unknown archive \"$download\"\n" } + if ($? == 0) { + unlink $download; + } else { + die "$0: keeping \"$download\"\n"; + } + } + } + +} + +exit; + +sub extract { + my $l = shift; + my $x = shift; + my $d = $download; + my $xd = '.'; + local $_; + + if (-t and not $windoof) { + print "Files in archive:\n"; + system(split(' ',$l),$download); + $d =~ s:.*/:./:; + $d =~ s/\.[^.]+$//; + for (;;) { + $xd = inquire("extract to directory (Ctrl-C to keep archive): ",$d); + last if $xd =~ s:^(\./*)*!?$:./:; + if ($xd eq '-') { + print "keeping $download\n"; + exit; + } + if ($xd !~ s/!$//) { + if (-d $xd) { + print "directory $xd does already exist, add \"!\" to overwrite\n"; + redo; + } + unless (mkdir $xd) { + print "cannot mkdir $xd - $!\n"; + redo; + } + } + unless (chdir $xd) { + print "cannot chdir $xd - $!\n"; + redo; + } + last; + } + } + print "extracting to $xd :\n"; + system(split(' ',$x),$download); +} + +sub del { + my $url = shift; + my ($server,$port); + my $del; + my @r; + + if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/fop/.+)}) { + $server = $2; + $port = $4 || ($1?443:80); + $del = $5.'?DELETE'; + } else { + die "$0: unknown F*EX URL $url\n"; + } + + sendheader("$server:$port","GET $del HTTP/1.1","User-Agent: $useragent"); + while (<$SH>) { + s/\r//; + last if /^\n/; # ignore HTML output + warn "<-- $_" if $opt_v; + push @r,$_; + } + die "$0: no response from fex server $server\n" unless @r; + return @r; +} + + +sub forward { + my $url = shift; + my ($server,$port); + my ($uri,$dkey,$list,$cmd,$n); + my @r; + + if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/fop/.+)}) { + $server = $2; + $port = $4 || ($1?443:80); + $uri = $5; + } else { + die "$0: unknown F*EX URL $url\n"; + } + + sendheader( + "$server:$port", + "GET $uri?COPY HTTP/1.1", + "User-Agent: $useragent", + ); + + $_ = <$SH>; + die "$0: no reply from fex server $server\n" unless $_; + warn "<-- $_" if $opt_v; + + unless (/^HTTP.*200/) { + s/^HTTP.... \d+ //; + die "$0: $_"; + } + + while (<$SH>) { + s/\r//; + last if /^\n/; # ignore HTML output + $dkey = $1 if /^Location:.*\/(\w+)\/.+/; + warn "<-- $_" if $opt_v; + } + + $cmd = 'fexsend -l >/dev/null 2>&1'; + print "$cmd\n" if $opt_v; + system 'fexsend -l >/dev/null 2>&1'; + $list = $ENV{HOME}.'/.fex/tmp/fexlist'; + open $list,$list or die "$0: cannot open $list - $!\n"; + while (<$list>) { + if (/^\s+(\d+)\) (\w+)/ and $2 eq $dkey) { + $n = $1; + $cmd = "fexsend -b $n $opt_f"; + print "$cmd\n" if $opt_v; + system $cmd; + last; + } + } + close $list; + + if ($n) { + $cmd = "fexsend -d $n >/dev/null 2>&1"; + print "$cmd\n" if $opt_v; + system $cmd; + } else { + warn "$0: forwarding failed\n"; + } +} + + +sub keep { + my $url = shift; + my ($server,$port); + my $keep; + my (@hh,@r); + + if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/fop/.+)}) { + $server = $2; + $port = $4 || ($1?443:80); + $keep = "$5?KEEP=$opt_K"; + } else { + die "$0: unknown F*EX URL $url\n"; + } + + push @hh,"GET $keep HTTP/1.1", + "Host: $server:$port", + "User-Agent: $useragent", + ""; + + foreach (@hh) { + warn $_,"\n" if $opt_v; + print $SH $_,"\r\n"; + } + while (<$SH>) { + s/\r//; + last if /^\n/; + push @r,$_; + } + die "$0: no response from fex server $server\n" unless @r; + grep { warn "\t$_" } @r if $opt_v; + return @r; +} + + +sub download { + my ($server,$port,$fop,$nocheck) = @_; + my ($file,$download,$ssl,$pipe,$filesize,$checkstorage); + my (@hh,@r); + my ($t0,$t1,$t2,$tt,$tm,$ts,$kBs,$b,$bt,$tb,$B,$buf); + my $length = 0; + my $seek = 0; + my $tc = 0; + local $_; + local *X; + + if ($opt_s) { + $file = $opt_s; + if ($opt_s eq '-') { + $pipe = $download = $opt_s; + } elsif (-p $opt_s or -c $opt_s) { + $download = $opt_s; + } else { + $download = $file.'.tmp'; + $seek = -s $download || 0; + } + } else { + # ask server for real file name + serverconnect($server, $port); + sendheader("$server:$port","HEAD $proxy_prefix$fop HTTP/1.1","User-Agent: $useragent"); + my $reply = $_ = <$SH>; + unless (defined $_ and /\w/) { + die "$0: no response from server\n"; + } + warn "<-- $_" if $opt_v; + unless (/^HTTP\/[\d.]+ 200/) { + s:HTTP/[\d. ]+::; + die "$0: server response: $_"; + } + while (<$SH>) { + s/\r//; + warn "<-- $_" if $opt_v; + last if /^\r?\n/; + if (/^Content-Disposition: attachment; filename="(.+)"/i) { + $file = locale(decode_utf8($1)); + $file =~ s:.*/::; + } + } + unless ($file) { + $file = $fop; + $file =~ s:.*/::; + } + $download = $file.'.tmp'; + $seek = -s $download || 0; + } + + push @hh,"GET $proxy_prefix$fop$opt_k HTTP/1.1", + "User-Agent: $useragent", + "Connection: close"; + push @hh,"Range: bytes=$seek-" if $seek; + + # HTTPS needs a new connection for actually downloading the file + serverconnect($server,$port) if $opt_P and $port == 443; + sendheader("$server:$port",@hh); + $_ = <$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//; + warn "<-- $_" if $opt_v; + last if /^\r?\n/; + if (/^Content-length:\s*(\d+)/i) { + $length = $1; + } elsif (/^X-Size: (\d+)/i) { + $filesize = $1; + } + } + } else { + s/HTTP\/[\d.]+ \d+ //; + die "$0: bad server reply: $_"; + } + + if ($pipe) { + *X = *STDOUT; + } else { + if ($opt_s and $opt_s eq $download) { + open X,'>',$download or die "$0: cannot write to \"$download\" - $!\n"; + $checkstorage = $filesize unless $nocheck; + } else { + if (-e $file and not $opt_o) { + die "$0: destination file \"$file\" does already exist\n"; + } + if ($seek) { + open X,'>>',$download or die "$0: cannot write to \"$download\" - $!\n"; + } else { + open X,'>',$download or die "$0: cannot write to \"$download\" - $!\n"; + $checkstorage = $filesize unless $nocheck; + } + } + if ($checkstorage and not $nocheck) { + $t0 = time; + my $n = 0; + print STDERR "checking storage...\r"; + $buf = '.' x M; + while (-s $download < $checkstorage) { + syswrite X,$buf or do { + unlink $download; + die "\n$0: cannot write $download - $!\n"; + }; + $n++; + print STDERR "checking storage... ".$n." MB\r"; + } + close X or do { + unlink $download; + die "\n$0: cannot write $download - $!\n"; + }; + print STDERR "checking storage... ".$n." MB ok!\n"; + unlink $download; + if (time-$t0 < 25) { + open X,'>',$download or die "$0: cannot write to \"$download\" - $!\n"; + } else { + # retry after timeout + return(download($server,$port,$fop,'nocheck')) + } + } + } + + $t0 = $t1 = $t2 = int(time); + $tb = $B = 0; + printf STDERR "resuming at byte %s\n",$seek if $seek; + print $rcamel[0] if ${'opt_+'}; + while ($B < $length and $b = read $SH,$buf,$bs) { + syswrite X,$buf; + $B += $b; + $tb += $b; + $bt += $b; + $t2 = time; + if (${'opt_+'} and int($t2*10)>$tc) { + print $rcamel[$tc%2+1]; + $tc = int($t2*10); + } + if (int($t2) > $t1) { + $kBs = int($bt/k/($t2-$t1)); + $kBs = int($tb/k/($t2-$t0)) if $kBs < 10; + $t1 = $t2; + $bt = 0; + # smaller block size is better on slow links + $bs = 4096 if $bs>4096 and $tb/($t2-$t0)<65536; + if ($tb<10*M) { + printf STDERR "%s: %d kB (%d%%) %d kB/s \r", + $download, + int(($tb+$seek)/k), + int(($tb+$seek)/($length+$seek)*100), + $kBs; + } else { + printf STDERR "%s: %d MB (%d%%) %d kB/s \r", + $download, + int(($tb+$seek)/M), + int(($tb+$seek)/($length+$seek)*100), + $kBs; + } + } + if ($opt_m) { + if ($t2 == $t0 and $B > $opt_m*k) { + print "\nsleeping...\r" if $opt_v; + sleep 1; + } else { + while ($t2 > $t0 and $tb/k/($t2-$t0) > $opt_m) { + print "\nsleeping...\r" if $opt_v; + sleep 1; + $t2 = time; + } + } + } + } + close $SH; + close X; + + print $rcamel[2] if ${'opt_+'}; + + $tt = $t2-$t0; + $tm = int($tt/60); + $ts = $tt-$tm*60; + $kBs = int($tb/k/($tt||1)); + if ($seek) { + printf STDERR "$file: %d MB, last %d MB in %d s (%d kB/s) \n", + int(($tb+$seek)/M),int($tb/M),$tt,$kBs; + } else { + printf STDERR "$file: %d MB in %d s (%d kB/s) \n", + int($tb/M),$tt,$kBs; + } + + if ($tb != $length) { + if ($windoof) { + exec "\"$0\" @ARGV"; + exit; + } else { + die "$0: $server annouced $length bytes, but only $tb bytes has been read\n"; + } + } + + unless ($pipe or -p $download or -c $download) { + my @s = stat $file if -e $file; + rename $download,$file + or die "$0: cannot rename \"$download\" to \"$file\" - $!\n"; + chmod $s[2],$file if @s; + } + + return sprintf("%s/%s",getcwd(),$file); +} + + +sub list { + my $cmd = "$fexsend -L"; + $cmd .= " -i $opt_i" if $opt_i; + if ($opt_v) { + $cmd .= " -v"; + warn "$cmd\n"; + } + open $cmd,"$cmd|" or die "$0: cannot run $cmd : $!\n"; + open $ffl,'>',$ffl or die "$0: cannot open $ffl : $!\n"; + my $n; + while (<$cmd>) { + if (/\d MB .*http/) { + $n++; + printf {$ffl} "%4d) %s",$n,$_; + s:http[^\"]*/::; + printf "%4d) %s",$n,$_; + } else { + print; + print {$ffl} $_; + } + } +} + + +sub locale { + my $string = shift; + + if ($CTYPE) { + if ($CTYPE =~ /UTF-?8/i) { + return $string; + } elsif (grep { $CTYPE =~ /^$_$/i } Encode->encodings()) { + return encode($CTYPE,$string); + } else { + return encode('ISO-8859-1',$string); + } + } + + return $string; +} + + +sub pathsearch { + my $prg = shift; + + foreach my $dir (split(':',$ENV{PATH})) { + return "$dir/$prg" if -x "$dir/$prg"; + } +} + + +sub quote { + local $_ = shift; + s/([^\w¡-ÿ_%\/=~:.,-])/\\$1/g; + return $_; +} + + +{ + my $tty; + + sub inquire { + my $prompt = shift; + my $default = shift; + local $| = 1; + local $_; + + if (defined $default) { + unless ($tty) { + chomp($tty = `tty 2>/dev/null`); + eval { local $^W; require "sys/ioctl.ph"; }; + } + + if (defined(&TIOCSTI) and $tty and open($tty,'>',$tty)) { + print $prompt; + foreach my $a (split("",$default)) { ioctl($tty,&TIOCSTI,$a) } + chomp($_ = <STDIN>||''); + } else { + $prompt =~ s/([\?:=]\s*)/ [$default]$1/ or $prompt .= " [$default]"; + print $prompt; + chomp($_ = <STDIN>||''); + $_ = $default unless length; + } + } else { + print $prompt; + chomp($_ = <STDIN>||''); + } + + return $_; + } +} + + +### common functions ### + + +sub mtime { + my @d = localtime((stat shift)[9]); + return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); +} + + +sub urldecode { + local $_ = shift; + s/\%([a-f\d]{2})/chr(hex($1))/ige; + return $_; +} + + +sub get_ssl_env { + # set SSL/TLS options + $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_ca_file) + ) { + my $env = uc($opt); + $env =~ s/_//g; + $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); + } + + if ($SSL{SSL_verify_mode}) { + &search_ca; + unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { + die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; + } + } elsif (defined($SSL{SSL_verify_mode})) { + # user has set SSLVERIFY=0 ! + } else { + &search_ca; + $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; + } +} + +sub search_ca { + local $_; + return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; + foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { + if (-f) { + $SSL{SSL_ca_file} = $_; + return; + } + } + foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { + if (-f) { + $SSL{SSL_ca_path} = $_; + return; + } + } +} + + +sub serverconnect { + 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) { + printf "--> %s\n",$connect if $opt_v; + nvtsend($connect,""); + $_ = <$SH>; + s/\r//; + printf "<-- $_"if $opt_v; + unless (/^HTTP.1.. 200/) { + die "$0: proxy error : $_"; + } + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->start_SSL($SH,%SSL); + } + } else { + tcpconnect($server,$port); + } +# if ($port == 443 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) { + # eval "use IO::Socket::SSL qw(debug3)"; + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + %SSL + ); + } else { + $SH = IO::Socket::INET->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 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"; + } + print "-->\n" if $opt_v; + print {$SH} "\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) { + undef $SH; + return 0; + } + } + + return 1; +} + + +# from MIME::Base64::Perl +sub encode_b64 { + my $res = ""; + my $eol = "\n"; + my $padding; + + pos($_[0]) = 0; + $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); + $res =~ tr|` -_|AA-Za-z0-9+/|; + $padding = (3-length($_[0])%3)%3; + $res =~ s/.{$padding}$/'=' x $padding/e if $padding; + return $res; +} diff -Nru fex-20140917/htdocs/download/fexsend fex-20150120/htdocs/download/fexsend --- fex-20140917/htdocs/download/fexsend 1970-01-01 01:00:00.000000000 +0100 +++ fex-20150120/htdocs/download/fexsend 2015-01-16 15:52:53.000000000 +0100 @@ -0,0 +1,3055 @@ +#!/usr/bin/perl -w + +# CLI client for the F*EX service (send, list, delete) +# +# see also: fexget +# +# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> +# +# Perl Artistic Licence + +use 5.006; +use strict qw'vars subs'; +use Encode; +use Config; +use Socket; +use IO::Handle; +use IO::Socket::INET; +use Getopt::Std; +use File::Basename; +use Cwd qw'abs_path'; +use Fcntl qw':flock :mode'; +use Digest::MD5 qw'md5_hex'; # encrypted ID / SID +use Time::HiRes qw'time'; +# use Smart::Comments; +use constant k => 2**10; +use constant M => 2**20; + +eval 'use Net::INET6Glue::INET_is_INET6'; + +&update if "@ARGV" eq 'UPDATE'; + +$| = 1; + +our ($SH,$fexhome,$idf,$tmpdir,$windoof,$useragent,$editor,$nomail); +our ($anonymous,$public); +our ($tpid,$frecipient); +our ($FEXID,$FEXXX,$HOME); +our (%alias); +our $chunksize = 0; +our $version = 20150120; +our $_0 = $0; +our $DEBUG; + +my %SSL = (SSL_version => 'TLSv1'); +my $sigpipe; + +if ($Config{osname} =~ /^mswin/i) { + $windoof = $Config{osname}; + $HOME = $ENV{USERPROFILE}; + $fexhome = $ENV{FEXHOME} || $HOME.'\fex'; + $tmpdir = $ENV{FEXTMP} || $ENV{TEMP} || "$fexhome\\tmp"; + $idf = "$fexhome\\id"; + $editor = $ENV{EDITOR} || 'notepad.exe'; + $useragent = sprintf("fexsend-$version (%s %s)", + $Config{osname},$Config{archname}); + $SSL{SSL_verify_mode} = 0; +} else { + $0 =~ s:.*/::; + $HOME = (getpwuid($<))[7]||$ENV{HOME}; + $fexhome = $HOME.'/.fex'; + $tmpdir = $ENV{FEXTMP} || "$fexhome/tmp"; + $idf = "$fexhome/id"; + $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')) { + eval { require } or warn $@; +} + +my $from = ''; +my $to = ''; +my $id = ''; +my $skey = ''; +my $gkey = ''; +my $atype = ''; # archive type +my $fexcgi; # F*EX CGI URL +my @files; # files to send +my %AB = (); # server based address book +my ($server,$port,$sid); +my $proxy = ''; +my $proxy_prefix = ''; +my $features = ''; +my $timeout = 30; # server timeout +my $fexlist = "$tmpdir/fexlist"; +my ($usage,$hints); +my $xx = $0 =~ /^xx/; + +if ($xx) { + $usage = "usage: send file(s): xx [:slot] file...\n". + " or: send STDIN: xx [:slot] -\n". + " or: send pipe: ... | xx [:slot] \n". + " or: get file(s) or STDIN: xx [:slot] \n". + " or: get file(s) no-questions: xx [:slot] --\n". + "examples: dmesg | xx\n". + " xx project\n". + " xx --\n". + " xx :conf /etc /boot\n"; +} else { + $usage = <<EOD; +usage: $0 [options] file(s) [@] recipient(s) + or: $0 [special options] + or: $0 -f \# recipient(s) + or: $0 -x \# [-C -k -D -K -S] +options: -v verbose mode + -d delete file on fex server + -c compress file + -g encrypt file with gpg + -m limit limit throughput (kB/s) + -i tag use ID data [tag] from ID file + -C comment add comment to notification e-mail + -k max keep file max days on fex server + -D delay auto-delete after download + -K no auto-delete after download + -M MIME-file (to be displayed in recipient\'s webbrowser) + -o overwrite mode, do not resume + -a archive put files in archive (.zip .7z .tar .tgz) + -s stream read data from pipe and upload it with stream name +special options: -I initialize ID file or show ID + -I tag add alternate ID data (secondary logins) to ID file + -l list sent files numbered (# needed for -f -x -d -N) + -f \# forward already uploaded file to another recipient + -x \# modify options -C -k -D -K for already uploaded file + -d \# delete file on fex server + -N \# resend notification e-mail + -Q check quotas + -A edit server address book (aliases) + -S show server/user settings and auth-ID + -H show hints, examples and more options + -V show version + (\# is a file number, see output from $0 -l) +examples: $0 visualization.mpg framstag\@rus.uni-stuttgart.de + $0 -a images.zip *.jpg webmaster\@flupp.org,metoo + lshw | $0 -s hardware.list admin\@flupp.org +EOD +# or: $0 -R FEX-URL e-mail +# -R FEX mail self-register your e-mail address at FEX server + + $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 +(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 +sent to him. Example: + $0 big.file http://fex.rus.uni-stuttgart.de/fup?skey=4285f8cdd881626524fba686d5f0a83a + +Recipient can be a GKEY URL, which you have received from a regular F*EX user. +Using this URL you are a member of his group and the file will be sent to all +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 +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 +(no notification e-mail will be sent). Example: + $0 software.tar . + +"//" as recipient means fex to yourself and create extra short download URL. +Example: + $0 software.tar // + +If you want a Bcc of the notification e-mail then add '!bcc!' to the comment: +fexsend -C '!bcc! for me and you' ... + +Additional special options: + + -. sends a short instead of a detailed notification e-mail + -/ does not upload the file, but tells the server to link it + -= uses an alias name as file name + -# excludes files (# is list separator) from archive -a + -n sends no notification e-mail, but shows the download URL immediately + -q is quiet mode + -r ADDRESS sets e-mail Reply-To ADDRESS + -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 +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, +then you first have to query the file number with: + $0 -l +and then copy-forward it with: + $0 -b # other\@address +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 +and then for example set the keep time to 30 days with: + $0 -x # -k 30 +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) +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: +SSLVERIFY=1 # activate server identity verification +SSLVERSION=TLSv1 # this is the default +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: + $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: + FEXID="FEXSERVER USER AUTHID" $0 file recipient +Example: + FEXID="fex.flupp.org gaga\@flupp.org blubb" $0 big.file framstag\@rus.uni-stuttgart.de + +You can define aliases (and optional fexsend options) in \$HOME/.fex/config.pl: + %alias = ( + 'alias1' => 'user1\@domain1.org', + 'alias2' => 'user2\@domain2.org', + 'both' => 'user1\@domain1.org,user2\@domain2.org', + 'extra' => 'extra\@special.net:-i other -K -k 30', + ); + +fexsend also respects aliases in $HOME/.mutt/aliases +The alias priority is (descending): +\$HOME/.fex/config.pl +\$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; +EOD +} + +my @rcamel = ( +'[A + _ _ c*_) + / \/ \// + *=( __ / + \\\\/\\\\/ +', +'[A \\\\/\\\\/ +', +'[A //\\\\//\\\\ +'); + +autoflush STDERR; + +if ($windoof and not @ARGV and not $ENV{PROMPT}) { + # restart with cmd.exe to have mouse cut+paste + exec qw'cmd /k',$0,'-W'; + exit; +} + +unless (-d $fexhome) { + mkdir $fexhome,0700 or die "$0: cannot create FEXHOME $fexhome - $!\n"; +} + +unless (-d $tmpdir) { + mkdir $tmpdir,0700 or die "$0: cannot create tmpdir $tmpdir - $!\n"; +} + +my @_ARGV = @ARGV; # save arguments + +our ($opt_q,$opt_h,$opt_H,$opt_v,$opt_m,$opt_c,$opt_k,$opt_d,$opt_l,$opt_I, + $opt_K,$opt_D,$opt_u,$opt_f,$opt_a,$opt_C,$opt_R,$opt_M,$opt_L,$opt_Q, + $opt_A,$opt_i,$opt_z,$opt_Z,$opt_b,$opt_P,$opt_x,$opt_X,$opt_V,$opt_U, + $opt_s,$opt_o,$opt_g,$opt_F,$opt_n,$opt_r,$opt_S,$opt_N); + +if ($xx) { + $opt_q = 1 if @ARGV and $ARGV[-1] eq '--' and pop @ARGV or not -t STDOUT; + $opt_h = $opt_v = $opt_m = $opt_I = 0; + $opt_X = ''; + $_ = "$fexhome/config.pl"; require if -f; + getopts('hvIm:') or die $usage; +} else { + $opt_h = $opt_v = $opt_m = $opt_c = $opt_k = $opt_d = $opt_l = $opt_I = 0; + $opt_H = $opt_K = $opt_D = $opt_R = $opt_M = $opt_L = $opt_Q = $opt_A = 0; + $opt_x = $opt_o = $opt_g = $opt_V = $opt_U = $opt_F = $opt_n = $opt_q = 0; + $opt_S = $opt_N = 0; + ${'opt_@'} = ${'opt_!'} = ${'opt_+'} = ${'opt_.'} = ${'opt_/'} = 0; + ${'opt_='} = ${'opt_#'} = ''; + $opt_u = $opt_f = $opt_a = $opt_C = $opt_i = $opt_b = $opt_P = $opt_X = ''; + $opt_s = $opt_r = ''; + $_ = "$fexhome/config.pl"; require if -f; + 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"; + } + + if ($opt_a and $opt_c) { + die "$0: you cannot use both options -a and -c\n"; + } + + if ($opt_a and $opt_s) { + die "$0: you cannot use both options -a and -s\n"; + } + + if ($opt_g and $opt_c) { + $opt_c = 0; + } + + $opt_f ||= $opt_b; + if ($opt_f and $opt_f !~ /^\d+$/) { + die "$0: option -f needs a number, see $0 -l\n"; + } + + if ($opt_I and $opt_R) { + die "$0: you cannot use both options -I and -R\n"; + } + + # $opt_C is COMMENT command in F*EX protocol + $opt_C = + ($opt_d) ? 'DELETE': + ($opt_l or $opt_L) ? 'LIST': + ($opt_Q) ? 'CHECKQUOTA': + ($opt_S) ? 'LISTSETTINGS': + ($opt_Z) ? 'RECEIVEDLOG': + ($opt_z) ? 'SENDLOG': + (${'opt_!'}) ? 'FOPLOG': + $opt_C; + + $opt_D = + ($opt_D) ? 'DELAY': + ($opt_K) ? 'NO': + $opt_D; +} + +&get_ssl_env; + +if ($opt_h) { + female_mode("show help?") if $opt_F; + print $usage; + exit; +} + + +if ($opt_R) { + ®ister; + exit; +} + + +die $usage if $opt_m and $opt_m !~ /^\d+/; + +if ($opt_P) { + if ($opt_P =~ /^([\w.-]+:\d+)(:(\d+))?/) { + $proxy = $1; + $chunksize = $3 || 0; + } else { + die "$0: proxy must be: SERVER:PORT\n"; + } +} + +if ($FEXID = $ENV{FEXID}) { + $FEXID = decode_b64($FEXID) if $FEXID !~ /\s/; + ($fexcgi,$from,$id) = split(/\s+/,$FEXID); +} else { + if ($windoof and not -f $idf) { &init_id } + if (open $idf,$idf) { + &get_id($idf); + close $idf; + } +} + +if ($xx) { + # convert old idxx file + if ($idf and open $idf,$idf.'xx') { + &get_id($idf); + close $idf; + if (open $idf,'>>',$idf) { + print {$idf} "\n[xx]\n", + "$fexcgi\n", + "$from\n", + "$id\n"; + close $idf; + unlink $idf.'xx'; + } + } + + # special xx ID? + if ($FEXXX = $ENV{FEXXX}) { + $FEXXX = decode_b64($FEXXX) if $FEXXX !~ /\s/; + ($fexcgi,$from,$id) = split(/\s+/,$FEXXX); + } elsif (open $idf,$idf) { + while (<$idf>) { + if (/^\[xx\]/) { + $proxy = $proxy_prefix = ''; + &get_id($idf); + last; + } + } + close $idf; + } + +} else { + + # alternativ ID? + if ($opt_i) { + $proxy = $proxy_prefix = ''; + open $idf,$idf or die "$0: cannot open $idf - $!\n"; + while (<$idf>) { + if (/^\[$opt_i\]/) { + &get_id($idf); + last; + } + } + close $idf; + die "$0: no [$opt_i] in $idf\n" unless $_; + } +} + +if ($opt_I) { + if ($xx) { &show_id } + else { &init_id } + exit; +} + +if (@ARGV > 1 and $ARGV[-1] =~ /(^|\/)anonymous/) { + $fexcgi = $1 if $ARGV[-1] =~ s:(.+)/::; + die "usage: $0 [options] file FEXSERVER/anonymous\n" unless $fexcgi; + $anonymous = $from = 'anonymous'; + $sid = $id = 'ANONYMOUS'; +} elsif (@ARGV > 1 and $id eq 'PUBLIC') { + $public = $sid = $id; +} elsif (@ARGV > 1 and $ARGV[-1] =~ m{^(https?://[\w.-]+(:\d+)?/fup\?[sg]key=\w+)}) { + $fexcgi = $1; + $skey = $1 if $fexcgi =~ /skey=(\w+)/; + $gkey = $1 if $fexcgi =~ /gkey=(\w+)/; +} 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"; + } + + if ($fexcgi !~ /^http/) { + if ($fexcgi =~ /:443/) { $fexcgi = "https://$fexcgi" } + else { $fexcgi = "http://$fexcgi" } + } + +} + +$server = $fexcgi; + +$port = 80; +$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"; +} + +$server =~ s{http://}{}; +$server =~ s{/.*}{}; + +# $chunksize = 4*k unless $chunksize; +$chunksize *= M; + +if ($proxy) { + if ($port == 80) { $proxy_prefix = "http://$server" } + elsif ($port != 443) { $proxy_prefix = "http://$server:$port" } +} + +# xx: special file exchange between own accounts +if ($xx) { + my $transferfile = "$tmpdir/STDFEX"; + # slot? + if ($0 eq 'xxx') { + $transferfile = "$tmpdir/xx:xxx"; + } elsif (@ARGV and $ARGV[0] =~ /^:([\w.=+-]+)$/) { + $transferfile = "$tmpdir/xx:$1"; + shift @ARGV; + } + 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"; + truncate $transferfile,0; + if (not @ARGV and -t) { + &get_xx($transferfile); + } else { + &send_xx($transferfile); + } + exit; +} + +# regular fexsend + +&inquire if $windoof and not @ARGV and not + ($opt_l or $opt_L or $opt_Q or $opt_A or $opt_U or $opt_I or + $opt_f or $opt_x or $opt_N); + +if (${'opt_.'}) { + $opt_C = "!SHORTMAIL! $opt_C"; +} + +if ($opt_n or $opt_C =~ /NOMAIL|!#!/) { + $nomail = 'NOMAIL'; +} + +unless ($skey or $gkey or $anonymous) { + if (not $opt_q and ( + $opt_f||$opt_x||$opt_Q||$opt_l||$opt_L||$opt_U||$opt_z||$opt_Z||$opt_A + ||$opt_d||${'opt_!'}||${'opt_@'}) + ) { warn "Server/User: $fexcgi/$from\n" } +} + +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 } +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 } +else { &send_fex } + +exit; + + +# initialize ID file or show ID +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"; + } + + # show ID + if (not $tag and open $idf,$idf) { + if ($opt_i) { + while (<$idf>) { + last if /^\[$opt_i\]/; + } + } + $fexcgi = <$idf>; + $from = <$idf>; + $id = <$idf>; + close $idf; + if ($id) { + chomp($fexcgi,$from,$id); + $FEXID = encode_b64("$fexcgi $from $id"); + if (-t STDIN) { + print "# hint: to edit the ID file $idf use \"$0 -I .\" #\n"; + print "export FEXID=$FEXID\n"; + print "history -d \$((HISTCMD-1));history -d \$((HISTCMD-1))\n"; + } else { + print "FEXID=$FEXID\n"; + } + exit; + } else { + die "$0: no ID data found\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>; + $fexcgi =~ s/[\s\n]//g; + die "you MUST provide a FEX-URL!\n" unless $fexcgi; + 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; + $fexcgi =~ s/\?.*//; + } + unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) { + die "\"$fexcgi\" is not a legal FEX-URL!\n"; + } + $fexcgi =~ s:/fup/*$::; + print "proxy address (hostname:port or empty if none): "; + $proxy = <STDIN>; + $proxy =~ s/[\s\n]//g; + if ($proxy =~ /^[\w.-]+:\d+$/) { + $proxy = "!$proxy"; + } elsif ($proxy =~ /\S/) { + die "wrong proxy address format\n"; + } else { + $proxy = ""; + } + if ($proxy) { + print "proxy POST limit in MB (use 2048 if unknown): "; + $_ = <STDIN>; + if (/(\d+)/) { + $proxy .= "[$1]"; + } + } + if ($skey) { + $from = 'SUBUSER'; + $id = $skey; + } elsif ($gkey) { + $from = 'GROUPMEMBER'; + $id = $gkey; + } else { + unless ($from) { + print "Your e-mail address as registered at $fexcgi: "; + $from = <STDIN>; + $from =~ s/[\s\n]//g; + die "you MUST provide your e-mail address!\n" unless $from; + } + unless ($from =~ /^[_:=\w\-\.\/\@\%\+]+$/) { + die "\"$from\" is not a legal e-mail address!\n"; + } + unless ($id) { + print "Your auth-ID for $from at $fexcgi: "; + $id = <STDIN>; + $id =~ s/[\s\n]//g; + die "you MUST provide your ID!\n" unless $id; + } + } + if (open $idf,'>>',$idf) { + print {$idf} "\n[$tag]\n" if $tag and -s $idf; + print {$idf} "$fexcgi$proxy\n", + "$from\n", + "$id\n"; + close $idf; + print "data written to $idf\n"; + } else { + die "$0: cannot write to $idf - $!\n"; + } +} + + +sub show_id { + my ($fexcgi,$from,$id); + if (open $idf,$idf) { + $fexcgi = <$idf>; + $from = <$idf>; + $id = <$idf>; + while (<$idf>) { + if (/^\[xx\]/) { + $fexcgi = <$idf>; + $from = <$idf>; + $id = <$idf>; + } + } + close $idf; + die "$0: too few data in $idf" unless defined $id; + chomp($fexcgi); + chomp($from); + chomp($id); + $FEXXX = encode_b64("$fexcgi $from $id"); + if (-t STDIN) { + print "export FEXXX=$FEXXX\n"; + print "history -d \$((HISTCMD-1));history -d \$((HISTCMD-1))\n"; + } else { + print "FEXXX=$FEXXX\n"; + } + } else { + die "$0: cannot read $idf - $!\n"; + } +} + + +sub register { + my $fs = shift @ARGV or die $usage; + my $mail = shift @ARGV or die $usage; + my $port; + my ($server,$user,$id); + + die "$0: $idf does already exist\n" if -e $idf; + + if ($fs =~ /^https/) { + die "$0: cannot handle https at this time\n"; + } + + $fs =~ s{^http://}{}; + $fs =~ s{/.*}{}; + if ($fs =~ s/:(\d+)//) { $port = $1 } + else { $port = 80 } + + tcpconnect($fs,$port); + sendheader("$fs:$port","GET $proxy_prefix/fur?user=$mail&verify=no HTTP/1.1"); + http_response(); + + while (<$SH>) { + s/\r//; + printf "<-- $_"if $opt_v; + last if /^\s*$/; + } + + while (<$SH>) { + s/\r//; + printf "<-- $_"if $opt_v; + if (m{http://(.*)/fup\?from=(.+)&ID=(.+)}) { + $server = $1; + $user = $2; + $id = $3; + + if (open F,">$idf") { + print F "$server\n", + "$user\n", + "$id\n"; + close F; + chmod 0600,$idf; + print "user data written to $idf\n"; + print "you can now fex!\n"; + exit; + } else { + die "$0: cannot write to $idf - $!\n"; + } + } + } + + die "$0: no account data received from F*EX server\n"; + +} + + +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' } + + if (-t) { + if ("@ARGV" eq '-') { + # store STDIN to transfer file + shelldo("cat >> $transferfile"); + } elsif (@ARGV) { + 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); + chdir $dir or die "$0: $dir - $!\n"; + } else { + $file = $ARGV[0]; + } + if (-l $file) { + shelldo(@tar,qw'--dereference -f',$transferfile,$file); + } else { + shelldo(@tar,'-f',$transferfile,$file); + } + } else { + shelldo(@tar,'-f',$transferfile,@ARGV); + } + if ($?) { + unlink $transferfile; + if ($? == 2) { + die "$0: interrupted making tar transfer file\n"; + } else { + die "$0: error while making tar transfer file\n"; + } + } + } + } else { + # write input from pipe to transfer file + shelldo("cat >> $transferfile"); + } + + die "$0: no transfer file\n" unless -s $transferfile; + + serverconnect($server,$port); + query_sid($server,$port); + + @r = formdatapost( + from => $from, + to => $from, + id => $sid, + file => $transferfile, + 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); + if ($transferfile =~ /:/ and $0 ne 'xxx') { + if ("@r" =~ /\s(X-)?Location: (http.*)\s/) { + print "wget -O- $2 | tar xvzf -\n"; + } + } + + unlink $transferfile; +} + + +sub query_quotas { + my (@r,$r); + local $_; + + female_mode("query quotas?") if $opt_F; + + @r = formdatapost( + from => $from, + to => $from, + id => $sid, + command => $opt_C, + ); + die "$0: no response from fex server $server\n" unless @r; + $_ = shift @r; + unless (/^HTTP.* 2/) { + s:HTTP/[\d\. ]+::; + die "$0: server response: $_\n"; + } + if (($_) = grep(/^X-Sender-Quota/,@r) and /(\d+)\s+(\d+)/) { + print "sender quota (used): $1 ($2) MB\n"; + } else { + print "sender quota: unlimited\n"; + } + if (($_) = grep(/^X-Recipient-Quota/,@r) and /(\d+)\s+(\d+)/) { + print "recipient quota (used): $1 ($2) MB\n"; + } else { + print "recipient quota: unlimited\n"; + } +} + + +sub query_settings { + my (@r,$r); + local $_; + + female_mode("query settings?") if $opt_F; + + if ($FEXID) { + print "ID data from \$FEXID\n"; + } elsif (-f $idf) { + print "ID data from $idf\n"; + } else { + die "$0: found no ID\n"; + } + print "server: $fexcgi\n"; + print "user: $from\n"; + print "auth-ID: $id\n"; + print "login URL: "; + &show_URL; + + @r = formdatapost( + from => $from, + to => $from, + id => $sid, + command => $opt_C, + ); + die "$0: no response from fex server $server\n" unless @r; + $_ = shift @r; + unless (/^HTTP.* 2/) { + s:HTTP/[\d\. ]+::; + die "$0: server response: $_\n"; + } + if (($_) = grep(/^X-Autodelete/,@r) and /:\s+(\w+)/) { + print "autodelete: $1\n"; + } + if (($_) = grep(/^X-Default-Keep/,@r) and /(\d+)/) { + print "default keep: $1 days\n"; + } + if (($_) = grep(/^X-Default-Locale/,@r) and /:\s+(\w+)/) { + print "default locale: $1\n"; + } + if (($_) = grep(/^X-MIME/,@r) and /:\s+(\w+)/) { + print "display file with browser: $1\n"; + } + if (($_) = grep(/^X-Sender-Quota/,@r) and /(\d+)\s+(\d+)/) { + print "sender quota (used): $1 ($2) MB\n"; + } else { + print "sender quota: unlimited\n"; + } + if (($_) = grep(/^X-Recipient-Quota/,@r) and /(\d+)\s+(\d+)/) { + print "recipient quota (used): $1 ($2) MB\n"; + } else { + print "recipient quota: unlimited\n"; + } +} + + +# list spool +sub list { + my (@r,$r); + my ($data,$dkey,$n); + 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/) { + 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"; + } + exit; + } + } + die "$0: file \#$n not found in fexlist\n"; + } else { + @r = formdatapost( + from => $from, + to => $opt_l ? '*' : $from, + command => $opt_C, + ); + } + die "$0: no response from fex server $server\n" unless @r; + $_ = shift @r; + unless (/^HTTP.* 200/) { + s:HTTP/[\d\. ]+::; + die "$0: server response: $_\n"; + } + + # list sent files + if ($opt_l) { + open $fexlist,">$fexlist" or die "$0: cannot write $fexlist - $!\n"; + foreach (@r) { + next unless /<pre>/ or $data; + $data = 1; + last if m:</pre>:; + if (/<a href=".*dkey=(\w+).*?">/) { $dkey = $1 } + else { $dkey = '' } +# $_ = encode_utf8($_); + s/<.*?>//g; + if (/^(to .* :)/) { + print "\n$1\n"; + print {$fexlist} "\n$1\n"; + } elsif (m/(\d+) MB (.+)/) { + $n++; + printf "%4s) %8d MB %s\n","#$n",$1,$2; + printf {$fexlist} "%3d) %s %s\n",$n,$dkey,$2; + } + } + close $fexlist; + } + + # list received files + if ($opt_L) { + foreach (@r) { + next unless /<pre>/ or $data; + $data = 1; + next if m:<pre>:; + last if m:</pre>:; + if (/(from .* :)/) { + print "\n$1\n"; + } + if (m{(\d+) (MB.*)<a href="(https?://.*/fop/\w+/.+)">(.+)</a>( ".*")?}) { + printf "%8d %s%s%s\n",$1,$2,$3,($5||''); + } + } + } +} + + +sub show_URL { + printf "%s/fup/%s\n",$fexcgi,encode_b64("from=$from&id=$id"); +} + + +sub get_log { + my (@r); + local $_; + + @r = formdatapost( + from => $from, + to => $from, + id => $sid, + command => $opt_C, + ); + die "$0: no response from fex server $server\n" unless @r; + $_ = shift @r; + unless (/^HTTP.* 200/) { + s:HTTP/[\d\. ]+::; + die "$0: server response: $_\n"; + } + while (shift @r) {} + foreach (@r) { print "$_\n" } +} + + +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'; + $_ = sprintf "%s = %s (%s) # %s\n", + $alias, + $AB{$alias}, + $AB{$alias}->{options}, + $AB{$alias}->{comment}; + s/ \(\)//; + s/ \# $//; + print; + } +} + + +sub purge { + die "$0: not yet implemented\n"; +} + + +sub delete { + my ($to,$file); + + 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 (.+\@.+) :/) { + $to = $1; + } elsif (/^\s*(\d+)\) (\w+) (.+)/ and $1 eq $opt_d) { + serverconnect($server,$port) unless $SH; + sendheader( + "$server:$port", + "GET $proxy_prefix/fop/$2/$2?DELETE HTTP/1.1", + "User-Agent: $useragent", + ); + $_ = <$SH>||''; + s/\r//; + print "<-- $_" if $opt_v; + if (/^HTTP.* 200/) { + while (<$SH>) { + s/\r//; + last if /^\n/; # ignore HTML output + print "<-- $_" if $opt_v; + if (/^X-File:.*\/(.+)/) { + printf "%s deleted\n",decode_utf8(urldecode($1)); + } + } + undef $SH; + } elsif (s:HTTP/[\d\. ]+::) { + die "$0: server response: $_"; + } else { + die "$0: no response from fex server $server\n"; + } + last; + } + } + close $fexlist; + sleep 1; # do not overrun server + } + + exit; +} + + +sub send_fex { + my @to; + my $file = ''; + 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 { + # look for single @ in arguments + for (my $i=1; $i<$#ARGV; $i++) { + if ($ARGV[$i] eq '@') { + $ARGV[$i] = join(',',@ARGV[$i+1 .. $#ARGV]); + $#ARGV = $i; + last; + } + } + $to = pop @ARGV or die $usage; + if ($to eq '.') { + $to = $from; + $nomail = $opt_C ||= 'NOMAIL'; + } + if ($to eq ':') { + $to = $from; + $nomail = $opt_C ||= 'NOMAIL'; + } + if ($opt_g and $to =~ /,/) { + die "$0: encryption is supported to only one recipient\n"; + } + if ($to =~ m{^https?://.*/fup\?skey=(\w+)}) { + $from = 'SUBUSER'; + $to = '_'; + $id = $1; + } + if ($to =~ m{^https?://.*/fup\?gkey=(\w+)}) { + $from = 'GROUPMEMBER'; + $to = '_'; + $id = $1; + } + } + @to = split(',',lc($to)); + + die $usage unless @ARGV or $opt_a or $opt_s; + die $usage if $opt_s and @ARGV; + + # early serverconnect necessary for X-Features info + serverconnect($server,$port); + + if ($anonymous) { + my $aok; + sendheader("$server:$port","OPTIONS FEX HTTP/1.1"); + $_ = <$SH>||''; + s/\r//; + die "$0: no response from fex server $server\n" unless $_; + print "<-- $_" if $opt_v; + if (/^HTTP.* 201/) { + while (<$SH>) { + s/\r//; + print "<-- $_" if $opt_v; + last unless /\w/; + $aok = $_ if /X-Features:.*ANONYMOUS/; + } + die "$0: no anonymous support on server $server\n" unless $aok; + } else { + die "$0: bad response from server $server : $_\n"; + } + } 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'; + } elsif ($to =~ m:^(//.*):) { + my $xkey = $1; + if ($features =~ /XKEY/) { + @to = ($from); + $opt_C = $xkey; + } else { + die "$0: server does not support XKEY\n"; + } + } elsif (grep /^[^@]*$/,@to and not $skey and not $gkey) { + %AB = query_address_book($server,$port,$from); + if ($proxy) { + serverconnect($server,$port); + query_sid($server,$port); + } + foreach $to (@to) { + # alias in local config? + if ($alias{$to}) { + if ($alias{$to} =~ /(.+?):(.+)/) { + my $ato = $1; + my $opt = $2; + my @argv = @_ARGV; + pop @argv; + # special extra upload + system $0,split(/\s/,$opt),@argv,$ato; + $to = ''; + } else { + $to = $alias{$to}; + } + } + # alias in server address book? + 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; + } + } + } + + $to = join(',',grep /./,@to) or exit; + warn "Server/User: $fexcgi/$from\n" unless $opt_q; + + if ( + not $skey and not $gkey + and $features =~ /CHECKRECIPIENT/ + and $opt_C !~ /^(DELETE|LIST|RECEIVEDLOG|SENDLOG|FOPLOG)$/ + ) { + checkrecipient($from,$to); + if ($proxy) { + serverconnect($server,$port); + query_sid($server,$port); + } + } + } + + 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"; + $opt_a = <STDIN>; + $opt_a =~ s/^\s+//; + $opt_a =~ s/\s+$//; + } + + if ($opt_s) { + $opt_s =~ s/^=//; + $opt_s =~ s:.*/::; + $opt_s =~ s/[^\w_.+-]/_/g; + @files = ($opt_s); + } elsif ($opt_a) { + $opt_a =~ s/^=//; + $opt_a =~ s:.*/::; + $opt_a =~ s/[^\w_.+-]/_/g; + if ($opt_a =~ /(.+)\.(zip|tar|tgz|7z)$/) { + $aname = $1; + $atype = $2; + } else { + die "$0: archive name must be one of ". + "$opt_a.tar $opt_a.tgz $opt_a.zip\n"; + } + # no file argument left? + unless (@ARGV) { + # use file name as archive name + push @ARGV,$aname; + $opt_a =~ s:/+$::g; + $opt_a =~ s:.*/::g; + } + foreach my $file (@ARGV) { + die "$0: cannot read $file\n" unless -l $file or -r $file; + } + $opt_a .= ".$atype" if $opt_a !~ /\.$atype$/; + $transferfile = "$tmpdir/$opt_a"; + unlink $transferfile; + print "Making fex archive ($opt_a):\n"; + if ($atype eq 'zip') { + if ($windoof) { + # if ($opt_c) { system(qw'7z a -tzip',$transferfile,@ARGV) } + # else { system(qw'7z a -tzip -mm=copy',$transferfile,@ARGV) } + system(qw'7z a -tzip',$transferfile,@ARGV); + @files = ($transferfile); + } else { + # zip archives must be < 2 GB, so split as necessary + @files = zipsplit($transferfile,@ARGV); + if (scalar(@files) == 1) { + $transferfile = $files[0]; + $transferfile =~ s/_1.zip$/.zip/; + rename $files[0],$transferfile; + @files = ($transferfile); + } + } + @transferfiles = @files; + } elsif ($atype eq '7z') { + # http://www.7-zip.org/ + my @X = (); # exclude list + if (${'opt_#'}) { + foreach my $x (split('#',${'opt_#'})) { + push @X,"-x!$x"; + } + } + if ($opt_c) { system(qw'7z a',@X,$transferfile,@ARGV) } + else { system(qw'7z a -t7z -mx0',@X,$transferfile,@ARGV) } + @transferfiles = @files = ($transferfile); + } elsif ($atype eq 'tar') { + if ($windoof) { + system(qw'7z a -ttar',$transferfile,@ARGV); + @transferfiles = @files = ($transferfile); + } else { + ## tar is now handled by formdatapost() + # system(qw'tar cvf',$transferfile,@ARGV); + @files = ($opt_a); + } + } elsif ($atype eq 'tgz') { + if ($windoof) { + die "$0: archive type tgz not available, use tar, zip or 7z\n"; + } else { + ## tgz is now handled by formdatapost() + # system(qw'tar cvzf',$transferfile,@ARGV); + @files = ($opt_a); + } + } 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; + } else { + die $usage; + } + } + + foreach (@ARGV) { + my $file = $_; + unless ($opt_d) { + unless (-f $file) { + if (-e $file) { + die "$0: $file is not a regular file, try option -a\n" + } else { + die "$0: $file does not exist\n"; + } + } + die "$0: cannot read $file\n" unless -r $file; + } + push @files,$file; + } + } + + if (${'opt_/'}) { + 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"; + } + } + } + + 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"; + } + female_mode("send file $file?") if $opt_F; + @r = formdatapost( + from => $from, + to => $to, + replyto => $opt_r, + id => $sid, + file => $file, + keep => $opt_k, + comment => $opt_C, + autodelete => $opt_D, + ); + + if (not @r or not grep /\w/,@r) { + die "$0: no response from server\n"; + } + 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"; + } else { + $r =~ s/.*?:\s*//; + $r =~ s/<.+?>//g; + die "$0: server error: $r\n"; + } + } + if (($r) = grep /<h3>\Q$file/,@r) { + $r =~ s/<.+?>//g; + print "$r\n"; + } + if ($opt_a !~ /^afex_\d+\.tar$/ and $file !~ /afex_\d+\.tar$/) { + # print grep({s/^(X-Recipient:.*\((.+)\))/Parameters: $2\n/i} @r); + my $nonot = 0; + my ($recipient,$location); + foreach (@r) { + if (/^(X-)?(Recipient.*)/i) { + $recipient = $2; + if (/notification=no/i) { $nonot = 1 } + else { $nonot = 0 } + } + 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"; + } + } + } + } + } + + # delete transfer tmp file + unlink $transferfile if $transferfile; +} + + +sub forward { + my (@r); + my ($to,$n,$dkey,$file,$req); + my $status = 1; + local $_; + + # look for single @ in arguments + for (my $i=1; $i<$#ARGV; $i++) { + if ($ARGV[$i] eq '@') { + $ARGV[$i] = join(',',@ARGV[$i+1 .. $#ARGV]); + $#ARGV = $i; + last; + } + } + + # if ($windoof and not @ARGV) { &inquire } + $to = pop @ARGV or die $usage; + $to = $from if $to eq '.'; + + open $fexlist,$fexlist or die "$0: $fexlist - $!\n"; + while (<$fexlist>) { + if (/^\s*(\d+)\) (\w+) \[\d+ d\] (.+)/ and $1 eq $opt_f) { + $n = $1; + $dkey = $2; + $file = $3; + if ($file =~ s/ "(.*)"$//) { + $opt_C ||= $1 if $1 ne 'NOMAIL'; + } + last; + } + } + close $fexlist; + + unless ($n) { + die "$0: file #$opt_f not found in fexlist\n"; + } + + female_mode("forward file #$opt_f?") if $opt_F; + + 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 .= "&keep=$opt_k" if $opt_k; + $req .= "&autodelete=$opt_D" if $opt_D; + $req .= "&$opt_X" if $opt_X; + $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; + } + } + } + + if ($status) { + die "$0: server failed, rerun command with option -v\n"; + } + exit; +} + + +sub renotify { + my (@r); + my ($to,$n,$dkey,$file,$req,$recipient); + local $_; + + die $usage if @ARGV; + + open $fexlist,$fexlist or die "$0: $fexlist - $!\n"; + while (<$fexlist>) { + if (/^\s*(\d+)\) (\w+) \[\d+ d\] (.+)/ and $1 eq $opt_N) { + $n = $1; + $dkey = $2; + last; + } + } + close $fexlist; + + unless ($n) { + die "$0: file #$opt_N not found in fexlist\n"; + } + + female_mode("resend notification for file #$opt_N?") if $opt_F; + + serverconnect($server,$port); + query_sid($server,$port); + + $req = "GET $proxy_prefix/fup?" + ."from=$from&ID=$sid&dkey=$dkey&command=RENOTIFY" + ." HTTP/1.1"; + sendheader("$server:$port",$req); + http_response(); + while (<$SH>) { + s/\r//; + print "<-- $_" if $opt_v; + last if /^\s*$/; + if (/^X-Notify: (.+)\/(.+)\/(.+)/) { + $recipient = $1; + $file = $3; + } + } + + if ($file) { + print "notification e-mail for $file has been resent to $recipient\n"; + } else { + if ($opt_v) { + die "$0: server failed\n"; + } else { + die "$0: server failed, rerun command with option -v\n"; + } + } + + exit; +} + + +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) { + $n = $1; + $dkey = $2; + $file = $3; + $file =~ s/ "(.*)"$//; + last; + } + } + 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 .= "&keep=$opt_k" if $opt_k; + $req .= "&autodelete=$opt_D" if $opt_D; + $req .= " HTTP/1.1"; + sendheader("$server:$port",$req); + http_response(); + while (<$SH>) { + if ($opt_v) { + print "<-- $_"; + } else { + print if /\Q$file/; + } + } + + exit; +} + + +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; + close $transferfile; + # gzip magic? + if (/\x1F\x8B\x08\x00/) { + rename $transferfile,"$transferfile.gz"; + shelldo(ws("gunzip $transferfile.gz")); + # assuming tar + $ft = 'tar archive'; + } + } + if ($ft =~ /tar archive/) { + rename $transferfile,"$transferfile.tar"; + $transferfile .= '.tar'; + if ($opt_q) { + $_ = 'y'; + } else { + print "Files in transfer-container:\n\n"; + shelldo(ws("tar tvf $transferfile")); + print "\nExtract these files? [Yn] "; + $_ = <STDIN>; + } + if (/^n/i) { + print "keeping $transferfile\n"; + } else { + system("tar xvf $transferfile && rm $transferfile"); + die "$0: error while untaring, see $transferfile\n" if -f $transferfile; + } + } else { + exec 'cat',$transferfile; + } + exit; +} + + +sub formdatapost { + my %P = @_; + my ($boundary,$filename,$filesize,$length,$buf,$file,$fpsize,$resume,$seek); + my ($flink); + my (@hh,@hb,@r,@pv,$to); + my ($bytes,$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 $connection = ''; + my $pct = ''; + my ($tar,$aname,$atype,$tarlist,$tarerror,$location,$transferfile); + local $_; + + if (defined($file = $P{file})) { + + $to = $AB{$P{to}} || $P{to}; # for gpg + + # special file: stream from STDIN + if ($opt_s) { + $filename = encode_utf8($file); + $filesize = -1; + } + + # compression? + if ($opt_c) { + my ($if,$of); + $if = $file; + $if =~ s/([^_\w\.\-])/\\$1/g; + $transferfile = $tmpdir . '/' . basename($file) . '.gz'; + $of = $transferfile; + $of =~ s/([^_\w\.\-])/\\$1/g; + shelldo("gzip <$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; + $atype = $2; + $tarlist = "$tmpdir/$aname.list"; + $tarerror = "$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-"; + } else { + $tar .= " -f-"; + } + if (${'opt_#'}) { + foreach my $x (split('#',${'opt_#'})) { + $tar .= " --exclude=$x"; + } + } + foreach (@ARGV) { + $file = $_; + $file =~ s/([^\w\-\@\#%,.=+~_:])/\\$1/g; + $tar .= ' '.$file; + } + # print "calculating archive size... "; + open $tar,"$tar 2>$tarerror|" or die "$0: cannot run tar - $!\n"; + $t0 = int(time) if -t STDOUT; + while ($b = read $tar,$_,$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 $tar) { + $_ = ''; + if (open $tarerror,$tarerror) { + local $/; + $_ = <$tarerror>; + close $tarerror; + } + unlink $tarlist,$tarerror; + die "$0: tar error:\n$_"; + } + $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/.*\\//; + } + $filename =~ s:.*/::; + $filename =~ s:[\r\n]+: :g; + 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"; + } + } + + $filename .= '.gpg' if $opt_g; + + unless ($opt_d) { + if ($opt_g) { + $filesize = -1; + $fileid = int(time); + } else { + if ($opt_a) { + $fileid = md5_hex(fmd(@ARGV)); + } else { + $fileid = fileid($file); + } + } + } + + } else { + $file = $filename = ''; + $filesize = 0; + } + + FORMDATAPOST: + + @hh = (); # HTTP header + @hb = (); # HTTP body + @r = (); + $seek = 0; + $resume = ''; + $chunk++; + + unless ($SH) { + 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 + ($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 ($proxy) { + sleep 1; # do not overrun proxy + serverconnect($server,$port); + } + } + + # file part size + 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" + ." files > %d MB via proxy\n",$chunksize/M); + } + $opt_o = 0; # no overwriting mode for next chunks + $fpsize = $chunksize - $bs; + } else { + $fpsize = $filesize - $seek; + } + + $boundary = randstring(48); + + $P{seek} = $seek; + $P{filesize} = $filesize; + + # send HTTP POST variables + if ($skey) { + $P{skey} = $skey; + @pv = qw'from to skey keep autodelete comment seek filesize'; + } elsif ($gkey) { + $P{gkey} = $gkey; + @pv = qw'from to gkey keep autodelete comment seek filesize'; + } else { + @pv = qw'from to id replyto keep autodelete comment command seek filesize'; + } + foreach my $v (@pv) { + if ($P{$v}) { + my $name = uc($v); + push @hb,"--$boundary"; + push @hb,"Content-Disposition: form-data; name=\"$name\""; + push @hb,""; + push @hb,encode_utf8($P{$v}); + } + } + + # at last, POST the file + if ($file) { + push @hb,"--$boundary"; + push @hb,"Content-Disposition: form-data; name=\"FILE\"; filename=\"$filename\""; + unless ($opt_d) { + if ($opt_M) { push @hb,"Content-Type: application/x-mime" } + else { push @hb,"Content-Type: application/octet-stream" } + if (${'opt_/'}) { + $flink = abs_path($file); + push @hb,"Content-Location: $flink"; + } else { + # push @hb,"Content-Length: " . ((-s $file||0) - $seek); # optional header! + push @hb,"Content-Length: $fpsize"; # optional header! NOT filesize! + push @hb,"X-File-ID: $fileid"; + } + push @hb,""; + } + push @hb,""; + # prevent proxy chunked mode reply + $connection = "close"; + } + + push @hb,"--$boundary--"; + + if ($fpsize < 0) { + $length = $fpsize; + } else { + $length = length(join('',@hb)) + scalar(@hb)*2 + $fpsize; + } + + if ($file and not $opt_d) { + if ($flink) { $hb[-2] = $flink } + else { $hb[-2] = '(file content)' } + } + # any other extra URL arguments + my $opt_X = ''; + $opt_X = "?$::opt_X" if $::opt_X and $file; + + # HTTP header + push @hh,"POST $proxy_prefix/fup$opt_X HTTP/1.1"; + push @hh,"Host: $server:$port"; + push @hh,"User-Agent: $useragent"; + push @hh,"Content-Length: $length"; + push @hh,"Content-Type: multipart/form-data; boundary=$boundary"; + push @hh,"Connection: $connection" if $connection; + push @hh,''; + + if ($opt_v) { + print "--> $_\n" foreach (@hh,@hb); + } + + $SIG{PIPE} = \&sigpipehandler; +# foreach $sig (keys %SIG) { +# eval '$SIG{$sig} = sub { print "\n!!! SIGNAL '.$sig.' !!!\n"; exit; }'; +# } + + if ($file) { + pop @hb; + pop @hb unless $flink; + nvtsend(@hh,@hb) or do { + warn "$0: server has closed the connection, reconnecting...\n"; + 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"; + } else { + open $file,'>&=STDIN' or die "$0: cannot open STDIN - $!\n"; + } + } elsif ($tar) { + if ($opt_g) { + open $file,"$tar|gpg -e -r $to|" or die "$0: cannot run tar&gpg - $!\n"; + } else { + open $file,"$tar|" or die "$0: cannot run tar - $!\n"; + } + if (-t STDOUT) { + $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>) { + print ' 'x(length($file)+40),"\r",$_; + } + sleep 1; + } + } + exit; + } + $SIG{CHLD} = 'IGNORE'; + } + if ($seek) { + print "Fast forward to byte $seek (resuming)\n"; + readahead($file,$seek); + } + } else { + if ($opt_g) { + my $fileq = $file; + $fileq =~ s/([^\w\-\@\#%,.=+~_:])/\\$1/g; + 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"; + seek $file,$seek,0; + } + binmode $file; + } + + $bytes = 0; + autoflush $SH 0; + + print $rcamel[0] if ${'opt_+'}; + + while (my $b = read $file,$buf,$bs) { + print {$SH} $buf or &sigpipehandler; + $bytes += $b; + if ($filesize > 0 and $bytes+$seek > $filesize) { + die "$0: $file filesize has grown while uploading\n"; + } + $bt += $b; + $t2 = time; + if (${'opt_+'} and int($t2*10)>$tc) { + print $rcamel[$tc%2+1]; + $tc = int($t2*10); + } + if (not $opt_q and -t STDOUT and int($t2)>$t1) { + &sigpipehandler unless $SH->connected; + # smaller block size is better on slow links + $bs = 4096 if $t1 and $bs>4096 and $bytes/($t2-$t0)<65536; + if ($filesize > 0) { + $pct = sprintf "(%d%%)",int(($bytes+$seek)/$filesize*100); + } + if ($bytes>2*M and $bs>4096) { + printf STDERR "%s: %d MB of %d MB %s %d kB/s \r", + $opt_s||$opt_a||$file, + int(($bytes+$seek)/M), + int($filesize/M), + $pct, + int($bt/k/($t2-$tt)); + } else { + printf STDERR "%s: %d kB of %d MB %s %d kB/s \r", + $opt_s||$opt_a||$file, + int(($bytes+$seek)/k), + int($filesize/M), + $pct, + int($bt/k/($t2-$tt)); + } + $t1 = $t2; + # time window for transfer rate calculation + if ($t2-$tt>10) { + $bt = 0; + $tt = $t2; + } + } + 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"; + $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)", + $opt_s||$opt_a||$file, + int($bytes/M), + $tt, + int($bytes/k/$tt); + if ($bytes+$seek == $filesize) { + printf STDERR ", total %d MB\n",int($filesize/M); + } else { + printf STDERR ", chunk #%d : %d MB\n", + $chunk,int(($bytes+$seek)/M); + } + } else { + printf STDERR "%s: %d kB in %d s (%d kB/s)", + $opt_s||$opt_a||$file, + int($bytes/k), + $tt, + int($bytes/k/$tt); + if ($bytes+$seek == $filesize) { + printf STDERR ", total %d kB\n",int($filesize/k); + } else { + printf STDERR ", chunk #%d : %d kB\n", + $chunk,int(($bytes+$seek)/k); + } + } + } else { + if ($bytes>2*M) { + 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", + $opt_s||$opt_a||$file, + int($bytes/k), + $tt, + 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"; + + # special handling of streaming file because of stunnel tcp shutdown bug + if ($opt_s or $opt_g) { + close $SH; + sleep 1; + serverconnect($server,$port); + query_sid($server,$port) unless $anonymous; + ($seek,$location) = query_file($server,$port,$P{to},$P{from},$sid, + $filename,$fileid); + if ($seek != $bytes) { + die "$0: streamed $bytes bytes but server received $seek bytes\n"; + } + return "X-Location: $location\n"; + } + + if ($flink) { + $bytes = -s $flink; + if ($bytes>2*M) { + printf STDERR "%s: %d MB\n",$flink,int($bytes/M); + } else { + printf STDERR "%s: %d kB\n",$flink,int($bytes/k); + } + } + } else { + autoflush $SH 1; + nvtsend(@hh,@hb); + } + + # SuSe: Can't locate object method "BINMODE" via package "IO::Socket::SSL::SSL_HANDLE" + # binmode $SH,':utf8'; + + if (not $opt_q and $file and -t STDOUT) { + print STDERR "\r \r"; + } + while (<$SH>) { + s/[\r\n]+//; + print "<-- $_\n" if $opt_v; + last if @r and $r[0] =~ / 204 / and /^$/ or /<\/html>/i; + push @r,decode_utf8($_); + } + + if ($file) { + close $SH; + undef $SH; + if ($proxy and $fpsize+$seek < $filesize) { + goto FORMDATAPOST; + } + } + + return @r; +} + + +sub randstring { + my $n = shift; + my @rc = ('A'..'Z','a'..'z',0..9 ); + my $rn = @rc; + my $rs; + + for (1..$n) { $rs .= $rc[int(rand($rn))] }; + return $rs; +} + + +sub zipsplit { + my $zipbase = shift; + my @files = @_; + my @zipfiles = (); + my $file; + my ($zsize,$size,$n); + + $zipbase =~ s/\.zip$//; + map { s/([^_\w\+\-\.])/\\$1/g } @files; + + open my $ff,"find @files|" or die "$0: cannot search for @_ - $!\n"; + @files = (); + + zipfile: for (;;) { + $n++; + if ($n eq 10) { + unlink @zipfiles; + die "$0: too many zip-archives\n"; + } + $zsize = 0; + while ($file = <$ff>) { + chomp $file; + # next if -l $file or not -f $file; + next unless -f $file; + $size = -s $file; + if ($size > 2147480000) { + unlink @zipfiles; + die "$0: $file too big for zip\n"; + } + if ($zsize + $size > 2147000000) { + push @zipfiles,zip($zipbase.'_'.$n.'.zip',@files); + @files = ($file); + next zipfile; + } else { + push @files,$file; + $zsize += $size; + } + } + close $ff; + last; + } + push @zipfiles,zip($zipbase.'_'.$n.'.zip',@files); + return @zipfiles; +} + + +sub zip { + no strict 'refs'; + my $zip = shift; + my $cmd; + local $_; + + unlink $zip; + # if ($opt_c) { $cmd = "zip -@ $zip" } + # else { $cmd = "zip -0 -@ $zip" } + $cmd = "zip -@ $zip"; + if (${'opt_#'}) { + ${'opt_#'} =~ s/#/ /g; + $cmd .= " -x ".${'opt_#'}; + } + print $cmd,"\n" if $opt_v; + open $cmd,"|$cmd" or die "$0: cannot create $zip - $!\n"; + foreach (@_) { + print {$cmd} $_."\n"; + print " $_\n" if $opt_v; + } + close $cmd or die "$0: zip failed - $!\n"; + + return $zip; +} + + +sub getline { + my $file = shift; + local $_; + + while (<$file>) { + chomp; + s/^#.*//; + s/\s+#.*//; + s/^\s+//; + s/\s+$//; + return $_ if length($_); + } + return ''; +} + + +sub query_file { + my ($server,$port,$to,$from,$id,$filename,$fileid) = @_; + my $seek = 0; + my $qfileid = ''; + my ($head,$location); + my ($response,$fexsrv); + local $_; + + $to =~ s/,.*//; + $to =~ s/:\w+=.*//; + $to = $AB{$to} if $AB{$to}; + $filename =~ s/([^_=:,;<>()+.\w\-])/'%'.uc(unpack("H2",$1))/ge; # urlencode + if ($skey) { + $head = "HEAD $proxy_prefix/fop/$to/$from/$filename??SKEY=$id HTTP/1.1"; + } elsif ($gkey) { + $head = "HEAD $proxy_prefix/fop/$to/$from/$filename??GKEY=$id HTTP/1.1"; + } else { + $head = "HEAD $proxy_prefix/fop/$to/$from/$filename??ID=$id HTTP/1.1"; + } + sendheader("$server:$port",$head); + $_ = <$SH>; + unless (defined $_ and /\w/) { + die "$0: no response from server\n"; + } + s/\r//; + print "<-- $_" if $opt_v; + unless (/^HTTP.* 200/) { + s:HTTP/[\d\. ]+::; + $response = $_; + while (<$SH>) { + s/\r//; + print "<-- $_" if $opt_v; + $fexsrv = $_ if /^(Server: fexsrv|X-Features:)/; + last if /^\s*$/; + } + die "$0: no fexserver at $server:$port\n" unless $fexsrv; + die "$0: server response: $response"; + } + while (<$SH>) { + s/\r//; + print "<-- $_" if $opt_v; + last if /^$/; + if (/^Content-Length:\s+(\d+)/) { $seek = $1 } + if (/^X-File-ID:\s+(.+)/) { $qfileid = $1 } + if (/^X-Features:\s+(.+)/) { $features = $1 } + if (/^X-Location:\s+(.+)/) { $location = $1 } + } + + # return true seek only if file is identified + $seek = 0 if $qfileid and $qfileid ne $fileid; + + return ($seek,$location); +} + + +sub edit_address_book { + my ($user) = @_; + my $alias; + 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; + + female_mode("edit your address book?") if $opt_F; + + %AB = query_address_book($server,$port,$user); + if ($AB{ADDRESS_BOOK} !~ /\w/) { + $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.'~'; +} + + +sub query_address_book { + my ($server,$port,$user) = @_; + my ($req,$alias,$address,$options,$comment,$cl,$ab,$b); + my %AB; + local $_; + + unless ($SH) { + 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>; + unless (defined $_ and /\w/) { + die "$0: no response from server\n"; + } + s/\r//; + print "<-- $_" if $opt_v; + unless (/^HTTP.* 200/) { + if (/^HTTP.* 404/) { + while (<$SH>) { last if /^\r?\n/ } + return; + } else { + # s:HTTP/[\d\. ]+::; + # die "$0: server response: $_"; + close $SH; + undef $SH; + return (); + } + } + while (<$SH>) { + s/\r//; + print "<-- $_" if $opt_v; + last if /^$/; + $cl = $1 if /^Content-Length: (\d+)/; + } + + if ($cl) { + while (<$SH>) { + $b += length; + $ab .= $_; + s/[\r\n]//g; + s/^\s+//; + s/\s+$//; + print "<-- $_\n" if $opt_v; + s/\s*#\s*(.*)//; + if ($_) { + $comment = $1||''; + ($alias,$address,$options) = split; + if ($address) { + if ($options) { $options =~ s/[()]//g } + else { $options = '' } + $AB{$alias} = $address; + $AB{$alias}->{options} = $options||''; + $AB{$alias}->{comment} = $comment||''; + if ($options and $options =~ /keep=(\d+)/i) { + $AB{$alias}->{keep} = $1; + } + if ($options and $options =~ /autodelete=(\w+)/i) { + $AB{$alias}->{autodelete} = $1; + } + } + } + last if $b >= $cl; + } + } + + $AB{ADDRESS_BOOK} = $ab; + + return %AB; +} + + +# sets global $sid $features $timeout # ugly hack! :-} +sub query_sid { + my ($server,$port) = @_; + my ($req,$fexsrv); + local $_; + + $sid = $id; + + if ($port eq 443) { + return if $features; # early return if we know enough + $req = "OPTIONS FEX HTTP/1.1"; + } elsif ($proxy) { + return if $features; # early return if we know enough + $req = "GET $proxy_prefix/SID HTTP/1.1"; + } else { + $req = "GET SID HTTP/1.1"; + } + + sendheader("$server:$port",$req,"User-Agent: $useragent"); + $_ = <$SH>; + unless (defined $_ and /\w/) { + print "\n" if $opt_v; + die "$0: no response from server\n"; + } + 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); + } + while (<$SH>) { + s/\r//; + print "<-- $_" if $opt_v; + $features = $1 if /^X-Features: (.+)/; + $timeout = $1 if /^X-Timeout: (\d+)/; + last if /^\n/; + } + } elsif (/^HTTP.* 301 /) { + while (<$SH>) { last if /Location/ } + die "$0: cannot use $server:$port because server has a redirection to\n".$_; + } else { + # no SID support - perhaps transparent web proxy? + while (<$SH>) { + s/\r//; + print "<-- $_" if $opt_v; + $fexsrv = $_ if /^(Server: fexsrv|X-Features:)/; + last if /^\s*$/; + } + die "$0: no fexserver at $server:$port\n" unless $fexsrv; + serverconnect($server,$port); + $sid = $id; + } + + # warn "proxy: $proxy\n"; + if ($proxy) { + serverconnect($server,$port); + $sid = $id; + } + +} + + +sub xxget { + my ($from,$id,$save) = @_; + my $bs = 4096; + my $xx = $save; + my ($url,$B,$b,$t0,$t1,$cl); + my ($ts,$tso); + local $_; + + $xx =~ s:.*/::; + $url = "$proxy_prefix/fop/$from/$from/$xx?ID=$id"; + + sendheader("$server:$port","GET $url HTTP/1.0","User-Agent: $useragent"); + http_response(); + while (<$SH>) { + s/\r//; + print "<-- $_" if $opt_v; + $cl = $1 if /^Content-Length:\s(\d+)/; + # $ft = $1 if /^X-File-Type:\s(.+)/; + last if /^$/; + } + + 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; + if (int(time) > $t1) { + $t1 = int(time); + $ts = ts($B,$cl); + if ($ts ne $tso) { + print STDERR $ts,"\r"; + $tso = $ts; + } + } + sleep 1 while ($opt_m and $B/k/(time-$t0||1) > $opt_m); + } + + print STDERR ts($B,$cl),"\n"; + close F; +} + + +# transfer status +sub ts { + my ($b,$tb) = @_; + return sprintf("transferred: %d MB (%d%%)",int($b/M),int($b/$tb*100)); +} + + +sub sigpipehandler { + $SIG{ALRM} = sub { }; + if (fileno $SH) { + alarm(1); + @_ = <$SH>; + alarm(0); + kill 9,$tpid if $tpid; + if (@_ and $opt_v) { + die "\n$0: ($$) server error: @_\n"; + } + if (@_ and $_[0] =~ /^HTTP.* \d+ (.*)/) { + die "\n$0: server error: $1\n"; + } + } + $timeout *= 2; + warn "\n$0: connection to $server died\n"; + warn "retrying after $timeout seconds...\n"; + sleep $timeout; + if ($windoof) { exec $^X,$0,@_ARGV } + else { exec $_0,@_ARGV } + die $!; +} + + +sub checkrecipient { + my ($from,$to) = @_; + my @r; + local $_; + + @r = formdatapost( + from => $from, + to => $to, + id => $sid, + command => 'CHECKRECIPIENT', + ); + + $_ = shift @r or die "$0: no reply from server\n"; + + if (/ 2\d\d /) { + foreach (@r) { + last if /^$/; + if (s/X-(Recipient: .+)/$1\n/) { + s/autodelete=\w+/autodelete=$opt_D/ if $opt_D; + s/keep=\d+/keep=$opt_k/ if $opt_k; + print; + $frecipient ||= (split)[1]; + } + } + } else { + http_response($_,@r); + } +} + + +# get ID data from ID file +sub get_id { + my $idf = shift; + + $fexcgi = getline($idf) || die "$0: no FEX-URL in $idf\n"; + $from = getline($idf) || die "$0: no FROM in $idf\n"; + $id = getline($idf) || die "$0: no ID in $idf\n"; + if ($fexcgi =~ s/!([\w.-]+:\d+)(:(\d+))?//) { + $proxy = $1; + $chunksize = $3 || 0; + } + unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) { + die "$0: illegal FEX-URL \"$fexcgi\" in $idf\n"; + } + unless ($from =~ /^[_:=\w\-\.\/\@\%\+]+$/) { + die "$0: illegal FROM \"$from\" in $idf\n"; + } + $fexcgi =~ s:/+$::; +} + + +# for windows +sub inquire { + my ($file,$to); + for (;;) { + print "file to send: "; + chomp($file = <STDIN>); + $file =~ s/^\"//; + $file =~ s/\"$//; + last if -e $file; + warn "$file does not exist\n"; + } + print "recipient (e-mail address): "; + chomp($to = <STDIN>); + die $usage unless $to; + unless ($opt_n) { + print "comment: "; + chomp($opt_C = <STDIN>); + } + @ARGV = ($file,$to); +} + + +sub shelldo { + if (system(@_) < 0) { die "failed: @_\n" } +} + + +# emulate seek on a pipe +sub readahead { + my $fh = shift; # filehandle + my $ba = shift; # bytes ahead + my $bs = 2**16; + my $s = 0; + my $n; + local $_; + + while ($s < $ba) { + $n = $ba-$s; + $n = $bs if $n > $bs; + $s += read $fh,$_,$n; + } +} + + +# fileid is inode and mtime +sub fileid { + my @s = stat(shift); + return @s ? $s[1].$s[9] : int(time); +} + + +# 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; + if (opendir $dir,$dir) { + while (defined ($file = readdir($dir))) { + next if $file eq '..'; + if ($file eq '.') { + $fmd .= $file.fileid($dir); + } else { + $fmd .= fmd("$dir/$file"); + } + } + closedir $dir; + } + } else { + $fmd .= $file.fileid($file); + } + } + + return $fmd; +} + + +# from MIME::Base64::Perl +sub decode_b64 { + local $_ = shift; + my $uu = ''; + my ($i,$l); + + tr|A-Za-z0-9+=/||cd; + s/=+$//; + tr|A-Za-z0-9+/| -_|; + return "" unless length; + + $l = (length)-60; + for ($i = 0; $i <= $l; $i += 60) { + $uu .= "M" . substr($_,$i,60); + } + $_ = substr($_,$i); + if (length) { + $uu .= chr(32+(length)*3/4) . $_; + } + return unpack("u",$uu); +} + + +sub female_mode { + local $_; + if (open my $tty,'/dev/tty') { + print "@_\n"; + print " [y] yes\n", + " [n] no\n", + " [p] perhaps - don't know\n", + "your choice: "; + $_ = <$tty> || ''; + close $tty; + if (/^y/i) { return } + if (/^n/i) { exit } + if (/^p/i) { int(rand(2)) ? return : exit } + female_mode(@_); + } +} + + +sub http_response { + local $_ = shift || <$SH>; + my @r = @_; + my $error; + + $_ = <$SH> unless $_; + unless (defined $_ and /\w/) { + die "$0: no response from server\n"; + } + s/\r?\n//; + # CGI fatalsToBrowser + if (/^HTTP.* 500/) { + @r = <$SH> unless @r; + @r = () unless @r; + die "$0: server error: $_\n@r\n"; + } + unless (/^HTTP.* 200/) { + $error = $_; + $error =~ s/HTTP.[\s\d.]+//; + if ($opt_v) { + print "<-- $_"; + print "<-- $_" while <$SH>; + } + die "$0: server error: $error\n"; + } + + print "<-- $_\n" if $opt_v; + return $_; +} + + +sub ws { + local $_ = shift; + return split; +} + + +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>; + close $p; + s/\n$cfb.*/\n$cfb\n$cfc/s; + system "vv -s $p"; + open $p,'>',$p or die "cannot write $p - $!\n"; + print {$p} $_; + close $p; + } + + exec "l $0 fexget sexsend"; + exit; +} + +### common functions ### + + +sub mtime { + my @d = localtime((stat shift)[9]); + return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); +} + + +sub urldecode { + local $_ = shift; + s/\%([a-f\d]{2})/chr(hex($1))/ige; + return $_; +} + + +sub get_ssl_env { + # set SSL/TLS options + $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_ca_file) + ) { + my $env = uc($opt); + $env =~ s/_//g; + $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); + } + + if ($SSL{SSL_verify_mode}) { + &search_ca; + unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { + die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; + } + } elsif (defined($SSL{SSL_verify_mode})) { + # user has set SSLVERIFY=0 ! + } else { + &search_ca; + $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; + } +} + +sub search_ca { + local $_; + return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; + foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { + if (-f) { + $SSL{SSL_ca_file} = $_; + return; + } + } + foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { + if (-f) { + $SSL{SSL_ca_path} = $_; + return; + } + } +} + + +sub serverconnect { + 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) { + printf "--> %s\n",$connect if $opt_v; + nvtsend($connect,""); + $_ = <$SH>; + s/\r//; + printf "<-- $_"if $opt_v; + unless (/^HTTP.1.. 200/) { + die "$0: proxy error : $_"; + } + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->start_SSL($SH,%SSL); + } + } else { + tcpconnect($server,$port); + } +# if ($port == 443 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) { + # eval "use IO::Socket::SSL qw(debug3)"; + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + %SSL + ); + } else { + $SH = IO::Socket::INET->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 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"; + } + print "-->\n" if $opt_v; + print {$SH} "\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) { + undef $SH; + return 0; + } + } + + return 1; +} + + +# from MIME::Base64::Perl +sub encode_b64 { + my $res = ""; + my $eol = "\n"; + my $padding; + + pos($_[0]) = 0; + $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); + $res =~ tr|` -_|AA-Za-z0-9+/|; + $padding = (3-length($_[0])%3)%3; + $res =~ s/.{$padding}$/'=' x $padding/e if $padding; + return $res; +} diff -Nru fex-20140917/htdocs/download/sexget fex-20150120/htdocs/download/sexget --- fex-20140917/htdocs/download/sexget 1970-01-01 01:00:00.000000000 +0100 +++ fex-20150120/htdocs/download/sexget 2015-01-19 13:59:57.000000000 +0100 @@ -0,0 +1,723 @@ +#!/usr/bin/perl -w + +# client for stream exchange of the FEX service +# +# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> +# +# Perl Artistic Licence + +# sexsend / sexget / sexxx + +use Getopt::Std; +use Socket; +use IO::Handle; +use IO::Socket::INET; +use Digest::MD5 qw(md5_hex); # encypted ID / SID + +use constant k => 2**10; +use constant M => 2**20; + +eval 'use Net::INET6Glue::INET_is_INET6'; + +our $version = 20150120; + +my %SSL = (SSL_version => 'TLSv1'); +my $sigpipe; + +if (-f ($_ = '/etc/fex/config.pl')) { + eval { require } or warn $@; +} + +$0 =~ s:.*/::; +$| = 1; + +# sexsend is default +$usage = + "usage: ... | $0 [options] [SEX-URL/]recipient [stream]\n". + "options: -v verbose mode\n". + " -g show transfer rate\n". + " -V show version\n". + " -t timeout timeout in s (waiting for recipient)\n". + "special: recipient may be \"public\" or \"anonymous\" or \".\"\n". + "see also: sexget, sexxx\n". + "example: tail -f /var/log/syslog | $0 fex.flupp.org/admin log\n"; + +if ($0 eq 'sexget' or $0 eq 'fuckme') { + $usage = + "usage: $0 [options] [[SEX-URL/]user:ID] [stream]\n". + "options: -v verbose mode\n". + " -g show transfer rate\n". + " -V show version\n". + "arguments: user:ID use this user & ID\n". + " (ID may be \"public\" or user:ID may be \"anonymous\")\n". + " stream name of the stream\n". + "see also: sexsend, sexxx\n". + "example: $0 log | grep kernel\n"; +} + +if ($0 eq 'sexxx') { + $usage = + "usage: $0 [-v] [-g] [-c] [-u [SEX-URL/]user] [-s stream] [files...]\n". + "usage: $0 [-v] [-g] [-u [SEX-URL/]user] [-s stream] | ...\n". + "options: -v verbose mode\n". + " -g show transfer rate\n". + " -q quiet mode\n". + " -c compress files\n". + " -u SEX-URL/user SEX-URL and user (default: use FEXID/FEXXX)\n". + " -s stream stream name (default: xx)\n". + "see also: sexsend, sexget\n". + "examples: $0 -s config /etc /usr/local/etc\n". + " $0 > backup.tar\n"; +} + +$fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/.fex'; +$user = $id = ''; +$type = $timeout = $stream = $mode = ''; +$idf = "$fexhome/id"; +$bs = $ENV{BS} || 2**16; # I/O blocksize + +# server URL, user and auth-ID +if ($FEXID = $ENV{FEXID}) { + $FEXID = decode_b64($FEXID) if $FEXID !~ /\s/; + ($fexcgi,$user,$id) = split(/\s+/,$FEXID); +} else { + if (open $idf,$idf) { + chomp($fexcgi = <$idf>) or die "$0: no FEX-URL in $idf\n"; + chomp($user = <$idf>) or die "$0: no FROM in $idf\n"; + chomp($id = <$idf>) or die "$0: no ID in $idf\n"; + close $idf; + despace($fexcgi,$user,$id); + unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) { + die "$0: illegal FEX-URL \"$fexcgi\" in $idf\n"; + } + unless ($user =~ /^[_:=\w\-\.\/\@\%\+]+$/) { + die "$0: illegal FROM \"$user\" in $idf\n"; + } + } +} + +$opt_h = $opt_v = $opt_V = $opt_q = 0; +$opt_u = $opt_s = $opt_c = $opt_t = ''; + +$_ = "$fexhome/config.pl"; require if -f; + +if ($0 eq 'sexxx') { + + # xx server URL, user and auth-ID + if ($FEXXX = $ENV{FEXXX}) { + $FEXXX = decode_b64($FEXXX) if $FEXXX !~ /\s/; + ($fexcgi,$user,$id) = split(/\s+/,$FEXXX); + } elsif (open $idf,$idf) { + while (<$idf>) { + if (/^\[xx\]/) { + chomp($fexcgi = <$idf>) or die "$0: no xx FEX-URL in $idf\n"; + chomp($user = <$idf>) or die "$0: no xx FROM in $idf\n"; + chomp($id = <$idf>) or die "$0: no xx ID in $idf\n"; + last; + } + } + close $idf; + } + + getopts('hgvcu:s:') or die $usage; + die $usage if $opt_h; + die $usage unless -t; + + if ($opt_c) { + $opt_c = 'z'; + $type = '&type=GZIP'; + } + + if ($opt_u) { + $fexcgi = $1 if $opt_u =~ s:(.+)/::; + $user = $opt_u; + } + + unless ($fexcgi) { + die "$0: no xx user found, use \"$0 -u SEX-URL/user\"\n"; + } + + unless ($user) { + die "$0: no xx user found, use \"$0 -u user\"\n"; + } + +} elsif ($0 eq 'sexget' or $0 eq 'fuckme') { + getopts('hgvVdu:') or die $usage; + die $usage if $opt_h; + + + if ($opt_V) { + print "Version: $version\n"; + exit unless @ARGV; + } + + if (not $opt_u and @ARGV and $ARGV[0] =~ m{^anonymous|/|:}) { + $opt_u = shift @ARGV; + } + + if ($opt_u) { + $fexcgi = $1 if $opt_u =~ s:(.+)/::; + ($user,$id) = split(':',$opt_u); + if ($user =~ /^anonymous/) { + $anonymous = $user; + } elsif (not $id) { + die $usage; + } + } + + unless ($fexcgi) { + die "$0: no SEX URL found, use \"$0 -u SEX-URL/recipient\" or \"fexsend -I\"\n"; + } + + unless ($user) { + die "$0: no recipient found, use \"$0 -u SEX-URL/recipient\" or \"fexsend -I\"\n"; + } + +} else { # sexsend + + $opt_g = 1; + getopts('hguvqVTt:') or die $usage; + die $usage if $opt_h; + + if ($opt_V) { + print "Version: $version\n"; + exit unless @ARGV; + } + + if ($opt_t and $opt_t =~ /^\d+$/) { + $timeout = "&timeout=$opt_t"; + } + + my $save_user = $user; + $user = shift or die $usage; + $fexcgi = $1 if $user =~ s:(.+)/::; + + if ($user =~ /^anonymous/) { + die "$0: need SEX-URL with anonymous SEX\n" unless $fexcgi; + $mode = 'anonymous'; + } elsif ($user eq 'public') { + unless ($id) { + die "$0: public SEX not possible without FEXID, set it with \"fexsend -I\"\n"; + } + $mode = $user; + $user = $save_user; + } elsif ($user eq '.') { + open $idf,$idf or die "$0: no $idf\n"; + $_ = <$idf>; + $user = <$idf>||''; + chomp $user; + } else { + unless ($fexcgi) { + die "$0: no SEX URL found, use \"$0 SEX-URL/recipient\" or \"fexsend -I\"\n"; + } + } + +} + +&get_ssl_env; + +$fexcgi =~ s(^http://)()i; +$fexcgi =~ s(/fup.*)(); +$server = $fexcgi; + +if ($server =~ s(^https://)()i) { $port = 443 } +elsif ($server =~ /:(\d+)/) { $port = $1 } +else { $port = 80 } + +$server =~ s([:/].*)(); + +## set up tcp/ip connection +# $iaddr = gethostbyname($server) +# or die "$0: cannot find ip-address for $server $!\n"; +# socket(SH,PF_INET,SOCK_STREAM,getprotobyname('tcp')) or die "$0: socket $!\n"; +# connect(SH,sockaddr_in($port,$iaddr)) or die "$0: connect $!\n"; +# warn "connecting $server:$port user=$user\n"; +if ($port == 443) { + if ($opt_v and %SSL) { + foreach my $v (keys %SSL) { + printf "%s => %s\n",$v,$SSL{$v}; + } + } + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + %SSL + ); +} else { + $SH = IO::Socket::INET->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + ); +} + +die "cannot connect $server:$port - $!\n" unless $SH; +warn "TCPCONNECT to $server:$port\n" if $opt_v; + +# autoflush $SH 1; +autoflush STDERR; + +$SIG{PIPE} = \&sigpipehandler; + +if ($0 eq 'sexget' or $0 eq 'fuckme') { + $stream = "&stream=" . shift if @ARGV; + if ($anonymous) { + $cid = 'anonymous'; + } elsif ($id eq 'public') { + $cid = 'public'; + } else { + $cid = query_sid($server,$port,$id); + } + request("GET /sex?BS=$bs&user=$user&ID=$cid$stream HTTP/1.0"); + transfer($SH,STDOUT); + # print while sysread $SH,$_,$bs; + exit; +} + +if ($0 eq 'sexxx') { + $stream = "&stream=" . ($opt_s || 'xx'); + if (@ARGV) { + warn "streaming:\n"; + open my $tar,'-|','tar',"cv${opt_c}f",'-',@ARGV or die "$0: cannot run tar - $!\n"; + request("POST /sex?BS=$bs&user=$user$type$stream HTTP/1.0"); + transfer($tar,$SH); + # while (read $tar,$_,$bs) { syswrite $SH,$_ } + } else { + $cid = query_sid($server,$port,$id); + request("GET /sex?BS=$bs&user=$user&ID=$cid$stream HTTP/1.0"); + $opt_c = 'z' if $H{'CONTENT-TYPE'} =~ /gzip/i; + if (-t STDOUT) { + print "extracting from stream:\n"; + open $out,"|tar xv${opt_c}f -" or die "$0: cannot run tar - $!\n"; + } else { + if ($opt_c) { + open $out,"|gzip -d" or die "$0: cannot run gunzip - $!\n"; + } else { + $out = *STDOUT; + } + } + print {$out} $_ while sysread $SH,$_,$bs; + } + exit; +} + +# sexsend +$stream = "&stream=" . shift if @ARGV; + +if ($mode eq 'anonymous') { + unless ($opt_q) { + print "http://$server:$port/sex?user=$user&ID=anonymous$stream\n"; + printf "http://$server:$port/sex?%s\n", + encode_b64("user=$user&ID=anonymous$stream"); + } + $mode = "&mode=anonymous"; +} elsif ($mode eq 'public') { + die "$0: need user/ID when sending to public, set it with fexsend -I\n" unless $user and $id; + unless ($opt_q) { + print "http://$server:$port/sex?user=$user&ID=public$stream\n"; + printf "http://$server:$port/sex?%s\n", + encode_b64("user=$user&ID=public$stream"); + } + $cid = query_sid($server,$port,$id); + $mode = "&ID=$cid&mode=public"; +} else { + # $user = checkalias($user) unless $opt_d; +} + +request("POST /sex?BS=$bs&user=$user$mode$type$timeout$stream HTTP/1.0"); +print STDERR "==> (streaming ...)\n" if $opt_v; + +transfer(STDIN,$SH); + +exit; + + +sub transfer { + my $source = shift; + my $destination = shift; + my ($t0,$t1,$tt); + my ($B,$b,$bt); + + $t0 = $t2 = time; + $tt = $t0-1; + $t1 = 0; + + while ($b = sysread $source,$_,$bs) { + print {$destination} $_ or die "$0: link failure - $!\n"; + $B += $b; + $bt += $b; + $t2 = time; + if ($t2>$t1) { + if ($opt_g) { + if ($B>2*M) { + printf STDERR "%d MB %d kB/s \r", + int($B/M),int($bt/k/($t2-$tt)); + } else { + printf STDERR "%d kB %d kB/s \r", + int($B/k),int($bt/k/($t2-$tt)); + } + } + $t1 = $t2; + if ($t2-$tt>10) { + sleep 1; # be nice to bandwith + $bt = 0; + $tt = $t2; + } + } + } + + die "$0: no stream data\n" unless $B; + + $tt = (time-$t0)||1; + + if ($opt_v or $opt_g) { + if ($B>2097152) { + printf STDERR "transfered: %d MB in %d s with %d kB/s\n", + int($B/1048576),$tt,int($B/1024/$tt); + } elsif($B>2048) { + printf STDERR "transfered: %d kB in %d s with %d kB/s\n", + int($B/1024),$tt,int($B/1024/$tt); + } else { + printf STDERR "transfered: %d B in %d s with %d kB/s\n", + $B,$tt,int($B/1024/$tt); + } + } + +} + + +sub request { + my $req = shift; + + print STDERR "==> $req\n" if $opt_v; + syswrite $SH,"$req\r\n\r\n"; + for (;;) { + unless (defined($_ = &getline)) { + die "$0: server has closed the connection\n"; + } + if (/^HTTP\/[\d\.]+ 200/) { + print STDERR "<== $_" if $opt_v; + last; + } elsif (/^HTTP\/[\d\.]+ 199/) { + print STDERR "<== $_" if $opt_v; + } else { + if ($opt_v) { + print STDERR "<== $_"; + exit 3; + } else { + s:^HTTP/[ \d\.]+::; + s/\r//; + die "$0: server response: $_"; + } + } + } + while (defined($_ = &getline)) { + last if /^\s*$/; + $H{uc($1)} = $2 if /(.+):\s*(.+)/; + print STDERR "<== $_" if $opt_v; + } +} + +# check for (mutt) alias +sub checkalias { + my $to = shift; + if ($to !~ /@/ and open F,$ENV{HOME}.'/.mutt/aliases') { + while (<F>) { + next if /,/; + if (/^alias $to\s/i) { + chomp; + s/\s*#.*//; + s/\s+$//; + s/.*\s+//; + s/<//; + s/>//; + $to = $_; + warn "$0: found alias, using address $to\n"; + die unless $to; + last; + } + } + close F; + } + return $to; +} + +sub despace { + foreach (@_) { + s/^\s+//; + s/\s+$//; + } +} + +sub query_sid { + my ($server,$port,$id) = @_; + my $req; + local $_; + + $req = "GET SID HTTP/1.1"; + print STDERR "==> $req\n" if $opt_v; + syswrite $SH,"$req\r\n\r\n"; + $_ = &getline; + unless (defined $_ and /\w/) { + print STDERR "\n" if $opt_v; + die "$0: no response from server\n"; + } + s/\r//; + if (/^HTTP.* 201 (.+)/) { + print STDERR "<== $_" if $opt_v; + $id = 'MD5H:'.md5_hex($id.$1); + while (defined($_ = &getline)) { + s/\r//; + last if /^\n/; + print STDERR "<== $_" if $opt_v; + } + } else { + die "$0: $server does not support session ID\n"; + } + return $id; +} + +sub sigpipehandler { + local $_ = ''; + $SIG{ALRM} = sub { }; + alarm(1); + $_ = &getline||''; + if (/^HTTP.* \d+ (.*)/) { + if ($opt_v) { + die "\n$0: server error: @_\n"; + } else { + die "\n$0: server error: $1\n"; + } + } else { + die "\n$0: got SIGPIPE (server closed connection)\n"; + } +} + +# read one text line from $SH; +sub getline { + my $line = ''; + my $c; + + local $SIG{ALRM} = sub { die "$0: timeout while waiting for server reply\n" }; + alarm($opt_t||300); + + # must use sysread to avoid perl line buffering + while (sysread $SH,$c,1) { + $line .= $c; + last if $c eq "\n"; + } + + alarm(0); + + return $line; +} + +# from MIME::Base64::Perl +sub decode_b64 { + local $_ = shift; + my $uu = ''; + my ($i,$l); + + tr|A-Za-z0-9+=/||cd; + s/=+$//; + tr|A-Za-z0-9+/| -_|; + return "" unless length; + + $l = (length) - 60; + for ($i = 0; $i <= $l; $i += 60) { + $uu .= "M" . substr($_,$i,60); + } + $_ = substr($_,$i); + if (length) { + $uu .= chr(32 + (length)*3/4) . $_; + } + return unpack ("u",$uu); +} + + +### common functions ### + + +sub mtime { + my @d = localtime((stat shift)[9]); + return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); +} + + +sub urldecode { + local $_ = shift; + s/\%([a-f\d]{2})/chr(hex($1))/ige; + return $_; +} + + +sub get_ssl_env { + # set SSL/TLS options + $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_ca_file) + ) { + my $env = uc($opt); + $env =~ s/_//g; + $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); + } + + if ($SSL{SSL_verify_mode}) { + &search_ca; + unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { + die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; + } + } elsif (defined($SSL{SSL_verify_mode})) { + # user has set SSLVERIFY=0 ! + } else { + &search_ca; + $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; + } +} + +sub search_ca { + local $_; + return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; + foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { + if (-f) { + $SSL{SSL_ca_file} = $_; + return; + } + } + foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { + if (-f) { + $SSL{SSL_ca_path} = $_; + return; + } + } +} + + +sub serverconnect { + 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) { + printf "--> %s\n",$connect if $opt_v; + nvtsend($connect,""); + $_ = <$SH>; + s/\r//; + printf "<-- $_"if $opt_v; + unless (/^HTTP.1.. 200/) { + die "$0: proxy error : $_"; + } + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->start_SSL($SH,%SSL); + } + } else { + tcpconnect($server,$port); + } +# if ($port == 443 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) { + # eval "use IO::Socket::SSL qw(debug3)"; + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + %SSL + ); + } else { + $SH = IO::Socket::INET->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 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"; + } + print "-->\n" if $opt_v; + print {$SH} "\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) { + undef $SH; + return 0; + } + } + + return 1; +} + + +# from MIME::Base64::Perl +sub encode_b64 { + my $res = ""; + my $eol = "\n"; + my $padding; + + pos($_[0]) = 0; + $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); + $res =~ tr|` -_|AA-Za-z0-9+/|; + $padding = (3-length($_[0])%3)%3; + $res =~ s/.{$padding}$/'=' x $padding/e if $padding; + return $res; +} diff -Nru fex-20140917/htdocs/download/sexsend fex-20150120/htdocs/download/sexsend --- fex-20140917/htdocs/download/sexsend 1970-01-01 01:00:00.000000000 +0100 +++ fex-20150120/htdocs/download/sexsend 2015-01-19 13:59:57.000000000 +0100 @@ -0,0 +1,723 @@ +#!/usr/bin/perl -w + +# client for stream exchange of the FEX service +# +# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de> +# +# Perl Artistic Licence + +# sexsend / sexget / sexxx + +use Getopt::Std; +use Socket; +use IO::Handle; +use IO::Socket::INET; +use Digest::MD5 qw(md5_hex); # encypted ID / SID + +use constant k => 2**10; +use constant M => 2**20; + +eval 'use Net::INET6Glue::INET_is_INET6'; + +our $version = 20150120; + +my %SSL = (SSL_version => 'TLSv1'); +my $sigpipe; + +if (-f ($_ = '/etc/fex/config.pl')) { + eval { require } or warn $@; +} + +$0 =~ s:.*/::; +$| = 1; + +# sexsend is default +$usage = + "usage: ... | $0 [options] [SEX-URL/]recipient [stream]\n". + "options: -v verbose mode\n". + " -g show transfer rate\n". + " -V show version\n". + " -t timeout timeout in s (waiting for recipient)\n". + "special: recipient may be \"public\" or \"anonymous\" or \".\"\n". + "see also: sexget, sexxx\n". + "example: tail -f /var/log/syslog | $0 fex.flupp.org/admin log\n"; + +if ($0 eq 'sexget' or $0 eq 'fuckme') { + $usage = + "usage: $0 [options] [[SEX-URL/]user:ID] [stream]\n". + "options: -v verbose mode\n". + " -g show transfer rate\n". + " -V show version\n". + "arguments: user:ID use this user & ID\n". + " (ID may be \"public\" or user:ID may be \"anonymous\")\n". + " stream name of the stream\n". + "see also: sexsend, sexxx\n". + "example: $0 log | grep kernel\n"; +} + +if ($0 eq 'sexxx') { + $usage = + "usage: $0 [-v] [-g] [-c] [-u [SEX-URL/]user] [-s stream] [files...]\n". + "usage: $0 [-v] [-g] [-u [SEX-URL/]user] [-s stream] | ...\n". + "options: -v verbose mode\n". + " -g show transfer rate\n". + " -q quiet mode\n". + " -c compress files\n". + " -u SEX-URL/user SEX-URL and user (default: use FEXID/FEXXX)\n". + " -s stream stream name (default: xx)\n". + "see also: sexsend, sexget\n". + "examples: $0 -s config /etc /usr/local/etc\n". + " $0 > backup.tar\n"; +} + +$fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/.fex'; +$user = $id = ''; +$type = $timeout = $stream = $mode = ''; +$idf = "$fexhome/id"; +$bs = $ENV{BS} || 2**16; # I/O blocksize + +# server URL, user and auth-ID +if ($FEXID = $ENV{FEXID}) { + $FEXID = decode_b64($FEXID) if $FEXID !~ /\s/; + ($fexcgi,$user,$id) = split(/\s+/,$FEXID); +} else { + if (open $idf,$idf) { + chomp($fexcgi = <$idf>) or die "$0: no FEX-URL in $idf\n"; + chomp($user = <$idf>) or die "$0: no FROM in $idf\n"; + chomp($id = <$idf>) or die "$0: no ID in $idf\n"; + close $idf; + despace($fexcgi,$user,$id); + unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) { + die "$0: illegal FEX-URL \"$fexcgi\" in $idf\n"; + } + unless ($user =~ /^[_:=\w\-\.\/\@\%\+]+$/) { + die "$0: illegal FROM \"$user\" in $idf\n"; + } + } +} + +$opt_h = $opt_v = $opt_V = $opt_q = 0; +$opt_u = $opt_s = $opt_c = $opt_t = ''; + +$_ = "$fexhome/config.pl"; require if -f; + +if ($0 eq 'sexxx') { + + # xx server URL, user and auth-ID + if ($FEXXX = $ENV{FEXXX}) { + $FEXXX = decode_b64($FEXXX) if $FEXXX !~ /\s/; + ($fexcgi,$user,$id) = split(/\s+/,$FEXXX); + } elsif (open $idf,$idf) { + while (<$idf>) { + if (/^\[xx\]/) { + chomp($fexcgi = <$idf>) or die "$0: no xx FEX-URL in $idf\n"; + chomp($user = <$idf>) or die "$0: no xx FROM in $idf\n"; + chomp($id = <$idf>) or die "$0: no xx ID in $idf\n"; + last; + } + } + close $idf; + } + + getopts('hgvcu:s:') or die $usage; + die $usage if $opt_h; + die $usage unless -t; + + if ($opt_c) { + $opt_c = 'z'; + $type = '&type=GZIP'; + } + + if ($opt_u) { + $fexcgi = $1 if $opt_u =~ s:(.+)/::; + $user = $opt_u; + } + + unless ($fexcgi) { + die "$0: no xx user found, use \"$0 -u SEX-URL/user\"\n"; + } + + unless ($user) { + die "$0: no xx user found, use \"$0 -u user\"\n"; + } + +} elsif ($0 eq 'sexget' or $0 eq 'fuckme') { + getopts('hgvVdu:') or die $usage; + die $usage if $opt_h; + + + if ($opt_V) { + print "Version: $version\n"; + exit unless @ARGV; + } + + if (not $opt_u and @ARGV and $ARGV[0] =~ m{^anonymous|/|:}) { + $opt_u = shift @ARGV; + } + + if ($opt_u) { + $fexcgi = $1 if $opt_u =~ s:(.+)/::; + ($user,$id) = split(':',$opt_u); + if ($user =~ /^anonymous/) { + $anonymous = $user; + } elsif (not $id) { + die $usage; + } + } + + unless ($fexcgi) { + die "$0: no SEX URL found, use \"$0 -u SEX-URL/recipient\" or \"fexsend -I\"\n"; + } + + unless ($user) { + die "$0: no recipient found, use \"$0 -u SEX-URL/recipient\" or \"fexsend -I\"\n"; + } + +} else { # sexsend + + $opt_g = 1; + getopts('hguvqVTt:') or die $usage; + die $usage if $opt_h; + + if ($opt_V) { + print "Version: $version\n"; + exit unless @ARGV; + } + + if ($opt_t and $opt_t =~ /^\d+$/) { + $timeout = "&timeout=$opt_t"; + } + + my $save_user = $user; + $user = shift or die $usage; + $fexcgi = $1 if $user =~ s:(.+)/::; + + if ($user =~ /^anonymous/) { + die "$0: need SEX-URL with anonymous SEX\n" unless $fexcgi; + $mode = 'anonymous'; + } elsif ($user eq 'public') { + unless ($id) { + die "$0: public SEX not possible without FEXID, set it with \"fexsend -I\"\n"; + } + $mode = $user; + $user = $save_user; + } elsif ($user eq '.') { + open $idf,$idf or die "$0: no $idf\n"; + $_ = <$idf>; + $user = <$idf>||''; + chomp $user; + } else { + unless ($fexcgi) { + die "$0: no SEX URL found, use \"$0 SEX-URL/recipient\" or \"fexsend -I\"\n"; + } + } + +} + +&get_ssl_env; + +$fexcgi =~ s(^http://)()i; +$fexcgi =~ s(/fup.*)(); +$server = $fexcgi; + +if ($server =~ s(^https://)()i) { $port = 443 } +elsif ($server =~ /:(\d+)/) { $port = $1 } +else { $port = 80 } + +$server =~ s([:/].*)(); + +## set up tcp/ip connection +# $iaddr = gethostbyname($server) +# or die "$0: cannot find ip-address for $server $!\n"; +# socket(SH,PF_INET,SOCK_STREAM,getprotobyname('tcp')) or die "$0: socket $!\n"; +# connect(SH,sockaddr_in($port,$iaddr)) or die "$0: connect $!\n"; +# warn "connecting $server:$port user=$user\n"; +if ($port == 443) { + if ($opt_v and %SSL) { + foreach my $v (keys %SSL) { + printf "%s => %s\n",$v,$SSL{$v}; + } + } + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + %SSL + ); +} else { + $SH = IO::Socket::INET->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + ); +} + +die "cannot connect $server:$port - $!\n" unless $SH; +warn "TCPCONNECT to $server:$port\n" if $opt_v; + +# autoflush $SH 1; +autoflush STDERR; + +$SIG{PIPE} = \&sigpipehandler; + +if ($0 eq 'sexget' or $0 eq 'fuckme') { + $stream = "&stream=" . shift if @ARGV; + if ($anonymous) { + $cid = 'anonymous'; + } elsif ($id eq 'public') { + $cid = 'public'; + } else { + $cid = query_sid($server,$port,$id); + } + request("GET /sex?BS=$bs&user=$user&ID=$cid$stream HTTP/1.0"); + transfer($SH,STDOUT); + # print while sysread $SH,$_,$bs; + exit; +} + +if ($0 eq 'sexxx') { + $stream = "&stream=" . ($opt_s || 'xx'); + if (@ARGV) { + warn "streaming:\n"; + open my $tar,'-|','tar',"cv${opt_c}f",'-',@ARGV or die "$0: cannot run tar - $!\n"; + request("POST /sex?BS=$bs&user=$user$type$stream HTTP/1.0"); + transfer($tar,$SH); + # while (read $tar,$_,$bs) { syswrite $SH,$_ } + } else { + $cid = query_sid($server,$port,$id); + request("GET /sex?BS=$bs&user=$user&ID=$cid$stream HTTP/1.0"); + $opt_c = 'z' if $H{'CONTENT-TYPE'} =~ /gzip/i; + if (-t STDOUT) { + print "extracting from stream:\n"; + open $out,"|tar xv${opt_c}f -" or die "$0: cannot run tar - $!\n"; + } else { + if ($opt_c) { + open $out,"|gzip -d" or die "$0: cannot run gunzip - $!\n"; + } else { + $out = *STDOUT; + } + } + print {$out} $_ while sysread $SH,$_,$bs; + } + exit; +} + +# sexsend +$stream = "&stream=" . shift if @ARGV; + +if ($mode eq 'anonymous') { + unless ($opt_q) { + print "http://$server:$port/sex?user=$user&ID=anonymous$stream\n"; + printf "http://$server:$port/sex?%s\n", + encode_b64("user=$user&ID=anonymous$stream"); + } + $mode = "&mode=anonymous"; +} elsif ($mode eq 'public') { + die "$0: need user/ID when sending to public, set it with fexsend -I\n" unless $user and $id; + unless ($opt_q) { + print "http://$server:$port/sex?user=$user&ID=public$stream\n"; + printf "http://$server:$port/sex?%s\n", + encode_b64("user=$user&ID=public$stream"); + } + $cid = query_sid($server,$port,$id); + $mode = "&ID=$cid&mode=public"; +} else { + # $user = checkalias($user) unless $opt_d; +} + +request("POST /sex?BS=$bs&user=$user$mode$type$timeout$stream HTTP/1.0"); +print STDERR "==> (streaming ...)\n" if $opt_v; + +transfer(STDIN,$SH); + +exit; + + +sub transfer { + my $source = shift; + my $destination = shift; + my ($t0,$t1,$tt); + my ($B,$b,$bt); + + $t0 = $t2 = time; + $tt = $t0-1; + $t1 = 0; + + while ($b = sysread $source,$_,$bs) { + print {$destination} $_ or die "$0: link failure - $!\n"; + $B += $b; + $bt += $b; + $t2 = time; + if ($t2>$t1) { + if ($opt_g) { + if ($B>2*M) { + printf STDERR "%d MB %d kB/s \r", + int($B/M),int($bt/k/($t2-$tt)); + } else { + printf STDERR "%d kB %d kB/s \r", + int($B/k),int($bt/k/($t2-$tt)); + } + } + $t1 = $t2; + if ($t2-$tt>10) { + sleep 1; # be nice to bandwith + $bt = 0; + $tt = $t2; + } + } + } + + die "$0: no stream data\n" unless $B; + + $tt = (time-$t0)||1; + + if ($opt_v or $opt_g) { + if ($B>2097152) { + printf STDERR "transfered: %d MB in %d s with %d kB/s\n", + int($B/1048576),$tt,int($B/1024/$tt); + } elsif($B>2048) { + printf STDERR "transfered: %d kB in %d s with %d kB/s\n", + int($B/1024),$tt,int($B/1024/$tt); + } else { + printf STDERR "transfered: %d B in %d s with %d kB/s\n", + $B,$tt,int($B/1024/$tt); + } + } + +} + + +sub request { + my $req = shift; + + print STDERR "==> $req\n" if $opt_v; + syswrite $SH,"$req\r\n\r\n"; + for (;;) { + unless (defined($_ = &getline)) { + die "$0: server has closed the connection\n"; + } + if (/^HTTP\/[\d\.]+ 200/) { + print STDERR "<== $_" if $opt_v; + last; + } elsif (/^HTTP\/[\d\.]+ 199/) { + print STDERR "<== $_" if $opt_v; + } else { + if ($opt_v) { + print STDERR "<== $_"; + exit 3; + } else { + s:^HTTP/[ \d\.]+::; + s/\r//; + die "$0: server response: $_"; + } + } + } + while (defined($_ = &getline)) { + last if /^\s*$/; + $H{uc($1)} = $2 if /(.+):\s*(.+)/; + print STDERR "<== $_" if $opt_v; + } +} + +# check for (mutt) alias +sub checkalias { + my $to = shift; + if ($to !~ /@/ and open F,$ENV{HOME}.'/.mutt/aliases') { + while (<F>) { + next if /,/; + if (/^alias $to\s/i) { + chomp; + s/\s*#.*//; + s/\s+$//; + s/.*\s+//; + s/<//; + s/>//; + $to = $_; + warn "$0: found alias, using address $to\n"; + die unless $to; + last; + } + } + close F; + } + return $to; +} + +sub despace { + foreach (@_) { + s/^\s+//; + s/\s+$//; + } +} + +sub query_sid { + my ($server,$port,$id) = @_; + my $req; + local $_; + + $req = "GET SID HTTP/1.1"; + print STDERR "==> $req\n" if $opt_v; + syswrite $SH,"$req\r\n\r\n"; + $_ = &getline; + unless (defined $_ and /\w/) { + print STDERR "\n" if $opt_v; + die "$0: no response from server\n"; + } + s/\r//; + if (/^HTTP.* 201 (.+)/) { + print STDERR "<== $_" if $opt_v; + $id = 'MD5H:'.md5_hex($id.$1); + while (defined($_ = &getline)) { + s/\r//; + last if /^\n/; + print STDERR "<== $_" if $opt_v; + } + } else { + die "$0: $server does not support session ID\n"; + } + return $id; +} + +sub sigpipehandler { + local $_ = ''; + $SIG{ALRM} = sub { }; + alarm(1); + $_ = &getline||''; + if (/^HTTP.* \d+ (.*)/) { + if ($opt_v) { + die "\n$0: server error: @_\n"; + } else { + die "\n$0: server error: $1\n"; + } + } else { + die "\n$0: got SIGPIPE (server closed connection)\n"; + } +} + +# read one text line from $SH; +sub getline { + my $line = ''; + my $c; + + local $SIG{ALRM} = sub { die "$0: timeout while waiting for server reply\n" }; + alarm($opt_t||300); + + # must use sysread to avoid perl line buffering + while (sysread $SH,$c,1) { + $line .= $c; + last if $c eq "\n"; + } + + alarm(0); + + return $line; +} + +# from MIME::Base64::Perl +sub decode_b64 { + local $_ = shift; + my $uu = ''; + my ($i,$l); + + tr|A-Za-z0-9+=/||cd; + s/=+$//; + tr|A-Za-z0-9+/| -_|; + return "" unless length; + + $l = (length) - 60; + for ($i = 0; $i <= $l; $i += 60) { + $uu .= "M" . substr($_,$i,60); + } + $_ = substr($_,$i); + if (length) { + $uu .= chr(32 + (length)*3/4) . $_; + } + return unpack ("u",$uu); +} + + +### common functions ### + + +sub mtime { + my @d = localtime((stat shift)[9]); + return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]); +} + + +sub urldecode { + local $_ = shift; + s/\%([a-f\d]{2})/chr(hex($1))/ige; + return $_; +} + + +sub get_ssl_env { + # set SSL/TLS options + $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_ca_file) + ) { + my $env = uc($opt); + $env =~ s/_//g; + $SSL{$opt} = $ENV{$env} if defined($ENV{$env}); + } + + if ($SSL{SSL_verify_mode}) { + &search_ca; + unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) { + die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n"; + } + } elsif (defined($SSL{SSL_verify_mode})) { + # user has set SSLVERIFY=0 ! + } else { + &search_ca; + $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file}; + } +} + +sub search_ca { + local $_; + return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path}; + foreach (qw(/etc/ssl/certs/ca-certificates.crt)) { + if (-f) { + $SSL{SSL_ca_file} = $_; + return; + } + } + foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) { + if (-f) { + $SSL{SSL_ca_path} = $_; + return; + } + } +} + + +sub serverconnect { + 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) { + printf "--> %s\n",$connect if $opt_v; + nvtsend($connect,""); + $_ = <$SH>; + s/\r//; + printf "<-- $_"if $opt_v; + unless (/^HTTP.1.. 200/) { + die "$0: proxy error : $_"; + } + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->start_SSL($SH,%SSL); + } + } else { + tcpconnect($server,$port); + } +# if ($port == 443 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) { + # eval "use IO::Socket::SSL qw(debug3)"; + eval "use IO::Socket::SSL"; + die "$0: cannot load IO::Socket::SSL\n" if $@; + $SH = IO::Socket::SSL->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + %SSL + ); + } else { + $SH = IO::Socket::INET->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 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"; + } + print "-->\n" if $opt_v; + print {$SH} "\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) { + undef $SH; + return 0; + } + } + + return 1; +} + + +# from MIME::Base64::Perl +sub encode_b64 { + my $res = ""; + my $eol = "\n"; + my $padding; + + pos($_[0]) = 0; + $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); + $res =~ tr|` -_|AA-Za-z0-9+/|; + $padding = (3-length($_[0])%3)%3; + $res =~ s/.{$padding}$/'=' x $padding/e if $padding; + return $res; +} diff -Nru fex-20140917/htdocs/FAQ/admin.faq fex-20150120/htdocs/FAQ/admin.faq --- fex-20140917/htdocs/FAQ/admin.faq 2014-08-25 09:15:02.000000000 +0200 +++ fex-20150120/htdocs/FAQ/admin.faq 2014-12-19 16:31:01.000000000 +0100 @@ -19,6 +19,9 @@ /home/fex/bin/fac -u memyselfandi@my.do.main secret-auth-id </pre> Then log in using the web interface: http://YOURFEXSERVER/ + + ... and join the F*EX mailing list! ☺ + https://listserv.uni-stuttgart.de/mailman/listinfo/fex Q: What is /home/fex/bin/fac and /home/fex/cgi-bin/fac ? A: fac stands for F*EX Admin Control @@ -83,6 +86,12 @@ /home/fex/bin/fac -R framstag@rus.uni-stuttgart.de </pre> +Q: How can I change user settings like quota, restrictions or keep time? +A: Use <code>/home/fex/bin/fac</code> + +Q: How can I delete or temporarly disable a user? +A: Use <code>/home/fex/bin/fac</code> + Q: I have BIG files already on the fexserver host. Can I upload just a link instead of the whole file? A: Set in fex.ph: @@ -125,7 +134,7 @@ Q: I need ACLs for group access, a file browser and integration in my native file system. -A: This is beyond the scope of F*EX, which is designed for file transfer. +A: This is beyond the scope of F*EX, which is designed for efficient file transfer only. Q: Feature/design XY is missing. A: Contact the author <framstag@rus.uni-stuttgart.de> diff -Nru fex-20140917/htdocs/FAQ/faq.pl fex-20150120/htdocs/FAQ/faq.pl --- fex-20140917/htdocs/FAQ/faq.pl 2014-04-03 15:32:58.000000000 +0200 +++ fex-20150120/htdocs/FAQ/faq.pl 2014-11-17 18:27:32.000000000 +0100 @@ -13,7 +13,7 @@ printf "Frequently Asked Questions: %s</h1>\n",ucfirst($faq); if ($faq ne 'local') { - print "<h3>Section: \n"; + print "<h3>Sections: "; foreach $s (@sections,'All') { if ($s =~ /$faq/i) { print "<b>$s</b>\n"; @@ -41,8 +41,10 @@ }; ($q,$a) = split /A:\s*/; $q =~ s/[\s\n]+$//; + $q =~ s/^\s+//; $q =~ s! (/\w[\S]+/[\S]+)! <code>$1</code>!g; $a =~ s/[\s\n]+$/\n/; + $a =~ s/^\s+//; while ($a =~ s/^(\s*)\*/$1<ul>\n$1<li>/m) { while ($a =~ s/(<li>.*\n\s*)\*/$1<li>/g) {} $a =~ s:(.*\n)(\s*)(<li>[^\n]+\n):$1$2$3$2</ul>\n:s @@ -72,8 +74,13 @@ $t = $s if $faq eq 'all'; for ($n = 0; $n < scalar(@{$Q{$c}}); $n++) { - printf "<tr valign=top><th align=left>%s Q%d:<td> <a href=\"#%s%d\">%s</tr>\n", - $s,$n+1,$t,$n+1,${Q{$c}[$n]}; + $q = ${Q{$c}[$n]}; + $qa = anchor($q); + printf '<tr valign=top><th align=left>'. + '<a href="#%s%d" style="text-decoration: none">'. + '<font color="black">%s Q%d</a>:'. + '<td><a href="#%s">%s</a></tr>'."\n", + $t,$n+1,$s,$n+1,$qa,$q; } } @@ -88,10 +95,15 @@ $t = $s if $faq eq 'all'; for ($n = 0; $n < scalar(@{$Q{$c}}); $n++) { + $q = ${Q{$c}[$n]}; + $qa = anchor($q); print "<p>\n"; print "<table>\n"; - printf "<tr valign=top><th><a name=\"%s%d\">%s Q%d:</a><td><b>%s</b></tr>\n", - $t,$n+1,$s,$n+1,${Q{$c}[$n]}; + printf "<tr valign=top><th>". + "<a name=\"%s%d\">%s Q%d:</a>". + "<a name=\"%s\"></a>". + "<td><b>%s</b></tr>\n", + $t,$n+1,$s,$n+1,$qa,$q; printf "<tr valign=top><th>%s A%d:<td>\n%s</tr>\n", $s,$n+1,${A{$c}[$n]}; print "</table>\n"; @@ -119,3 +131,12 @@ s/\s+$//; return "<pre>$_</pre>\n"; } + +sub anchor { + local $_ = shift; + s/<.+?>//g; + s/\(.+?\)//g; + s/\W/_/g; + s/_+$//; + return $_; +} diff -Nru fex-20140917/htdocs/FAQ/meta.faq fex-20150120/htdocs/FAQ/meta.faq --- fex-20140917/htdocs/FAQ/meta.faq 2014-08-25 09:21:25.000000000 +0200 +++ fex-20150120/htdocs/FAQ/meta.faq 2014-12-19 16:31:42.000000000 +0100 @@ -3,7 +3,7 @@ and use cases http://fex.rus.uni-stuttgart.de/usecases/ Q: Why not use one of the commercial services like DropLoad, ALLPeers, YouSendIt, etc? -A: * They have a limit of 2 GB or even less. +A: * They have a file size limit of 2 GB or even less. * Their security and privacy status is unknown (ever heard of "Snowden & NSA"?). * They are not open source based. * There are no UNIX (CLI) clients for them. @@ -64,9 +64,9 @@ * European Commission Institute for Energy and Transport http://fex.jrc.nl * High Performance Computing Center Stuttgart http://fex.hlrs.de * Swiss National Supercomputing Centre http://fex.cscs.ch + * Centre National de la Recherche Scientifique (French National Center for Scientific Research) http://bigfiles.cnrs-gif.fr * Institut Pasteur http://dl.pasteur.fr * Palo Alto Research Center (Xerox PARC) http://parcftp.parc.com - * Open Computing Facility University of California at Berkeley http://fex.ocf.berkeley.edu * Baden-Württembergs extended LAN http://fex.belwue.de * Deutsche Kinemathek Museum für Film und Fernsehen http://upload.deutsche-kinemathek.de diff -Nru fex-20140917/htdocs/FAQ/user.faq fex-20150120/htdocs/FAQ/user.faq --- fex-20140917/htdocs/FAQ/user.faq 2014-09-03 16:38:17.000000000 +0200 +++ fex-20150120/htdocs/FAQ/user.faq 2014-12-16 12:21:30.000000000 +0100 @@ -18,6 +18,17 @@ Q: My recipient has lost the notification email with the download-URL. What can I do? A: You can resend the notification email via "user config & operation control" +Q: Why should I use a special F*EX client? +A: When you are using F*EX with your webbrowser, you are limited to its restrictions. + With a special F*EX client http://$HTTP_HOST$/tools.html you can + + * resume an aborted transfer + * send several files or even whole directory trees at once + * stream files + * transfer files via command line + * use an Internet clipboard http://fex.rus.uni-stuttgart.de/usecases/xx.html + * do much more :-) + Q: How can I upload several files at once? A: Put your files in an archive file (ZIP). Your web browser cannot do that. Or you can use a F*EX client, see http://$HTTP_HOST$/tools.html @@ -27,6 +38,9 @@ Firefox and Google Chrome have no limitation. But remember: No web browser is able to resume an interrupted upload. You need a special F*EX client like fexsend or schwuppdiwupp for resuming, see http://$HTTP_HOST$/tools.html +Q: I need to send a file bigger than my quota allows. What can I do? +A: Simply ask $SERVER_ADMIN$ to raise your quota. + Q: Why is the upload status window empty and I cannot see the progress bar? A: Most probably you are using a (enforced) web proxy, which cannot handle dynamic HTML pages. A workaround is using Google Chrome, which shows the upload status by itself. @@ -46,7 +60,7 @@ Q: Can I use a download manager/accelerator? A: Generally, no, because they suck: they are not RFC compliant and produce a LOT of unnecessary server load. - But there is one exception: axel [http://axel.alioth.debian.org/] + But there is one exception: axel http://axel.alioth.debian.org/ Q: When I hit [ESC] in firefox the upload is canceled. Why? A: This is a built-in feature of firefox: ESC terminates the current operation. @@ -67,8 +81,15 @@ Q: I have uploaded a file to a list of recipients. Will the file be deleted after the first recipient has dowloaded it? A: No. Every recipient gets his own copy of the file which is independant from the others. -Q: The default keep time is too short for me, I need more. How can I set it? -A: Use fexsend, ask your fexmaster or read the source code :-) +Q: The default keep time is too short for me (sender), I need more. How can I set it? +A: Use fexsend, ask $SERVER_ADMIN$ or read the source code :-) + +Q: The default keep time is too short for me (recipient), I need more. How can I set it? +A: Ask $SERVER_ADMIN$ to raise your default KEEP value. + +Q: I forgot to download a file. Now it is expired. How can I obtain it nevertheless? +A: An expired file is definitively deleted. Even the admin cannot restore it. + You must re-request it from the sender. Q: I have sent a second file with the same name, but the recpient has not received a second notification email. Why? A: A file with the same name to the same recpient overwrites the first one if it is still there (no download so far). @@ -100,3 +121,16 @@ Q: I cannot login with Internet Explorer, it tells me "This page can't be displayed". What shall I do? A: Use Firefox or any other Internet-compatible web browser, that Internet Explorer is not. This is one of the many bugs of Internet Explorer. + +Q: I have recived a "file.7z". How can I extract it on my Mac? +A: For example with "Stuffit Expander": + https://itunes.apple.com/us/app/stuffit-expander/id405580712?mt=12 + http://my.smithmicro.com/stuffit-expander-mac-download.html + +Q: How can I prevent the fexsend error <code>SSL3_GET_SERVER_CERTIFICATE:certificate verify failed</code>? +A: Set the environment variable <code>SSLVERIFY=0</code> + + Rationale: + Your openssl library cannot resolve the SSL certification path. + With <code>SSLVERIFY=0</code> you tell openssl to ignore certification verification. + Yes, this is a crude workaround :-} diff -Nru fex-20140917/htdocs/features.html fex-20150120/htdocs/features.html --- fex-20140917/htdocs/features.html 2014-08-25 09:36:16.000000000 +0200 +++ fex-20150120/htdocs/features.html 2014-12-17 16:02:39.000000000 +0100 @@ -51,6 +51,7 @@ <li>optional authentification by LDAP, RADIUS, POP, IMAP, mailman <li>server available for UNIX and Windows hosts <li>about 10 times faster than apache + <li><b>very</b> low memory usage <li>(reverse) proxy support <li>F*EX is a HTTP web-service and needs no firewall-tunnels <li>works with NAT or DHCP clients, too diff -Nru fex-20140917/htdocs/version fex-20150120/htdocs/version --- fex-20140917/htdocs/version 2014-09-17 22:07:21.000000000 +0200 +++ fex-20150120/htdocs/version 2015-01-20 10:59:25.000000000 +0100 @@ -1 +1 @@ -fex-20140917 +fex-20150120 diff -Nru fex-20140917/install fex-20150120/install --- fex-20140917/install 2014-08-27 19:16:27.000000000 +0200 +++ fex-20150120/install 2014-12-17 09:41:40.000000000 +0100 @@ -83,11 +83,14 @@ $premiss++; } -if ( -x '/usr/lib/sendmail') { - print "found /usr/lib/sendmail\n"; -} elsif ( -x '/usr/sbin/sendmail') { - print "found /usr/sbin/sendmail\n"; -} else { +foreach (qw'/usr/lib/sendmail /usr/sbin/sendmail') { + if (-x) { + $sendmail = $_; + print "found $sendmail\n"; + last; + } +} +unless ($sendmail) { print "sendmail NOT found\n"; $premiss++; } @@ -171,7 +174,7 @@ if (-d "$FEXHOME/spool") { warn "checking spool ...\n"; &convert_spool; - system "chown -R fex $spooldir"; + system "chown -R fex $spooldir/"; } else { $newinstall = $FEXHOME; chmod 0700,$FEXHOME; @@ -365,23 +368,33 @@ print "\n"; print "F*EX update installed.\n"; print "You can inform your users about the new features with:\n"; - print "$FEXHOME/bin/fexwall 'new features on $hostname' ". + print "$FEXHOME/bin/fexwall 'new F*EX features on $hostname' ". "< $FEXHOME/doc/newfeatures\n"; } if (@local_rdomains and not @local_rhosts) { - print "WARNING:\n"; + print "\nWARNING:\n"; print "In $fph you have @local_rdomains but not @local_rhosts!\n"; print "Selfregistrating of external users will not work!\n"; print "See ${fph}_new/\n"; } - + +if (`$sendmail -h 2>&1` =~ /exim/ and + `grep trusted_users /etc/exim4/exim4.conf 2>/dev/null` !~ /\bfex\b/) { + print "\nWARNING:\n"; + print "$sendmail is exim\n"; + print "You MUST set in your exim4.conf:\n"; + print "trusted_users = mail : uucp : fex\n"; +} exit; sub convert_spool { my ($f,$d,$to,$from,$link); + local $) = $FEX[3]; + local $> = $FEX[2]; + our ($spooldir,$skeydir,$gkeydir); $ENV{FEXLIB} = $FEXLIB = "$FEXHOME/lib"; require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n"; diff -Nru fex-20140917/lib/dop fex-20150120/lib/dop --- fex-20140917/lib/dop 2014-09-11 00:08:33.000000000 +0200 +++ fex-20150120/lib/dop 2014-12-20 11:41:20.000000000 +0100 @@ -54,8 +54,7 @@ "Connection: close", "" ); - exec($FEXHOME.'/bin/fexsrv') if $ENV{KEEP_ALIVE}; - exit; + &reexec; } # watchdog documents @@ -74,6 +73,7 @@ my ($var,$env,$con); my @files; my $htmldoc = ''; + my $htauth; my @s; my $s = 0; my $b = 0; @@ -86,6 +86,8 @@ } security_check($file); + $htauth = dirname($file).'/.htauth'; + require_auth($htauth,$file) if -f $htauth; if (-f $file) { # normal file @@ -337,6 +339,7 @@ my @files = (); my $uri = $ENV{REQUEST_URI}; my $allowed; + my ($htindex,$htauth); local $_; $uri =~ s:/+$::; @@ -344,7 +347,11 @@ security_check($dir); - open my $htindex,"$dir/.htindex" or http_error(403); + $htindex = "$dir/.htindex"; + $htauth = "$dir/.htauth"; + + open $htindex,$htindex or http_error(403); + require_auth($htauth,$dir) if -f $htauth; # .htindex may contain listing regexp chomp ($allowed = <$htindex>||'.'); @@ -536,6 +543,49 @@ } +# HTTP Basic authentication +sub require_auth { + my $htauth = shift; + my $doc = shift; + my ($realm,$auth); + my @http_auth; + my $uri = $ENV{REQUEST_URI} || '/'; + + $uri =~ s/\/index\.html$//; + $uri =~ s/\/$//; + + if (-d $doc or $doc =~ /\/index\.html$/) { + $realm = $uri; + } else { + $realm = dirname($uri); + } + + $auth = slurp($htauth); + unless ($auth and $realm) { + http_header("200 OK"); + print html_header("$ENV{SERVER_NAME} no authentication"); + pq(qq( + '<h3><code>$htauth</code> missing</h3>' + '</body></html>' + )); + exit; + } + chomp $auth; + + if ($ENV{HTTP_AUTHORIZATION} and $ENV{HTTP_AUTHORIZATION} =~ /Basic\s+(.+)/) + { @http_auth = split(':',decode_b64($1)) } + if (@http_auth != 2 or $http_auth[1] ne $auth) { + http_header( + '401 Authorization Required', + "WWW-Authenticate: Basic realm=\"$realm\"", + 'Content-Length: 0', + ); + # control back to fexsrv for further HTTP handling + &reexec; + } +} + + # function for <<perl-code>> inside HTML documents sub out { $__ .= join('',@_); diff -Nru fex-20140917/lib/fex.ph fex-20150120/lib/fex.ph --- fex-20140917/lib/fex.ph 2014-08-16 12:13:02.000000000 +0200 +++ fex-20150120/lib/fex.ph 2015-01-17 11:43:35.000000000 +0100 @@ -87,7 +87,10 @@ ## Allow or disallow overwriting of files $overwrite = 'YES'; - + +## Allow user requests for forgotten auth-IDs (then send by email) +$mail_authid = 'YES'; + ## optional: from which hosts and for which mail domains users may ## register themselves as full users (must set both!) # @local_hosts = qw(127.0.0.1 ::1 10.10.100.0-10.10.200.255 129.69.1.129); diff -Nru fex-20140917/lib/fex.pp fex-20150120/lib/fex.pp --- fex-20140917/lib/fex.pp 2014-09-14 01:16:50.000000000 +0200 +++ fex-20150120/lib/fex.pp 2015-01-17 11:41:00.000000000 +0100 @@ -54,6 +54,10 @@ $mailmode = 'auto'; $bcc = 'fex'; $default_locale = ''; +$fop_auth = 0; +$mail_authid = 'yes'; +$force_https = 0; +$debug = 0; $FHS = -f '/etc/fex/fex.ph' and -d '/usr/share/fex/lib'; # Debian FHS @@ -74,6 +78,11 @@ # local config require "$FEXLIB/fex.ph" or die "$0: cannot load $FEXLIB/fex.ph - $!"; +$fop_auth = 0 if $fop_auth =~ /no/i; +$mail_authid = 0 if $mail_authid =~ /no/i; +$force_https = 0 if $force_https =~ /no/i; +$debug = 0 if $debug =~ /no/i; + # check for name based virtual host $vhost = vhost($ENV{'HTTP_HOST'}); @@ -132,6 +141,8 @@ } } +$default_locale ||= 'english'; + unless ($durl) { my $host = ''; my $port = 0; @@ -649,6 +660,7 @@ local $_; $a .= '@'.$mdomain if $mdomain and $a !~ /@/; + return $a if -d "$spooldir/$a"; # ok, if user already exists if (@forbidden_recipients) { foreach (@forbidden_recipients) { $fr = quotemeta; @@ -754,11 +766,16 @@ if (open $file,'<',"$file/filename") { $filename = <$file>||''; - close $file; chomp $filename; + close $file; } - return $filename ? $filename : '???'; + unless ($filename) { + $filename = $file; + $filename =~ s:.*/::; + } + + return $filename; } @@ -843,15 +860,14 @@ sub faillog { my $request = shift; my $n = 1; - my $ra = $ENV{REMOTE_ADDR}; - if ($faillog and $max_fail_handler and open $ra,"+>>$faillog") { - flock($ra,LOCK_EX); - seek $ra,0,SEEK_SET; - $n++ while <$ra>; - printf {$ra} "%s %s\n",isodate(time),$request; - close $ra; - &$max_fail_handler($ra) if $n > $max_fail; + if ($faillog and $max_fail_handler and open $faillog,"+>>$faillog") { + flock($faillog,LOCK_EX); + seek $faillog,0,SEEK_SET; + $n++ while <$faillog>; + printf {$faillog} "%s %s\n",isodate(time),$request; + close $faillog; + &$max_fail_handler($ENV{REMOTE_ADDR}) if $n > $max_fail; } } @@ -915,7 +931,7 @@ my $sender = shift; my $squota = $sender_quota||0; my $du = 0; - my ($file,@file,$size,%size,$qf,$qs); + my ($file,$size,%file,$data); local $_; if (open $qf,'<',"$sender/\@QUOTA") { @@ -925,15 +941,22 @@ } close $qf; } - $qs = "*/$sender/*"; - if (glob $qs and open $qs,untaint("du $qs 2>/dev/null|")) { - while (<$qs>) { - $du += $1 if /^(\d+)/; + + foreach $file (glob "*/$sender/*") { + $data = "$file/data"; + if (not -l $data and $size = -s $data) { + # count hard links only once (= same inode) + my $i = (stat($data))[1]||0; + unless ($file{$i}) { + $du += $size; + $file{$i} = $i; + } + } elsif (-f "$file/upload" and $size = readlink "$file/size") { + $du += $size; } - close $qs; } - return($squota,int($du/1024)); + return($squota,int($du/1024/1024)); } @@ -942,6 +965,7 @@ my $recipient = shift; my $rquota = $recipient_quota||0; my $du = 0; + my ($file,$size); local $_; if (open my $qf,'<',"$recipient/\@QUOTA") { @@ -951,9 +975,12 @@ } close $qf; } - foreach my $data (glob("$recipient/*/*/data $recipient/*/*/upload")) { - unless (-l $data) { - $du += -s $data||0; + + foreach $file (glob "$recipient/*/*") { + if (-f "$file/upload" and $size = readlink "$file/size") { + $du += $size; + } elsif (not -l "$file/data" and $size = -s "$file/data") { + $du += $size; } } @@ -1142,6 +1169,50 @@ } } +sub notify_locale { + my $dkey = shift; + my $status = shift || 'new'; + my ($to,$keep,$locale,$file,$filename,$comment,$autodelete,$replyto,$mtime); + local $_; + + if ($dkey =~ m:/.+/.+/:) { + $file = $dkey; + $dkey = readlink("$file/dkey"); + } else { + $file = readlink("$dkeydir/$dkey") + or http_die("internal error: no DKEY $DKEY"); + } + $file =~ s:^../::; + $filename = filename($file); + $to = $file; + $to =~ s:/.*::; + $mtime = mtime("$file/data") or http_die("internal error: no $file/data"); + $comment = slurp("$file/comment") || ''; + $replyto = readlink "$file/replyto" || ''; + $autodelete = readlink "$file/autodelete" + || readlink "$to/\@AUTODELETE" + || $::autodelete; + $keep = readlink "$file/keep" + || readlink "$to/\@KEEP" + || $keep_default; + + $locale = readlink "$to/\@LOCALE" || readlink "$file/locale" || 'english'; + $_ = untaint("$FEXHOME/locale/$locale/lib/lf.pl"); + require if -f; + unless ($notify{$locale}) { + $locale = 'english'; + $notify{$locale} ||= \¬ify; + } + return &{$notify{$locale}}( + status => $status, + dkey => $dkey, + filename => $filename, + keep => $keep-int((time-$mtime)/DS), + comment => $comment, + autodelete => $autodelete, + replyto => $replyto, + ); +} ### locale functions ### # will be extracted by install process and saved in $FEXHOME/lib/lf.pl @@ -1348,6 +1419,7 @@ print {$sendmail} $header,"\n",$body; close $sendmail or $! and http_die("cannot send notification e-mail (sendmail error $!)\n"); + return $to; } diff -Nru fex-20140917/lib/fup.pl fex-20150120/lib/fup.pl --- fex-20140917/lib/fup.pl 2013-05-09 12:13:09.000000000 +0200 +++ fex-20150120/lib/fup.pl 2014-11-07 13:01:11.000000000 +0100 @@ -10,7 +10,7 @@ After download or after $keep_default days the server deletes the file. F*EX is not an archive! <p> -See also <a href="/FAQ/FAQ.html">questions & answers</a> and +See also <a href="/FAQ/">questions & answers</a> and <a href="http://fex.rus.uni-stuttgart.de/usecases/">use cases</a>. <p><hr><p> <address> @@ -26,12 +26,12 @@ <em>NOTE: Many web browsers cannot upload files > 2 GB!</em><br> If your file is larger you have to use a special <a href="/fuc?show=tools">F*EX client</a> or Firefox or Google Chrome which have no size limit.<br> -You also need a F*EX client for resuming interrupted uploads. Your web browser cannot do this. +You also need a <a href="/fuc?show=tools">F*EX client</a> for resuming interrupted uploads. Your web browser cannot do this. <p> If you want to send more than one file, then put them in a zip or tar archive, e.g. with <a href="http://www.7-zip.org/download.html">7-Zip</a>. <p> -See also the <a href="/FAQ/FAQ.html">FAQ<a> and +See also the <a href="/FAQ/user.html">FAQ<a> and <a href="http://fex.rus.uni-stuttgart.de/usecases/">use cases</a>. <p><hr><p> <address> diff -Nru fex-20140917/locale/czech/htdocs/FAQ.html fex-20150120/locale/czech/htdocs/FAQ.html --- fex-20140917/locale/czech/htdocs/FAQ.html 2012-09-28 19:03:08.000000000 +0200 +++ fex-20150120/locale/czech/htdocs/FAQ.html 1970-01-01 01:00:00.000000000 +0100 @@ -1,271 +0,0 @@ -<HTML> -This FAQ has 3 parts:</p> -<ul> - <li><a href="#Meta">Meta</a> - <li><a href="#User">User</a> - <li><a href="#Admin">Admin</a> -</ul> -<p> -<PRE> -<a name="meta"> -<a name="Meta"> -Meta questions: -=============== - -<a name="1"><a href="#1">Q</a>: Why name "F*EX" and not shortly "FEX"? - -A: At publication time there was already an (older) program named "FEX" on - freshmeat.net. - - -<a name="2"><a href="#2">Q</a>: Why not use one of the commercial services like - DropLoad, ALLPeers, YouSendIt, etc? - -A: They have a limit of 2 GB or even less. - Their security and privacy status is unknown. - They are not open source based. - There are no UNIX (CLI) clients for them. - They need java, active-X, flash or other evil plugins. - It is unknown how long they will exist - DropLoad and ALLPeers already - have terminated their business. - - -<a name="3"><a href="#3">Q</a>: Why a camel as the logo? - -A: The logo was inspired by the Perl camel, but it is based on a Steiff - plush camel, which rides with us on our racing tandem. The logo was - drawn by my stoker Beate - <a href="http://fex.rus.uni-stuttgart.de/Vortrag/tosa.html">http://fex.rus.uni-stuttgart.de/Vortrag/tosa.html</a> - - -<a name="4"><a href="#4">Q</a>: Where can I get the F*EX sources? - -A: <a href="http://fex.rus.uni-stuttgart.de/fex.html">http://fex.rus.uni-stuttgart.de/fex.html</a> - - -<a name="5"><a href="#5">Q</a>: What do I need to install F*EX? - -A: A UNIX host with a DNS entry and smtp for outgoing e-mail. - And you must be root on this host. - - -<a name="6"><a href="#6">Q</a>: What is DNS and smtp? - -A: Do not install F*EX. It is beyond your horizon. - - -<a name="7"><a href="#7">Q</a>: Who is the author? - -A: Ulli Horlacher <<a href="mailto:framstag@rus.uni-stuttgart.de">framstag@rus.uni-stuttgart.de</a>> - - -<a name="8"><a href="#8">Q</a>: Which licence does F*EX have? - -A: Perl Artistic free software, see <a href="http://fex.rus.uni-stuttgart.de/doc/Licence">http://fex.rus.uni-stuttgart.de/doc/Licence</a> - - -<a name="9"><a href="#9">Q</a>: Is there a F*EX mailing list? - -A: <a href="https://listserv.uni-stuttgart.de/mailman/listinfo/fex">https://listserv.uni-stuttgart.de/mailman/listinfo/fex</a> - - -<a name="10"><a href="#10">Q</a>: Where can I get commercial support for F*EX? - -A: Contact <a href="mailto:fex@nepustil.net">fex@nepustil.net</a> <a href="http://www.nepustil.net/">http://www.nepustil.net/</a> - - -<a name="11"><a href="#11">Q</a>: I have more/other questions than in this document! - -A: Ask the author <<a href="mailto:framstag@rus.uni-stuttgart.de">framstag@rus.uni-stuttgart.de</a>> - - -<a name="User"> -User questions: -=============== - -<a name="12"><a href="#12">Q</a>: What is the "auth-ID"? - -A: The auth-ID is an internal identification which authentificates the user. - It will be first generated by the admin or the automatic registration - process and can later be modified by you, the user. Think of some kind - of a low security password. - - -<a name="13"><a href="#13">Q</a>: Can I use a HTTP proxy? - -A: Yes. - - -<a name="14"><a href="#14">Q</a>: I have uploaded a HUGE file but misspelled my recipient's address. Now I - have got an error bounce e-mail. Must I re-upload the HUGE file? - -A: No, it is not necessary. You can redirect the file with - <a href="http://$HTTP_HOST$/rup">http://$HTTP_HOST$/rup</a> - - -<a name="15"><a href="#15">Q</a>: I have uploaded a HUGE file but forgot another recipient. - Must I re-upload the HUGE file? - -A: No, it is not necessary. You can forward-copy the file with - <a href="http://$HTTP_HOST$/foc">http://$HTTP_HOST$/foc</a> - - -<a name="16"><a href="#16">Q</a>: I cannot upload files > 2 GB with my web browser!? - -A: All web browsers I am aware of have bugs in their HTML-FORM - implementation. The limit mostly is 2 GB, sometimes 4 GB. - - You have to use a special F*EX client to upload files > 2 GB, see - <a href="http://$HTTP_HOST$/tools.html">http://$HTTP_HOST$/tools.html</a> - - -<a name="17"><a href="#17">Q</a>: My download was aborted before it was finished. Can I resume the download? - -A: F*EX supports resuming at download, but your client also has to support - this feature. Firefox eg is missing this HTTP feature, you need an other - client like opera, wget or fexget. - - -<a name="18"><a href="#18">Q</a>: My upload was aborted before it was finished. Can I resume the upload? - -A: F*EX supports resuming at upload, but your client also has to support it. - No web browser has this feature, you need a special F*EX client like - fexsend, schwuppdiwupp or F*IX. - See <a href="http://$HTTP_HOST$/tools.html">http://$HTTP_HOST$/tools.html</a> - - -<a name="19"><a href="#19">Q</a>: My webbrowser cannot start the java client F*IX, it says: - "found no java runtime environment, cannot start F*IX upload applet" - -A: A java plugin for your webbrowser is missing. On Debian and Ubuntu you - can install it with: "sudo aptitude install sun-java6-plugin" - - -<a name="20"><a href="#20">Q</a>: When I hit [ESC] in firefox the upload is canceled. Why? - -A: This is a built-in feature of firefox: ESC terminates the current operation. - Simple solution: do not hit ESC in Firefox. - Complex solution: ask the Firefox developers to add keyboard configuration. - - -<a name="21"><a href="#21">Q</a>: Sending as a F*EX user is easy, but how to receive files from others, - outside? - -A: Register them as your subusers or create a F*EX group - with <a href="http://$HTTP_HOST$/fuc">http://$HTTP_HOST$/fuc</a> - - -<a name="22"><a href="#22">Q</a>: Sometimes I can download a file more than once, especially when I - repeat it quickly. Is the autodelete feature buggy? - -A: The F*EX server has a grace time of 1 minute after first sucessfully - download in which the file is still available. This is necessary - because of some stupid "download managers" which requests the file - several times at once. Otherwise they would report an error to the user. - -A: Your fexmaster has set AUTODELETE=DELAY as default, which means that - the autodelete cleanup process is called once a day. - -A: Power users (use the source, Luke!) can set a "do not delete after - download" flag. - - -<a name="23"><a href="#23">Q</a>: The default keep time is too short for me, I need more. How can I set it? - -A: Use fexsend, ask your fexmaster or read the source code :-) - - -<a name="24"><a href="#24">Q</a>: I cannot download files with Internet Explorer, it tells me "Cannot - open Internet site". What shall I do? - -A: Use Firefox or any other Internet-compatible web browser, that Internet - Explorer is not. This is one of the many bugs of Internet Explorer. - - - -<a name="Admin"> -Admin questions: -================ - -<a name="25"><a href="#25">Q</a>: I cannot install a web server like fexsrv, because I have no root - permissions. Is there a pure-CGI-version of F*EX which runs with an - apache web server? - -A: F*EX is hard bound to fexsrv for several reasons (performance, file - size limit, session concept, etc) and cannot be run as CGI under apache. - But you might have a look at - <a href="http://gpl.univ-avignon.fr/filez/">http://gpl.univ-avignon.fr/filez/</a> - <a href="http://freshmeat.net/projects/eventh/">http://freshmeat.net/projects/eventh/</a> - <a href="http://www.schaarwaechter.de/sp/projekte/dateiaustausch.html">http://www.schaarwaechter.de/sp/projekte/dateiaustausch.html</a> (German only!) - which implement a file exchange as pure CGIs, but with a 2 GB file size limit. - - -<a name="26"><a href="#26">Q</a>: F*EX is not working at all! I cannot connect to it with my web browser! - -A: Check your routing, ipfilters and firewall setup. - Also check whether your xinetd is linked with tcp-wrapper and configure - it correctly (hosts.allow). - F*EX needs port 80/tcp (HTTP) and optional port 443/tcp (HTTPS). - - -<a name="27"><a href="#27">Q</a>: F*EX is too complicated! I need something more simplified. - -A: Try <a href="http://www.home.unix-ag.org/simon/woof.html">http://www.home.unix-ag.org/simon/woof.html</a> - - -<a name="28"><a href="#28">Q</a>: How can I integrate F*EX in the existing user management at my site? - -A: F*EX has several authentification modules: - local, RADIUS, LDAP, mailman and POP - For the last 4 please contact the author <a href="mailto:framstag@rus.uni-stuttgart.de">framstag@rus.uni-stuttgart.de</a> - - -<a name="29"><a href="#29">Q</a>: I want that all of my local users can use F*EX automaticly. How? - -A: Let them register theirselves with http://yourfexserver/fur - You have to edit lib/fex.ph and set (example): - @local_hosts = qw(127.0.0.1 10.10.100.0-10.10.255.255); - @local_domains = qw(flupp.org ulm.sub.net); - (Of course you have to add your real local hosts/networks!) - - -<a name="30"><a href="#30">Q</a>: I need more security! How can I enable HTTPS? - -A: Read doc/SSL and also look for "fop_auth" in doc/concept - - -<a name="31"><a href="#31">Q</a>: I need a corporate identity look. How can I configure F*EX in this way? - -A: See variable @H1_extra in fex.ph and you can add HTML code to - htdocs/header.html - -A: See htdocs/fup_template.html, modify it to your needs and use it as your - start-page. - - -<a name="32"><a href="#32">Q</a>: F*EX is too complicated for my tie users. I need a simplified upload form. - -A: See htdocs/fup_template.html - - -<a name="33"><a href="#33">Q</a>: I want the Bcc mails to fex (admin user) to be sent to another address. - -A: Use procmail or write OTHERADDRESS to /home/fex/.forward - - -<a name="34"><a href="#34">Q</a>: Can I get a localized version in my native languange? - -A: With your help, yes. Please contact the author <a href="mailto:framstag@rus.uni-stuttgart.de">framstag@rus.uni-stuttgart.de</a> - - -Misc questions: -=============== - -<a name="35"><a href="#35">Q</a>: F*EX is great! Can I join the developing team? What needs to be done? - -A: Contact the author <a href="mailto:framstag@rus.uni-stuttgart.de">framstag@rus.uni-stuttgart.de</a> - Requested features are: - - - a F*EX plugin for thunderbird or outlook - - more (other) languange support -</PRE></HTML> diff -Nru fex-20140917/locale/german/htdocs/FAQ.html fex-20150120/locale/german/htdocs/FAQ.html --- fex-20140917/locale/german/htdocs/FAQ.html 2012-09-28 19:00:04.000000000 +0200 +++ fex-20150120/locale/german/htdocs/FAQ.html 2014-11-26 17:06:53.000000000 +0100 @@ -1,4 +1,6 @@ <HTML> +<h3>Dieses Dokument ist veraltet. Bitte benutzen Sie die + <a href="/FAQ/meta.html?locale=english">englische FAQ</a>.</h3> <PRE> Allgemeine Fragen: ================== diff -Nru fex-20140917/locale/italian/htdocs/FAQ.html fex-20150120/locale/italian/htdocs/FAQ.html --- fex-20140917/locale/italian/htdocs/FAQ.html 2012-09-28 19:01:55.000000000 +0200 +++ fex-20150120/locale/italian/htdocs/FAQ.html 2014-12-02 12:47:54.000000000 +0100 @@ -1,4 +1,7 @@ <HTML> +<h3>Questo documento non è aggiornato. Si prega di utilizzare il + <a href="/FAQ/meta.html?locale=english">inglese FAQ</a>.</h3> +<PRE> <PRE> Domande Generiche: ================== diff -Nru fex-20140917/locale/spanish/htdocs/FAQ.html fex-20150120/locale/spanish/htdocs/FAQ.html --- fex-20140917/locale/spanish/htdocs/FAQ.html 2012-09-28 19:00:54.000000000 +0200 +++ fex-20150120/locale/spanish/htdocs/FAQ.html 2014-11-26 16:52:42.000000000 +0100 @@ -1,4 +1,6 @@ <HTML> +<h3>Este documento está obsoleto. Por favor, use + <a href="/FAQ/meta.html?locale=english">FAQ en inglés</a>.</h3> <PRE> Meta preguntas: =============== @@ -12,11 +14,11 @@ P: ¿Por qué no emplear un servicio comercial DropLoad, ALLPeers, YouSendIt, etc? -R: Tienen un límite de 2GB e incluso menos. +R: Tienen un límite de 2GB incluso ó menos. Su estado de privacidad y seguridad es desconocido. No están basados en software abierto. No existe ningún cliente UNIX (CLI) para ellos. - Necesita java, active-X, flash u otros plugins endemeniados. + Necesitan java, active-X, flash u otros plugins endemeniados. Se desconoce cuanto durarán - DropLoad y ALLPeers ha finalizado sus asuntos. diff -Nru fex-20140917/locale/translations fex-20150120/locale/translations --- fex-20140917/locale/translations 2014-09-15 16:02:51.000000000 +0200 +++ fex-20150120/locale/translations 2015-01-20 10:58:26.000000000 +0100 @@ -179,8 +179,8 @@ si vous n'avez pas déjà un compte F*EX You may also use <a href="/fup?from=anonymous&to=$a">anonymous upload</a> -Sie können auch <a href="/fup?from=anonymous&to=$a">anonymen Upload</a> verwenden. -Du kosch au <a href="/fup?from=anonymous&to=$a">anonymes Nufflada</a> nemma. +Sie können auch <a href="/fup?from=anonymous&to=$a">anonymen Upload</a> verwenden +Du kosch au <a href="/fup?from=anonymous&to=$a">anonymes Nufflada</a> nemma Se tambien puede usar <a href="/fup?from=anonymous&to=$a">anonymous upload</a> Tamén pode usar <a href="/fup?from=anonymous&to=$a">o envÃo anónimo</a> Potresti anhe utilizzare <a href="/fup?from=anonymous&to=$a">anonymous upload</a> @@ -188,13 +188,13 @@ Vous pouvez aussi utiliser <a href="/fup?from=anonymous&to=$a">l'upload anonyme</a> You may also use <a href="/sup.html">simple upload</a> -Sie können auch <a href="/sup.html">vereinfachten Upload</a> verwenden. -Du kosch au <a href="/sup.html">oifachs Nufflada</a> nemma. -You may also use <a href="/sup.html">simple upload</a> -You may also use <a href="/sup.html">simple upload</a> -You may also use <a href="/sup.html">simple upload</a> -You may also use <a href="/sup.html">simple upload</a> +Sie können auch <a href="/sup.html">vereinfachten Upload</a> verwenden +Du kosch au <a href="/sup.html">oifachs Nufflada</a> nemma +Puede tambien usar <a href="/sup.html">subir simplificado</a> You may also use <a href="/sup.html">simple upload</a> +Potresti anche usare <a href="/sup.html">caricamento semplice</a> +Můşete také pouÅŸÃt <a href="/sup.html">jednoduché nahrávánÃ</a>. +Vous pouvez également utiliser <a href="/sup.html">l'upload simple</a> <code>$file</code> already exists for <code>$file</code> existiert bereits für @@ -295,6 +295,24 @@ NeodesÃlat <a href="/fuc?reminder=no&akey=$akey">şádná pÅipomenutÃ</a> (souÄasné nastavenÃ: <em>odeslat upozornÄnÃ</em>) Ne pas recevoir <a href="/fuc?reminder=no&akey=$akey">les rappels</a> par e-mail (configuration actuelle: <em>rappels envoyés</em>) +Save</a> files after download (current setting: <em>display</em> +Speichere</a> Dateien nach dem download (aktuelle Einstellung: <em>anzeigen</em> +Schpeicher</a> die Dateia nochm Ronderlada (aktuelle Eischtellong: <em>ozeiga</em> +Save</a> downloads (current setting: <em>display</em> +Save</a> downloads (current setting: <em>display</em> +Save</a> downloads (current setting: <em>display</em> +Save</a> downloads (current setting: <em>display</em> +Save</a> downloads (current setting: <em>display</em> + +Display</a> files when downloading with web browser (current setting: <em>save</em> +Anzeige</a> von Dateien direkt beim download (aktuelle Einstellung: <em>abspeichern</em> +Ozeiga</a> von Dateia beim Ronderlada (aktuelle Eischtellong: <em>abschpeichra</em> +Display</a> downloads (current setting: <em>save</em> +Display</a> downloads (current setting: <em>save</em> +Display</a> downloads (current setting: <em>save</em> +Display</a> downloads (current setting: <em>save</em> +Display</a> downloads (current setting: <em>save</em> + You will now get no reminder notification e-mails Sie werden nun keine Erinnerung E-Mails erhalten Du wirsch jetzt koine Drodenka E-Mails meh bekomma @@ -331,6 +349,24 @@ E-maily s upozornÄnÃm jsou nynà odesÃlány ve zkráceném formátu Les emails de notifications sont maintenant au format simple +Downloads will now be saved +Downloads werden nun gespeichert +Downloads werdet ab jetzt gschpeichert +Descargas están guardadas +Downloads will now be saved +I downloads saranno ora salvati +Stahované soubory se nynà uloÅŸÃ +Les téléchargements vont maintenant être sauvés + +Downloads will now be displayed (if possible) +Downloads werden nun angezeigt (wenn möglich) +Downloads werdet ab jetzt ozeigt (wenns ghot) +Descargas están indicadas ahora (si posible) +Downloads will now be displayed (if possible) +I downloads saranno mostrati (se possibile) +Stahované soubory se nynà zobrazà (je-li to moÅŸné) +Les téléchargements cont maintenant être affichés (si possible) + E-mail disclaimer reset to default Der E-Mail Disclaimer wurde auf Standard zurückgesetzt Dr E-Mail Ohängsl isch wieder orginal @@ -1008,7 +1044,7 @@ delete file after download Datei nach dem Download löschen -Datie nochm Ronderlada löscha +Datei nochm Ronderlada löscha borrar el fichero tras su descarga borrar o ficheiro trala súa descarga cancella il file dopo il download @@ -1036,11 +1072,11 @@ delete file $autodelete days after download Lösche Datei $autodelete Tage nach dem Download Lösch Datei $autodelete Dag nochm ronderlada +borrar archivo $autodelete dias despues del descargar delete file $autodelete days after download -delete file $autodelete days after download -delete file $autodelete days after download -delete file $autodelete days after download -delete file $autodelete days after download +cancella file $autodelete giorni dopo il download +smazat soubor po $autodelete dnech po staÅŸenà +effacer $autodelete jours aprÚs le téléchargement F*EX service F*EX-Service @@ -1411,6 +1447,15 @@ a < et < +You are a restricted user and may only fex to these recipients: +Sie sind ein eingeschränkter Benutzer und können nur an diese Empfänger fexen: +Du bisch a eigeschränktr Benutzr ond kosch bloss an die Empfängr fexa: +Usted es un usuario restringido y solo puede enviar a estos destinatarios: +You are a restricted user and may only fex to these recipients: +Sei un utente limitato e puoi inviare solo a questi destinatari: +Jste uÅŸivatel s omezenÃm a můşete odesÃlat pouze tÄmto pÅÃjemcům: +Vous êtes un utilisateur restreint et vous ne pouvez utiliser fex que pour ces destinataires: + fex yourself eigene Adresse verwenden fex dir selbr @@ -1780,6 +1825,15 @@ velikost souboru taille du fichier +No file selected +Keine Datei ausgewählt +Koi Datei ausgwählt +Ningún archivo seleccionado +No file selected +Nessun file selezionato +ŜádnÜ soubor nebyl vybrán +Aucun fichier sélectionné + no filename?! Kein Dateiname?! Koin Dateinome?! @@ -2007,21 +2061,21 @@ your e-mail address Ihre E-Mail Adresse -dei E-Mail Adresss +dei E-Mail Adress sú dirección de correo electrónico o séu enderezo de correo electrónico il tuo indirizzo e-mail vaÅ¡e e-mailová adresa votre adresse e-mail -Subject: F*EX user registration -Subject: F*EX-Benutzer Registrierung -Subject: F*EX-Benutzrregischdrierong -Sujeto: Registro del usuario de F*EX -Suxeito: Rexistro do usuario de F*EX -Oggetto: registrazione utente F*EX -PÅedmÄt: Registrace F*EX uÅŸivatele -Sujet: Enregistrement F*EX +F*EX user registration +F*EX-Benutzer Registrierung +F*EX-Benutzrregischdrierong +Registro del usuario de F*EX +Rexistro do usuario de F*EX +Registrazione utente F*EX +Registrace F*EX uÅŸivatele +Enregistrement F*EX $user has been auto-registrated with $user wurde auto-registriert mit @@ -2032,14 +2086,14 @@ $user byl automaticky zaregistrován s l'utilisateur $user a été automatiquement enregistré avec -Subject: F*EX user registration request -Subject: F*EX-Benutzer Registrierungs-Anfrage -Subject: F*EX-Benutzrregischdrierongsofrog -Sujeto: Petición de registro de usuario F*EX -Suxeito: Petición de rexistro de usuario F*EX -Oggetto: richiesta registrazione utente F*EX -PÅedmÄt: PoÅŸadavek na zaregistrovánà F*EX uÅŸivatele -Sujet: Demande d'enregistrement d'utilisateur F*EX +F*EX user registration request +F*EX-Benutzer Registrierungs-Anfrage +F*EX-Benutzrregischdrierongsofrog +Petición de registro de usuario F*EX +Petición de rexistro de usuario F*EX +Richiesta registrazione utente F*EX +PoÅŸadavek na zaregistrovánà F*EX uÅŸivatele +Demande d'enregistrement d'utilisateur F*EX To activate your new F*EX account go to this URL: Um Ihren neuen F*EX-Account zu aktivieren oeffnen Sie diese URL: @@ -2089,11 +2143,11 @@ is not an email address ist keine E-Mail-Adresse isch koi E-Mail-Adress +no es una dirección email is not an email address -is not an email address -is not an email address -is not an email address -is not an email address +non Ú un indirizzo e-mail +nenà e-mailová adresa +n'est pas une adresse électronique F*EX redirect ERROR F*EX Umadressierungs-FEHLER @@ -2365,6 +2419,15 @@ Pro vÃce informacà se podÃvejte na $index Voir $index pour plus d'informations +No notification e-mail has been sent to $to +Es wurde keine Benachrichtigungs-E-Mail an $to verschickt +$to isch ned benochritigt worda +No se ha enviado ningún correo electrónico de notificación a $to +No notification e-mail has been sent to $to +Nessuna e-mail di notifica Ú stata inviata a $to +ŜádnÜ e-mail s oznámenÃm nebyl $to odeslán +Aucun email de notification n'a été envoyé à $to + Ehh... $ndata <b>BYTES</b>?! You are kidding Moment... $ndata <b>BYTES</b>?! Das ist wohl ein Witz Moment amole $ndata <b>BYTES</b>?! Wilsch me verarsche @@ -2410,23 +2473,23 @@ URL pro staÅŸenà okopÃrovat a vloÅŸit URL de téléchargement pour copier/coller -Link is valid for $keep days -Dieser Link ist für $keep Tage gültig -Sell Link isch fir $keep Dag giltig -El enlace es válido durante $keep dÃas -A ligazón é válida durante $keep dÃas -Il link Ú valido per $keep giorni -Odkaz je platnÜ $keep dny(ů) -Le lien restera valide $keep jours - -old $file for $to overwritten -vorhandenes $file für $to überschrieben -alts $file fir $to iberschrieba -El anterior $file para $to se ha sobreescrito -Sobrescribiuse o anterior $file para $to -vecchio file $file per $to sovrascritto -původnà soubor $file pro $to byl nahrazen -$file pour $to reécrit. +Link is valid for $keep{$to} days +Dieser Link ist für $keep{$to} Tage gültig +Sell Link isch fir $keep{$to} Dag giltig +El enlace es válido durante $keep{$to} dÃas +A ligazón é válida durante $keep{$to} dÃas +Il link Ú valido per $keep{$to} giorni +Odkaz je platnÜ $keep{$to} dny(ů) +Le lien restera valide $keep{$to} jours + +old <code>$file</code> for $to overwritten +vorhandenes <code>$file</code> für $to überschrieben +alts <code>$file</code> fir $to iberschrieba +El anterior <code>$file</code> para $to se ha sobreescrito +Sobrescribiuse o anterior <code>$file</code> para $to +vecchio file <code>$file</code> per $to sovrascritto +původnà soubor <code>$file</code> pro $to byl nahrazen +<code>$file</code> pour $to reécrit. $to notified $to benachrichtigt @@ -2437,6 +2500,24 @@ $to byl informován $to prévenu +<code>$file</code> removed because you are a restricted user +<code>$file</code> wurde gelöscht weil Sie ein eingeschränkter Benutzer sind +<code>$file</code> isch wieder glöscht worda weil du a bschränkter Benutzer bisch +<code>$file</code> se ha borrado porque usted es un usuario restringido +<code>$file</code> removed because you are a restricted user +<code>$file</code> rimosso perchÚ sei un utente limitato +<code>$file</code> odstranÄn, protoÅŸe jste uÅŸivatel s omezenÃm +<code>$file</code> supprimé car vous êtes un utilisateur restreint + +and recipient $to cannot receive e-mail +und Empfänger $to keine E-Mail empfangen kann +ond Empfängr $to ko koi E-Mail empfanga +y el destinatario $to no puede recibir correos electrónicos +and recipient $to cannot receive e-mail +ed il destinatario $to non può ricevere e-mail +a pÅÃjemce $to nemůşe pÅijÃmat poÅ¡tu +et le destinataire $to ne peut pas recevoir d'email + send another file eine weitere Datei schicken a weitere Datei schicka @@ -2692,80 +2773,80 @@ ERROR: no upload received FEHLER: es wurde kein Upload empfangen FEHLER: do isch fei nix okomma +ERROR: ningún subir recibido ERROR: no upload received -ERROR: no upload received -ERROR: no upload received -ERROR: no upload received -ERROR: no upload received +ERRORE: nessun caricamento ricevuto +CHYBA: şádnÜ soubor nebyl nahrán +ERREUR: aucun upload reçu You cannot send to more than one group Sie können nicht an mehrere Gruppen senden Du kansch net an mehrere Gruppa senda +No puede enviar a varios grupos You cannot send to more than one group -You cannot send to more than one group -You cannot send to more than one group -You cannot send to more than one group -You cannot send to more than one group +Non puoi spedire a più di un gruppo +Nemůşete odesÃlat vÃce neÅŸ jedné skupinÄ +Vous ne pouvez pas envoyer à plus d'un groupe file transfer aborted Dateitransfer abgebrochen Dateitransfer abbrocha +Trasmisión del archivo aborto file transfer aborted -file transfer aborted -file transfer aborted -file transfer aborted -file transfer aborted +trasferimento file interrotto +pÅenos souboru pÅeruÅ¡en +transfert de fichier abandonné <code>$from</code> is not allowed to upload from IP $ra <code>$from</code> darf nicht von IP-Adresse $ra hochladen <code>$from</code> darf ned von IP-Adress $ra hochlada +<code>$from</code> no está permitido a subir de esta dirección IP $ra <code>$from</code> is not allowed to upload from IP $ra -<code>$from</code> is not allowed to upload from IP $ra -<code>$from</code> is not allowed to upload from IP $ra -<code>$from</code> is not allowed to upload from IP $ra -<code>$from</code> is not allowed to upload from IP $ra +<code>$from</code> non Ú consentito caricarlo da IP $ra +<code>$from</code> z IP adresy $ra nenà dovoleno nahrávat soubory +<code>$from</code> n'est pas autorisé à uploader vers l'IP $ra Group <code>$to</code> does not exist Gruppe <code>$to</code> existiert nicht Grupp <code>$to</code> gibts net +Grupo <code>$to</code> no existe Group <code>$to</code> does not exist -Group <code>$to</code> does not exist -Group <code>$to</code> does not exist -Group <code>$to</code> does not exist -Group <code>$to</code> does not exist +Il gruppo <code>$to</code> non esiste +Skupina <code>$to</code> neexistuje +Le groupe <code>$to</code> n'existe pas server runs in NOMAIL mode - groups ($to) are not allowed Server läuft im NOMAIL Modus - Gruppen ($to) sind nicht erlaubt Server läuft em NOMAIL Modus - Gruppa ($to) senn net erlaubt +Servidor está en modo NOMAIL - grupos ($to) no están permitidos server runs in NOMAIL mode - groups ($to) are not allowed -server runs in NOMAIL mode - groups ($to) are not allowed -server runs in NOMAIL mode - groups ($to) are not allowed -server runs in NOMAIL mode - groups ($to) are not allowed -server runs in NOMAIL mode - groups ($to) are not allowed +server eseguto in modalità NOMAIL - i gruppi ($to) non sono permessi +Server bÄÅŸÃ v reÅŸimu NOMAIL - skupiny ($to) nejsou povoleny +Le serveur tourne en mode NOMAIL - les groupes ($to) ne sont pas autorisés File not found Datei nicht gefunden Datei net gfonda +Archivo no encontrado File not found -File not found -File not found -File not found -File not found +File non trovato +Soubor nenalezen +Fichier introuvable <code>$to</code> is not a valid recipient <code>$to</code> ist kein gültiger Empfänger <code>$to</code> isch koi gültigr Empfängr +<code>$to</code> no es un destinario válido <code>$to</code> is not a valid recipient -<code>$to</code> is not a valid recipient -<code>$to</code> is not a valid recipient -<code>$to</code> is not a valid recipient -<code>$to</code> is not a valid recipient +<code>$to</code> non Ú un destinatario valido +<code>$to</code> nenà platnÜ pÅÃjemce +<code>$to</code> n'est pas un destinataire valide File $file already exists in your outgoing spool Datei $file existiert bereits im ausgehenden Spool Datei $file gibts fei scho em nausganganda Spool +Archivo $file ya existe en sú spool saliente File $file already exists in your outgoing spool -File $file already exists in your outgoing spool -File $file already exists in your outgoing spool -File $file already exists in your outgoing spool -File $file already exists in your outgoing spool +Il file $file esiste già nel tuo spool in uscita +Soubor $file se jiÅŸ ve frontÄ k odeslánà nacházà +Le fichier $file exite déjà dans votre spool sortant diff -Nru fex-20140917/upgrade fex-20150120/upgrade --- fex-20140917/upgrade 2014-08-27 19:16:27.000000000 +0200 +++ fex-20150120/upgrade 2014-12-17 09:41:40.000000000 +0100 @@ -83,11 +83,14 @@ $premiss++; } -if ( -x '/usr/lib/sendmail') { - print "found /usr/lib/sendmail\n"; -} elsif ( -x '/usr/sbin/sendmail') { - print "found /usr/sbin/sendmail\n"; -} else { +foreach (qw'/usr/lib/sendmail /usr/sbin/sendmail') { + if (-x) { + $sendmail = $_; + print "found $sendmail\n"; + last; + } +} +unless ($sendmail) { print "sendmail NOT found\n"; $premiss++; } @@ -171,7 +174,7 @@ if (-d "$FEXHOME/spool") { warn "checking spool ...\n"; &convert_spool; - system "chown -R fex $spooldir"; + system "chown -R fex $spooldir/"; } else { $newinstall = $FEXHOME; chmod 0700,$FEXHOME; @@ -365,23 +368,33 @@ print "\n"; print "F*EX update installed.\n"; print "You can inform your users about the new features with:\n"; - print "$FEXHOME/bin/fexwall 'new features on $hostname' ". + print "$FEXHOME/bin/fexwall 'new F*EX features on $hostname' ". "< $FEXHOME/doc/newfeatures\n"; } if (@local_rdomains and not @local_rhosts) { - print "WARNING:\n"; + print "\nWARNING:\n"; print "In $fph you have @local_rdomains but not @local_rhosts!\n"; print "Selfregistrating of external users will not work!\n"; print "See ${fph}_new/\n"; } - + +if (`$sendmail -h 2>&1` =~ /exim/ and + `grep trusted_users /etc/exim4/exim4.conf 2>/dev/null` !~ /\bfex\b/) { + print "\nWARNING:\n"; + print "$sendmail is exim\n"; + print "You MUST set in your exim4.conf:\n"; + print "trusted_users = mail : uucp : fex\n"; +} exit; sub convert_spool { my ($f,$d,$to,$from,$link); + local $) = $FEX[3]; + local $> = $FEX[2]; + our ($spooldir,$skeydir,$gkeydir); $ENV{FEXLIB} = $FEXLIB = "$FEXHOME/lib"; require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
Attachment:
signature.asc
Description: Digital signature