#!/usr/bin/perl -wT # F*EX CGI for upload # # Author: Ulli Horlacher # # Contribs: # Sebastian Zaiser (upload status) # BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 } use Encode; use Fcntl qw':flock :seek :mode'; use IO::Handle; use Digest::MD5 qw'md5_hex'; use Cwd qw'abs_path'; # add fex lib (our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/; $| = 1; our $debug; our $ndata = 0; our $error = 'F*EX upload ERROR'; our $head = "$ENV{SERVER_NAME} F*EX upload"; our $autodelete = 'YES'; our $locale; # import from fex.ph our (@locales,@throttle,$bcc,$keep_max,$nomail,$nostore,$overwrite); our (@local_domains,@local_rdomains,@local_hosts,@local_rhosts,); our (@registration_hosts,@demo,@file_link_dirs); # import from fex.pp our ($FEXHOME); our ($spooldir,$durl,$tmpdir,@logdir,$logdir,$docdir,$hostname,$admin,$fra); our ($keep_default,$recipient_quota,$sender_quota,$fex_yourself); our ($sendmail,$mdomain,$fop_auth,$mail_auth,$faillog,$amdl); our ($dkeydir,$ukeydir,$akeydir,$skeydir,$gkeydir,$xkeydir); our ($MB,$DS); our $RB; # read POST bytes (total) our $akey = ''; our $dkey = ''; our $skey = ''; our $gkey = ''; our $seek = 0; # already sent bytes (from previous upload) our $filesize = 0; # total file size our $fpsize = 0; # file part size (MIME-part) my $data; my $boundary; my $rid = ''; # real ID my @header; # HTTP entity header my $fileid; # file ID my $captive; my $muser; # main user fur sub or group user # load common code, local config: $FEXLIB/fex.ph require "$FEXLIB/fex.pp"; # load fup local config our ($info_1,$info_2,$info_login); $locale = $ENV{LOCALE} || 'english'; foreach ( "/var/lib/fex/locale/$locale/lib/fup.pl", "$FEXLIB/fup.pl", ) { if (-f) { require; last; } } &check_camel unless $sid; chdir $spooldir or http_die("$spooldir - $!\n"); my $log = 'fup.log'; my $http_client = $ENV{HTTP_USER_AGENT} || ''; my $cl = $ENV{X_CONTENT_LENGTH} || $ENV{CONTENT_LENGTH} || 0; $fra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR}; $from = $to = $id = $file = $fkey = $comment = $command = $bwlimit = ''; $filename = $okey = $addto = $replyto = $submit = ''; @to = (); $data = ''; $locale = untaint($ENV{LOCALE}||''); my $ra = $ENV{REMOTE_ADDR}||0; if (@upload_hosts and not ipin($ra,@upload_hosts)) { http_die( "Uploads from your host ($ra) are not allowed.", "Contact $ENV{SERVER_ADMIN} for details." ); } &check_maint; &parse_request; # showstatus will not come back! if ($addto) { my %to; foreach $to (@to) { $to{$to} = 1 } push @to,$addto unless $to{$addto}; if ($submit and @to == 1) { $addto = '' } } $to = join(',',@to); if ($from eq $to and $fex_yourself =~ /^no|0$/i) { http_die("fexing to yourself is not allowed"); } $uid = randstring(8) unless $uid; # upload ID # user requests for forgotten ID $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; } # public recipients? (needs no auth-ID for sender) if ($to and $id and $id eq 'PUBLIC' and @public_recipients) { unless ($from) { http_die("missing sender e-mail address"); } # must use $param{FROM} for checking because $from is expanded with $mdomain unless (checkaddress(despace($param{FROM}))) { http_die("$param{FROM} is not a valid e-mail address"); } foreach my $to (@to) { unless (grep /^\Q$to\E$/i,@public_recipients) { http_die("$to is not a valid recipient"); } } $restricted = $public = $rid = $id; } # anonymous upload from enabled IP? if ($from =~ /^anonymous@/ and @anonymous_upload and ipin($ra,@anonymous_upload)) { $id = $rid = $anonymous = 'anonymous'; if ($to =~ /^anonymous/) { @to = ($to); $autodelete{$to} = $autodelete = 'NO'; } $nomail = $anonymous; } $comment = 'NOMAIL' if $nomail and not $comment; # one time token if ($okey) { $to = "@to" or http_die("no recipient specified"); $from = readlink "$to/\@OKEY/$okey" or http_die("no upload key \"$okey\" - ". "request another one from $to"); $from = untaint($from); } &check_status($from) if $from; # look for regular sender ID if ($id and $from and not ($public or $anonymous or $okey)) { if (open $from,'<',"$from/\@") { # chomp($rid = <$from> || ''); $rid = getline($from); close $from; $rid = sidhash($rid,$id); # set time mark for successfull access if ($id eq $rid) { my $time = untaint(time); utime $time,$time,$from; } } else { my $error = $!; # if recipient (to) is specified, we have to look for subusers later, too unless (@to) { fuplog("ERROR: $spooldir/$from/\@ $error"); debuglog("cannot open $spooldir/$from/\@ : $error"); faillog("user $from, id $id"); http_die("wrong user or auth-ID"); } } } # check regular ID if ($from and $id and not ($gkey or $skey or $public or $okey)) { if ($rid and $rid eq $id) { # set akey link for HTTP sessions # (need original id for consistant non-moving akey) if (-d $akeydir and open $idf,'<',"$from/@" and my $id = getline($idf)) { $akey = untaint(md5_hex("$from:$id")); mksymlink("$akeydir/$akey","../$from"); # show URL from fexsend if ($from eq $to and $comment eq '*') { mksymlink("$akeydir/$akey","../$from"); } } $captive = -e "$from/\@CAPTIVE"; } else { fuplog("ERROR: wrong auth-ID for $from"); debuglog("id sent by user $from=$id, real id=$rid"); faillog("user $from, id $id"); http_die("Wrong user or auth-ID"); } } # optional $auth_hook() in fup.pl if ($auth_hook and ($akey or $skey or $gkey) and $from and -d $from) { &$auth_hook; } # forward a copy of a file to another recipient if ($akey and $dkey and $command eq 'FORWARD') { my $file = untaint(readlink "$dkeydir/$dkey"||''); http_die("unknown dkey $dkey>") unless $file; $file =~ s:^\.\./::; forward($file); exit; } # modify file parameter if ($akey and $dkey and $command eq 'MODIFY') { my $file = untaint(readlink "$dkeydir/$dkey"||''); http_die("unknown dkey $dkey") unless $file; $file =~ s:^\.\./::; modify($file); exit; } # copy file from incoming to outgoing spool if ($akey and $dkey and $command eq 'COPY') { unless ($file = readlink "$dkeydir/$dkey") { http_die("No such file with DKEY=$dkey"); } if ($file =~ m:../(.+)/(.+)/(.+):) { ($to,$from,$file) = ($1,$2,$3); } else { http_die("Bad DKEY $dkey -> $file"); } unless (-f "$to/$from/$file/data") { http_die("File not found"); } if (-e "$to/$to/$file/data") { http_die("File $file already exists in your outgoing spool") if (readlink("$to/$to/$file/id")||$to) ne (readlink("$to/$from/$file/id")||$from); } else { mkdirp("$to/$to/$file"); link "$to/$from/$file/data","$to/$to/$file/data" or http_die("cannot link to $to/$to/$file/data - $!\n"); copy("$to/$from/$file/filename","$to/$to/$file/filename"); copy("$to/$from/$file/id","$to/$to/$file/id"); open $file,'>',"$to/$to/$file/notify"; close $file; open $file,'>',"$to/$to/$file/download"; print {$file} "$to\n"; close $file; $dkey = randstring(8); unlink "$to/$to/$file/dkey","$to/$to/$file/keep","$dkeydir/$dkey"; symlink "../$to/$to/$file","$dkeydir/$dkey"; symlink $dkey,"$to/$to/$file/dkey"; } nvt_print( "HTTP/1.1 302 Found", "Location: $ENV{PROTO}://$ENV{HTTP_HOST}/rup?akey=$akey&oto=$to&file=$file", 'Content-Length: 0', '' ); &reexec; } # delete file without download if ($akey and $dkey and $command eq 'DELETE') { $del = untaint(readlink "$dkeydir/$dkey"||''); http_die("unknown dkey $dkey") unless $del; $del =~ s:^\.\./::; $filename = filename($del); if (unlink("$del/data") or unlink("$del/upload")) { if (open F,'>',"$del/error") { printf F "%s has been deleted by %s at %s\n", $filename,$ENV{REMOTE_ADDR},isodate(time); close F; } # http_header('200 OK'); # print html_header($head); # print "

$filename deleted

\n"; nvt_print( "HTTP/1.1 302 Found", "Location: $ENV{PROTO}://$ENV{HTTP_HOST}/fup?akey=$akey&command=LISTRECEIVED", 'Content-Length: 0', "" ); &reexec; } else { my $s = $!; http_header('404 Not Found'); print html_header($head); print "

$filename not deleted ($s)

\n"; print "continue\n" if $akey; print "\n"; } exit; } # special commands if (($from and $id and $rid eq $id or $gkey or $skey) and $command) { if ($command eq 'CHECKQUOTA') { 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; nvt_print(''); 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 $nfile = ''; if ($dkey) { # resend notification e-mail $file = readlink("$dkeydir/$dkey") or html_error($error,"illegal DKEY $dkey"); $file =~ s:^../::; $file = untaint($file); unlink "$file/download"; # re-allow download from any ip address notify_locale($dkey,'new'); http_header( '200 OK', "X-Notify: $file", ); $nfile = $file; } else { http_header('200 OK'); } print html_header($head); # list sent files print "

Files from $from, ", "click on the file name to resend a notification e-mail:

\n", "
\n";
    foreach $file (glob "*/$from/*") {
      next if $file =~ m:/STDFEX$:;
      next if $file =~ m:(.+?)/: and -l $1;
      $size = -s "$file/data";
      next unless $size;
      $size = int($size/$MB+0.5);
      $filename = $comment = '';
      my $rto = $file;
      $rto =~ s:/.*::;
      if ($dkey = readlink "$file/dkey") {
        if ($rto ne $to) {
          $to = $rto;
          print "\nto $to :\n";
        }
        if (open $file,'<',"$file/filename") {
          $filename = <$file>;
          close $file;
        }
        if ($filename and length $filename) { 
          $filename = html_quote($filename);
        } else { 
          $filename = '???';
        }
        if (open $file,'<',"$file/comment") {
          $comment = untaint(html_quote(getline($file)));
          close $file;
        }
        my $rkeep = untaint(readlink "$file/keep"||$keep_default)
                    - int((time-mtime("$file/filename"))/$DS);
        if ($comment =~ /NOMAIL/ or 
           (readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) {
          printf "%8s MB [%s d] %s/%s/%s\n",
                 $size,
                 $rkeep,
                 $durl,
                 $dkey,
                 urlencode(basename($file));
        } else {
          printf "%8s MB [%s d] %s%s %s\n",
                 $size,
                 $rkeep,
                 untaint("/fup?akey=$akey&dkey=$dkey&command=RENOTIFY"),
                 $filename,
                 $comment ? qq' "$comment"' : '',
                 $file eq $nfile ? 
                   " → notification e-mail has been resent" :
                   "";
        }
      }
    }
    pq(qq(
      '
' '

back to F*EX operation control' '' )); exit; } if ($command =~ /^LIST(RECEIVED)?$/) { http_die("illegal command \"$command\"") if $public or $anonymous; # list sent files if ($to and $param{'TO'} eq '*') { http_header('200 OK'); print html_header($head); # "(Format: [size] [rest keep time] [filename] [comment])

\n", print "

Files from $from:

\n", "
\n";
      foreach $file (glob "*/$from/*") {
        next if $file =~ m:/STDFEX$:;
        next if $file =~ m:(.+?)/: and -l $1;
        $size = -s "$file/data";
        next unless $size;
        $size = int($size/$MB+0.5);
        $filename = $comment = '';
        my $rto = $file;
        $rto =~ s:/.*::;
        if ($dkey = readlink "$file/dkey") {
        # die $file if -s "$file/data" and $file =~ /^$from/;
          if ($rto ne $to) {
            $to = $rto;
            print "\nto $to :\n";
          }
          if (open $file,'<',"$file/filename") {
            $filename = <$file>;
            close $file;
          }
          if ($filename and length $filename) { 
            $filename = html_quote($filename);
          } else { 
            $filename = '???';
          }
          if (open $file,'<',"$file/comment") {
            $comment = untaint(html_quote(getline($file)));
            close $file;
          }
          my $rkeep = untaint(readlink "$file/keep"||$keep_default) 
                      - int((time-mtime("$file/filename"))/$DS);
          printf "%8s MB [%s d] %s%s\n",
                 $size,
                 $rkeep,
                 untaint("/fup?akey=$akey&dkey=$dkey&command=FORWARD"),
                 $filename,
                 $comment?qq( "$comment"):'';
        }
      }
      pq(qq(
        '
' '

back to F*EX operation control' '' )); } # list received files else { $to = $from; http_header('200 OK'); print html_header($head); # "(Format: [size] [rest keep time] [URL] [comment])

\n", print "

Files for $to (*):

\n", "
\n";
      foreach $from (glob "$to/*") {
        next if $from =~ /[A-Z]/;
        $from =~ s:.*/::;
        $url = '';
        foreach $file (glob "$to/$from/*") {
          next if $file =~ /\/STDFEX$/;
          $filename = $comment = '';
          $size = -s "$file/data";
          next unless $size;
          $size = int($size/$MB+0.5);
          if ($dkey = readlink "$file/dkey") {
            print "\nfrom $from :\n" unless $url;
            $file =~ m:.*/(.+):;
            $url = "$durl/$dkey/$1";
            unless (-l "$dkeydir/$dkey") {
              symlink untaint("../$file"),untaint("$dkeydir/$dkey");
            }
            if (open $file,'<',"$file/filename") {
              $filename = <$file>;
              close $file;
            }
            if ($filename and length $filename) { 
              $filename = html_quote($filename);
            } else { 
              $filename = '???';
            }
            if (open $file,'<',"$file/comment") {
              $comment = untaint(html_quote(getline($file)));
              $comment = ' "'.$comment.'"';
              close $file;
            }
            my $rkeep = untaint(readlink "$file/keep"||$keep_default) 
                        - int((time-mtime("$file/filename"))/$DS);
            printf "[delete] ",
                   $akey,$dkey;
            printf "[forward] ",
                   $akey,$dkey;
            printf "%8s MB (%s d) %s%s\n",
                   $size,$rkeep,$url,$filename,$comment;
          }
        }
      }
      pq(qq(
        '
' '(*) Files for other e-mail addresses you own will not be listed here!

' 'back to F*EX operation control' '' )); } exit; } if ($command eq 'LISTSENT') { http_die("illegal command \"$command\"") if $public or $anonymous; # show download URLs http_header('200 OK'); print html_header($head); print "

Download URLs of files you have sent\n"; foreach $to (glob "*/$from") { if (@files = glob "$to/*/data") { $to =~ s:/.*::; print "

to $to :

\n"; print "
\n";
        foreach $file (@files) {
          $file =~ s:/data::;
          next if $file =~ /\/STDFEX$/;
          $dkey = readlink "$file/dkey" or next;
          $file =~ s:.*/::;
          print "$ENV{PROTO}://$ENV{HTTP_HOST}/fop/$dkey/$file\n";
        }
        print "
\n"; } } pq(qq( '' '

back to F*EX operation control' '' )); exit; } if ($command eq 'FOPLOG') { http_die("illegal command \"$command\"") if $public or $anonymous; if (open my $log,"$logdir/fop.log") { http_header('200 OK'); while (<$log>) { next if /\/STDFEX\s/; if (s:^([^/]+)/$from/:$1 :) { if (s:(\d+)/(\d+)$:$1: and $1 and $1 == $2) { s/ \[[\d_]+\]//; print; } } } } exit; } if ($command eq 'RECEIVEDLOG') { http_die("illegal command \"$command\"") if $public or $anonymous; if (open my $log,"$logdir/fup.log") { http_header('200 OK'); while (<$log>) { next if /\sSTDFEX\s/; if (/\d+$/) { my @F = split; if ($F[5] eq $to) { s/ \[[\d_]+\]//; print; } } } } exit; } if ($command eq 'SENDLOG') { http_die("illegal command \"$command\"") if $public or $anonymous; if (open my $log,"$logdir/fup.log") { http_header('200 OK'); while (<$log>) { next if /\sSTDFEX\s/; if (/(\S+\@\S+)/ and $1 eq $from) { s/ \[[\d_]+\]//; print; } } } exit; } 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,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(''); # control back to fexsrv for further HTTP handling &reexec; } if ($file and @to and $command eq 'DELETE') { http_die("illegal command \"$command\"") if $public or $anonymous; foreach (@group?@group:@to) { my $to = $_; $to =~ s/:\w+=.*//; # remove options from address $del = "$to/$from/$fkey"; # swap to and from for special senders, see fup storage swap! $del = "$from/$to/$fkey" if $from =~ /^(fexmail|anonymous)/; $del =~ s:^/+::; if ($del =~ /\/\./) { http_die("illegal parameter $del"); } $del = untaint($del); if (unlink("$del/data") or unlink("$del/upload")) { if (open F,'>',"$del/error") { print F "$file has been deleted by $from\n"; close F; } http_header('200 OK',"X-File: $del"); print html_header($head); print "

$file deleted

\n"; } else { http_header("404 Not Found"); print html_header($head); print "

$file not deleted

\n"; } if ($akey) { printf "continue\n", $akey,$to; } print "\n"; } exit; } } # ip restrictions if ($from and $id and $rid eq $id and open my $ipr,"$from/\@UPLOAD_HOSTS") { my @hosts; while (<$ipr>) { chomp; s/#.*//; push @hosts,$_ if /\w/; } close $ipr; unless (@hosts and ipin($ra,@hosts)) { http_die("$from is not allowed to upload from IP $ra"); } } # quotas 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/$MB > $quota) { http_die("you are overquota"); } # check recipient quota foreach my $to (@to) { ($quota,$du) = check_recipient_quota($to); if ($quota and $du+$cl/$MB > $quota) { http_die("$to cannot receive files: is overquota"); } } } # check recipients restriction if ($id and $id eq $rid and $from and @to and not $public) { check_rr($from,@to); } # on secure mode "fop authorization" also check if recipient(s) exists # (= has a F*EX ID) if (not $addto and $fop_auth and $id and $id eq $rid and $from and @to) { my ($to_reg,$idf,$subuser); foreach my $to (my @loop = @to) { $to =~ s/:\w+=.*//; # remove options from address $to_reg = 0; # full user? if (open $idf,'<',"$to/@") { $to_reg = getline($idf); close $idf; } # sub user? elsif (open $idf,'<',"$from/\@SUBUSER") { while (<$idf>) { s/#.*//; next unless /:/; chomp; ($subuser) = split ':'; if ($subuser eq $to or $subuser eq '*@*' or $subuser =~ /^\*\@(.+)/ and $to =~ /\@\Q$1\E$/i or $subuser =~ /(.+)\@\*$/ and $to =~ /^\Q$1\E\@/i) { $to_reg = $_; last; } } close $idf; } unless ($to_reg) { http_die("recipient $to is not a registered F*EX full or sub user"); } } } $to = join(',',@to); if ($to =~ /^@(.+)/) { if ($nomail) { http_die("server runs in NOMAIL mode - groups ($to) are not allowed"); } my $gf = "$from/\@GROUP/$1"; if (open $gf,'<',$gf) { while (<$gf>) { s/#.*//; push @group,$1 if /(.+@.+):/; } } close $gf; $group = $to; } if ($redirect) { nvt_print( "HTTP/1.1 302 Found", "Location: $ENV{PROTO}://$ENV{HTTP_HOST}/$redirect?akey=$akey", 'Content-Length: 0', "" ); &reexec; } if ($from and $id and $id eq $rid and $faillog) { unlink $faillog; } # display HTML form and request user data unless ($file) { if ($test) { $cgi = $test } else { $cgi = $ENV{SCRIPT_NAME} } $cgi = 'fup'; # delete old cookies on logout referer my @cookies; if ($logout and my $cookie = $ENV{HTTP_COOKIE}) { while ($cookie =~ s/(\w+key)=\w+//) { push @cookies,"Set-Cookie: $1=; Max-Age=0; Discard"; } } if (($akey or $skey or $gkey) and $from and -d $from) { # save default locale for this user if (not $locale and ($ENV{HTTP_COOKIE}||'') =~ /\blocale=(\w+)/) { $locale = $1; } mksymlink("$from/\@LOCALE",$locale) if $locale; } http_header('200 OK',@cookies); # print html_header($head,''); print html_header($head); if ($http_client =~ /(Konqueror|w3m)/) { pq(qq( '


' '

' '

Your client seems to be "$1" which is incompatible with F*EX and will probably not work!

' 'We recommend firefox.' '
' '


' )); } # default "fex yourself" setting? if ($from and $id and $id eq $rid and not $addto and not ($gkey or $skey or $okey or $public or $anonymous) and (not @to or "@to" eq $from) and -f "$from/\@FEXYOURSELF") { @to = ($from); $nomail = 'fexyourself'; } # ask for recipient address(es) 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 = (""); # select menu from server address book if (open my $AB,'<',"$from/\@ADDRESS_BOOK") { while (<$AB>) { s/#.*//g; if (/(\S+)[=\s]+(\S+@[\w.-]+\S*)/) { $_ = "$1 <$2>"; s/,.*/,.../g; push @ab,""; } } close $AB; } unless (@to) { unless ($nomail) { foreach (glob "$from/\@GROUP/*") { if (-f and not -l) { s:.*/::; push @ab,"" unless /~$/; } } } } my $ab64 = b64("from=$from&id=$id"); # '

' ' ' ' ' ' ' ' ' ' ' '
sender: $from
recipient(s):' '
' )); if (grep /@/,@ab) { pq(qq( ' or select from your address book:' ' ' ' and' ' ' )); } pq(qq( '
' '

' )); my $rr = "$from/\@ALLOWED_RECIPIENTS"; if (-s $rr and open $rr,'<',$rr) { pq(qq( 'You are a restricted user and may only fex to these recipients:

' '

'
      ));
      while (<$rr>) {
        chomp;
        s/#.*//;
        s/\s//g;
        next unless $_;
        if (/^\@LOCAL_RDOMAINS/) {
          foreach my $rd (@local_rdomains) {
            print "*\@$rd\n";
          }
        } else {
          print "$_\n";
        }
      }
      print "

\n"; close $rr; } print qq' '; if ($fex_yourself =~ /^yes|1/i) { print qq' or ' } print "\n

\n

\n"; if ($akey and -f "$from/\@" and not $captive ) { pq(qq( 'user config & operation control' )); } if ($from eq $admin ) { pq(qq( '

' 'server config & admin control' )); } if (0 and -f "$docdir/FIX.jar") { print "

\n"; if ($public) { print "" } elsif ($skey) { print "" } elsif ($gkey) { print "" } else { print "" } print "Alternate Java client (for files > 2 GB or sending of more than one file)\n"; } print &logout; if (-x "$FEXHOME/cgi-bin/login") { print $info_login||$info_1; } pq(qq( '


' '' 'Warning: the recipient must not be a mailing list, because after' 'download the file will be no more available!' '
' 'Contact fexmaster' 'if you want to fex to a mailing list,' 'he can allow multiple downloads for specific addresses.' '' )); exit; } # ask for filename if ($from and ($id or $okey)) { $to = $group if $group; present_locales($ENV{REQUEST_URI}) if $skey or $gkey or $okey; # " '$ENV{PROTO}://$ENV{HTTP_HOST}/$cgi?showstatus=$uid'," pq(qq( '' )); pq(qq( '

' ' ' ' ' ' ' )); if ($public) { my $toh = join('
',@to); pq(qq( ' ' ' ' ' ' ' ' ' ' )); } elsif ($okey) { pq(qq( ' ' ' ' '
sender: $from
recipient:$toh
' ' ' ' ' )); } elsif ($skey) { pq(qq( ' ' '
sender: $from
recipient:$to
' ' ' ' ' )); } elsif (@group) { if ($gkey) { pq(qq( ' ' )); } my $toh = "group $group:
    "; my $toc = join(',',@group); foreach my $gm (@group) { $toh .= "
  • $gm" } $toh .= "
"; pq(qq( ' ' '
sender: $from
recipient:$to
' ' ' ' ' )); } else { my $toc = join(',',@to); my $toh = join('
',@to); pq(qq( ' ' '
sender:$from
recipient(s):' ' $toh
' ' ' )); if ($anonymous) { pq(qq( ' ' )); } else { pq(qq( ' ' )); } } $autodelete = lc $autodelete; $keep = $keep_default unless $keep; my ($quota,$du) = check_sender_quota($muser||$from); $quota = $quota ? "" : ''; $bwl = qq' kB/s'; if (@throttle) { foreach (@throttle) { if (/\[?(.+?)\]?:(\d+)$/) { my $throttle = $1; my $limit = $2; # throttle ip address? if ($throttle =~ /^[\w:.-]+$/) { if (ipin($ra,$throttle)) { $bwl = qq' $limit kB/s'; last; } } # throttle e-mail address? else { # allow wildcard *, but not regexps $throttle =~ quotemeta $throttle; $throttle =~ s/\*/.*/g; if ($from =~ /^$throttle$/i) { $bwl = qq' $limit kB/s'; last; } } } } } $autodelete = $autodelete{$to} if $autodelete{$to}; my $adt = ''; for ($autodelete) { if (/yes/i) { $adt = 'delete file after download' } elsif (/no/i) { $adt = 'do not delete file after download' } elsif (/delay/i) { $adt = 'delete file after download with delay' } elsif (/^\d+$/) { $adt = "delete file $autodelete days after download" } } $adt .= qq''; my $ctr = my $ktr = ''; if ($nomail) { $ctr = qq'no notification e-mail will be send'; } else { $ctr = qq''; } if ($captive) { $ktr = qq'$keep days'; } else { $ktr = qq'$keep days'; } pq(qq( ' ' ' ' ' $quota' ' ' ' ' ' ' ' ' '
sender:$from
recipient:' ' $toh
recipient(s):' ' $toh
sender quota (used):$quota ($du) MB
autodelete:' ' $adt' '
keep:' ' $ktr' '
bandwith limit:' ' $bwl' '
comment:' ' $ctr' '
file:' ' ' '
file size:
' '

' ' '

' '

' )); if ($akey and -f "$from/\@" and not $captive) { print "

\n", "user config & operation control\n"; } if ($from eq $admin ) { pq(qq( '

' 'server config & admin control' )); } if (0 and -f "$docdir/FIX.jar" and not $okey) { print "

\n"; if ($public) { print "" } elsif ($skey) { print "" } elsif ($gkey) { print "" } else { print "" } print "Alternate Java client (for files > 2 GB or sending of more than one file)\n"; } print &logout; print $info_2; # printf "


%s
\n",$ENV{HTTP_HEADER}; print "\n"; exit; } present_locales('/fup'); if ($ENV{REQUEST_METHOD} eq 'POST') { pq(qq( '

' ' You have to fill out this form completely to continue.' '

' )); } pq(qq( '
' ' ' ' ' ' ' '
sender:' '
auth-ID:' '
' )); if ($mail_authid and not ($fop_auth or $nomail)) { # pq(qq( # 'If you enter "?" as your auth-ID then it will be sent by e-mail to you.' # '

' # )); pq(qq( ' ' ' I have lost my auth-ID! Send it to me by e-mail! ' ' (you must fill out sender field above)' )); } pq(qq( '

' )); if (not $nomail and ( @local_domains and @local_hosts or @local_rdomains and @local_rhosts or @demo )) { pq(qq( 'You can register yourself ' 'if you do not have a F*EX account yet.

' )); } if (@anonymous_upload and ipin($ra,@anonymous_upload)) { my $a = 'anonymous_'.int(rand(999999)); pq(qq( 'You may also use anonymous upload' )); } # if (-f "$docdir/sup.html") { # pq(qq( # '
' # 'You may also use simple upload' # )); # } print "

\n"; print $info_1; if ($debug and $debug>1) { print "
\n
\n";
    foreach $v (sort keys %ENV) {
      print "$v = $ENV{$v}\n";
    }
    print "
\n"; } print "\n"; exit; } # from sup.html if ($from and $file and not @to) { check_rr($from,$from); @to = ($from); $sup = 'fexyourself'; } # all these variables should be defined here, but just to be sure... http_die("no file specified") unless $file; http_die("no sender specified") unless $from; http_die("no recipient specified") unless @to; unless ($okey and -l "$to/\@OKEY/$okey") { http_die("no auth-ID specified") unless $id; unless ($rid eq $id or $gkey or $skey) { faillog("user $from, id $id"); http_die("wrong auth-ID specified"); } } &check_status($from); if (@throttle) { foreach (@throttle) { if (/(.+):(\d+)$/) { my $throttle = $1; my $limit = $2; if (not $bwlimit or $limit < $bwlimit) { # throttle ip address? if ($throttle =~ /^[\d.-]+$/) { if (ipin($ra,$throttle)) { $bwlimit = $limit; last; } } # throttle e-mail address? else { # allow wildcard *, but not regexps $throttle =~ quotemeta $throttle; $throttle =~ s/\*/.*/g; if ($from =~ /^$throttle$/i) { $bwlimit = $limit; last; } } } } } } # address rewriting for storage (swap sender and recipient), see also fop! if (not ($skey or $gkey) and $from =~ /^(anonymous|fexmail)/) { ($from,@to) = ("@to",$from); } if (not $anonymous and $overwrite =~ /^n/i) { foreach $to (@to) { if (-f "$to/$from/$fkey/data") { http_die("$file already exists for $to"); } } } # additional last check unless (@group or $gkey or $skey or $public or $okey) { foreach $to (@to) { checkaddress($to) or http_die("$to is not a valid e-mail address"); } } $to = join(',',@to); # file overwriting for anonymous is only possible if his client has the # download cookie - else request purging if ($anonymous and not $seek and my $dkey = readlink "$to/$from/$fkey/dkey") { if ($overwrite =~ /^n/i) { http_die("$file already exists for $to"); } if ($ENV{HTTP_COOKIE} !~ /$dkey/) { my $purge = "/fop/$dkey/$dkey?purge"; # http_die("$file already exists $dkey:$ENV{HTTP_COOKIE}:"); http_die("$file already exists - purge it?!"); } } if (@group) { @to = @group; $comment = "[$group] $comment"; } elsif ($public) { $comment .= ' (public upload)'; } # file data still waits on STDIN ... get it now! &get_file; if ($to eq $from and $file eq 'ADDRESS_BOOK') { unlink "$from/\@ADDRESS_BOOK"; rename "$from/$from/ADDRESS_BOOK/upload","$from/\@ADDRESS_BOOK" or http_die("cannot save $from/\@ADDRESS_BOOK - $!\n"); http_header('200 OK'); print html_header($head); print "address book updated", "\n"; exit; } # finalize upload unless ($nostore) { foreach (@group?@group:@to) { my $to = $_; $to =~ s/:\w+=.*//; # remove options from address $filed = "$to/$from/$fkey"; $save = "$filed/data"; $upload = "$filed/upload"; $download = "$filed/download"; $dkey{$to} = readlink "$filed/dkey"; $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 my $msg = sprintf "%s %s %s %s %s\n", isodate(time),$dkey{$to},$from,$to,$fkey; writelog('dkey.log',$msg); # send notification e-mails if necessary 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'"); } } } # send HTTP status $HTTP_HEADER = 'HTTP/1.1 200 OK'; if ($nostore) { nvt_print($HTTP_HEADER,'Content-Type: text/html',''); exit if $http_client =~ /^fexsend/; } elsif ($file eq 'STDFEX') { nvt_print($HTTP_HEADER,''); exit; } else { nvt_print($HTTP_HEADER); if ($xkey and not $restricted) { my $x = "$durl//$xkey"; $x =~ s:/fop::; nvt_print("X-Location: $x"); } if ($anonymous) { my $dkey = $dkey{$to}; my $cookie = $dkey; $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 $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; } if ($http_client =~ /^(fexsend|schwuppdiwupp)/) { nvt_print(''); exit; } else { nvt_print('Content-Type: text/html',''); } } # send HTML report print html_header($head); if ($nostore) { printf "%s (%s MB) received\n",$file,int($ndata/$MB); } elsif (not $restricted and ($anonymous or $from eq $to)) { my $size = $ndata<2*1024 ? sprintf "%s B",$ndata: $ndata<2*$MB ? sprintf "%s kB",int($ndata/1024): sprintf "%s MB",int($ndata/$MB); pq(qq( '$file ($size) received and saved

' 'Download URL for copy & paste:' '

$durl/$dkey{$to}/$fkey

' 'Link is valid for $keep{$to} days!

' )); } else { if ($ndata<2*1024) { print "$file ($ndata B) received and saved

\n"; if (not $boring and not $seek) { print "Ehh... $ndata BYTES?! You are kidding?

\n"; } } elsif ($ndata<2*$MB) { $ndata = int($ndata/1024); print "$file ($ndata kB) received and saved

\n"; if ($ndata<1024 and not ($boring or $seek)) { print "Using F*EX for less than 1 MB: ", "ever heard of MIME e-mail? ☺

\n"; } } else { $ndata = int($ndata/$MB); print "$file ($ndata MB) received and saved

\n"; } print "

\n"; } if ($okey) { unlink "$to/\@OKEY/$okey"; } elsif (not $anonymous and not $sup) { print ""; print "send another file\n"; if ($http_client !~ /fexsend/ and $http_client =~ /Linux/i) { print qq'

Hi Linux-user, try fexsend! ☺

\n'; } print &logout; } print "\n"; exit; # parse GET and POST requests sub parse_request { my %to; my ($to,$dkey); my ($x,$k,$v); my $qs = $ENV{QUERY_STRING}; local $_; # get JUP parameters from environment (HTTP headers) while (($k,$v) = each %ENV) { if ($k =~ s/^FEX_//) { setparam($k,$v); } } # decode base64 PATH_INFO to QUERY_STRING if ($ENV{PATH_INFO} =~ m:^/(\w+=*)$:) { if ($qs) { $qs = sprintf("%s&%s",decode_b64($1),$qs); } else { $qs = decode_b64($1); } } # parse HTTP QUERY_STRING (parameter=value pairs) if ($qs) { foreach (split '&',$qs) { if (s/^(\w+)=//) { my $x = $1; # decode URL-encoding s/%([a-f0-9]{2})/chr(hex($1))/gie; setparam($x,$_); } } } # HTTP redirect does not work correctly with opera! # ==> locale handling is now done by fexsrv if (0 and $locale) { nvt_print( "HTTP/1.1 302 Found", "Location: $ENV{PROTO}://$ENV{HTTP_HOST}/fup", "Set-Cookie: locale=$locale", 'Expires: 0', 'Content-Length: 0', '' ); &reexec; } if ($showstatus) { &showstatus; exit; } # check for akey, gkey and skey (from HTTP GET) &check_keys; if ($ENV{REQUEST_METHOD} eq 'POST' and $cl) { foreach $sig (keys %SIG) { if ($sig !~ /^(CHLD|CLD)$/) { $SIG{$sig} = \&sigexit; } } $SIG{PIPE} = 'IGNORE' if $ENV{PROTO} eq 'https'; # stunnel workaround $SIG{__DIE__} = \&sigdie; http_die("invalid Content-Length header \"$cl\"") if $cl !~ /^-?\d+$/; debuglog($0); debuglog(sprintf("awaiting %d bytes from %s %s", $cl,$ENV{REMOTE_ADDR}||'',$ENV{REMOTE_HOST}||''),"\n"); &check_space($cl) if $cl > 0; $SIG{ALRM} = sub { die "TIMEOUT\n" }; alarm($timeout); binmode(STDIN,':raw'); if (defined($ENV{FEX_FILENAME})) { # JUP via HTTP header $file = $param{'FILE'} = $ENV{FEX_FILENAME}; $fileid = $ENV{FEX_FILEID} || 0; $fpsize = $ENV{X_CONTENT_LENGTH} || 0; $boundary = ''; } elsif ($contentlength) { # JUP via URL parameter $fpsize = $contentlength; $boundary = ''; } else { # FUP if ($ENV{CONTENT_TYPE} =~ /boundary=\"?([\w\-\+\/_]+)/) { $boundary = $1; } else { http_die("malformed HTTP POST (no boundary found)"); } READPOST: while (&nvt_read) { # the file itself - *must* be last part of POST! if (/^Content-Disposition:\s*form-data;\s*name="file";\s*filename="(.+)"/i) { push @header,$_; $file = $param{'FILE'} = $1; while (&nvt_read) { last if /^\s*$/; $fileid = $1 if /^X-File-ID:\s*(.+)/; $fpsize = $1 if /^Content-Length:\s*(\d+)/; $flink = $1 if /^Content-Location:\s*(\/.+)/; push @header,$_; } # STDIN is now at begin of file, will be read later with get_file() last; } # all other parameters if (/^Content-Disposition:\s*form-data;\s*name="([a-z]\w*)"/i) { my $x = $1; nvt_skip_to('^\s*$'); &nvt_read; setparam($x,$_); NEXTPART: while (&nvt_read) { last READPOST if /^--\Q$boundary--/; last NEXTPART if /^--\Q$boundary/; } } } } if (length($file)) { $file =~ s/%(\d+)/chr($1)/ge; $file = untaint(strip_path(normalize($file))); $file =~ s/[\\\/<>]/_/g; # filter out dangerous chars $file =~ s/^\|//; # filter out dangerous chars $file =~ s/\|$//; # filter out dangerous chars $filename = $file; $fkey = urlencode($file); } # check for akey, gkey and skey (from HTTP POST) &check_keys; } if ($from) { unless ($skey or $gkey or $okey) { $from .= '@'.$mdomain if $mdomain and $from !~ /@/; if ($from ne 'anonymous' and not checkaddress($from)) { http_die("$from is not a valid e-mail address"); } } $from = untaint($from); } # collect multiple addresses and check for aliases (not group) if (@to and "@to" !~ /^@[\w-]+$/ and not ($gkey or $addto or $command =~ /^LIST(RECEIVED)?$/)) { # read address book if ($from and open my $AB,'<',"$from/\@ADDRESS_BOOK") { my ($alias,$address,$autodelete,$locale,$keep); while (<$AB>) { s/#.*//; $_ = lc $_; if (s/^\s*(\S+)[=\s]+(\S+)//) { ($alias,$address) = ($1,$2); $autodelete = $locale = $keep = ''; $autodelete = $1 if /autodelete=(\w+)/; $locale = $1 if /locale=(\w+)/; $keep = $1 if /keep=(\d+)/; foreach my $address (split(",",$address)) { $address .= '@'.$mdomain if $mdomain and $address !~ /@/; push @{$ab{$alias}},$address; $autodelete{$alias} = $autodelete; $keep{$alias} = $keep; $locale{$alias} = $locale; } } } close $AB; } # look for recipient's options and eliminate dupes %to = (); foreach my $to (my @loop = @to) { # address book alias? if ($to !~ /@/ and $ab{$to}) { foreach my $address (my @loop = @{$ab{$to}}) { $address .= '@'.$mdomain if $mdomain and $address !~ /@/; $to{$address} = $address; # ignore dupes if ($specific{'autodelete'}) { $autodelete{$address} = $specific{'autodelete'}; } elsif ($autodelete{$to}) { $autodelete{$address} = $autodelete{$to}; } else { $autodelete{$address} = readlink "$address/\@AUTODELETE" || $autodelete; } if (my $locale = readlink "$address/\@LOCALE") { $locale{$address} = $locale; } elsif ($locale{$to}) { $locale{$address} = $locale{$to}; } else { $locale{$address} = $locale ; } unless ($locale{$address}) { $locale{$address} = $default_locale || 'english'; } if ($specific{'keep'}) { $keep{$address} = $specific{'keep'} } elsif ($keep{$to}) { $keep{$address} = $keep{$to} } } } else { $to = expand($to); $to{$to} = $to; # ignore dupes unless ($autodelete{$to}) { $autodelete{$to} = readlink "$to/\@AUTODELETE" || $autodelete; } $autodelete{$to} = $specific{'autodelete'} if $specific{'autodelete'}; $keep{$to} = $keep_default; $keep{$to} = $keep if $keep; $keep{$to} = untaint(readlink "$to/\@KEEP") if -l "$to/\@KEEP"; $keep{$to} = $specific{'keep'} if $specific{'keep'}; # recipient specific parameters $keep{$to} = $1 if $to =~ /:keep=(\d+)/i; $autodelete{$to} = $1 if $to =~ /:autodelete=(\w+)/i; } $autodelete{$to} = 'NO' if $to =~ /$amdl/; # mailing lists, etc if (-e "$to/\@CAPTIVE") { my $v; $v = readlink "$to/\@AUTODELETE" and $autodelete{$to} = $v; $v = readlink "$to/\@KEEP" and $keep{$to} = $v; } } @to = keys %to; if (scalar(@to) == 1) { $to = "@to"; $keep = $keep{$to} if $keep{$to}; $autodelete = $autodelete{$to} if $autodelete{$to}; } # check recipients and eliminate dupes %to = (); foreach $to (@to) { if ($to eq 'anonymous') { $to{$to} = $to; } else { if ($to =~ /^@(.+)/) { http_die("You cannot send to more than one group") if @to > 1; http_die("Group $to does not exist") unless -f "$from/\@GROUP/$1"; } else { if ($skey or $gkey or $okey or checkaddress($to)) { $to .= '@'.$mdomain if $mdomain and $to !~ /@/; $to{$to} = untaint($to); } else { http_die("$to is not a valid e-mail address"); } } } } @to = values %to; } foreach $to (@to) { unless (checkforbidden($to)) { http_die("$to is not allowed"); } } } # show the status progress bar sub showstatus { my $wclose; my ($upload,$data,$sfile,$ukey,$file); my ($nsize,$tsize); my ($t0,$t1,$t2,$tt,$ts,$tm); my ($osize,$percent,$npercent); local $_; $wclose = '

close'."\n". ''."\n"; $ukey = "$ukeydir/$uid"; $upload = "$ukey/upload"; $data = "$ukey/data"; $sfile = "$ukey/size"; for (1..$timeout) { sleep 1; $tsize = readlink $sfile and last; # upload error? # remark: stupid Internet Explorer *needs* the error represented in this # asynchronous popup window, because it cannot display the error in the # main window on HTTP POST! if (-f $ukey and open $ukey,'<',$ukey or -f "$ukey/error" and open $ukey,'<',"$ukey/error") { undef $/; unlink $ukey; html_error($error,<$ukey> || 'unknown'); } } # unlink $sfile; if (defined $tsize and $tsize == 0) { print "\n"; exit; } unless ($tsize) { html_error($error, "no file data received - does your file exist or is it >2GB?") } html_error($error,"file size unknown") unless $tsize =~ /^\d+$/; http_header('200 OK'); if (open $ukey,'<',"$ukey/filename") { local $/; $file = <$ukey>; close $ukey; } http_die("no filename?!") unless $file; my $ssize = $tsize; if ($ssize<2097152) { $ssize = sprintf "%d kB",int($ssize/1024); } else { $ssize = sprintf "%d MB",int($ssize/1048576); } pq(qq( "" "

" "

Upload Status for
$file ($ssize)

" '' "
" "" "
" "
" "
" )); # wait for upload file for (1..9) { last if -f $upload or -f $data; sleep 1; } unless (-f $upload or -f $data) { print "

ERROR: no upload received

\n"; print $wclose; exit; } $SIG{ALRM} = sub { die "TIMEOUT in showstatus: no (more) data received\n" }; alarm($timeout*2); $t0 = $t1 = time; $osize = $percent = $npercent = 0; for ($percent = 0; $percent<100; sleep(1)) { $t2 = time; $nsize = -s $upload; if (defined $nsize) { if ($nsize<$osize) { print "

ABORTED

\n"; print $wclose; exit; } if ($nsize>$osize) { alarm($timeout*2); $osize = $nsize; } $npercent = int($nsize*100/$tsize); $showsize = calcsize($tsize,$nsize); } else { $npercent = 100; $showsize = calcsize($tsize,$tsize); } # hint: for ISDN (or even slower) links, 5 s tcp delay is minimum # so, updating more often is contra-productive if ($t2>$t1+5 or $npercent>$percent) { $percent = $npercent; $t1 = $t2; $tm = int(($t2-$t0)/60); $ts = $t2-$t0-$tm*60; $tt = sprintf("%d:%02d",$tm,$ts); pq(qq( "" )) or last; } } alarm(0); if ($npercent == 100) { print "

file successfully transferred

\n"; } else { print "

file transfer aborted

\n"; } pq(qq( "" )); print $wclose; unlink $ukey; exit; } # get file from post request sub get_file { my ($to,$filed,$upload,$nupload,$speed,$download); my ($b,$n,$uss); my $dkey; my ($fh,$filesize); my ($t0,$tt); my $fb = 0; # file bytes my $ebl = 0; # end boundary length # FUP, not JUP if ($boundary) { $ebl = length($boundary)+8; # 8: 2 * CRLF + 2 * "--" } unless ($nostore) { # download already in progress? foreach $to (@to) { $to =~ s/:\w+=.*//; # remove options from address $filed = "$to/$from/$fkey"; $download = "$filed/download"; if (-f $download and open $download,'>>',$download) { flock($download,LOCK_EX|LOCK_NB) or http_die("$filed locked: a download is currently in progress"); } } # prepare upload foreach $to (@to) { $to =~ s/:\w+=.*//; # remove options from address $filed = "$to/$from/$fkey"; $nupload = "$filed/upload"; # upload for next recipient mkdirp($filed); # upload already prepared (for first recipient)? if ($upload) { # link upload for next recipient unless ($upload eq $nupload or -r $upload and -r $nupload and (stat $upload)[1] == (stat $nupload)[1]) { unlink $nupload; link $upload,$nupload; } } # first recipient => create upload else { $upload = $nupload; unlink "$ukeydir/$uid"; if ($flink) { if ($seek) { http_die("cannot resume on link upload"); } &nvt_read and $flink = $_; if ($flink !~ /^\//) { http_die("no file link name ($flink)"); } $flink = abs_path($flink); my $fok; foreach (@file_link_dirs) { my $dir = abs_path($_); $fok = $flink if $flink =~ /^\Q$dir\//; } unless ($fok) { http_die("$flink not allowed for linking"); } my @s = stat($flink); unless (@s and ($s[2] & S_IROTH) and -r $flink) { http_die("cannot read $flink"); } unless (-f $flink and not -l $flink) { http_die("$flink is not a regular file"); } # http_die("DEBUG: flink = $flink"); &nvt_read; &nvt_read if /^$/; unless (/^--\Q$boundary--/) { http_die("found no MIME end boundary in upload ($_)"); } unlink $upload; symlink untaint($flink),$upload; } else { unlink $upload if -l $upload; open $upload,'>>',$upload or http_die("cannot write $upload - $!"); flock($upload,LOCK_EX|LOCK_NB) or http_die("$file locked: a transfer is already in progress"); unless ($seek) { seek $upload,0,0; truncate $upload,0; } # already uploaded file data size $uss = -s $upload; # provide upload ID symlink for showstatus symlink "../$filed","$ukeydir/$uid"; } } unlink "$filed/autodelete", "$filed/error", "$filed/restrictions", "$filed/locale", "$filed/keep", "$filed/header", "$filed/id", "$filed/ip", "$filed/speed", "$filed/replyto", "$filed/useragent", "$filed/uurl", "$filed/comment", "$filed/notify"; unlink "$filed/size" unless $seek; # showstatus needs file name and size # fexsend needs full file size (+$seek) $fh = "$filed/filename"; open $fh,'>',$fh or die "cannot write $fh - $!\n"; print {$fh} $filename; close $fh; if ($::filesize > 0 or $cl > 0) { if ($::filesize > 0) { $filesize = $fpsize || $::filesize } else { $filesize = $cl-$RB-$ebl+$seek } # new file unless ($seek) { if ($::filesize > 0) { # total file size as reported by POST mksymlink("$filed/size",$::filesize) or die "cannot write $filed/size - $!\n"; } else { # file size as counted mksymlink("$filed/size",$filesize) or die "cannot write $filed/size - $!\n"; } } } if ($from eq "@to") { # special "fex yourself" mksymlink("$filed/autodelete",'NO'); } else { $autodelete{$to} = $autodelete unless $autodelete{$to}; if ($autodelete{$to} =~ /^(DELAY|NO|\d+)$/i) { mksymlink("$filed/autodelete",$autodelete{$to}); } } if (my $keep = $keep{$to} || $::keep) { mksymlink("$filed/keep",$keep); } mksymlink("$filed/id",$fileid) if $fileid; mksymlink("$filed/ip",$ra) if $ra; if (my $uurl = $ENV{REQUEST_URL}) { mksymlink("$filed/uurl",$uurl); } 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",$_); } elsif ($locale{$to}) { mksymlink("$filed/locale",$locale{$to}); } 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) { copy($arh,"$filed/restrictions"); } if (@header and open $fh,'>',"$filed/header") { print {$fh} join("\n",@header),"\n"; close $fh; } if ((readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) { $nomail{$to} = 'NOTIFICATION'; } if ($nomail) { open $fh,'>',"$filed/notify" and close $fh; } if ($comment) { if (open $fh,'>',"$filed/comment") { print {$fh} encode_utf8($comment); close $fh; } } # provide download ID key unless ($dkey = readlink("$filed/dkey") and -l "$dkeydir/$dkey") { $dkey = randstring(8); unlink "$dkeydir/$dkey"; symlink "../$filed","$dkeydir/$dkey" or http_die("cannot symlink $dkeydir/$dkey ($!)"); unlink "$filed/dkey"; symlink $dkey,"$filed/dkey"; } } # extra download (XKEY)? if ($anonymous and $fkey =~ /^afex_\d/ or $from eq "@to" and $comment =~ s:^//(.*)$:NOMAIL:) { $xkey = $1||$fkey; $nomail = $comment; my $x = "$xkeydir/$xkey"; unless (-l $x and readlink($x) eq "../$from/$from/$fkey") { if (-e $x) { http_die("extra download key $xkey already exists"); } symlink "../$from/$from/$fkey",$x or http_die("cannot symlink $x - $!\n"); unlink "$x/xkey"; symlink $xkey,"$x/xkey"; } } } # file link? if ($flink) { # upload link has been already created, no data to read any more $to = join(',',@to); fuplog($to,$fkey,0); debuglog("upload link successfull, dkey=$dkey"); } # regular file else { # at last, read (real) file data $t0 = time(); # streaming data? if ($cl == -1) { alarm($timeout*2); # read until EOF, including MIME end boundary # note: cannot use sysread because of previous buffered read! while ($n = read(STDIN,$_,$bs)) { $RB += $n; $fb += $n; syswrite $upload,$_ unless $nostore; alarm($timeout*2); } # size of transferred file, without end boundary $ndata = untaint($fb-$ebl); } # normal file with known file size else { if ($fpsize) { debuglog(sprintf("still awaiting %d+%d = %d bytes", $fpsize,$ebl,$fpsize+$ebl)); $cl = $RB+$fpsize+$ebl; # recalculate CONTENT_LENGTH } else { if ($::filesize) { $cl = $RB+$::filesize+$ebl; # recalculate CONTENT_LENGTH } debuglog(sprintf("still awaiting %d-%d = %d bytes", $cl,$RB,$cl-$RB)); } # read until end boundary, not EOF while ($RB < $cl-$ebl) { $b = $cl-$ebl-$RB; $b = $bs if $b > $bs; # max wait for 1 kB/s, but at least 10 s # $timeout = $b/1024; # $timeout = 10 if $timeout < 10; alarm($timeout); if ($n = read(STDIN,$_,$b)) { $RB += $n; $fb += $n; # syswrite is much faster than print syswrite $upload,$_ unless $nostore; if ($bwlimit) { alarm(0); $tt = (time-$t0) || 1; while ($RB/$tt/1024 > $bwlimit) { sleep 1; $tt = time-$t0; } } # debuglog($_); } else { last; } } # read end boundary - F*IX is broken! if ($ebl and $http_client !~ /F\*IX/) { $_ = ; $_ = ||''; unless (/^--\Q$boundary--/) { http_die("found no MIME end boundary in upload ($_)"); } } $RB += $ebl; $ndata = untaint($fb); } alarm(0); unless ($nostore) { close $upload; # or die "cannot close $upload - $!\n";; # throuput in kB/s $tt = (time-$t0) || 1; mksymlink("$filed/speed",int($fb/1024/$tt)); unless ($ndata) { http_die( "No file data received!". " File name correct?". " File too big (browser-limit: 2 GB!)?" ); } $to = join(',',@to); # streaming upload? if ($cl == -1) { open $upload,'<',$upload or http_die("internal error - cannot read upload"); seek $upload,$ndata+2,0; $_ = <$upload>||''; unless (/^--\Q$boundary--/) { http_die("found no MIME end boundary in upload ($_)"); } close $upload; truncate $upload,$ndata; } else { # truncate boundary string # truncate $upload,$ndata+$uss if -s $upload > $ndata+$uss; # incomplete? if ($cl != $RB) { fuplog($to,$fkey,$ndata,'(aborted)'); if ($fpsize) { http_die("read $RB bytes, but Content-Length announces $fpsize bytes"); } else { http_die("read $RB bytes, but CONTENT_LENGTH announces $cl bytes"); } } # multipost, not complete if ($::filesize > -s $upload) { http_header('206 Partial OK'); exit; } # save error? if (-s $upload > ($::filesize||$filesize)) { fuplog($to,$fkey,$ndata,'(write error: upload > filesize)'); http_die("internal server error while writing file data"); } } fuplog($to,$fkey,$ndata); debuglog("upload successfull, dkey=$dkey"); } } } # check recipients restriction sub check_rr { my $from = shift; my @to = @_; my $rr = "$from/\@ALLOWED_RECIPIENTS"; my ($allowed,$to,$ar,$rd); if (-s $rr and open $rr,'<',$rr) { $restricted = $rr; foreach (@to) { my $to = $_; $allowed = 0; seek $rr,0,0; while (<$rr>) { chomp; s/#.*//; s/\s//g; if (/^\@LOCAL_RDOMAINS/) { $ar = '(@'; foreach (@local_rdomains) { my $rd = $_; # allow wildcard *, but not regexps $rd =~ s/\./\\./g; $rd =~ s/\*/[\\w.-]+/g; $ar .= '|[^\@]+\@' . $rd; } $ar .= ')'; } else { # allow wildcard *, but not regexps $ar = quotemeta $_; $ar =~ s/\\\*/[^@]*/g; } if ($to =~ /^$ar$/i) { $allowed = 1; last; } } unless ($allowed) { fuplog("ERROR: $from not allowed to fex to $to"); debuglog("$to not in $spooldir/$from/\@ALLOWED_RECIPIENTS"); http_die("You ($from) are not allowed to fex to $to"); } } close $rr; } } # add domain to user if necessary sub expand { my @users = @_; my @ua; foreach my $u (my @loop = @users) { if ($u =~ /^anonymous(_\d+)?$/) { $u = "$u\@$hostname"; } if ($u eq 'nettest') { 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" } elsif (-d "$u\@$hostname") { push @ua,"$u\@$hostname" } else { push @ua,$u } } return wantarray ? @ua : join(',',@ua); } # forward-copy (bounce) an already uploaded file sub forward { my $file = shift; my ($nfile,$to,$AB); my ($filename); my (%to); http_die("no file data for $file") unless -f "$file/data"; if (@to) { # check recipients restriction check_rr($from,@to); # read aliases from address book if (open $AB,'<',"$from/\@ADDRESS_BOOK") { while (<$AB>) { s/#.*//; $_ = lc $_; if (s/^\s*(\S+)[=\s]+(\S+)//) { my ($alias,$address) = ($1,$2); foreach my $address (split(",",$address)) { $address .= '@'.$mdomain if $mdomain and $address !~ /@/; push @{$ab{$alias}},$address; } } } close $AB; } # collect addresses foreach my $to (my @loop = @to) { if ($ab{$to}) { foreach my $address (@{$ab{$to}}) { $to{$address} = $address; } } else { $to .= '@'.$mdomain if $mdomain and $to !~ /@/; $to{$to} = $to; } } http_header('200 OK'); print html_header($head); @to = keys %to; foreach my $to (my @loop = @to) { $to =~ s/:\w+=.*//; # remove options from address $nfile = $file; $nfile =~ s:.*?/:$to/:; next if $nfile eq $file; mkdirp($nfile); http_die("cannot create directory $nfile") unless -d $nfile; unlink "$nfile/data", "$nfile/upload", "$nfile/download", "$nfile/autodelete", "$nfile/error", "$nfile/restrictions", "$nfile/keep", "$nfile/header", "$nfile/id", "$nfile/speed", "$nfile/comment", "$nfile/replyto", "$nfile/notify"; if ($comment) { open $comment,'>',"$nfile/comment"; print {$comment} $comment; close $comment; } if ($autodelete =~ /^(DELAY|NO|\d+)$/i) { symlink($autodelete,"$nfile/autodelete"); } symlink($keep||$keep_default, "$nfile/keep"); copy("$file/id", "$nfile/id"); copy("$file/ip", "$nfile/ip"); 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 http_die("cannot symlink $dkeydir/$dkey"); unlink "$nfile/dkey"; symlink $dkey,"$nfile/dkey" or http_die("cannot create $nfile/dkey - $!"); } if ($nomail or $nomail{$to}) { if ($filename) { my $url = "$durl/$dkey/".normalize_filename($filename); pq(qq( 'Download-URL for $to:
' '$url' '

' )); } } else { notify_locale($dkey,'new'); fuplog($to,urlencode($filename),"(forwarded)"); if ($filename) { pq(qq( 'File "$filename" copy-forwarded to $to and notified.' '

' )); } } } pq(qq( 'back to F*EX operation control' '' )); } else { $filename = filename($file); http_header('200 OK'); print html_header($head); pq(qq( '

' ' ' ' ' ' ' ' forward a copy of "$filename" to:
' ' ' '
' '' )); } } # modify file parameter sub modify { my $file = shift; my $filename = filename($file); my $dkey = readlink "$file/$dkey"; my $to; my @parameter; http_die("no file data for $file") unless -f "$file/data"; $to = $file; $to =~ s:/.*::; if ($specific{'keep'}) { mksymlink("$file/keep",$keep); utime time,time,"$file/filename"; push @parameter,'KEEP'; } if ($specific{'autodelete'}) { mksymlink("$file/autodelete",$autodelete); push @parameter,'AUTODELETE'; } if ($comment) { if (open $comment,'>',"$file/comment") { print {$comment} $comment; close $comment; } notify_locale($dkey,'new'); push @parameter,'COMMENT'; } http_header('200 OK'); print "Parameter ".join(',',@parameter)." modified for $filename for $to\n"; } sub calcsize { my ($tsize,$nsize) = @_; if ($tsize<2097152) { return sprintf "%d kB",int($nsize/1024); } else { return sprintf "%d MB",int($nsize/1048576); } } # set parameter variables sub setparam { my ($v,$vv) = @_; my ($idf,$to); $v = uc(despace($v)); # if ($vv =~ /([<>])/) { # http_die(sprintf("\"&#%s;\" is not allowed in parameter $v",ord($1))); # } $param{$v} = $vv; if ($v eq 'LOGOUT') { $logout = $v; # skey and gkey are persistant! $akey = $1 if $ENV{QUERY_STRING} =~ /AKEY:(\w+)/i; unlink "$akeydir/$akey"; $login = $FEXHOME.'/cgi-bin/login'; if (-x $login) { $login = readlink $login || 'login'; nvt_print( "HTTP/1.1 302 Found", "Location: $ENV{PROTO}://$ENV{HTTP_HOST}/$login", 'Content-Length: 0', "" ); } else { nvt_print( "HTTP/1.1 302 Found", "Location: $ENV{PROTO}://$ENV{HTTP_HOST}/fup", 'Content-Length: 0', "" ); } &reexec; } elsif ($v eq 'LOCALE' and $vv =~ /^(\w+)$/) { $locale = $1; } elsif ($v eq 'REDIRECT' and $vv =~ /^([\w?=]+)$/) { $redirect = $1; } elsif (($v eq 'KEY' or $v eq 'SKEY') and $vv =~ /^([\w:]+)$/) { $skey = $1; $restricted = $v; } elsif ($v eq 'GKEY' and $vv =~ /^([\w:]+)$/) { $gkey = $1 unless $nomail; $restricted = $v; } elsif ($v eq 'DKEY' and $vv =~ /^(\w+)$/) { $dkey = $1; } elsif ($v eq 'AKEY' and $vv =~ /^(\w+)$/) { $akey = $1; } elsif ($v eq 'FROM' or $v eq 'USER') { $from = normalize_email($vv); $from = untaint(expand($from)); checkchars('from address',$from); # maybe FROM=SUBUSER ! # checkaddress($from) or http_die("FROM $from is no legal e-mail address"); } elsif ($v eq 'REPLYTO') { $replyto = normalize_email($vv); checkchars('replyto address',$replyto); checkaddress($replyto) or http_die("REPLYTO $replyto is no legal e-mail address"); } elsif ($v eq 'ADDTO') { $vv =~ s/\s.*//; $addto = normalize_email($vv); } elsif ($v eq 'SUBMIT') { $submit = decode_utf8(normalize($vv)); } elsif ($v eq 'FEXYOURSELF') { $submit = $vv; @to = ($from); } elsif ($v eq 'TO') { # extract AUTODELETE and KEEP options if ($vv =~ s/[\s,]+AUTODELETE=(\w+)//i) { $specific{'autodelete'} = $autodelete = uc($1); } if ($vv =~ s/[\s,]+KEEP=(\d+)//i) { $keep = $1; $keep = $keep_max if $keep_max and $keep > $keep_max; $specific{'keep'} = $keep; } $to = normalize(lc($vv)); $to =~ s/[\n\s;,]+/,/g; if ($from) { if ($to eq '.') { $to = $from; } if ($to eq '//') { $to = $from; $comment = '//'; } } checkchars('to address',$to); push @to,split(',',$to); } elsif ($v eq 'ID') { $id = despace($vv); checkchars('auth-ID',$id); } elsif ($v eq 'TCE') { $test = despace($vv); } elsif ($v eq 'OKEY' and $vv =~ /^(\w+)$/) { $okey = $1; $restricted = $v; } elsif ($v eq 'FILEID' and $vv =~ /^(\w+)$/) { $fileid = $1; } elsif ($v eq 'CONTENTLENGTH' and $vv =~ /^(\d+)$/) { $contentlength = $1; } elsif ($v eq 'FILE' or $v eq 'FILENAME') { $file = strip_path(normalize($vv)); } elsif ($v eq 'UID' and $vv =~ /^(\w+)$/) { $uid = $1; } elsif ($v eq 'ID_FORGOTTEN') { $id_forgotten = $vv; } elsif ($v eq 'SHOWSTATUS' and $vv =~ /^(\w+)$/) { $showstatus = $uid = $1; } elsif ($v eq 'COMMENT') { $comment = decode_utf8(normalize($vv)); $comment =~ s/^\s*!\.!/!SHORTMAIL!/; $comment =~ s/^!#!/!NOMAIL!/; $comment =~ s/^!-!/!NOSTORE!/; $nomail = $comment if $comment =~ /NOMAIL/; $nostore = $nomail = $comment if $comment =~ /NOSTORE/; $bcc .= " $from" if $comment =~ s/\s*!bcc!?\s*//i; # backward compatibility foreach my $cmd (qw( DELETE LIST CHECKQUOTA CHECKRECIPIENT RECEIVEDLOG SENDLOG FOPLOG FORWARD )) { $command = $comment if $comment eq $cmd } } elsif ($v eq 'COMMAND') { $command = normalize($vv); } elsif ($v eq 'BWLIMIT' and $vv =~ /^(\d+)$/) { $bwlimit = $1; } elsif ($v eq 'SEEK' and $vv =~ /^(\d+)$/) { $seek = $1; } elsif ($v eq 'FILESIZE' and $vv =~ /^(\d+)$/) { $filesize = $1; # complete filesize! &check_space($filesize-$seek); } elsif ($v eq 'AUTODELETE' and $vv =~ /^(\w+)$/) { $specific{'autodelete'} = $autodelete = uc($1); } elsif ($v eq 'KEEP' and $vv =~ /^(\d+)$/) { $keep = $1; $keep = $keep_max if $keep_max and $keep > $keep_max; $specific{'keep'} = $keep; } elsif ($v eq 'TIMEOUT' and $vv =~ /^(\d+)$/) { $specific{'timeout'} = $timeout = $1; } } sub id_forgotten { my ($id,$to,$subuser,$gm,$skey,$gkey,$url,$fup); return if $nomail; $fup = $durl; $fup =~ s:/fop:/fup:; # full user if (open $from,'<',"$from/\@") { $id = getline($from); close $from; } if ($id) { $url = "$fup/".b64("from=$from&id=$id"); mail_forgotten($from,qqq(qq( 'Your reqested F*EX auth-ID for $fup?from=$from is:' '$id' '' 'Or use:' '$url' ))); exit; } # sub user foreach my $skey (glob("$skeydir/*")) { if (-f $skey and open $skey,'<',$skey) { while (<$skey>) { $_ = lc; if (/^(\w+)=(.+)/) { $subuser = $2 if $1 eq 'from'; $to = $2 if $1 eq 'to'; } } close $skey; } if ($from and $to and $from eq $subuser) { $skey =~ s:.*/::; mail_forgotten($subuser,qqq(qq( 'Your reqested F*EX login is:' '' '$fup?skey=$skey' ))); exit; } } # group user foreach my $gkey (glob("$gkeydir/*")) { if (-f $gkey and open $gkey,'<',$gkey) { while (<$gkey>) { $_ = lc; if (/^(\w+)=(.+)/) { $gm = $2 if $1 eq 'from'; $to = $2 if $1 eq 'to'; } } close $gkey; } if ($gm and $to and $from eq $gm) { $gkey =~ s:.*/::; mail_forgotten($gm,qqq(qq( 'Your reqested F*EX login is:' '' '$fup?gkey=$gkey' ))); exit; } } http_die("$from is not a F*EX user on this server"); } sub mail_forgotten { my $user = shift; my @msg = @_; local *P; return if $nomail; open P,'|-',$sendmail,$user,$bcc or http_die("cannot start sendmail - $!\n"); pq(P,qq( 'From: $admin' 'To: $user' 'Subject: F*EX service $hostname' 'X-Mailer: F*EX' '' )); print P @msg; close P or http_die("cannot send mail - $!\n"); http_header('200 OK'); print html_header($head); print "

Mail has been sent to you ($from)

\n"; print "\n"; } # lookup akey, skey and gkey (full and sub user and group) sub check_keys { # only one key can be valid $akey = $gkey = '' if $skey; $akey = $skey = '' if $gkey; if ($skey) { # encrypted SKEY? if ($skey =~ s/^MD5H:(.+)/$1/) { # search real SKEY foreach my $s (glob "$skeydir/*") { $s =~ s:.*/::; if ($skey eq md5_hex($s.$sid)) { $skey = $s; last; } } } if (open $skey,'<',"$skeydir/$skey") { $akey = $gkey = ''; while (<$skey>) { if (/^(\w+)=(.+)/) { $from = $2 if lc($1) eq 'from'; @to = ($muser = $2) if lc($1) eq 'to'; $rid = $id = $2 if lc($1) eq 'id'; } } close $skey; } else { # $skey = ''; http_die("invalid SKEY $skey"); } } if ($gkey) { # encrypted GKEY? if ($gkey =~ s/^MD5H:(.+)/$1/) { # search real GKEY foreach my $g (glob "$gkeydir/*") { $g =~ s:.*/::; if ($gkey eq md5_hex($g.$sid)) { $gkey = $g; last; } } } if (open $gkey,'<',"$gkeydir/$gkey") { $akey = $skey = ''; while (<$gkey>) { if (/^(\w+)=(.+)/) { $from = $2 if lc($1) eq 'from'; $to = $muser = $2 if lc($1) eq 'to'; $rid = $id = $2 if lc($1) eq 'id'; # $user = $2 if lc($1) eq 'user'; } } close $gkey; @to = ($to); } else { # $gkey = ''; http_die("invalid GKEY $gkey"); } } if ($akey and not $id) { my $idf; # sid is not set with web browser # akey with sid is set with schwuppdiwupp & co $idf = "$akeydir/$akey/@"; if (open $idf,'<',$idf and $id = getline($idf)) { close $idf; $from = readlink "$akeydir/$akey" or http_die("internal server error: no $akey symlink"); $from =~ s:.*/::; $from = untaint($from); if ($akey ne md5_hex("$from:$id")) { $from = $id = ''; } } else { $akey = ''; } } } # check if there is enough space on spool sub check_space { my $req = shift; my ($df,$free,$uprq); local *P; if (open $df,"df -k $spooldir|") { while (<$df>) { if (/^.+?\s+\d+\s+\d+\s+(\d+)/ and $req/1024 > $1) { $free = int($1/1024); $uprq = int($req/$MB); if (not $nomail and open P,"|$sendmail -t") { pq(P,qq( 'From: $admin' 'To: $admin' 'Subject: F*EX spool out of space' '' 'F*EX spool $spooldir on $ENV{SERVER_NAME} is out of space.' '' 'Current free space: $free MB' 'Upload request: $uprq MB' )); close P; } debuglog("aborting because not enough free space in spool ($free MB)"); http_die("not enough free space for this upload"); } } close $df; } } # global substitution as a function like in gawk sub gsub { local $_ = shift; my ($p,$r) = @_; s/$p/$r/g; return $_; } # standard log sub fuplog { my $msg = "@_"; $msg =~ s/\n/ /g; $msg =~ s/\s+$//; $msg = sprintf "%s [%s_%s] %s (%s) %s\n", isodate(time),$$,$ENV{REQUESTCOUNT},$from,$fra,$msg; writelog($log,$msg); } sub sigdie { local $_ = shift; chomp; sigexit('DIE',$_); } sub sigexit { my ($sig) = @_; my $msg; my $to = join(',',@to); $SIG{__DIE__} = 'DEFAULT'; foreach (keys %SIG) { $SIG{$_} = 'DEFAULT' } $msg = @_ ? "@_" : '???'; $msg =~ s/\n/ /g; $msg =~ s/\s+$//; $msg = sprintf "%s %s (%s) %s %s caught SIGNAL %s %s\n", isodate(time), $from||'-', $fra||'-', $to||'-', encode_Q($file||'-'), $msg, $RB?"(after $RB bytes)":""; writelog($log,$msg); if ($sig eq 'DIE') { shift; die "$msg\n"; } else { die "SIGNAL $msg\n"; } } sub present_locales { my $url = shift; my @locales = @::locales; # from fex.ph my ($locale,$lang); if ($url =~ /\?/) { $url .= "&"; $url =~ s/locale=\w+&//g; } else { $url .= "?"; } if (@locales) { map { $_ = "$FEXHOME/locale/$_" } @locales; } else { @locales = glob "$FEXHOME/locale/*"; } if (@locales > 1) { print "

"; foreach my $locale (my @loop = @locales) { if (-x "$locale/cgi-bin/fup") { $lang = "$locale/lang.html"; $locale =~ s:.*/::; if (open $lang,'<',$lang and $lang = getline($lang)) { close $lang; } else { $lang = $locale; } print "$lang "; } } print "

\n"; } } sub check_camel { my ($logo,$camel); local $/; if (open $logo,"$docdir/logo.jpg") { $camel = md5_hex(<$logo>) eq 'ad8a95bba8dd1a61d70bd38611bc2059'; } if ($camel and open $logo,"$docdir/action-fex-camel.gif") { $camel = md5_hex(<$logo>) eq '1f3d7acc70377496f95c5adddaf4ca7b'; } http_die("Missing camel") unless $camel; }