Original release 20150615

author fextracker <fextracker@treefish.org>

Tue, 16 Jun 2015 20:08:16 +0000 (22:08 +0200)

committer fextracker <fextracker@treefish.org>

Tue, 16 Jun 2015 20:08:16 +0000 (22:08 +0200)
author fextracker <fextracker@treefish.org>
Tue, 16 Jun 2015 20:08:16 +0000 (22:08 +0200)
committer fextracker <fextracker@treefish.org>
Tue, 16 Jun 2015 20:08:16 +0000 (22:08 +0200)
diff --git a/bin/fac b/bin/fac

index 0946704adbcb94c0ba54b6f011d5ef7c4a7aa7e1..cec687a3b81023d28153ea712c3a0ed157aaf0e7 100755 (executable)
--- a/bin/fac
+++ b/bin/fac
@@ -43,7 +43,7 @@ unless ($<) {
  umask 077;
  
  # import from fex.pp
  umask 077;
  
  # import from fex.pp
-our ($FEXHOME,$FHS,$hostname,$spooldir,$logdir,$akeydir,$docdir);
+our ($FEXHOME,$FHS,$hostname,$spooldir,@logdir,$akeydir,$docdir);
  our ($durl,@durl,$mdomain,$admin,$mailmode);
  our ($autodelete,$keep_default,$keep_max,$recipient_quota,$sender_quota);
  our (@local_rdomains);
  our ($durl,@durl,$mdomain,$admin,$mailmode);
  our ($autodelete,$keep_default,$keep_max,$recipient_quota,$sender_quota);
  our (@local_rdomains);
@@ -198,7 +198,7 @@ if ($opt_M) {
  
  # show logfile
  if ($opt_w) {
  
  # show logfile
  if ($opt_w) {
-  $log = "$logdir/fexsrv.log";
+  $log = $logdir[0]."/fexsrv.log";
    warn "$0: polling $log\n\n";
    exec "$FEXHOME/bin/logwatch",$log;
    die "$0: logwatch not found\n";
    warn "$0: polling $log\n\n";
    exec "$FEXHOME/bin/logwatch",$log;
    die "$0: logwatch not found\n";
@@ -401,10 +401,10 @@ if ($opt_A) {
  }
  
  # show config
  }
  
  # show config
-if ($opt_v) {
+if ($opt_v and not @ARGV) {
    print  "config from $FEXLIB/fex.ph :\n";
    print  "  spooldir        = $spooldir\n";
    print  "config from $FEXLIB/fex.ph :\n";
    print  "  spooldir        = $spooldir\n";
-  print  "  logdir          = $logdir\n";
+  print  "  logdir          = @logdir\n";
    print  "  docdir          = $docdir\n";
    print  "  durl            = @durl\n";
    print  "  admin           = $admin\n";
    print  "  docdir          = $docdir\n";
    print  "  durl            = @durl\n";
    print  "  admin           = $admin\n";
@@ -433,26 +433,27 @@ if ($opt_v) {
  
  # add user or show user config
  if ($opt_u) {
  
  # add user or show user config
  if ($opt_u) {
+  chdir $spooldir or die "$0: cannot chdir $spooldir = $!\n";
    if ($opt_u = shift @ARGV) {
      $user = lc $opt_u;
      $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
      $id = shift @ARGV;
    if ($opt_u = shift @ARGV) {
      $user = lc $opt_u;
      $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
      $id = shift @ARGV;
-    $idf = "$spooldir/$user/@";
+    $idf = "$user/@";
      if (open $idf,$idf) {
        chomp($ido = <$idf>||'');
        close $idf;
      }
      unless ($id) {
      if (open $idf,$idf) {
        chomp($ido = <$idf>||'');
        close $idf;
      }
      unless ($id) {
-      die "$0: $user is not a FEX user\n" unless -f "$spooldir/$user/@";
+      die "$0: $user is not a regular FEX user\n" unless -f "$user/@";
        showuser($user,$ido);
        exit;
      }
      unless ($user =~ /\w@[\w.-]+\.[a-z]+$/) {
        die "$0: $user is not a valid email-address!\n";
      }
        showuser($user,$ido);
        exit;
      }
      unless ($user =~ /\w@[\w.-]+\.[a-z]+$/) {
        die "$0: $user is not a valid email-address!\n";
      }
-    unless (-d "$spooldir/$user") {
-      mkdir "$spooldir/$user",0755
-        or die "$0: cannot mkdir $spooldir/$user - $!\n";
+    unless (-d $user) {
+      mkdir $user,0755
+        or die "$0: cannot mkdir $user - $!\n";
      }
      open F,">$idf" or die "$0: cannot write $idf - $!\n";
      print F $id,"\n";
      }
      open F,">$idf" or die "$0: cannot write $idf - $!\n";
      print F $id,"\n";
@@ -460,7 +461,7 @@ if ($opt_u) {
      showuser($user,$id);
    } else {
      print "Users in $spooldir:\n";
      showuser($user,$id);
    } else {
      print "Users in $spooldir:\n";
-    foreach $user (glob "$spooldir/*/@") {
+    foreach $user (glob "*/@") {
        $user =~ s:.*/(.+)/@:$1:;
        print "$user\n";
      }
        $user =~ s:.*/(.+)/@:$1:;
        print "$user\n";
      }
@@ -533,7 +534,7 @@ if ($opt_q) {
    $user = lc $opt_q;
    $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
    unless (-d "$spooldir/$user") {
    $user = lc $opt_q;
    $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
    unless (-d "$spooldir/$user") {
-    die "$0: $user is not a regular FEX user\n";
+    die "$0: $user is not a FEX user\n";
    }
    quota($user,@ARGV);
    exit;
    }
    quota($user,@ARGV);
    exit;
@@ -637,7 +638,7 @@ usage(3);
  sub showuser {
    my $user = shift;
    my $id = shift;
  sub showuser {
    my $user = shift;
    my $id = shift;
-  my ($keep,$autodelete,$notification);
+  my ($keep,$autodelete,$notification,$login);
  
    $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  
  
    $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  
@@ -646,6 +647,14 @@ sub showuser {
    printf "%s/%s\n",$fup,b64("from=$user&id=$id");
    # printf "%s/%s\n",$fup,b64("from=$user&to=$user&id=$id&submit=.");
    print "spool: $spooldir/$user/\n";
    printf "%s/%s\n",$fup,b64("from=$user&id=$id");
    # printf "%s/%s\n",$fup,b64("from=$user&to=$user&id=$id&submit=.");
    print "spool: $spooldir/$user/\n";
+  if ($login_check and $login = readlink "$user/.login") {
+    my $lc = &$login_check($login);
+    if ($lc) {
+      print "login: $login\n";
+    } else {
+      print "login: DELETED\n";
+    }
+  }
    printf "fex yourself web default: %s\n",
           -e "$spooldir/$user/\@FEXYOURSELF" ? 'yes' : 'no';
    printf "persistent: %s\n",
    printf "fex yourself web default: %s\n",
           -e "$spooldir/$user/\@FEXYOURSELF" ? 'yes' : 'no';
    printf "persistent: %s\n",
@@ -712,7 +721,7 @@ sub fupstat {
    my ($log,$u,$d,$z);
    my $Z = 0;
  
    my ($log,$u,$d,$z);
    my $Z = 0;
  
-  if (-t) { $log = "$logdir/fup.log" }
+  if (-t) { $log = $logdir[0].'/fup.log' }
    else    { $log = '>&=STDIN' }
    open $log,$log or die "$0: cannot open $log - $!\n";
  
    else    { $log = '>&=STDIN' }
    open $log,$log or die "$0: cannot open $log - $!\n";
  
@@ -749,7 +758,7 @@ sub fopstat {
    my ($log,$u,$d,$z);
    my (%user,%domain,%du);
  
    my ($log,$u,$d,$z);
    my (%user,%domain,%du);
  
-  if (-t) { $log = "$logdir/fop.log" }
+  if (-t) { $log = $logdir[0].'/fop.log' }
    else    { $log = '>&=STDIN' }
    open $log,$log or die "$0: cannot open $log - $!\n";
  
    else    { $log = '>&=STDIN' }
    open $log,$log or die "$0: cannot open $log - $!\n";
  
@@ -789,11 +798,6 @@ sub cpa {
  }
  
  
  }
  
  
-sub mtime {
-  my @s = lstat shift;
-  return @s ? $s[9] : undef;
-}
-
  sub check_admin {
    
    my $admin_id = slurp("$spooldir/$admin/@") or
  sub check_admin {
    
    my $admin_id = slurp("$spooldir/$admin/@") or
diff --git a/bin/fbm b/bin/fbm

index b33fd6f2fae91dc6c32513a38ada4aaaeb2fa73d..1750641109ba0911aa3a19563a000916c839ff3f 100755 (executable)
--- a/bin/fbm
+++ b/bin/fbm
@@ -20,7 +20,7 @@ use constant M => 2**20;
  
  our ($SH,$windoof,$sigpipe,$useragent);
  our ($FEXSERVER);
  
  our ($SH,$windoof,$sigpipe,$useragent);
  our ($FEXSERVER);
-our $version = 20150120;
+our $version = 20150615;
  
  # server defaults
  my $server = 'fex.rus.uni-stuttgart.de';
  
  # server defaults
  my $server = 'fex.rus.uni-stuttgart.de';
diff --git a/bin/fex_cleanup b/bin/fex_cleanup

index c54b2e0d832852ecbb121fa5b17290a9c3361498..1adec4e4fd6f0f269e40976b808e4e0ef64bf0fb 100755 (executable)
--- a/bin/fex_cleanup
+++ b/bin/fex_cleanup
@@ -38,7 +38,7 @@ $| = 1;
  
  # use fex.ph for site configuration!
  our ($FEXHOME);
  
  # use fex.ph for site configuration!
  our ($FEXHOME);
-our ($spooldir,$logdir,$docdir);
+our ($spooldir,@logdir,$docdir);
  our ($akeydir,$ukeydir,$dkeydir,$skeydir,$gkeydir,$xkeydir,$lockdir);
  our ($durl,$debug,$autodelete,$hostname,$admin,$admin_pw,$bcc);
  $keep_default = 5;
  our ($akeydir,$ukeydir,$dkeydir,$skeydir,$gkeydir,$xkeydir,$lockdir);
  our ($durl,$debug,$autodelete,$hostname,$admin,$admin_pw,$bcc);
  $keep_default = 5;
@@ -46,6 +46,8 @@ $keep_default = 5;
  # load common code, local config : $HOME/lib/fex.ph
  require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
  
  # load common code, local config : $HOME/lib/fex.ph
  require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
  
+my $logdir = $logdir[0];
+
  # localized functions 
  # (needed for reminder and account reactivation e-mails)
  foreach my $lf (glob "$FEXHOME/locale/*/lib/lf.pl") { require $lf }
  # localized functions 
  # (needed for reminder and account reactivation e-mails)
  foreach my $lf (glob "$FEXHOME/locale/*/lib/lf.pl") { require $lf }
@@ -64,13 +66,13 @@ $today = time;
  $isodate = isodate($today);
  
  chdir $spooldir or die "$0: $spooldir - $!\n";
  $isodate = isodate($today);
  
  chdir $spooldir or die "$0: $spooldir - $!\n";
-open L,">>$logdir/cleanup.log";
+# open L,">>$logdir/cleanup.log";
  
  # clean up regular spool
  opendir $spooldir,'.' or die "$0: $spooldir - $!\n";
  while ($to = readdir $spooldir) {
  
  # clean up regular spool
  opendir $spooldir,'.' or die "$0: $spooldir - $!\n";
  while ($to = readdir $spooldir) {
-  next if $to !~ /@/ or -l $to;
-  if (@demo and -f "$to/.demo" and time > mtime("$to/.demo")+$demo[1]*DS) {
+  next if $to !~ /@/ or $_ = readlink($to) and not /\//;
+  if (@demo and -f "$to/.demo" and time > lmtime("$to/.demo")+$demo[1]*DS) {
      logdel($to,"demo user $to deleted");
      next;
    }
      logdel($to,"demo user $to deleted");
      next;
    }
@@ -117,7 +119,7 @@ while ($to = readdir $spooldir) {
          if ($lc) {
            if (-f "$user/\@~" and not "$user/@") {
              rename "$user/\@~","$user/@" unless $opt_d;
          if ($lc) {
            if (-f "$user/\@~" and not "$user/@") {
              rename "$user/\@~","$user/@" unless $opt_d;
-            logv("$isodate $user reanimated (login_check)");
+            logv("$user reanimated (login_check)");
            }
          } else {
            rename "$user/@","$user/\@~" unless $opt_d;
            }
          } else {
            rename "$user/@","$user/\@~" unless $opt_d;
@@ -145,7 +147,7 @@ if (chdir $ukeydir and opendir D,'.') {
    while ($file = readdir D) {
      next if $file eq '.' or $file eq '..';
      if (($link = readlink $file and not -e "$link/upload"
    while ($file = readdir D) {
      next if $file eq '.' or $file eq '..';
      if (($link = readlink $file and not -e "$link/upload"
-         or -f $file and time > mtime($file)+DS)) {
+         or -f $file and time > lmtime($file)+DS)) {
        logdel($file,".ukeys/$file deleted");
      }
    }
        logdel($file,".ukeys/$file deleted");
      }
    }
@@ -155,7 +157,7 @@ if (chdir $ukeydir and opendir D,'.') {
  # clean up authorization key lookup directory
  if (chdir $akeydir and opendir D,'.') {
    while ($file = readdir D) {
  # clean up authorization key lookup directory
  if (chdir $akeydir and opendir D,'.') {
    while ($file = readdir D) {
-    if (-l $file and time > mtime($file)+DS) {
+    if (-l $file and time > (lmtime($file)||0)+DS) {
        logdel($file,".akeys/$file deleted");
      }
    }
        logdel($file,".akeys/$file deleted");
      }
    }
@@ -176,7 +178,7 @@ if (chdir $xkeydir and opendir D,'.') {
  # clean up lock directory
  if (chdir $lockdir and opendir D,'.') {
    while ($file = readdir D) {
  # clean up lock directory
  if (chdir $lockdir and opendir D,'.') {
    while ($file = readdir D) {
-    if (-f $file and time > mtime($file)+DS) {
+    if (-f $file and time > lmtime($file)+DS) {
        logdel($file,".locks/$file deleted");
      }
    }
        logdel($file,".locks/$file deleted");
      }
    }
@@ -187,7 +189,7 @@ if (chdir $lockdir and opendir D,'.') {
  if (chdir "$spooldir/.error" and opendir D,'.') {
    while ($file = readdir D) {
      if (-f $file) {
  if (chdir "$spooldir/.error" and opendir D,'.') {
    while ($file = readdir D) {
      if (-f $file) {
-      $mtime = mtime($file);
+      $mtime = lmtime($file);
        if ($mtime and $today > 10*$keep_default*DS+$mtime) {
          if ($opt_d) { print "unlink .error/$file\n" }
          else        { 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") }
@@ -198,10 +200,10 @@ if (chdir "$spooldir/.error" and opendir D,'.') {
  }
  
  # clean up debug directory
  }
  
  # clean up debug directory
-if (chdir "$logdir/.debug" and opendir D,'.') {
+if (chdir "$spooldir/.debug" and opendir D,'.') {
    while ($file = readdir D) {
      if (-f $file) {
    while ($file = readdir D) {
      if (-f $file) {
-      $mtime = mtime($file);
+      $mtime = lmtime($file);
        if ($mtime and $today > $keep_default*DS+$mtime) {
          # logdel($file,".debug/$file deleted");
          if ($opt_d) { print "unlink .debug/$file\n" }
        if ($mtime and $today > $keep_default*DS+$mtime) {
          # logdel($file,".debug/$file deleted");
          if ($opt_d) { print "unlink .debug/$file\n" }
@@ -257,7 +259,7 @@ foreach $subuser (glob '*/@MAINUSER') {
  # clean up old OKEYs
  chdir $spooldir;
  foreach my $okey (glob '*/@OKEY/*') {
  # clean up old OKEYs
  chdir $spooldir;
  foreach my $okey (glob '*/@OKEY/*') {
-  if (time > mtime($okey)+30*DS) {
+  if (time > lmtime($okey)+30*DS) {
      logdel($okey,"$okey deleted");
    }
  }
      logdel($okey,"$okey deleted");
    }
  }
@@ -301,7 +303,7 @@ if (chdir $gkeydir and opendir D,'.') {
  if (chdir "$spooldir/.reg" and opendir D,'.') {
    while ($file = readdir D) {
      if (-f $file) {
  if (chdir "$spooldir/.reg" and opendir D,'.') {
    while ($file = readdir D) {
      if (-f $file) {
-      $mtime = mtime($file);
+      $mtime = lmtime($file);
        if ($mtime and $today > $mtime+DS) {
          logdel($file,".reg/$file deleted");
        }
        if ($mtime and $today > $mtime+DS) {
          logdel($file,".reg/$file deleted");
        }
@@ -346,7 +348,7 @@ if ($account_expire and $account_expire =~ /^(\d+)/) {
        next if $user =~ /^(fexmaster|fexmail)/ or $user eq $admin;
        next if -l "$user/.login";
  
        next if $user =~ /^(fexmaster|fexmail)/ or $user eq $admin;
        next if -l "$user/.login";
  
-      if (time > mtime($user)+$expire*DS) {
+      if (time > lmtime($user)+$expire*DS) {
          # print "$spooldir/$user\n";
          my $locale = readlink "$user/\@LOCALE";
          $locale = 'english' unless $locale and $reactivation{$locale};
          # print "$spooldir/$user\n";
          my $locale = readlink "$user/\@LOCALE";
          $locale = 'english' unless $locale and $reactivation{$locale};
@@ -358,8 +360,6 @@ if ($account_expire and $account_expire =~ /^(\d+)/) {
    }
  }
  
    }
  }
  
-close L;
-
  # vhosts
  exit if $opt_V;
  if (%vhost) {
  # vhosts
  exit if $opt_V;
  if (%vhost) {
@@ -374,7 +374,8 @@ if (%vhost) {
    }
  }
  
    }
  }
  
-if ($notify_newrelease or not defined $notify_newrelease) {
+if ($notify_newrelease and $notify_newrelease !~ /^no$/i 
+    or not defined $notify_newrelease) {
    $notify_newrelease ||= $admin;
    $newnew = $new = '';
    $snew = $FEXHOME.'/doc/new';
    $notify_newrelease ||= $admin;
    $newnew = $new = '';
    $snew = $FEXHOME.'/doc/new';
@@ -384,10 +385,10 @@ if ($notify_newrelease or not defined $notify_newrelease) {
    else         { $qn = "new?$hostname:0" }
    for (1..3) {
      sleep rand(10);
    else         { $qn = "new?$hostname:0" }
    for (1..3) {
      sleep rand(10);
-    $newnew = `wget -qO- http://fex.rus.uni-stuttgart.de/$qn 2>/dev/null`;
-    last if $newnew =~ /release/;
      $newnew = `wget -qO- http://fex.belwue.de/$qn 2>/dev/null`;
      last if $newnew =~ /release/;
      $newnew = `wget -qO- http://fex.belwue.de/$qn 2>/dev/null`;
      last if $newnew =~ /release/;
+    # $newnew = `wget -qO- http://fex.rus.uni-stuttgart.de/$qn 2>/dev/null`;
+    # last if $newnew =~ /release/;
    };
    if ($newnew =~ /release/) {
      if ($newnew ne $new) {
    };
    if ($newnew =~ /release/) {
      if ($newnew ne $new) {
@@ -432,12 +433,12 @@ sub cleanup {
    if ($file =~ /\/ADDRESS_BOOK/) {
      logdel($file,"$file deleted");
    } elsif (-d $file and not -f $data) {
    if ($file =~ /\/ADDRESS_BOOK/) {
      logdel($file,"$file deleted");
    } elsif (-d $file and not -f $data) {
-    if ($mtime = mtime("$file/upload")) {
+    if ($mtime = lmtime("$file/upload")) {
        if ($today > $mtime+DS) {
          verbose("rmrf $file (today=$today mtime_upload=$mtime)");
          logdel($file,"$file deleted");
        }
        if ($today > $mtime+DS) {
          verbose("rmrf $file (today=$today mtime_upload=$mtime)");
          logdel($file,"$file deleted");
        }
-    } elsif ($mtime = mtime("$file/error")) {
+    } elsif ($mtime = lmtime("$file/error")) {
        if ($today > 3*$keep*DS+$mtime) {
          verbose("rmrf $file (today=$today mtime_error=$mtime keep=$keep)");
          logdel($file,"$file deleted");
        if ($today > 3*$keep*DS+$mtime) {
          verbose("rmrf $file (today=$today mtime_error=$mtime keep=$keep)");
          logdel($file,"$file deleted");
@@ -449,19 +450,19 @@ sub cleanup {
      $delay = autodelete($file);
      $delay = 1 if $delay !~ /^\d+$/;
      $delay--;
      $delay = autodelete($file);
      $delay = 1 if $delay !~ /^\d+$/;
      $delay--;
-    $mtime = mtime($download);
+    $mtime = lmtime($download);
      if ($mtime and $today > $delay*DS+$mtime 
          and logdel($data,"$data deleted")) {
        if (open $ef,'>',$ef) {
          printf {$ef} "%s has been autodeleted after download at %s\n",
      if ($mtime and $today > $delay*DS+$mtime 
          and logdel($data,"$data deleted")) {
        if (open $ef,'>',$ef) {
          printf {$ef} "%s has been autodeleted after download at %s\n",
-                     filename($file),isodate(mtime($download));
+                     filename($file),isodate(lmtime($download));
          close $ef;
        }
      }
    } elsif (-f $data) {
      my $reactivation = $file =~ m{/\Q$admin/reactivation.txt\E$};
      $warn = $reactivation ? $keep-5 : $keep-2;
          close $ef;
        }
      }
    } elsif (-f $data) {
      my $reactivation = $file =~ m{/\Q$admin/reactivation.txt\E$};
      $warn = $reactivation ? $keep-5 : $keep-2;
-    $mtime = mtime("$file/filename") || mtime($data) || 0;
+    $mtime = lmtime("$file/filename") || lmtime($data) || 0;
      if ($today > $mtime+$keep*DS) {
        if ($account_expire and $reactivation) {
          if ($account_expire =~ /delete/) {
      if ($today > $mtime+$keep*DS) {
        if ($account_expire and $reactivation) {
          if ($account_expire =~ /delete/) {
@@ -514,7 +515,7 @@ sub cleanup {
          chomp ($comment = <$c>||'');
          close $c;
        }
          chomp ($comment = <$c>||'');
          close $c;
        }
-      &{$notify{$locale}}(
+      if (&{$notify{$locale}}(
          status     => 'remind',
          dkey       => $dkey,
          filename   => filename($file),
          status     => 'remind',
          dkey       => $dkey,
          filename   => filename($file),
@@ -522,10 +523,13 @@ sub cleanup {
          comment    => $comment,
          warn       => int(($mtime-$today)/DS)+$keep,
          autodelete => autodelete($file),
          comment    => $comment,
          warn       => int(($mtime-$today)/DS)+$keep,
          autodelete => autodelete($file),
-      );
-      open $notify,'>',$notify;
-      close $notify;
-      print "sent reminder for $file\n" if -t or $opt_v;
+      )) {
+        open $notify,'>',$notify;
+        close $notify;
+        print "sent reminder for $file\n" if -t or $opt_v;
+      } else {
+        warn "$0: reminder notification for $file failed\n";
+      }
      }
    }
  }
      }
    }
  }
@@ -545,11 +549,6 @@ sub autodelete {
    return $autodelete||$::autodelete;
  }
  
    return $autodelete||$::autodelete;
  }
  
-sub mtime {
-  my @s = lstat shift;
-  return @s ? $s[9] : undef;
-}
-
  sub logdel {
    my ($file,$msg) = @_;
    my $status = 0;
  sub logdel {
    my ($file,$msg) = @_;
    my $status = 0;
@@ -560,8 +559,8 @@ sub logdel {
      if ($status = rmrf($file)) {
        logv($msg);
      } else {
      if ($status = rmrf($file)) {
        logv($msg);
      } else {
-      print L "$isodate $file DEL FAILED : $!\n";
-      warn     "$file DEL FAILED : $!\n" if -t or $opt_v;
+      logv("$file DEL FAILED : $!");
+      warn "$file DEL FAILED : $!\n" if -t or $opt_v;
      }
    }
    
      }
    }
    
@@ -571,8 +570,17 @@ sub logdel {
  
  sub logv {
    my $msg = shift;
  
  sub logv {
    my $msg = shift;
-  print L "$isodate $msg\n" unless $opt_d;
+
    print "$msg\n" if -t or $opt_v;
    print "$msg\n" if -t or $opt_v;
+
+  unless ($opt_d) {
+    foreach my $ld (@logdir) {
+      if (open my $log,">>$ld/cleanup.log") {
+        print {$log} "$isodate $msg\n";
+        close $log;
+      }
+    }
+  }
  }
  
  
  }
  
  
@@ -585,3 +593,9 @@ sub verbose {
      }
    }
  }
      }
    }
  }
+
+
+sub lmtime {
+  my @s = lstat(shift);
+  return @s?$s[9]:0;
+}
diff --git a/bin/fexget b/bin/fexget

index 034ced112fa3d6e581ea7a092c602f9c6e2ff436..6c0126f807183cfad1d17b438e2419a4b7e82aa0 100755 (executable)
--- 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 ($fexhome,$idf,$tmpdir,$windoof,$useragent);
  our ($xv,%autoview);
  our $bs = 2**16; # blocksize for tcp-reading and writing file
-our $version = 20150120;
+our $version = 20150615;
  our $CTYPE = 'ISO-8859-1';
  our $fexsend = $ENV{FEXSEND} || 'fexsend';
  
  our $CTYPE = 'ISO-8859-1';
  our $fexsend = $ENV{FEXSEND} || 'fexsend';
  
@@ -157,48 +157,7 @@ if ($opt_H) {
    exit;
  }
  
    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)
  
  
  my $ffl = "$tmpdir/fexget";            # F*EX files list (cache)
  
diff --git a/bin/fexsend b/bin/fexsend

index 607d1391f9de05c5362701ae806199a02d6424a6..a0eabe189aadc858c4d80a7dfa06c5a29ebae23a 100755 (executable)
--- a/bin/fexsend
+++ b/bin/fexsend
@@ -37,7 +37,7 @@ our ($tpid,$frecipient);
  our ($FEXID,$FEXXX,$HOME);
  our (%alias);
  our $chunksize = 0;
  our ($FEXID,$FEXXX,$HOME);
  our (%alias);
  our $chunksize = 0;
-our $version = 20150120;
+our $version = 20150615;
  our $_0 = $0;
  our $DEBUG;
  
  our $_0 = $0;
  our $DEBUG;
  
@@ -199,6 +199,10 @@ and then copy-forward it with:
    $0 -b # other\@address
  Where # is the file number.
  
    $0 -b # other\@address
  Where # is the file number.
  
+You can list an uploaded file in more detail with
+  $0 -l #
+Where # is the file number.
+  
  If you want to modify the keep time, comment or auto-delete behaviour of an
  already uploaded file then you first have to query the file number with:
    $0 -l
  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
@@ -625,8 +629,10 @@ sub init_id {
    if ($fexcgi =~ /\?/) {
      $from = $1 if $fexcgi =~ /\bfrom=(.+?)(&|$)/i;
      $id   = $1 if $fexcgi =~ /\bid=(.+?)(&|$)/i;
    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;
+    # $skey = $1 if $fexcgi =~ /\bskey=(.+?)(&|$)/i;
+    # $gkey = $1 if $fexcgi =~ /\bgkey=(.+?)(&|$)/i;
+    die "$0: cannot use GKEY URL in ID file\n" if $fexcgi =~ /gkey=/i;
+    die "$0: cannot use SKEY URL in ID file\n" if $fexcgi =~ /skey=/i;
      $fexcgi =~ s/\?.*//;
    }
    unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) {
      $fexcgi =~ s/\?.*//;
    }
    unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) {
@@ -1001,6 +1007,9 @@ sub list {
        else                              { $dkey = '' }
  #      $_ = encode_utf8($_);
        s/<.*?>//g;
        else                              { $dkey = '' }
  #      $_ = encode_utf8($_);
        s/<.*?>//g;
+      s/&amp;/&/g;
+      s/&quot;/\"/g;
+      s/&lt;/</g;
        if (/^(to .* :)/) {
          print "\n$1\n";
          print {$fexlist} "\n$1\n";
        if (/^(to .* :)/) {
          print "\n$1\n";
          print {$fexlist} "\n$1\n";
@@ -1135,7 +1144,6 @@ sub send_fex {
    my @files = ();
    my ($data,$aname,$alias);
    my (@r,$r);
    my @files = ();
    my ($data,$aname,$alias);
    my (@r,$r);
-  my $ma = $HOME.'/.mutt/aliases';
    my $t0 = time;
    my $transferfile;
    my @transferfiles;
    my $t0 = time;
    my $transferfile;
    my @transferfiles;
@@ -1254,38 +1262,18 @@ sub send_fex {
            # $to = $AB{$to};
          } 
          # look for mutt aliases
            # $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;
+        elsif ($to !~ /@/ and $to ne $from) {
+          $to = get_mutt_alias($to);
          }
        }
      }
    
      $to = join(',',grep /./,@to) or exit;
          }
        }
      }
    
      $to = join(',',grep /./,@to) or exit;
-    warn "Server/User: $fexcgi/$from\n" unless $opt_q;
+    # warn "Server/User: $fexcgi/$from\n" unless $opt_q;
    
      if (
        not $skey and not $gkey
    
      if (
        not $skey and not $gkey
+      and $from ne $to
        and $features =~ /CHECKRECIPIENT/ 
        and $opt_C !~ /^(DELETE|LIST|RECEIVEDLOG|SENDLOG|FOPLOG)$/
      ) {
        and $features =~ /CHECKRECIPIENT/ 
        and $opt_C !~ /^(DELETE|LIST|RECEIVEDLOG|SENDLOG|FOPLOG)$/
      ) {
@@ -1497,7 +1485,7 @@ sub send_fex {
  sub forward {
    my (@r);
    my ($to,$n,$dkey,$file,$req);
  sub forward {
    my (@r);
    my ($to,$n,$dkey,$file,$req);
-  my $status = 1;
+  my ($status,$fp);
    local $_;
    
    # look for single @ in arguments
    local $_;
    
    # look for single @ in arguments
@@ -1512,6 +1500,9 @@ sub forward {
    # if ($windoof and not @ARGV) { &inquire }
    $to = pop @ARGV or die $usage;
    $to = $from if $to eq '.';
    # if ($windoof and not @ARGV) { &inquire }
    $to = pop @ARGV or die $usage;
    $to = $from if $to eq '.';
+  if ($to !~ /@/ and $to ne $from) {
+    $to = get_mutt_alias($to);
+  }
  
    open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
    while (<$fexlist>) {
  
    open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
    while (<$fexlist>) {
@@ -1545,16 +1536,12 @@ sub forward {
    $req .= " HTTP/1.1";
    sendheader("$server:$port",$req);
    http_response();
    $req .= " HTTP/1.1";
    sendheader("$server:$port",$req);
    http_response();
+  $fp = $file;
+  $fp =~ s/[^\w_.-]/.+/g; # because of UTF8 filename
+  $status = 1;
    while (<$SH>) { 
    while (<$SH>) { 
-    if ($opt_v) {
-      print;
-      $status = 0 if /\Q"$file"/;
-    } else {
-      if (/\Q"$file"/) {
-        print;
-        $status = 0;
-      }
-    }
+    $status = 0 if /"$fp"/;
+    print if $opt_v or /"$fp"/;
    }
    
    if ($status) {
    }
    
    if ($status) {
@@ -1723,7 +1710,11 @@ sub get_xx {
      if (/^n/i) {
        print "keeping $transferfile\n";
      } else {
      if (/^n/i) {
        print "keeping $transferfile\n";
      } else {
-      system("tar xvf $transferfile && rm $transferfile");
+      my $untar = "tar xvf";
+      # if ($> == 0 and `tar --help 2>&1` =~ /gnu/) {
+      #  $untar = "tar --no-same-owner -xvf";
+      # }
+      system("$untar $transferfile && rm $transferfile");
        die "$0: error while untaring, see $transferfile\n" if -f $transferfile;
      }
    } else {
        die "$0: error while untaring, see $transferfile\n" if -f $transferfile;
      }
    } else {
@@ -2058,8 +2049,11 @@ sub formdatapost {
        
        print $rcamel[0] if ${'opt_+'};
  
        
        print $rcamel[0] if ${'opt_+'};
  
+      $SIG{ALRM} = sub { retry("timed out") };
        while (my $b = read $file,$buf,$bs) {
        while (my $b = read $file,$buf,$bs) {
-        print {$SH} $buf or &sigpipehandler;
+        alarm($timeout*2);
+        syswrite $SH,$buf or &sigpipehandler;
+        alarm(0);
          $bytes += $b;
          if ($filesize > 0 and $bytes+$seek > $filesize) {
            die "$0: $file filesize has grown while uploading\n";
          $bytes += $b;
          if ($filesize > 0 and $bytes+$seek > $filesize) {
            die "$0: $file filesize has grown while uploading\n";
@@ -2611,21 +2605,27 @@ sub ts {
    
  
  sub sigpipehandler {
    
  
  sub sigpipehandler {
-  $SIG{ALRM} = sub { };
+  retry("died");
+}
+
+sub retry {
+  my $reason = shift;
+  local $SIG{ALRM} = sub { };
+  
    if (fileno $SH) {
      alarm(1);
    if (fileno $SH) {
      alarm(1);
-    @_ = <$SH>;
+    my @r = <$SH>;
      alarm(0);
      kill 9,$tpid if $tpid;
      alarm(0);
      kill 9,$tpid if $tpid;
-    if (@_ and $opt_v) {
-      die "\n$0: ($$) server error: @_\n";
+    if (@r and $opt_v) {
+      die "\n$0: ($$) server error: @r\n";
      }
      }
-    if (@_ and $_[0] =~ /^HTTP.* \d+ (.*)/) {
+    if (@r and $r[0] =~ /^HTTP.* \d+ (.*)/) {
        die "\n$0: server error: $1\n";
      }
    }
    $timeout *= 2;
        die "\n$0: server error: $1\n";
      }
    }
    $timeout *= 2;
-  warn "\n$0: connection to $server died\n";
+  warn "\n$0: connection to $server $reason\n";
    warn "retrying after $timeout seconds...\n";
    sleep $timeout;
    if ($windoof) { exec $^X,$0,@_ARGV }
    warn "retrying after $timeout seconds...\n";
    sleep $timeout;
    if ($windoof) { exec $^X,$0,@_ARGV }
@@ -2736,6 +2736,37 @@ sub fileid {
  }
  
  
  }
  
  
+sub get_mutt_alias {
+  my $to = shift;
+  my $ma = $HOME.'/.mutt/aliases';
+  my $alias;
+  local $_;
+  
+  open $ma,$ma or return $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;
+  return ($alias||$to);
+}
+
+
  # collect file meta data (filename, inode, mtime)
  sub fmd {
    my @files = @_;
  # collect file meta data (filename, inode, mtime)
  sub fmd {
    my @files = @_;
@@ -2815,6 +2846,7 @@ sub http_response {
    unless (defined $_ and /\w/) {
      die "$0: no response from server\n";
    }
    unless (defined $_ and /\w/) {
      die "$0: no response from server\n";
    }
+  print "<-- $_\n" if $opt_v;
    s/\r?\n//;
    # CGI fatalsToBrowser
    if (/^HTTP.* 500/) {
    s/\r?\n//;
    # CGI fatalsToBrowser
    if (/^HTTP.* 500/) {
@@ -2825,9 +2857,12 @@ sub http_response {
    unless (/^HTTP.* 200/) {
      $error = $_;
      $error =~ s/HTTP.[\s\d.]+//;
    unless (/^HTTP.* 200/) {
      $error = $_;
      $error =~ s/HTTP.[\s\d.]+//;
-    if ($opt_v) {
-      print "<-- $_";
-      print "<-- $_" while <$SH>;
+    @r = <$SH> unless @r;
+    @r = ()    unless @r;
+    foreach (@r) {
+      chomp;
+      $error .= "\n".$_ if /^Location/;
+      print "<-- $_\n" if $opt_v;
      }
      die "$0: server error: $error\n";
    }
      }
      die "$0: server error: $error\n";
    }
@@ -2937,12 +2972,6 @@ sub serverconnect {
    my $connect = "CONNECT $server:$port HTTP/1.1";
    local $_;
    
    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) {
    if ($proxy) {
      tcpconnect(split(':',$proxy));
      if ($port == 443) {
@@ -2954,8 +2983,7 @@ sub serverconnect {
        unless (/^HTTP.1.. 200/) {
          die "$0: proxy error : $_";
        }
        unless (/^HTTP.1.. 200/) {
          die "$0: proxy error : $_";
        }
-      eval "use IO::Socket::SSL";
-      die "$0: cannot load IO::Socket::SSL\n" if $@;
+      &enable_ssl;
        $SH = IO::Socket::SSL->start_SSL($SH,%SSL);
      }
    } else {
        $SH = IO::Socket::SSL->start_SSL($SH,%SSL);
      }
    } else {
@@ -2978,8 +3006,7 @@ sub tcpconnect {
    
    if ($port == 443) {
      # eval "use IO::Socket::SSL qw(debug3)";
    
    if ($port == 443) {
      # eval "use IO::Socket::SSL qw(debug3)";
-    eval "use IO::Socket::SSL";
-    die "$0: cannot load IO::Socket::SSL\n" if $@;
+    &enable_ssl;
      $SH = IO::Socket::SSL->new(
        PeerAddr => $server,
        PeerPort => $port,
      $SH = IO::Socket::SSL->new(
        PeerAddr => $server,
        PeerPort => $port,
@@ -3004,6 +3031,18 @@ sub tcpconnect {
  }
  
  
  }
  
  
+sub enable_ssl {
+  eval "use IO::Socket::SSL";
+  die "$0: cannot load IO::Socket::SSL\n" if $@;
+  eval '$SSL{SSL_verify_mode} = 0 if Net::SSLeay::SSLeay() <= 9470143';
+  if ($opt_v) {
+    foreach my $v (keys %SSL) {
+      printf "%s => %s\n",$v,$SSL{$v};
+    }
+  }
+}
+
+
  sub sendheader {
    my $sp = shift;
    my @head = @_;
  sub sendheader {
    my $sp = shift;
    my @head = @_;
diff --git a/bin/fexsrv b/bin/fexsrv

index 27e331864289d4d0674044a17fd996b54a2d5b8a..11911ffcb893fabbe2f293daa3de26601e272735 100755 (executable)
--- a/bin/fexsrv
+++ b/bin/fexsrv
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -wT
+#!/usr/bin/perl -T
  
  # fexsrv : web server for F*EX service
  #
  
  # fexsrv : web server for F*EX service
  #
@@ -9,9 +9,50 @@ use 5.008;
  use Socket;
  use IO::Handle;
  use Fcntl qw':flock :seek';
  use Socket;
  use IO::Handle;
  use Fcntl qw':flock :seek';
-
-# stunnel workaround
-BEGIN { $SIG{CHLD} = "DEFAULT" }
+use warnings;
+
+BEGIN { 
+  # stunnel workaround
+  $SIG{CHLD} = "DEFAULT";
+  $ENV{PERLINIT} = q{
+    unshift @INC,(getpwuid($<))[7].'/perl';
+    # web error handler
+    $SIG{__DIE__} = $SIG{__WARN__} = sub {
+      my $info = '';
+      my $url = $ENV{REQUEST_URL}||'';
+      my @d = localtime time;
+      my $time = sprintf('%d-%02d-%02d %02d:%02d:%02d',
+                 $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
+      if ($admin) {
+        my $mailto = "mailto:$admin?subject=fex%20bug";
+        $info = "<h3>send this error to <a href=\"$mailto\">$admin</a></h3>";
+      }
+      $_ = join("\n",@_);
+      chomp;
+      s/&/&amp;/g;
+      s/</&lt;/g;
+      $_ = join("\n",
+        "<html><body>",
+        "<h1>INTERNAL ERROR in $0</h1>",
+        "<pre>\n$_\n</pre>\n<p>",
+        "$url\n<p>",
+        "$time\n<p>",
+        "$info\n<p>",
+        "</body></html>"
+      );
+      $length = length;
+      unless ($HTTP_HEADER) {
+        print "HTTP/1.0 200 ERROR\r\n";
+        print "Content-Type: text/html\r\n";
+        print "Content-Length: $length\r\n";
+        print "\r\n";
+      }
+      print;
+      exit 99;
+    }
+  };
+  eval $ENV{PERLINIT};
+}
  
  # use BSD::Resource;
  # setrlimit(RLIMIT_CPU,999,999) or die "$0: $!\n";
  
  # use BSD::Resource;
  # setrlimit(RLIMIT_CPU,999,999) or die "$0: $!\n";
@@ -25,10 +66,10 @@ if (@ARGV and $ARGV[0] eq 'stunnel' and $ENV{REMOTE_HOST} =~ /(.+)/) {
  if ($ENV{KEEP_ALIVE}) { 
    $keep_alive = $ENV{KEEP_ALIVE};
  } else {
  if ($ENV{KEEP_ALIVE}) { 
    $keep_alive = $ENV{KEEP_ALIVE};
  } else {
-  %ENV = ();   # clean environment
+  %ENV = ( PERLINIT => $ENV{PERLINIT} );   # clean environment
  }
  
  }
  
-$ENV{HOME} = (getpwuid($<))[7] or die "$0: no HOME\n";
+$ENV{HOME} = (getpwuid($<))[7] or die "no HOME";
  
  # fexsrv MUST be run with full path!
  if ($0 =~ m:^(/.+)/bin/fexsrv:) {
  
  # fexsrv MUST be run with full path!
  if ($0 =~ m:^(/.+)/bin/fexsrv:) {
@@ -50,16 +91,16 @@ foreach my $lib (
  
  # import from fex.pp
  our ($hostname,$debug,$timeout,$max_error,$max_error_handler);
  
  # import from fex.pp
  our ($hostname,$debug,$timeout,$max_error,$max_error_handler);
-our ($spooldir,$logdir,$docdir,$xkeydir,$lockdir);
-our ($force_https,$default_locale,$bs,$adlm);
+our ($spooldir,@logdir,$docdir,$xkeydir,$lockdir);
+our ($force_https,$default_locale,$bs,$MB,$adlm);
  our (@locales);
  
  # load common code (local config: $FEXHOME/lib/fex.ph)
  our (@locales);
  
  # load common code (local config: $FEXHOME/lib/fex.ph)
-require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
+require "$FEXLIB/fex.pp" or die "cannot load $FEXLIB/fex.pp - $!\n";
  
  chdir $spooldir or http_die("$0: $spooldir - $!\n");
  
  
  chdir $spooldir or http_die("$0: $spooldir - $!\n");
  
-our $log = "$logdir/fexsrv.log";
+our $log = 'fexsrv.log';
  our $error = 'F*EX ERROR';
  our $htmlsource;
  our $hid = ''; # header ID
  our $error = 'F*EX ERROR';
  our $htmlsource;
  our $hid = ''; # header ID
@@ -67,8 +108,9 @@ our @log;
  
  $0 = untaint($0);
    
  
  $0 = untaint($0);
    
-$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
+$ENV{GATEWAY_INTERFACE} = 'CGI/1.1f';
  $ENV{SERVER_NAME} = $hostname;
  $ENV{SERVER_NAME} = $hostname;
+$ENV{REQUEST_METHOD} = '';
  $ENV{QUERY_STRING} = '';
  $ENV{HTTP_COOKIE} = '';
  $ENV{PATH_INFO} = '';
  $ENV{QUERY_STRING} = '';
  $ENV{HTTP_COOKIE} = '';
  $ENV{PATH_INFO} = '';
@@ -119,7 +161,7 @@ else {
    # HTTP connect
    else {
      $ENV{PROTO} = 'http';
    # HTTP connect
    else {
      $ENV{PROTO} = 'http';
-    my $sa = getpeername(STDIN) or die "$0: no network stream on STDIN\n";
+    my $sa = getpeername(STDIN) or die "no network stream on STDIN\n";
      if (sockaddr_family($sa) == AF_INET) {
        ($ENV{REMOTE_PORT},$iaddr) = sockaddr_in($sa);
        $ENV{REMOTE_ADDR} = $ra = inet_ntoa($iaddr);
      if (sockaddr_family($sa) == AF_INET) {
        ($ENV{REMOTE_PORT},$iaddr) = sockaddr_in($sa);
        $ENV{REMOTE_ADDR} = $ra = inet_ntoa($iaddr);
@@ -129,11 +171,11 @@ else {
        $^W = 0; eval 'use Socket6'; $^W = 1;
        http_error(503) if $@;
        ($ENV{REMOTE_PORT},$iaddr) = unpack_sockaddr_in6($sa);
        $^W = 0; eval 'use Socket6'; $^W = 1;
        http_error(503) if $@;
        ($ENV{REMOTE_PORT},$iaddr) = unpack_sockaddr_in6($sa);
-      $ENV{REMOTE_ADDR} = $ra = inet_ntop(AF_INET6, $iaddr);
+      $ENV{REMOTE_ADDR} = $ra = inet_ntop(AF_INET6,$iaddr);
        $rh = gethostbyaddr($iaddr,AF_INET6);
        ($port) = unpack_sockaddr_in6(getsockname(STDIN));
      } else {
        $rh = gethostbyaddr($iaddr,AF_INET6);
        ($port) = unpack_sockaddr_in6(getsockname(STDIN));
      } else {
-      die "$0: unknown IP version\n";
+      die "unknown IP version\n";
      }
      $port = 80 unless $port;
    }
      }
      $port = 80 unless $port;
    }
@@ -143,6 +185,7 @@ else {
    $ENV{HTTP_HOST} = ($port == 80 or $port == 443) 
                    ? $hostname : "$hostname:$port";
  
    $ENV{HTTP_HOST} = ($port == 80 or $port == 443) 
                    ? $hostname : "$hostname:$port";
  
+  $ENV{PORT} = $port;
  }
  
  if ($reverse_proxy_ip and $reverse_proxy_ip eq $ra) {
  }
  
  if ($reverse_proxy_ip and $reverse_proxy_ip eq $ra) {
@@ -199,6 +242,10 @@ REQUEST: while (*STDIN) {
        $header{$1} = $2 if /(.+)\s*:\s*(.+)/;
        push @log,$_;
      }
        $header{$1} = $2 if /(.+)\s*:\s*(.+)/;
        push @log,$_;
      }
+    if ($hl > $MB) {
+      fexlog($connect,@log,"OVERRUN");
+      http_error(413);
+    }
      
      if (/^(GET \/|X-Forwarded-For|User-Agent)/i) {
        $hid .= $_."\n";
      
      if (/^(GET \/|X-Forwarded-For|User-Agent)/i) {
        $hid .= $_."\n";
@@ -306,6 +353,7 @@ REQUEST: while (*STDIN) {
    }
  
    if ($request =~ /^(GET|HEAD|POST)\s+(.+)\s+(HTTP\/[\d\.]+$)/i) {
    }
  
    if ($request =~ /^(GET|HEAD|POST)\s+(.+)\s+(HTTP\/[\d\.]+$)/i) {
+    $ENV{REQUEST}       = $_;
      $ENV{REQUEST_METHOD} = uc($1);
      $ENV{REQUEST_URI}    = $uri = $cgi = $2;
      $ENV{HTTP_VERSION}   = $protocol = $3;
      $ENV{REQUEST_METHOD} = uc($1);
      $ENV{REQUEST_URI}    = $uri = $cgi = $2;
      $ENV{HTTP_VERSION}   = $protocol = $3;
@@ -457,7 +505,9 @@ REQUEST: while (*STDIN) {
    if ($debug) {
      debuglog("ENV:\n");
      foreach $var (sort keys %ENV) {
    if ($debug) {
      debuglog("ENV:\n");
      foreach $var (sort keys %ENV) {
-      debuglog(sprintf "  %s = >%s<\n",$var,$ENV{$var});
+      if (defined($ENV{$var})) {
+        debuglog(sprintf "  %s = >%s<\n",$var,$ENV{$var});
+      }
      }
      debuglog("\n");
    }
      }
      debuglog("\n");
    }
@@ -473,12 +523,20 @@ REQUEST: while (*STDIN) {
                
    # prepare document file name
    if ($ENV{REQUEST_METHOD} =~ /^GET|HEAD$/) {
                
    # prepare document file name
    if ($ENV{REQUEST_METHOD} =~ /^GET|HEAD$/) {
+    if (%redirect) {
+      foreach my $r (keys %redirect) {
+        if ($uri =~ /^\Q$r/) {
+          redirect($uri,$r);
+          exit;
+        }
+      }
+    }
      $doc = untaint($uri);
      $doc =~ s/%([\dA-F]{2})/unpack("a",pack("H2",$1))/ge;
      $doc =~ m:/\.\./: and http_error(403);
      $doc =~ s:^/+::;
      $doc =~ s/\?.*//;
      $doc = untaint($uri);
      $doc =~ s/%([\dA-F]{2})/unpack("a",pack("H2",$1))/ge;
      $doc =~ m:/\.\./: and http_error(403);
      $doc =~ s:^/+::;
      $doc =~ s/\?.*//;
-    if ($locale and -e "$docdir/locale/$locale/$doc") {
+    if ($locale and $locale ne 'english' and -e "$docdir/locale/$locale/$doc") {
        $doc = "$docdir/locale/$locale/$doc";
      } else {
        $doc = "$docdir/$doc";
        $doc = "$docdir/locale/$locale/$doc";
      } else {
        $doc = "$docdir/$doc";
@@ -514,7 +572,7 @@ REQUEST: while (*STDIN) {
          fexlog($connect,@log,"FORBIDDEN");
          http_error(403);
        }
          fexlog($connect,@log,"FORBIDDEN");
          http_error(403);
        }
-      unlink "$logdir/.error/$ra";
+      unlink "$spooldir/.error/$ra";
        # push @log,"DEBUG: locale=$locale locales=(@locales)";
        fexlog($connect,@log,"EXEC $cgi");
        eval { local $^W = 0; exec $cgi };
        # push @log,"DEBUG: locale=$locale locales=(@locales)";
        fexlog($connect,@log,"EXEC $cgi");
        eval { local $^W = 0; exec $cgi };
@@ -573,7 +631,7 @@ REQUEST: while (*STDIN) {
            or $doc =~ /(.+)\.tgz$/           and -f "$1.tar"
            or $doc =~ /(.+)\.gz$/            and -f $1)
        {
            or $doc =~ /(.+)\.tgz$/           and -f "$1.tar"
            or $doc =~ /(.+)\.gz$/            and -f $1)
        {
-        unlink "$logdir/.error/$ra";
+        unlink "$spooldir/.error/$ra";
          delete $ENV{SCRIPT_FILENAME};        
          $ENV{DOCUMENT_FILENAME} = $doc;
          require "$FEXLIB/dop";
          delete $ENV{SCRIPT_FILENAME};        
          $ENV{DOCUMENT_FILENAME} = $doc;
          require "$FEXLIB/dop";
@@ -628,6 +686,7 @@ REQUEST: while (*STDIN) {
  # read one text line unbuffered from STDIN
  sub getaline {
    my $line = '';
  # read one text line unbuffered from STDIN
  sub getaline {
    my $line = '';
+  my $n = 0;
    my $c;
  
    alarm($timeout);
    my $c;
  
    alarm($timeout);
@@ -636,7 +695,12 @@ sub getaline {
    # (later exec would destroy line buffer)
    while (sysread STDIN,$c,1) {
      $line .= $c;
    # (later exec would destroy line buffer)
    while (sysread STDIN,$c,1) {
      $line .= $c;
+    $n++;
      last if $c eq "\n";
      last if $c eq "\n";
+    if ($n > $bs) {
+      fexlog($connect,@log,$line,"OVERRUN");
+      http_error(413);
+    }
    }
  
    alarm(0);
    }
  
    alarm(0);
@@ -647,18 +711,20 @@ sub getaline {
  
  sub fexlog {
    my @log = @_;
  
  sub fexlog {
    my @log = @_;
-  if (open $log,">>$log") {
-    flock $log,LOCK_EX;
-    seek $log,0,SEEK_END;
-    print {$log} "\n",join("\n",@log),"\n";
-    close $log;
-  } else {
-    http_die("$0: cannot write to $log - $!\n");
+  
+  foreach my $logdir (@logdir) {
+    if (open $log,'>>',"$logdir/$log") {
+      flock $log,LOCK_EX;
+      seek $log,0,SEEK_END;
+      print {$log} "\n",join("\n",@log),"\n";
+      close $log;
+    } else {
+      http_die("$0: cannot write to $logdir/$log - $!\n");
+    }
    }
  }
  
  
    }
  }
  
  
-
  sub badchar {
    my $bc = shift;
    
  sub badchar {
    my $bc = shift;
    
@@ -711,6 +777,9 @@ sub http_error {
    } elsif ($error eq 404) {
      http_error_header("404 Not Found");
      nvt_print("The requested URI $URI was not found on this server.");
    } elsif ($error eq 404) {
      http_error_header("404 Not Found");
      nvt_print("The requested URI $URI was not found on this server.");
+  } elsif ($error eq 413) {
+    http_error_header("413 Payload Too Large");
+    nvt_print("Your HTTP header is too large.");
    } elsif ($error eq 416) {
      http_error_header("416 Requested Range Not Satisfiable");
    } elsif ($error eq 503) {
    } elsif ($error eq 416) {
      http_error_header("416 Requested Range Not Satisfiable");
    } elsif ($error eq 503) {
@@ -765,6 +834,44 @@ sub http_error_header {
  }
  
  
  }
  
  
+sub redirect {
+  my $uri = shift;
+  my $r = shift;
+  my $rr = $redirect{$r};
+  my $newurl;
+  
+  $uri =~ s/\Q$r//;
+
+  if ($rr =~ s/^!//) {
+    $newurl = $rr.$uri;
+      nvt_print(
+        "HTTP/1.1 301 Moved Permanently",
+        "Location: $newurl",
+        "Content-Length: 0",
+        ""
+      );
+  } else {
+    if ($rr =~ /^http/) {
+      $newurl = $rr.$uri;
+    } else {
+      $newurl = "$ENV{PROTO}://$ENV{HTTP_HOST}$rr$uri";
+    }
+  
+    http_header("200 OK");
+    print html_header("$hostname page has moved");
+    pq(qq(
+      '<h3>Please use new URL: <a href="$newurl">$newurl</a></h3>'
+      '</body></html>'
+    ));
+  }
+  if ($rr =~ /^http/) {
+    exit;
+  } else {
+    &reexec;
+  }
+}
+
+
  sub badlog {
    my $request = shift;
    my @n;
  sub badlog {
    my $request = shift;
    my @n;
diff --git a/bin/fexwall b/bin/fexwall

index 7004a531e60f598bd463a9f0db83e8e85f72da25..c632e1545f4e5ae278d3d7332f095e8d3141d929 100755 (executable)
--- a/bin/fexwall
+++ b/bin/fexwall
@@ -120,5 +120,5 @@ sub uniq {
  
  sub usage {
    print "usage: $0 \"SUBJECT\" < mail.text\n";
  
  sub usage {
    print "usage: $0 \"SUBJECT\" < mail.text\n";
-  exit shift;
+  exit shift||0;
  }
  }
diff --git a/bin/l b/bin/l

index 93c4aca0307ac4c6d12055095834fa4816c87b0b..1389931a5e070cdcdf82f03ef9fb9c14b53d55bb 100755 (executable)
--- a/bin/l
+++ b/bin/l
@@ -22,10 +22,10 @@ $ENV{LC_CTYPE} = 'C';
  # 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;
  # 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_U = $opt_x = 0;
  ${'opt_*'} = ${'opt_?'} = 0;
  $opt_m = $opt_f = $opt_F = $opt_D = '';
  ${'opt_*'} = ${'opt_?'} = 0;
  $opt_m = $opt_f = $opt_F = $opt_D = '';
-&usage if !getopts('hdnlLNitcuarsUSRz*?m:f:D:F:') || $opt_h;
+&usage if !getopts('hdnlLNitcuarsxUSRz*?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';
  $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';
@@ -167,6 +167,12 @@ sub collect {
        # traverse real subdirs
        if (-d $f and not -l $f) { 
          $f =~ s:/*$:/:;
        # traverse real subdirs
        if (-d $f and not -l $f) { 
          $f =~ s:/*$:/:;
+        # skip other file systems on -x
+        if ($opt_x) {
+          my @pd = stat(dirname($f));
+          my @sd = stat($f);
+          next if $pd[0] ne $sd[0];
+        }
          collect(getfiles($f));
        }
        
          collect(getfiles($f));
        }
        
@@ -545,7 +551,7 @@ sub fmatch {
  
  
  sub usage {
  
  
  sub usage {
-  my $opts = '[-lastcuidnrzLRNS*] [-f format] [-D X:Y]';
+  my $opts = '[-lastcuidnrzLRxNS*] [-f format] [-D X:Y]';
    if ($0 ne 'lf') { 
      print "usage: $0 $opts [-F regexp] [file...]\n";
    }
    if ($0 ne 'lf') { 
      print "usage: $0 $opts [-F regexp] [file...]\n";
    }
@@ -566,6 +572,7 @@ options: -l  long list
           -z  squeeze size field (slows down output)
           -L  derefernce symbolic links
           -R  recursive into subdirs
           -z  squeeze size field (slows down output)
           -L  derefernce symbolic links
           -R  recursive into subdirs
+         -x  do not cross filesystem boundaries with -R
           -F  find files matching case insensitive regexp
           -N  show only normal (regular) files
           -S  print statistics summary at end
           -F  find files matching case insensitive regexp
           -N  show only normal (regular) files
           -S  print statistics summary at end
diff --git a/bin/logwatch b/bin/logwatch

index 7ef1d4ba25a1ea04c425f3d5a956e037e036b0a6..1b75a2191c1626c213145f0f75e12c888bc56fc8 100755 (executable)
--- a/bin/logwatch
+++ b/bin/logwatch
@@ -1,6 +1,5 @@
  #!/usr/bin/perl -w
  
  #!/usr/bin/perl -w
  
-use Encode;
  use File::Basename;
  use Cwd 'abs_path';
  use I18N::Langinfo qw'langinfo CODESET';
  use File::Basename;
  use Cwd 'abs_path';
  use I18N::Langinfo qw'langinfo CODESET';
@@ -19,7 +18,7 @@ unless ($FEXLIB = $ENV{FEXLIB}) {
  die "$0: no $FEXLIB\n" unless -d $FEXLIB;
  
  # import from fex.pp
  die "$0: no $FEXLIB\n" unless -d $FEXLIB;
  
  # import from fex.pp
-our ($logdir,$spooldir,$debug);
+our (@logdir,$spooldir,$debug);
  
  # load common code, local config : $HOME/lib/fex.ph
  require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
  
  # load common code, local config : $HOME/lib/fex.ph
  require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
@@ -27,7 +26,7 @@ require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
  $CTYPE = langinfo(CODESET());
  binmode(STDOUT,":encoding($CTYPE)");
  
  $CTYPE = langinfo(CODESET());
  binmode(STDOUT,":encoding($CTYPE)");
  
-$log = shift || "$logdir/fexsrv.log";
+$log = shift || $logdir[0].'/fexsrv.log';
  
  $ignore = join('|',qw(
    (CONNECT|CONTINUE).*(crawl|msnbot|obertux)
  
  $ignore = join('|',qw(
    (CONNECT|CONTINUE).*(crawl|msnbot|obertux)
@@ -40,9 +39,9 @@ $ignore = join('|',qw(
    GET./fup\?showstatus
    GET./FAQ/faq\.css
    GET./FAQ/jquery\.js
    GET./fup\?showstatus
    GET./FAQ/faq\.css
    GET./FAQ/jquery\.js
-  GET./10+.B
    GET.*Arrow\.gif
    GET./apple-touch
    GET.*Arrow\.gif
    GET./apple-touch
+  GET./browserconfig\.xml
    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)
    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)
@@ -132,7 +131,7 @@ for (;;) {
        printf "  TO=\"%s\"\n",$to;
        $cgi = '';
        if ($comment = slurp("$ddir/comment")) {
        printf "  TO=\"%s\"\n",$to;
        $cgi = '';
        if ($comment = slurp("$ddir/comment")) {
-        printf "  COMMENT=\"%s\"\n",decode_utf8($comment,0)||'';
+        printf "  COMMENT=\"%s\"\n",utf8decode($comment)||'';
        }
        if (not -f "$ddir/data" and $_ = slurp("$ddir/error")) {
          s/\n.*//s;
        }
        if (not -f "$ddir/data" and $_ = slurp("$ddir/error")) {
          s/\n.*//s;
@@ -146,12 +145,12 @@ for (;;) {
        read_skey($1);
        print "\n";
      }
        read_skey($1);
        print "\n";
      }
+    if ($debug and $pid and $cgi) {
+      &read_debug_log;
+    };
+    $pid = $cgi = '';
    }
    sleep 1;
    }
    sleep 1;
-  if ($debug and $pid and $cgi) {
-    &read_debug_log;
-    $pid = $cgi = '';
-  };
  }
  
  
  }
  
  
@@ -164,7 +163,7 @@ sub read_debug_log {
  
    for (1..2) {
      sleep 1;
  
    for (1..2) {
      sleep 1;
-    @log = `ls -rt $logdir/.debug/*_${pid}.$cgi 2>/dev/null`;
+    @log = `ls -rt $logdir[0]/.debug/*_${pid}.$cgi 2>/dev/null`;
      if ($log = $log[-1] and open $log,$log) {
        # binmode($log,":encoding(UTF-8)");
        while (<$log>) {
      if ($log = $log[-1] and open $log,$log) {
        # binmode($log,":encoding(UTF-8)");
        while (<$log>) {
@@ -176,7 +175,7 @@ sub read_debug_log {
            $_ = <$log>;
            my $v = <$log>||'';
            $v =~ s/[\r\n]+//;
            $_ = <$log>;
            my $v = <$log>||'';
            $v =~ s/[\r\n]+//;
-          printf "  %s=\"%s\"\n",$p,decode_utf8($v,0)||$v if $v;
+          printf "  %s=\"%s\"\n",$p,utf8decode($v)||$v if $v;
            read_akey($v) if $p eq 'AKEY';
            read_skey($v) if $p eq 'SKEY';
          } elsif (/^(Param|Exp): (\w+=".+")/) {
            read_akey($v) if $p eq 'AKEY';
            read_skey($v) if $p eq 'SKEY';
          } elsif (/^(Param|Exp): (\w+=".+")/) {
@@ -209,3 +208,10 @@ sub read_skey {
      close $skey;
    }
  }
      close $skey;
    }
  }
+
+
+sub utf8decode {
+  local $_ = shift;
+  s/([\xC0-\xDF])([\x80-\xBF])/chr(ord($1)<<6&0xC0|ord($2)&0x3F)/eg;
+  return $_;
+}
diff --git a/bin/sexsend b/bin/sexsend

index 7340e497e98b97a984f2de429cba3699d947e7e7..1fedac8935f7ae1e825824f764ba53ba81fa25ff 100755 (executable)
--- a/bin/sexsend
+++ b/bin/sexsend
@@ -19,7 +19,7 @@ use constant M => 2**20;
  
  eval 'use Net::INET6Glue::INET_is_INET6';
  
  
  eval 'use Net::INET6Glue::INET_is_INET6';
  
-our $version = 20150120;
+our $version = 20150615;
  
  my %SSL = (SSL_version => 'TLSv1');
  my $sigpipe;
  
  my %SSL = (SSL_version => 'TLSv1');
  my $sigpipe;
diff --git a/bin/zz b/bin/zz

index 48a5a9fdb9356d82d8534c7817bb50876bc4fd50..8195b873b9dd18932ae41d32a4b299f19fcdfbc4 100755 (executable)
--- a/bin/zz
+++ b/bin/zz
@@ -7,7 +7,7 @@
  
  ZZ=${ZZ:-$HOME/.zz}
  
  
  ZZ=${ZZ:-$HOME/.zz}
  
-if [ "X$*" = X-h -o "X$*" = X--help ]; then
+if [ "$*" = -h -o "$*" = --help ]; then
    exec cat<<EOD
  zz is the generic clip board program. See also the edit helper program ezz.
  The clip board is \$ZZ (default: \$HOME/.zz). Options and modes are:
    exec cat<<EOD
  zz is the generic clip board program. See also the edit helper program ezz.
  The clip board is \$ZZ (default: \$HOME/.zz). Options and modes are:
@@ -35,15 +35,15 @@ Limitation: zz does not work across different accounts or hosts! Use xx instead.
  EOD
  fi
  
  EOD
  fi
  
-if [ x"$1"x = x+x ]; then 
+if [ "$1" = + ]; then 
    shift
    exec cat -- "$@" >>$ZZ
  fi
  
  if [ -t 0 ]; then
    shift
    exec cat -- "$@" >>$ZZ
  fi
  
  if [ -t 0 ]; then
-    if [ x"$1"x = xx ]; then 
+    if [ -z "$1" ]; then 
          exec cat -- $ZZ
          exec cat -- $ZZ
-    elif [ x"$1"x = x..x ]; then 
+    elif [ "$1" = .. ]; then 
          exec cat -- $ZZ~
      else 
          test -f $ZZ && mv $ZZ $ZZ~
          exec cat -- $ZZ~
      else 
          test -f $ZZ && mv $ZZ $ZZ~
diff --git a/cgi-bin/fac b/cgi-bin/fac

index 1470b83c1f266e5eda46726599cafbae56954947..410eb6b06382811c799b585043b55b996f851b96 100755 (executable)
--- a/cgi-bin/fac
+++ b/cgi-bin/fac
@@ -1,28 +1,29 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl -Tw
  
  # F*EX CGI for administration
  #
  
  # F*EX CGI for administration
  #
-# Author: Andre Hafner <andrehafner@gmx.net>
+# Original author: Andre Hafner <andrehafner@gmx.net>
  #
  
  #
  
-use CGI                        qw(:standard);
-use CGI::Carp          qw(fatalsToBrowser);
+BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
  
  $| = 1;
  
  
  $| = 1;
  
+$fac = $0;
+$fac =~ s:.*/::;
+
  # add fex lib
  # add fex lib
-(our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
-die "no \$FEXLIB\n" unless -d $FEXLIB;
+(our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/ or die "no \$FEXLIB\n";
  
  # import from fex.pp and fex.ph
  
  # import from fex.pp and fex.ph
-our ($FEXHOME,$spooldir,$logdir,$docdir,$durl,$mdomain);
-our ($bs,$hostname,$keep_default,$recipient_quota,$sender_quota,$autodelete);
+our ($FEXHOME,$spooldir,$logdir,$docdir,$akeydir,$durl,$mdomain,$bs,$hostname);
+our ($keep_default,$keep_max,$recipient_quota,$sender_quota,$autodelete);
  our ($admin,$admin_pw,$admin_hosts);
  our ($sendmail,$bcc);
  our $error = 'FAC error';
  
  # load common code, local config : $HOME/lib/fex.ph
  our ($admin,$admin_pw,$admin_hosts);
  our ($sendmail,$bcc);
  our $error = 'FAC error';
  
  # load common code, local config : $HOME/lib/fex.ph
-require "$FEXLIB/fex.pp" or http_die("cannot load $FEXLIB/fex.pp - $!\n");
+require "$FEXLIB/fex.pp";
  
  my @http_auth = ();
  my $ra = $ENV{REMOTE_ADDR}||0;
  
  my @http_auth = ();
  my $ra = $ENV{REMOTE_ADDR}||0;
@@ -38,7 +39,9 @@ chomp($admin_pw = slurp("$admin/@")||'');
  html_error($error,"no F*EX account for admin $admin\n") unless $admin_pw;
  
  # redirect to https if configured
  html_error($error,"no F*EX account for admin $admin\n") unless $admin_pw;
  
  # redirect to https if configured
-if (0 and open my $x,'/etc/xinetd.d/fexs') {
+(undef,$port) = split(':',$ENV{HTTP_HOST}||'');
+$port ||= $ENV{PROTO} eq 'https' ? 443 : 80;
+if ($port == 80 and open my $x,'/etc/xinetd.d/fexs') {
    while (<$x>) {
      if (/^\s*disable\s*=\s*no/) {
        nvt_print(
    while (<$x>) {
      if (/^\s*disable\s*=\s*no/) {
        nvt_print(
@@ -53,6 +56,11 @@ if (0 and open my $x,'/etc/xinetd.d/fexs') {
    close $x;
  }
  
    close $x;
  }
  
+our %PARAM;
+&parse_parameters;
+
+$action = $PARAM{"action"}||'';
+
  # authentication
  &require_akey;
  
  # authentication
  &require_akey;
  
@@ -61,16 +69,20 @@ $fup =~ s:/fop:/fup:;
  
  my $http_client = $ENV{HTTP_USER_AGENT} || '';
  
  
  my $http_client = $ENV{HTTP_USER_AGENT} || '';
  
-# here is chosen which files to save with backup function
+# files to save with backup function
  my @backup_files = qw(
    htdocs/index.html
    lib/fex.ph
    lib/fup.pl
    spool/*@*/@*
  my @backup_files = qw(
    htdocs/index.html
    lib/fex.ph
    lib/fup.pl
    spool/*@*/@*
+  spool/*@*/.auto
  );
  
  # backup goes first
  );
  
  # backup goes first
-if (defined param("action") and param("action") eq "backup") { &backup }
+if ($action eq "backup") { 
+  &backup;
+  exit;
+}
  
  http_header('200 OK');
  
  
  http_header('200 OK');
  
@@ -79,132 +91,136 @@ s:</h1>: (<a href="?action=logout">logout</a>)</h1>:;
  print;
  
  my $nav_user = 
  print;
  
  my $nav_user = 
-  li("<a href=\"?action=create\">Create new user</a>") . "\n" .
-  li("<a href=\"?action=change-auth\">Change user auth-ID</a>") . "\n" .
-  li("<a href=\"?action=edit\">Edit user restrictions file</a>") . "\n" .
-  li("<a href=\"?action=delete\">Delete existing user</a>") . "\n" .
-  li("<a href=\"?action=quota\">Manage disk quota</a>") . "\n";
+  "<li><a href=\"?action=create\">Create new user</a>\n".
+  "<li><a href=\"?action=change-auth\">Change user auth-ID</a>\n".
+  "<li><a href=\"?action=edit\">Edit user restrictions file</a>\n".
+  "<li><a href=\"?action=delete\">Delete existing user</a>\n".
+  "<li><a href=\"?action=quota\">Manage disk quota</a>\n";
  
  my $nav_log = 
  
  my $nav_log = 
-  li("<a href=\"?action=fup.log\">Get fup.log</a>") . "\n" .
-  li("<a href=\"?action=fop.log\">Get fop.log</a>") . "\n" .
-  li("<a href=\"?action=error.log\">Get error.log</a>") . "\n";
+  "<li><a href=\"?action=fup.log\">Get fup.log</a>\n".
+  "<li><a href=\"?action=fop.log\">Get fop.log</a>\n".
+  "<li><a href=\"?action=error.log\">Get error.log</a>\n";
  
  
-if (-f 'fexsrv.log') {
+if (-f "$logdir/fexsrv.log") {
    $nav_log =
    $nav_log =
-    li("<a href=\"?action=watch\">Watch logfile</a>") . "\n" .
-    li("<a href=\"?action=fexsrv.log\">Get fexsrv.log</a>") . "\n" .
-  $nav_log;
+    "<li><a href=\"?action=watch\">Watch logfile</a>\n".
+    "<li><a href=\"?action=fexsrv.log\">Get fexsrv.log</a>\n".
+    $nav_log;
  }
  
  my $nav_backup = 
  }
  
  my $nav_backup = 
-  li("<a href=\"?action=backup\">Download backup<br>(config only)</a>") . "\n" .
-  li("<a href=\"?action=restore\">Restore backup</a>") . "\n";
+  "<li><a href=\"?action=backup\">Download backup<br>(config only)</a>\n".
+  "<li><a href=\"?action=restore\">Restore backup</a>\n";
  
  my $nav_show =
  
  my $nav_show =
-  li("<a href=\"?action=list\">List spooled files</a>") . "\n" .
-  li("<a href=\"?action=showquota\">Show quotas (sender/recipient)</a>") . "\n" .
-  li("<a href=\"?action=showconfig\">Show server config</a>") . "\n" .
-  li("<a href=\"?action=userconfig\">Show user config</a>") . "\n";
+  "<li><a href=\"?action=list\">List spooled files</a>\n".
+  "<li><a href=\"?action=showquota\">Show quotas (sender/recipient)</a>\n".
+  "<li><a href=\"?action=showconfig\">Show server config</a>\n".
+  "<li><a href=\"?action=userconfig\">Show user config</a>\n";
    
  my $nav_edit =  
    
  my $nav_edit =  
-  li("<a href=\"?action=editconfig\">Edit config</a>") . "\n" .
-  li("<a href=\"?action=editindex\">Edit index.html</a>") . "\n";
-
-#print table({-border=>"0"},Tr({-valign=>"top"},[td([ul($nav_user), ul($nav_log), ul($nav_backup), ul($nav_other)])])), "\n";
-#print "\n", hr, "\n" ;
-print table({-border=>"0"},
-       th({},["manage user","show","log files","edit","backup"]),
-       Tr({-valign=>"top"},[td([
-               ul($nav_user),
-               ul($nav_show),
-               ul($nav_log),
-               ul($nav_edit),
-               ul($nav_backup)
-])])), "\n";
-print "<hr>\n";
+  "<li><a href=\"?action=editconfig\">Edit config</a>\n".
+  "<li><a href=\"?action=editindex\">Edit index.html</a>\n";
+
+pq(qq(
+  '<table border="0">'
+  '  <th>manage user</th>'
+  '  <th>show</th>'
+  '  <th>log files</th>'
+  '  <th>edit</th>'
+  '  <th>backup</th>'
+  '  <tr valign="top">'
+  '    <td><ul>$nav_user</ul>'
+  '    <td><ul>$nav_show</ul>'
+  '    <td><ul>$nav_log</ul>'
+  '    <td><ul>$nav_edit</ul>'
+  '    <td><ul>$nav_backup</ul>'
+  '  </tr>'
+  '</table>'
+  '<hr>'
+));
  
  my @user_items = &userList;
  
  my @user_items = &userList;
-if (my $action = param("action")) {
-    if    ($action eq "create")      { &createUserForm } 
-    elsif ($action eq "change-auth") { &changeAuthForm } 
-    elsif ($action eq "edit")        { &editRestrictionsForm } 
-    elsif ($action eq "delete")      { &deleteUserForm } 
-    elsif ($action eq "quota")       { &changeQuotaForm } 
-    elsif ($action eq "list")        { &listFiles }
-    elsif ($action eq "showquota")   { &showQuota } 
-    elsif ($action eq "showconfig")  { &showConfig } 
-    elsif ($action eq "userconfig")  { &userConfigForm } 
-    elsif ($action eq "watch")       { &watchLog } 
-    elsif ($action eq "fexsrv.log")  { &getlog("fexsrv.log") } 
-    elsif ($action eq "fup.log")     { &getlog("fup.log") }
-    elsif ($action eq "fop.log")     { &getlog("fop.log") } 
-    elsif ($action eq "error.log")   { &getlog("error.log") } 
-    elsif ($action eq "editconfig")  { &editFile("$FEXLIB/fex.ph") } 
-    elsif ($action eq "editindex")   { &editFile("$docdir/index.html") } 
-    elsif ($action eq "backup")      { &backup } 
-    elsif ($action eq "restore")     { &restoreForm } 
-    else                             { http_die("STOP TRYING TO CHEAT ME!\n") }
-}
-
-if (defined param("createUser")) {
-    createUser(param("createUser"), param("authID"));
-
-} elsif (defined param("changeAuthUser")) {
-    if (param("changeAuthUser") =~ /^#.*/) {
-       &changeAuthForm;
-    } else {
-       changeUser(param("changeAuthUser"), param("authID"));
-    }
-
-} elsif (defined param("showUserConfig")) {
-    if (param("showUserConfig") =~ /^#.*/) {
-       &userConfigForm;
-    } else {
-       showUserConfig(param("showUserConfig"));
-    }
-
-} elsif (defined param("deleteUser")) {
-    if (param("deleteUser") =~ /^#.*/) {
-       &deleteUserForm;
-    } else {
-       deleteUser(param("deleteUser"));
-    }
  
  
-} elsif (defined param("userQuota")) {
-    if (param("userQuota") =~ /^#.*/) {
-       &changeQuotaForm;
+if    ($action eq "create")      { &createUserForm } 
+elsif ($action eq "change-auth") { &changeAuthForm } 
+elsif ($action eq "edit")        { &editRestrictionsForm } 
+elsif ($action eq "delete")      { &deleteUserForm } 
+elsif ($action eq "quota")       { &changeQuotaForm } 
+elsif ($action eq "list")        { &listFiles }
+elsif ($action eq "showquota")   { &showQuota } 
+elsif ($action eq "showconfig")  { &showConfig } 
+elsif ($action eq "userconfig")  { &userConfigForm } 
+elsif ($action eq "watch")       { &watchLog } 
+elsif ($action eq "fexsrv.log")  { &getlog("fexsrv.log") } 
+elsif ($action eq "fup.log")     { &getlog("fup.log") }
+elsif ($action eq "fop.log")     { &getlog("fop.log") } 
+elsif ($action eq "error.log")   { &getlog("error.log") } 
+elsif ($action eq "editconfig")  { &editFile("$FEXLIB/fex.ph") } 
+elsif ($action eq "editindex")   { &editFile("$docdir/index.html") } 
+elsif ($action eq "backup")      { &backup } 
+elsif ($action eq "restore")     { &restoreForm } 
+
+if (defined $PARAM{"createUser"}) {
+  createUser($PARAM{"createUser"}, $PARAM{"authID"});
+} elsif (defined $PARAM{"changeAuthUser"}) {
+  if ($PARAM{"changeAuthUser"} =~ /^#.*/) {
+    &changeAuthForm;
+  } else {
+    changeUser($PARAM{"changeAuthUser"}, $PARAM{"authID"});
+  }
+} elsif (defined $PARAM{"showUserConfig"}) {
+  if ($PARAM{"showUserConfig"} =~ /^#.*/) {
+    &userConfigForm;
+  } else {
+    showUserConfig($PARAM{"showUserConfig"});
+  }
+} elsif (defined $PARAM{"deleteUser"}) {
+  if ($PARAM{"deleteUser"} =~ /^#.*/) {
+    &deleteUserForm;
+  } else {
+    deleteUser($PARAM{"deleteUser"});
+  }
+} elsif (defined $PARAM{"userQuota"}) {
+  if ($PARAM{"userQuota"} =~ /^#.*/) {
+    &changeQuotaForm;
+  } else {
+    if (defined $PARAM{"default quota"}) {
+      $user = normalize_user($PARAM{"userQuota"});
+      unlink "$user/\@QUOTA";
+      print "$user has now default quota:<p>\n";
+      print "recipient quota: $recipient_quota MB<br>\n";
+      print "sender quota: $sender_quota MB<br>\n";
+      &end_html;
      } else {
      } else {
-       if (defined param("remove quota")) {
-           $user = param("userQuota");
-           deleteFiles("$spooldir/$user/\@QUOTA");
-       } else {
-           alterQuota(param("userQuota"), param("recipientQuota"), param("senderQuota"));
-       }
+      alterQuota(
+        $PARAM{"userQuota"},
+        $PARAM{"recipientQuota"},
+        $PARAM{"senderQuota"}
+      );
      }
      }
-
-} elsif (defined param("editUser")) {
-    if (param("editUser") =~ /^#.*/) {
-       &editRestrictionsForm;
+  }
+} elsif (defined $PARAM{"editUser"}) {
+  if ($PARAM{"editUser"} =~ /^#.*/) {
+    &editRestrictionsForm;
+  } else {
+    if (defined $PARAM{"delete file"}) {
+      $user = normalize_user($PARAM{"editUser"});
+      unlink "$user/\@ALLOWED_RECIPIENTS";
+      print "upload restrictions for $user have been deleted\n";
+      &end_html;
      } else {
      } else {
-       if (defined param("delete file")) {
-           $user = param("editUser");
-           deleteFiles("$spooldir/$user/\@ALLOWED_RECIPIENTS");
-       } else {
-           editUser(param("editUser"));
-       }
+      editUser($PARAM{"editUser"});
      }
      }
-
-} elsif (defined param("contentBox") && defined param("ar")) {
-    saveFile(param("contentBox"), param("ar"));
-
-} elsif (defined param("upload_archive")) {
-    restore(param("upload_archive"));
+  }
+} elsif ($PARAM{"contentBox"} and $PARAM{"ar"}) {
+  saveFile($PARAM{"contentBox"},$PARAM{"ar"});
+} elsif ($PARAM{"upload_archive"}) {
+  restore($PARAM{"upload_archive"}{data});
  }
  
  }
  
-print end_html();
-exit;
-
+&end_html;
  
  #######
  # declaration of formular functions
  
  #######
  # declaration of formular functions
@@ -213,102 +229,163 @@ exit;
  # formular for creating new users
  # required arguments: -
  sub createUserForm {
  # formular for creating new users
  # required arguments: -
  sub createUserForm {
-    my $nameRow = "\n" . td(["user:", textfield(-size=>80, -name=>"createUser")]);
-    my $authRow = "\n" . td(["auth-ID:", textfield(-size=>80, -name=>"authID")]);
-    print "\n", h3("Create new user");
-    print "\n", start_form(-name=>"create", -method=>"POST");
-    print "\n", table(Tr([$nameRow, $authRow]));
-    print "\n", submit('create user'), br;
-    print "\n", end_form;
+  print h3("Create new user");
+  pq(qq(
+    '<form action="/$fac" method="post" enctype="multipart/form-data">'
+    '<table>'
+    '<tr>'
+    '<td>user</td><td><input type="text" name="createUser" size="80"></td>'
+    '</tr>'
+    '<tr>'
+    '<td>auth-ID:</td><td><input type="text" name="authID" size="16"></td>'
+    '</tr>'
+    '</table>'
+    '<input type="submit" name="create user" value="create user">'
+    '</form>'
+  ));
+  &end_html;
  }
  
  # formular for changing auth-id of an user
  # required arguments: -
  sub changeAuthForm {
  }
  
  # formular for changing auth-id of an user
  # required arguments: -
  sub changeAuthForm {
-    my $nameRow = "\n" . td(["user:", popup_menu(-name=>"changeAuthUser", -values=>\@user_items)]);
-    my $authRow = "\n" . td(["new auth-ID:", textfield(-size=>80, -name=>"authID")]);
-    print "\n", h3("change auth-ID");
-    print "\n", start_form(-name=>"change-auth", -method=>"POST");
-    print "\n", table(Tr([$nameRow, $authRow]));
-    print "\n", submit('change'), br;
-    print "\n", end_form;
+  my @option = map { "<option value=\"$_\">$_</option>\n" } @user_items;
+
+  print h3("change auth-ID");
+  pq(qq(
+    '<form action="/$fac" method="post" enctype="multipart/form-data">'
+    '<table>'
+    '<tr>'
+    '<td>user:</td><td><select name="changeAuthUser">@option</select></td>'
+    '</tr>'
+    '<tr>'
+    '<td>new auth-ID:</td><td><input type="text" name="authID" size="16"></td>'
+    '</tr>'
+    '</table>'
+    '<input type="submit" name="change" value="change">'
+    '</form>'
+  ));
+  &end_html;
  }
  
  # formular choosing user, whose config files shall be shown
  # required arguments: -
  sub userConfigForm {
  }
  
  # formular choosing user, whose config files shall be shown
  # required arguments: -
  sub userConfigForm {
-    my $nameRow = "\n". td(["user:", popup_menu(-name=>"showUserConfig", -values=>\@user_items)]);
-    print "\n", h3("Show user config files");
-    print "\n", start_form(-name=>"showUserConfig", -method=>"POST");
-    print "\n", table(Tr([$nameRow]));
-    print "\n", submit('show config files'), br;
-    print "\n", end_form;
+  my @option = map { "<option value=\"$_\">$_</option>\n" } @user_items;
+
+  print h3("Show user config files");
+  pq(qq(
+    '<form action="/$fac" method="post enctype="multipart/form-data">'
+    '<table>'
+    '<tr>'
+    '<td>user:</td><td><select name="showUserConfig">@option</select></td>'
+    '</tr>'
+    '</table>'
+    '<input type="submit" name="show config files" value="show config files">'
+    '</form>'
+  ));
+  &end_html;
  }
  
  # formular for choosing user, whose restriction file shall be edited
  # required arguments: -
  sub editRestrictionsForm {
  }
  
  # formular for choosing user, whose restriction file shall be edited
  # required arguments: -
  sub editRestrictionsForm {
-    my $nameRow = "\n" . td(["user:", popup_menu(-name=>"editUser", -values=>\@user_items)]);
-    print "\n", h3("Edit user restriction file");
-    print "\n", start_form(-name=>"edit", -method=>"POST");
-    print "\n", table(Tr([$nameRow]));
-    print "\n", submit('edit file');
-    print "\n", submit('delete file'), br;
-    print "\n", end_form;
+  my @option = map { "<option value=\"$_\">$_</option>\n" } @user_items;
+
+  print h3("Edit user restriction file");
+  pq(qq(
+    '<form action="/$fac" method="post enctype="multipart/form-data">'
+    '<table>'
+    '<tr>'
+    '<td>user:</td><td><select name="editUser">@option</select></td>'
+    '</tr>'
+    '</table>'
+    '<input type="submit" name="edit file" value="edit file">'
+    '<input type="submit" name="delete file" value="delete file">'
+    '</form>'
+  ));
+  &end_html;
  }
  
  # formular for choosing user, who shall be removed
  # required arguments: - 
  sub deleteUserForm {
  }
  
  # formular for choosing user, who shall be removed
  # required arguments: - 
  sub deleteUserForm {
-    my $nameRow = "\n". td(["user:", popup_menu(-name=>"deleteUser", -values=>\@user_items)]);
-    print "\n", h3("Delete existing user");
-    print "\n", start_form(-name=>"deleteUser", -method=>"POST");
-    print "\n", table(Tr([$nameRow]));
-    print "\n", submit('delete user'), br;
+  my @option = map { "<option value=\"$_\">$_</option>\n" } @user_items;
  
  
-    print "\n", end_form;
+  print h3("Delete existing user");
+  pq(qq(
+    '<form action="/$fac" method="post enctype="multipart/form-data">'
+    '<table>'
+    '<tr>'
+    '<td>user:</td><td><select name="deleteUser">@option</select></td>'
+    '</tr>'
+    '</table>'
+    '<input type="submit" name="delete user" value="delete user">'
+    '</form>'
+  ));
+  &end_html;
  }
  
  # formular for changing an user's quota file
  # required arguments: -
  sub changeQuotaForm {
  }
  
  # formular for changing an user's quota file
  # required arguments: -
  sub changeQuotaForm {
-    my ($rquota,$squota) = '';
-    $rquota = param("rquota") if defined param("rquota");
-    $squota = param("squota") if defined param("squota");
-    my $dropdownMenu;
-    if (defined param("user")) {
-       $dropdownMenu = "<select name=\"userQuota\">\n";
-       foreach (@user_items) {
-           if ($_ eq param("user")) {
-               $dropdownMenu .= "<option value=\"$_\" selected>$_</option>";
-           } else {
-               $dropdownMenu .= "<option value=\"$_\">$_</option>";
-           }
-       }
-       $dropdownMenu .= "</select>\n";
+  my $user;
+  my @option;
+  my $rquota = '';
+  my $squota = '';
+  
+  if ($user = $PARAM{"user"}) {
+
+    $user = normalize_user($user);
+    $rquota = $1 if ($PARAM{"rquota"}||'') =~ /^(\d+)$/;
+    $squota = $1 if ($PARAM{"squota"}||'') =~ /^(\d+)$/;
+  }
+
+  foreach (@user_items) {
+    if ($user and $user eq $_) {
+      push @option,"<option value=\"$_\" selected>$_</option>\n";
      } else {
      } else {
-       $dropdownMenu = popup_menu(-name=>"userQuota", -values=>\@user_items);
+      push @option,"<option value=\"$_\">$_</option>\n";
      }
      }
-    my $nameRow = "\n" . td(["user:", $dropdownMenu]);
-    my $recipientRow = "\n" . td(["new quota for recipient:", textfield(-size=>20, -name=>"recipientQuota", -value=>$rquota). " MB (optional)"]);
-    my $senderRow = "\n" . td (["new quota for sender:", textfield(-size=>20, -name=>"senderQuota", -value=>$squota). " MB (optional)"]);
-    print "\n", h3("Manage disk quota");
-    print "\n", start_form(-name=>"manageQuota", -method=>"POST");
-    print "\n", table(Tr([$nameRow, $recipientRow, $senderRow]));
-    print "\n", submit('change quota');
-    print "\n", submit('remove quota'), br;
-    print "\n", end_form;
+  }
+
+  print h3("Manage disk quota");
+  pq(qq(
+    '<form action="/$fac" method="post" enctype="multipart/form-data">'
+    '<table>'
+    '<tr>'
+    '<td>user:</td><td><select name="userQuota">@option</select></td>'
+    '</tr>'
+    '<tr>'
+    '<td>new quota for recipient:</td>'
+    '<td><input type="text" name="recipientQuota" size="12" value=\"$rquota\">'
+    ' MB (optional)</td>'
+    '</tr>'
+    '<tr>'
+    '<td>new quota for sender:</td>'
+    '<td><input type="text" name="senderQuota" size="12" value=\"$squota\">'
+    ' MB (optional)</td>'
+    '</tr>'
+    '</table>'
+    '<input type="submit" name="change quota" value="change quota">'
+    '<input type="submit" name="default quota" value="default quota">'
+    '</form>'
+  ));
+  &end_html;
  }
  
  # formular for choosing backup file to restore
  # required arguments: -
  sub restoreForm {
  }
  
  # formular for choosing backup file to restore
  # required arguments: -
  sub restoreForm {
-    print h2("restore config");
-    print "please specify the backup-archive you want to restore:";
-    print "\n", start_form(-name=>"restoreFile", -method=>"POST");
-    print "\n", filefield(-name=>"upload_archive", -size=>"80"), br;
-    print "\n", submit('restore');
-    print "\n", end_form;
+  print h2("restore config");
+  pq(qq(
+    'Specify the backup-archive you want to restore:<br>'
+    '<form action="/$fac" method="post" enctype="multipart/form-data">'
+    '<input type="file" name="upload_archive" size="80"><br>'
+    '<input type="submit" name="restore" value="restore">'
+    '</form>'
+  ));
+  &end_html;
  }
  
  
  }
  
  
@@ -319,417 +396,453 @@ sub restoreForm {
  # function for creating new users
  # required arguments: username, auth-id
  sub createUser {
  # function for creating new users
  # required arguments: username, auth-id
  sub createUser {
-    my ($user,$id) = @_;
-    my $idf;
-  
-    $id or http_die("not enough arguments in createUser");
-  
-    $user = lc $user;
-    $user =~ s:/::g;
-    $user =~ s:^[.@]+::;
-    $user =~ s:@+$::;
-
-    if ($user !~ /@/) {
-        if ($mdomain) {
-            $user .= '@'.$mdomain;
-        } else {
-            error("Missing domain part in user address");
-        }
-    }
+  my ($user,$id) = @_;
+  my $idf;
    
    
-    unless (-d "$spooldir/$user") {
-        mkdir "$spooldir/$user",0755 
-          or http_die("cannot mkdir $spooldir/$user - $!\n");
-    }
+  http_die("not enough arguments in createUser") unless $id;
    
    
-    $idf = "$spooldir/$user/@";
+  $user = normalize_user($user);
  
  
-    if (-f $idf) {
-       error("There is already an user $user!");       
-    }
+  unless (-d "$user") {
+    mkdir "$user",0755 or http_die("cannot mkdir $user - $!");
+  }
+  
+  $idf = "$user/@";
+
+  if (-f $idf) {
+    html_error($error,"There is already an user $user!");      
+  }
    
    
-    open $idf,'>',$idf or http_die("cannot write $idf - $!\n");
-    print {$idf} $id,"\n";
-    close $idf or http_die("cannot write $idf - $!\n");
-    print "<code>\n";
-    printf "%s?from=%s&ID=%s<br>\n",$fup,$user,$id;
-    printf "%s/%s<p>\n",$fup,b64("from=$user&id=$id");
-    print "</code>\n";
-    notifyUser($user,$id);
-    print "An information e-mail to $user has been sent.\n";
+  open $idf,'>',$idf or http_die("cannot write $idf - $!");
+  print {$idf} $id,"\n";
+  close $idf or http_die("cannot write $idf - $!");
+  print "<code>\n";
+  printf "%s?from=%s&ID=%s<br>\n",$fup,$user,$id;
+  printf "%s/%s<p>\n",$fup,b64("from=$user&id=$id");
+  print "</code>\n";
+  notifyUser($user,$id);
+  print "An information e-mail to $user has been sent.\n";
+  &end_html;
  }
  
  # function for changing an user's auth-ID
  # required arguments: username, auth-id
  sub changeUser {
  }
  
  # function for changing an user's auth-ID
  # required arguments: username, auth-id
  sub changeUser {
-    my ($user,$id) = @_;
-    defined($id) or http_die("not enough arguments in changeUser.\n");
-
-    $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
-    my $idf = "$spooldir/$user/@";
-    print "<code>\n";
-    print "$idf<p>";
-
-    open $idf,'>',$idf or http_die("cannot write $idf - $!\n");
-    print {$idf} $id,"\n";
-    close $idf or http_die("cannot write $idf - $!\n");
-    printf "%s?from=%s&ID=%s<br>\n",$fup,$user,$id;
-    printf "%s/%s\n",$fup,b64("from=$user&id=$id");
-    print "</code><p>\n";
-    notifyUser($user,$id,"change-auth");
-    print "An information e-mail to $user has been sent.\n";
+  my ($user,$id) = @_;
+  
+  http_die("not enough arguments in changeUser") unless $id;
+  
+  $id = despace($id);
+  $user = normalize_user($user);
+  my $idf = "$user/@";
+  print "<code>\n";
+  print "$idf<p>";
+  
+  open $idf,'>',$idf or http_die("cannot write $idf - $!");
+  print {$idf} $id,"\n";
+  close $idf or http_die("cannot write $idf - $!");
+  printf "%s?from=%s&ID=%s<br>\n",$fup,$user,$id;
+  printf "%s/%s\n",$fup,b64("from=$user&id=$id");
+  print "</code><p>\n";
+  notifyUser($user,$id,"change-auth");
+  print "An information e-mail to $user has been sent.\n";
+  &end_html;
  }
  
  # function for showing an user's config files
  # required arguments: username
  sub showUserConfig {
  }
  
  # function for showing an user's config files
  # required arguments: username
  sub showUserConfig {
-    http_die("not enough arguments in showUserConfig!\n") unless (my $user = $_[0]);
+  my $user = shift;
+
+  http_die("not enough arguments in showUserConfig!") unless $user;
+  $user = normalize_user($user);
     
     
-    chdir "$spooldir/$user" or http_die("could not change directory $spooldir/$user - $!");
-    print h2("Config files of <code>$user</code>");
-
-    foreach my $file (glob('.auto @* @GROUP/*')) {
-       if (-f $file and not -l $file and $file !~ /.*~$/) {
-           print h3($file), "\n";
-           open $file,'<',$file or http_die("cannot open $file - $!");
-            # print "<table border=1><tr><td>\n";
-            dumpfile($file);
-            # print "</tr></table>\n";
-           close $file;
-       }
+  chdir "$user" or http_die("could not change directory $user - $!");
+  print h2("Config files of <code>$user</code>");
+
+  foreach my $file (glob('.auto @* @GROUP/*')) {
+    if (-f $file and not -l $file and $file !~ /.*~$/) {
+      print h3($file), "\n";
+      open $file,'<',$file or http_die("cannot open $file - $!");
+      # print "<table border=1><tr><td>\n";
+      dumpfile($file);
+      # print "</tr></table>\n";
+      close $file;
      }
      }
+  }
+  &end_html;
  }
  
  # function for editing an user's recipient/sender restrictions
  # required arguments: username
  sub editUser {
  }
  
  # function for editing an user's recipient/sender restrictions
  # required arguments: username
  sub editUser {
-    http_die("not enough arguments in editUser.\n") unless (my $user = $_[0]);
-    my @content;
-    http_die("no user $user") unless -d "$spooldir/$user";
-    my $ar = "$spooldir/$user/\@ALLOWED_RECIPIENTS";
-    unless (-f $ar) {
-       print "yeah!";
-        open F,">$ar" or http_die("cannot open $ar - $!");
-        print F<<EOD;
+  my $user = shift;
+  my $content;
+  
+  http_die("not enough arguments in editUser") unless $user;
+  $user = normalize_user($user);
+  http_die("no user $user") unless -d $user;
+  my $ar = "$user/\@ALLOWED_RECIPIENTS";
+  unless (-f $ar) {
+    open $ar,'>',$ar or http_die("cannot open $ar - $!");
+    print {$ar}<<'EOD';
  # Restrict allowed recipients. Only those listed here are allowed.
  # Make this file COMPLETLY empty if you want to disable the restriction.
  # An allowed recipient is an e-mail address, you can use * as wildcard.
  # Restrict allowed recipients. Only those listed here are allowed.
  # Make this file COMPLETLY empty if you want to disable the restriction.
  # An allowed recipient is an e-mail address, you can use * as wildcard.
-# Example: *\@flupp.org
+# Example: *@flupp.org
  EOD
  EOD
-        close F;
-    }
-    open my $file,'<',$ar or http_die("cannot open $ar - $!");
-    while (<$file>) {
-        push @content, $_;
-    }
-    close $file or http_die("cannot write $file - $!\n");
-    print "\nedit file:", br;
-    print "\n", start_form(-name=>"editRestrictions", -method=>"POST");
-    print "\n", textarea(-name=>'contentBox', -default=>join('',@content), -rows=>10, -columns=>80), br;
-    print "\n", hidden(-name=>'ar', -default=>"$ar",);
-    print "\n", submit('save changes');
-    print "\n", end_form;
+    close $ar;
+  }
+  $content = dehtml(slurp($ar));
+  pq(qq(
+    'Edit restrictions file for user $user :<br>'
+    '<form action="/$fac" method="post" enctype="multipart/form-data">'
+    '<textarea name="contentBox"  rows="10" cols="80">'
+    '$content'
+    '</textarea><br>'
+    '<input type="hidden" name="ar" value="$ar">'
+    '<input type="submit" name="save changes" value="save changes">'
+    '</form>'
+  ));
+  &end_html;
  }
  
  # function for deleting files
  # required arguments: list of Files
  sub deleteFiles {
  }
  
  # function for deleting files
  # required arguments: list of Files
  sub deleteFiles {
-    http_die("not enough arguments in deleteFiles.\n") unless (my @files = @_);
+  http_die("not enough arguments in deleteFiles") unless (my @files = @_);
      
      
-    foreach (@files) {
-       if (-e $_) {
-           if (unlink $_) {
-               print "file has been deleted: $_\n", br;
-           } else {
-               print "file could not be deleted: $_ - $!\n", br;
-           }
-       } else {
-           print "file does not exists: $_\n", br;
-       }
+  foreach (@files) {
+    if (-e) {
+      if (unlink $_) {
+        print "file has been deleted: $_<br>\n";
+      } else {
+        print "file could not be deleted: $_ - $!<br>\n";
+      }
+    } else {
+      print "file does not exists: $_<br>\n";
      }
      }
+  }
+  &end_html;
  }
  
  # function for saving a single file
  # required arguments: content, location
  sub saveFile {
  }
  
  # function for saving a single file
  # required arguments: content, location
  sub saveFile {
-    http_die("not enough arguments in saveFile.\n") unless (my ($rf,$ar) = @_);
-
-    if ($ar eq "$FEXLIB/fex.ph") {
-        open my $conf,">${ar}_new" or http_die("cannot open ${ar}_new - $!");
-        print {$conf} $rf;
-        close $conf or http_die("cannot write $conf - $!\n");;
-        my $status = `perl -c $FEXLIB/fex.ph_new 2>&1`;
-        if ($status =~ /syntax OK/ ) {
-             unlink "${ar}_new";
-        } else {
-            pq(qq(
-              'No valid syntax in configuration file:'
-              '<p>'
-              '<pre>$status</pre>'
-            ));
-            &editFile("$FEXLIB/fex.ph_new");
-            exit;
-        }
-    }
-    open my $file,">$ar" or http_die("cannot open $ar - $!");
-    print {$file} $rf;
-    close $file or http_die("cannot write $file - $!\n");;
-    print "The following data has been saved:\n<p>\n";
-    open $file,'<',$ar or http_die("cannot open $ar - $!");
-    if ($ar =~ /\.html$/) {
-       print while <$file>;
+  my ($rf,$ar) = @_;
+  my $new;
+  
+  http_die("not enough arguments in saveFile") unless $ar;
+  
+  if ($ar eq 'index.html') {
+    $ar = "$docdir/index.html"
+  } elsif ($ar eq 'fex.ph') {
+    $ar = "$FEXLIB/fex.ph"
+  } elsif ($ar =~ m'^([^/]+/\@ALLOWED_RECIPIENTS)$') {
+    $ar = $1;
+  } else {
+    http_die("unknown file $ar")
+  }
+  
+  $new = $ar.'_new';
+  if ($ar =~ /fex.ph$/) {
+    open $new,'>',$new or http_die("cannot open ${ar}_new - $!");
+    print {$new} $rf;
+    close $new or http_die("cannot write $new - $!");;
+    my $status = dehtml(`perl -c $FEXLIB/fex.ph_new 2>&1`);
+    if ($status =~ /syntax OK/ ) {
+      rename $ar,"$ar~";
+      rename $new,$ar;
+      http_die("cannot write $ar~ - $!") if $?;
      } else {
      } else {
-        print "<pre>\n";
-       print while <$file>;
+      rename "$ar~",$ar;
+      pq(qq(
+        'No valid syntax in configuration file:'
+        '<p><pre>$status</pre><p>'
+        '<a href="javascript:history.back()">back</a>'
+      ));
+      &end_html;
      }
      }
-    close $file or http_die("cannot write $file - $!\n");;
+  } else {
+    system qw'cp -a',$ar,"$ar~";
+  }
+  open $ar,'>',$ar or http_die("cannot write $ar - $!");
+  print {$ar} $rf;
+  close $ar or http_die("cannot write $ar - $!");;
+  print "<code>$ar</code> has been saved\n";
+  &end_html;
  }
  
  # function for deleting existing user
  # required arguments: username
  sub deleteUser {
  }
  
  # function for deleting existing user
  # required arguments: username
  sub deleteUser {
-    http_die("not enough arguments in createUser.\n") unless (my $user = $_[0]);
+  my $user = shift;
+
+  http_die("not enough arguments in deleteUser") unless $user;
+
+  $user = normalize_user($user);
  
  
-    $idf = "$spooldir/$user/\@";
-    http_die("no such user $user\n") unless -f $idf;
-    unlink $idf or http_die("cannot remove $idf - $!\n");
-    unlink "$spooldir/$user/\@ALLOWED_RECIPIENTS";
-    print "$user deleted\n";
+  $idf = "$user/\@";
+  http_die("no such user $user") unless -f $idf;
+  unlink $idf or http_die("cannot remove $idf - $!");
+  unlink "$user/\@ALLOWED_RECIPIENTS";
+  unlink "$user/\@SUBUSER";
+  rmrf("$user/\@GROUP");
+  print "$user deleted\n";
+  &end_html;
  }
  
  # function for saving quota information for one single user
  # required arguments: username, recipient-quota, sender-quota
  sub alterQuota {
  }
  
  # function for saving quota information for one single user
  # required arguments: username, recipient-quota, sender-quota
  sub alterQuota {
-    http_die("not enough arguments in createUser.\n") unless (my ($user,$rq,$sq) = @_);
-
-    $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
-    unless (-d "$spooldir/$user") {
-        http_die("$user is not a regular F*EX user\n");
-    }
+  my ($user,$rq,$sq) = @_;
+  my ($rquota,$squota);
+  my $qf;
  
  
-    $rquota = $squota = '';
-    $qf = "$spooldir/$user/\@QUOTA";
-    if (open $qf,'<',$qf) {
-        while (<$qf>) {
-            s/#.*//;
-            $rquota = $1 if /recipient.*?(\d+)/i;
-            $squota = $1 if /sender.*?(\d+)/i;
-        }
-        close $qf or http_die("cannot write $qf - $!\n");
-    }
-
-    open $qf,'>',$qf or http_die("cannot open $qf - $!\n");
-    if(defined($rq) && $rq ne "") {
-        $rquota = $1 if $rq =~ /(\d+)/i;
+  $user = normalize_user($user);
+  http_die("$user is not a F*EX user") unless -d $user;
+  
+  $rquota = $squota = '';
+  $qf = "$user/\@QUOTA";
+  if (open $qf,$qf) {
+    while (<$qf>) {
+      s/#.*//;
+      $rquota = $1 if /recipient.*?(\d+)/i;
+      $squota = $1 if /sender.*?(\d+)/i;
      }
      }
-    if(defined($sq) && $sq ne "") {
-        $squota = $1 if $sq =~ /(\d+)/i;
-    }    
-    print {$qf} "recipient:$rquota\n" if $rquota =~ /\d/;
-    print {$qf} "sender:$squota\n" if $squota =~ /\d/;
-    close $qf or http_die("cannot write $qf - $!\n");
-
-    $rquota = $recipient_quota if $rquota !~ /\d/;
-    $squota = $sender_quota    if $squota !~ /\d/;
-    print h3("New quotas for $user");
-    print "recipient quota: $rquota MB\n", br;
-    print "sender quota:   $squota MB\n", br;
+    close $qf;
+  }
+  
+  $rquota = $1 if $rq and $rq =~ /(\d+)/;
+  $squota = $1 if $sq and $sq =~ /(\d+)/;
+  open $qf,'>',$qf or http_die("cannot write $qf - $!");
+  print {$qf} "recipient:$rquota\n" if $rquota;
+  print {$qf} "sender:$squota\n"    if $squota;
+  close $qf or http_die("cannot write $qf - $!");
+  
+  $rquota = $recipient_quota unless $rquota;
+  $squota = $sender_quota    unless $squota;
+  print h3("New quotas for $user");
+  print "recipient quota: $rquota MB<br>\n";
+  print "sender quota: $squota MB<br>\n";
+  &end_html;
  }
  
  # function for listing f*exed files
  # required arguments: -
  sub listFiles {
  }
  
  # function for listing f*exed files
  # required arguments: -
  sub listFiles {
-    print h3("List current files"),"\n";
-    my ($file,$dkey);
-    chdir $spooldir or http_die("$spooldir - $!\n");
-    print "<code>\n";
-    foreach $file (glob "*/*/*") {
-        if (-s "$file/data" and  $dkey = readlink("$file/dkey") and -l ".dkeys/$dkey") {
-          ($to,$from,$file) = split "/",$file;
-          $file = html_quote($file);
-          print "$from --> $to : $durl/$dkey/$file<br>\n";
-        }
+  print h3("List current files");
+  my ($file,$dkey);
+  print "<pre>\n";
+  foreach $recipient (glob "*@*") {
+    next if -l $recipient;
+    foreach $file (glob "$recipient/*/*") {
+      if (-s "$file/data" and  $dkey = readlink("$file/dkey") and -l ".dkeys/$dkey") {
+        ($to,$from,$file) = split "/",$file;
+        $file = html_quote($file);
+        print "$from &rarr; $to : $durl/$dkey/$file\n";
+      }
      }
      }
-    print "</code>\n";
+  }
+  print "</pre>\n";
+  &end_html;
  }
  
  # function for watching the fex-logfile
  # required arguments: -
  sub watchLog {
  }
  
  # function for watching the fex-logfile
  # required arguments: -
  sub watchLog {
-  if (-f 'fexsrv.log') {
+  if (-f "$logdir/fexsrv.log") {
      print h2("polling fexsrv.log"),"\n";
      open my $log,"$FEXHOME/bin/logwatch|" 
      print h2("polling fexsrv.log"),"\n";
      open my $log,"$FEXHOME/bin/logwatch|" 
-      or http_die("cannot run $FEXHOME/bin/logwatch - $!\n");
+      or http_die("cannot run $FEXHOME/bin/logwatch - $!");
      dumpfile($log);
    } else {
      dumpfile($log);
    } else {
-    print h2("no fexsrv.log"),"\n";
+    print h2("no fexsrv.log");
    }
    }
+  &end_html;
  }
  
  # function for showing logfiles
  # required arguments: logfile-name
  sub getlog {
  }
  
  # function for showing logfiles
  # required arguments: logfile-name
  sub getlog {
-    my $log = shift or http_die("not enough arguments in getLog");
-
-    print h2("show $log"),"\n";
-    if (open $log,"$logdir/$log") {
-        dumpfile($log);
-        close $log;
-    } else {
-        http_die("cannot open $logdir/$log - $!\n");
-    }
+  my $log = shift or http_die("not enough arguments in getLog");
+  
+  print h2("show $log");
+  if (open $log,"$logdir/$log") {
+    dumpfile($log);
+    close $log;
+  } else {
+    http_die("cannot open $logdir/$log - $!");
+  }
+  &end_html;
  }
  
  # function for creating a new backup file
  # required arguments: -
  sub backup {
  }
  
  # function for creating a new backup file
  # required arguments: -
  sub backup {
-    my @d = localtime time;
-    my $date = sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]);
-    my $backup = "backup/config-$date.tar";
-    my $http_client = $ENV{HTTP_USER_AGENT} || '';
-    my $size;
-
-    my $home = $FEXHOME;
-    $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
+  my @d = localtime time;
+  my $date = sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]);
+  my $backup = "backup/config-$date.tar";
+  my $http_client = $ENV{HTTP_USER_AGENT} || '';
+  my $size;
+
+  my $home = $FEXHOME;
+  $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
    
    
-    chdir $home or http_die("$home - $!\n");
-
-    unless (-d "backup") {
-       mkdir "backup",0700 or http_die("cannot mkdir backup - $!\n");
-    }
-
-    system "tar -cf $backup @backup_files 2>/dev/null";
-
-    $size = -s $backup or http_die("backup file empty\n");
-
-    open $backup,'<',$backup or http_die("cannot open $backup - $!\n");
-
-    nvt_print(
-        'HTTP/1.1 200 OK',
-        "Content-Length: $size",
-        "Content-Type: application/octet-stream; filename=fex-backup-$date.tar",
-        "Content-Disposition: attachment; filename=\"fex-backup-$date.tar\"",
-       "",
-       );
- 
-    while (read($backup,my $b,$bs)) {
-       print $b or last;
-    }
-
-    exit;
+  chdir $home or http_die("$home - $!");
+  
+  unless (-d "backup") {
+    mkdir "backup",0700 or http_die("cannot mkdir backup - $!");
+  }
+  
+  system "tar -cf $backup @backup_files 2>/dev/null";
+  
+  $size = -s $backup or http_die("backup file empty");
+  
+  open $backup,'<',$backup or http_die("cannot open $backup - $!");
+  
+  nvt_print(
+    'HTTP/1.1 200 OK',
+    "Content-Length: $size",
+    "Content-Type: application/octet-stream; filename=fex-backup-$date.tar",
+    "Content-Disposition: attachment; filename=\"fex-backup-$date.tar\"",
+    "",
+  );
+  
+  while (read($backup,my $b,$bs)) {
+    print $b or last;
+  }
+  
+  exit;
  }
  
  # function for restoring an old configuration file
  # required arguments: uploaded archive
  sub restore {
  }
  
  # function for restoring an old configuration file
  # required arguments: uploaded archive
  sub restore {
-    http_die("not enough arguments in restore!\n") unless (my $archive_file = $_[0]);
-    my $restore = "backup.tar";
-
-    my $home = $FEXHOME;
-    $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
-
-    chdir $home or http_die("$home - $!\n");
-
-    open $restore,'>',$restore or http_die("cannot open $restore - $!");
-
-    my $data;
-    while(read $archive_file,$data,$bs) {
-       print {$restore} $data;
-    }
-    close $restore or http_die("cannot write $restore - $!");
-    if (-s $restore) {
-       print "file upload successful, saving actual config in $home/backup/failsave.tar\n", br;
-       system "tar -cf $home/backup/failsave.tar @backup_files 2>/dev/null";
-       print "starting restore:\n<p><pre>\n";
-        system "tar -xvf $restore";
-        unlink $restore;
-    } else {
-       http_die("upload error - no file data received\n");
-    }
+  my $archive_file = shift or http_die("not enough arguments in restore!");
+  my $restore = "backup.tar";
+  my $home = $FEXHOME;
+
+  $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
+
+  chdir $home or http_die("$home - $!");
+  mkdir 'backup';
+
+  open $restore,'>',$restore or http_die("cannot open $restore - $!");
+  print {$restore} $archive_file;
+  close $restore or http_die("cannot write $restore - $!");
+  if (-s $restore) {
+    print "file upload successful<br>\n";
+    print "saving actual config in $home/backup/config.tar<br>\n";
+    print "<pre>\n";
+    system "tar -cf backup/config.tar @backup_files";
+    print "</pre>\n";
+    print "starting restore:\n<p>\n";
+    print "<pre>\n";
+    system "tar -xvf $restore";
+    unlink $restore;
+    &end_html;
+  } else {
+    http_die("upload error - no file data received");
+  }
  }
  
  # function for editing a text-file
  # required arguments: filepath, filename
  sub editFile {
  }
  
  # function for editing a text-file
  # required arguments: filepath, filename
  sub editFile {
-    my $ar = shift;
-    my $file;
-    local $/;
+  my $ar = shift;
+  my $file;
    
    
-    open $ar,'<',$ar or http_die("cannot open $ar - $!");
-    $file = <$ar>;
-    close $ar;
+  $file = dehtml(slurp($ar));
+  
+  $ar =~ s:.*/::;
  
  
-    print start_form(-name=>"editFile", -method=>"POST"),"\n";
-    print textarea(-name=>'contentBox', -default=>$file, -rows=>26, -columns=>80), br,"\n";
-    print hidden(-name=>'ar', -default=>"$ar"),"\n";
-    print submit('save changes'),"\n";
-    print end_form(),"\n";
+  print h2("edit <code>$ar<code>");
+
+  pq(qq(
+    '<form action="/$fac" enctype="multipart/form-data" method="post">'
+    '<textarea name="contentBox" rows="26" cols="80">'
+    '$file'
+    '</textarea><br>'
+    '<input type="hidden" name="ar" value="$ar">'
+    '<input type="submit" name="save changes" value="save changes">'
+    '</form>'
+  ));
+  &end_html;
  }
  
  # function for showing all users' quotas
  # required arguments: -
  sub showQuota {
  }
  
  # function for showing all users' quotas
  # required arguments: -
  sub showQuota {
-    my @table_content;
-    my $table_head;
-
-    print h2("Show quotas (domain sorted, values in MB)");
-    foreach (@user_items) {
-       if (s/###\s*//g) {
-           $table_head = th({}, ["\@$_","sender","sender (used)","recipient","recipient (used)"]);
-           if (@table_content) {
-               print table({-border=>1},Tr([@table_content])), "\n<p>\n";
-               @table_content = '';
-           }
-           push @table_content, $table_head;
-       } else {
-           my $rquota = $recipient_quota;
-           my $squota = $sender_quota;
-           my $rquota_used = 0;
-           my $squota_used = 0;
-           my $user = $_;
-           ($squota,$squota_used) = check_sender_quota($user);
-           ($rquota,$rquota_used) = check_recipient_quota($user);
-           s/\@.*//;
-           push @table_content, 
-              "<td><a href=\"?action=quota&user=$user&rquota=$rquota&squota=$squota\">$_</a></td>".
-              "<td align=\"right\">$squota</td>".
-              "<td align=\"right\">$squota_used</td>".
-              "<td align=\"right\">$rquota</td>".
-              "<td align=\"right\">$rquota_used</td>";
-       }
+
+  print h2("Show quotas (domain sorted, values in MB)");
+  print "<table border=\"1\"><tr>";
+  foreach (@user_items) {
+    if (/\#\#\#\s(\S+)/) {
+      print "<tr>";
+      print "<th>\@$1</th>";
+      print "<th>sender</th>";
+      print "<th>sender (used)</th>";
+      print "<th>recipient</th>";
+      print "<th>recipient (used)</th>";
+      print "</tr>\n";
+#      $table = $_;
+    } else {
+      my $rquota = $recipient_quota;
+      my $squota = $sender_quota;
+      my $rquota_used = 0;
+      my $squota_used = 0;
+      my $user = $_;
+      ($squota,$squota_used) = check_sender_quota($user);
+      ($rquota,$rquota_used) = check_recipient_quota($user);
+      my $action = "quota&user=$user&rquota=$rquota&squota=$squota";
+      s/\@.*//;
+      print "<tr>";
+      print "<td><a href=\"?action=$action\">$_</a></td>";
+      print "<td align=\"right\">$squota</td>";
+      print "<td align=\"right\">$squota_used</td>";
+      print "<td align=\"right\">$rquota</td>";
+      print "<td align=\"right\">$rquota_used</td>";
+      print "</tr>\n";
      }
      }
-    print table({-border=>1},Tr([@table_content])), "\n";
+  }
+  print "</table>\n";
+  &end_html;
+
  }
  
  # function for showing fex-server configuration
  # required arguments: -
  sub showConfig {
  }
  
  # function for showing fex-server configuration
  # required arguments: -
  sub showConfig {
-    print h3("Show config");
-    print table({},Tr([
-                   td(["spooldir:",        $spooldir       ]),
-                   td(["logdir:",          $logdir         ]),
-                   td(["docdir:",          $docdir         ]),
-                   td(["durl:",            $durl           ]),
-                   td(["mdomain:",         $mdomain||''    ]),
-                   td(["autodelete:",      $autodelete     ]),
-                   td(["keep:",            $keep_default   ]),
-                   td(["recipient_quota:", $recipient_quota]),
-                   td(["sender_quota:",    $sender_quota   ]),
-                   td(["admin:",           $admin          ])
-    ]));
+  print h3("Show config");
+  print "<table border=\"0\">\n";
+  printf "<tr><td>spooldir:</td><td>%s</td>\n",$spooldir;
+  printf "<tr><td>logdir:</td><td>%s</td>\n",$logdir;
+  printf "<tr><td>docdir:</td><td>%s</td>\n",$docdir;
+  printf "<tr><td>durl:</td><td>%s</td>\n",$durl;
+  printf "<tr><td>mdomain:</td><td>%s</td>\n",$mdomain||'';
+  printf "<tr><td>autodelete:</td><td>%s</td>\n",$autodelete;
+  printf "<tr><td>keep:</td><td>%s</td>\n",$keep_default;
+  printf "<tr><td>keep_max:</td><td>%s</td>\n",$keep_max;
+  printf "<tr><td>recipient_quota:</td><td>%s</td>\n",$recipient_quota;
+  printf "<tr><td>sender_quota:</td><td>%s</td>\n",$sender_quota;
+  printf "<tr><td>admin:</td><td>%s</td>\n",$admin;
+  print "</table>\n";
+  &end_html;
  }
  
  # require authentification
  sub require_akey {
    my $id;
    my $rid;
  }
  
  # require authentification
  sub require_akey {
    my $id;
    my $rid;
-  my $action;
  
  
-  $action = param("action");
-  if ($action and $action eq 'logout') {
+  if ($action eq 'logout') {
+    if (($ENV{HTTP_COOKIE}||'') =~ /akey=(\w+)/) {
+      unlink "$akeydir/$1";
+    }
      nvt_print(
        "HTTP/1.1 301 Moved Permanently",
      nvt_print(
        "HTTP/1.1 301 Moved Permanently",
-      "Location: /fac",
+      "Location: /$fac",
        'Content-Length: 0',
        "Set-Cookie: akey=; Max-Age=0; Discard",
        ''
        'Content-Length: 0',
        "Set-Cookie: akey=; Max-Age=0; Discard",
        ''
@@ -740,7 +853,7 @@ sub require_akey {
    $rid = slurp("$admin/@") or html_error($error,"no F*EX account for $admin");
    chomp $rid;
  
    $rid = slurp("$admin/@") or html_error($error,"no F*EX account for $admin");
    chomp $rid;
  
-  $id = param("id");  
+  $id = $PARAM{"id"};
  
    if ($id) {
      # correct auth-ID?
  
    if ($id) {
      # correct auth-ID?
@@ -773,14 +886,12 @@ sub require_akey {
    }
  
    pq(qq(
    }
  
    pq(qq(
-    '<form action="/fac" '
-    '      method="post" '
-    '      enctype="multipart/form-data">'
+    '<form action="/$fac" method="post" enctype="multipart/form-data">'
      '  auth-ID for <code>$admin</code>:'
      '  <input type="password" name="id" size="16" autocomplete="off">'
      '</form>'
    ));
      '  auth-ID for <code>$admin</code>:'
      '  <input type="password" name="id" size="16" autocomplete="off">'
      '</form>'
    ));
-  exit;
+  &end_html;
  }
  
  
  }
  
  
@@ -804,81 +915,91 @@ sub require_auth {
    }
  }
  
    }
  }
  
+
  # function for sending notification mails to an user
  # required arguments: username, auth-id, message-type
  sub notifyUser {
  # function for sending notification mails to an user
  # required arguments: username, auth-id, message-type
  sub notifyUser {
-    http_die("not enough arguments in createUser.\n") unless (my ($user,$id) = @_);
-    my $type = $_[2];
-    my $message = 'A F*EX account has been created for you. Use';
+  my ($user,$id,$type) = @_;
+  my $url = $durl;
+  my $message = 'A F*EX account has been created for you. Use';
  
  
-    if (defined($type) and $type eq "change-auth") {
-       $message = 'New auth-ID for your F*EX account has been set. Use'
-    }
+  http_die("not enough arguments in createUser") unless $id;
+  if ($type and $type eq "change-auth") {
+    $message = 'New auth-ID for your F*EX account has been set. Use'
+  }
  
  
-    $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
-    open my $mail,'|-',$sendmail,'-f',$admin,$user,$bcc
-       or http_die("cannot start sendmail - $!\n");
-    pq($mail,qq(
-        'From: $admin'
-        'To: $user'
-        'Subject: your F*EX account on $hostname'
-        'X-Mailer: F*EX'
-        ''
-        '$message'
-        ''
-        '$ENV{PROTO}://$ENV{HTTP_HOST}/fup?from=$user'
-        'auth-ID: $id'
-        ''
-        'See http://$ENV{HTTP_HOST}/index.html for more information about F*EX.'
-        ''
-        'Questions? ==> F*EX admin: $admin'
-    ));
-    close $mail
-       or http_die("cannot send notification e-mail (sendmail error $!)\n");
+  $user = normalize_user($user);
+  open my $mail,'|-',$sendmail,'-f',$admin,$user,$bcc
+    or http_die("cannot start sendmail - $!");
+  $url =~ s:/fop::;
+  pq($mail,qq(
+    'From: $admin'
+    'To: $user'
+    'Subject: your F*EX account on $hostname'
+    'X-Mailer: F*EX'
+    ''
+    '$message'
+    ''
+    '$url/fup?from=$user'
+    'auth-ID: $id'
+    ''
+    'See $url/index.html for more information about F*EX.'
+    ''
+    'Questions? ==> F*EX admin: $admin'
+  ));
+  close $mail
+    or http_die("cannot send notification e-mail (sendmail error $!)");
  }
  
  }
  
+
  # sort key is the (inverse) domain
  # required arguments: list of usernames (e-mail addresses)
  sub domainsort {
  # sort key is the (inverse) domain
  # required arguments: list of usernames (e-mail addresses)
  sub domainsort {
-#    http_die("not enough arguments in domainsort.\n") unless (my @d = @_);
-    my @d = @_;
-    local $_;
-
-    foreach (@d) {
-       s/ //g;
-       s/^/ /;
-       s/\./,/ while /\..*@/;
-       s/@/@./;
-       $_ = join('.',reverse(split /\./));
-    }
-
-    @d = sort { lc $a cmp lc $b } @d;
-
-    foreach (@d) {
-       $_ = join('.',reverse(split /\./));
-       s/,/./g;
-       s/@\./@/;
-    }
-
-    return @d;
+#    http_die("not enough arguments in domainsort") unless (my @d = @_);
+  my @d = @_;
+  local $_;
+
+  foreach (@d) {
+    s/\s//g;
+    s/\./,/ while /\..*@/;
+    s/@/@./;
+    $_ = join('.',reverse(split /\./));
+  }
+  
+  @d = sort { lc $a cmp lc $b } @d;
+  
+  foreach (@d) {
+    $_ = join('.',reverse(split /\./));
+    s/,/./g;
+    s/@\./@/;
+  }
+  
+  return @d;
  }
  
  # function for creating a sorted list of all users
  # required arguments: -
  sub userList {
  }
  
  # function for creating a sorted list of all users
  # required arguments: -
  sub userList {
-    my @u;
-    my $d = '';
-
-    foreach (domainsort(grep { s:/@:: } glob('*@*/@'))) {
-       s/ //g;
-        /@(.+)/;
-        if ($1 ne $d) {
-            push @u,"### $1 ###";
-       }
-       push @u,$_;
-        $d = $1;
+  my (@u,@list);
+  my $domain = '';
+  my $u;
+  
+  foreach $u (glob('*@*')) {
+    next if -l $u;
+    push @u,$u if -f "$u/@";
+  }
+  
+  foreach (domainsort(@u)) {
+    if (/@(.+)/) {
+      if ($1 ne $domain) {
+        push @list,"### $1 ###";
+      }
+      push @list,$_;
+      $domain = $1;
      }
      }
-    return @u;
+  }
+  
+  return @list;
  }
  
  
  }
  
  
@@ -886,17 +1007,34 @@ sub dumpfile {
    my $file = shift;
    
    print "<pre>\n";
    my $file = shift;
    
    print "<pre>\n";
-  while (<$file>) {
-    s/&/&amp;/g;
-    s/</&lt;/g;
-    print or exit;
-  }
+  while (<$file>) { print dehtml($_) }
    print "\n</pre>\n";
  }
  
  
    print "\n</pre>\n";
  }
  
  
-sub error {
-    print join("\n",@_),"\n";
-    print end_html();
-    exit;
+sub h2 {
+  local $_ = shift;
+  chomp;
+  return "<h2>$_</h2>\n";
+}
+
+
+sub h3 {
+  local $_ = shift;
+  chomp;
+  return "<h3>$_</h3>\n";
+}
+
+
+sub end_html {
+  print "</body></html>\n";
+  exit;
+}
+
+
+sub dehtml {
+  local $_ = shift;
+  s/&/&amp;/g;
+  s/</&lt;/g;
+  return $_;
  }
  }
diff --git a/cgi-bin/foc b/cgi-bin/foc

index e5eea41e90dcfcfd4332d206a99486df0c9d7f6f..f384784b9be5c2f5c71c111cde5659daef265a5a 100755 (executable)
--- a/cgi-bin/foc
+++ b/cgi-bin/foc
@@ -5,14 +5,11 @@
  # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
  #
  
  # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
  #
  
-use CGI         qw(:standard);
-use CGI::Carp  qw(fatalsToBrowser);
+BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
+
  use Fcntl      qw(:flock);
  use Digest::MD5        qw(md5_hex);
  
  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;
  # add fex lib
  ($FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
  die "$0: no $FEXLIB\n" unless -d $FEXLIB;
@@ -31,9 +28,11 @@ $akeydir = "$spooldir/.akeys";
  $user = $id = '';
  
  # look for CGI parameters
  $user = $id = '';
  
  # look for CGI parameters
-foreach my $v (param) {
-  my $vv = param($v);
-  debuglog("Param: $v=\"$vv\"");
+our %PARAM;
+&parse_parameters;
+foreach my $v (keys %PARAM) {
+  my $vv = $PARAM{$v};
+  # debuglog("Param: $v=\"$vv\"");
    if ($v =~ /^akey$/i and $vv =~ /^(\w+)$/) { 
      $akey = $1;
    } elsif ($v =~ /^(from|user)$/i) {
    if ($v =~ /^akey$/i and $vv =~ /^(\w+)$/) { 
      $akey = $1;
    } elsif ($v =~ /^(from|user)$/i) {
diff --git a/cgi-bin/fop b/cgi-bin/fop

index 4370fb6f6b408970b2c1c78c32359906ce54de4e..949f084564d3a4dc4c20e219f70bac55ba5efae3 100755 (executable)
--- a/cgi-bin/fop
+++ b/cgi-bin/fop
@@ -5,8 +5,8 @@
  # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
  #
  
  # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
  #
  
-use CGI                qw':standard';
-use CGI::Carp          qw'fatalsToBrowser';
+BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
+
  use Fcntl              qw':flock :seek';
  use Cwd                        qw'abs_path';
  use File::Basename;
  use Fcntl              qw':flock :seek';
  use Cwd                        qw'abs_path';
  use File::Basename;
@@ -20,8 +20,8 @@ die "$0: no $FEXLIB\n" unless -d $FEXLIB;
  our $error = 'F*EX download ERROR';
  our $head = "$ENV{SERVER_NAME} F*EX download";
  # import from fex.pp
  our $error = 'F*EX download ERROR';
  our $head = "$ENV{SERVER_NAME} F*EX download";
  # import from fex.pp
-our ($spooldir,$tmpdir,$logdir,$skeydir,$dkeydir,$durl);
-our ($bs,$fop_auth,$timeout,$keep_default);
+our ($spooldir,$tmpdir,@logdir,$skeydir,$dkeydir,$durl);
+our ($bs,$fop_auth,$timeout,$keep_default,$nowarning);
  our ($limited_download,$admin,$akey,$adlm,$amdl);
  our (@file_link_dirs);
  
  our ($limited_download,$admin,$akey,$adlm,$amdl);
  our (@file_link_dirs);
  
@@ -46,7 +46,7 @@ if ($0 !~ m{/locale/.*/fop} and my $lang = $ENV{HTTP_ACCEPT_LANGUAGE}) {
    }
  }
  
    }
  }
  
-my $log = "$logdir/fop.log";
+my $log = 'fop.log';
  
  chdir $spooldir or die "$spooldir - $!\n";
  
  
  chdir $spooldir or die "$spooldir - $!\n";
  
@@ -397,11 +397,13 @@ if ($qs = $ENV{QUERY_STRING}) {
                        $filename,$ENV{REMOTE_ADDR},isodate(time);
          close $log;
        }
                        $filename,$ENV{REMOTE_ADDR},isodate(time);
          close $log;
        }
-      if (open $log,'>>',$log) {
-        printf {$log}
-               "%s [%s_%s] %s %s deleted\n",
-               isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file);
-        close $log;
+      foreach my $logdir (@logdir) {
+        my $msg = sprintf "%s [%s_%s] %s %s deleted\n",
+                  isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file);
+        if (open $log,'>>',"$logdir/$log") {
+          print {$log} $msg;
+          close $log;
+        }
        }
        http_header('200 OK',"X-File: $file");
        print html_header($head),
        }
        http_header('200 OK',"X-File: $file");
        print html_header($head),
@@ -420,11 +422,13 @@ if ($qs = $ENV{QUERY_STRING}) {
      if (@anonymous_upload and ipin($ra,@anonymous_upload)) {
        unlink "$dkeydir/$dkey" if $dkey;
        if (rmrf($file)) {
      if (@anonymous_upload and ipin($ra,@anonymous_upload)) {
        unlink "$dkeydir/$dkey" if $dkey;
        if (rmrf($file)) {
-        if (open $log,'>>',$log) {
-          printf {$log}
-                 "%s [%s_%s] %s %s purged\n",
-                 isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file);
-          close $log;
+        foreach my $logdir (@logdir) {
+          my $msg = sprintf "%s [%s_%s] %s %s purged\n",
+                    isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file);
+          if (open $log,'>>',"$logdir/$log") {
+            print {$log} $msg;
+            close $log;
+          }
          }
          http_header('200 OK',"X-File: $file");
          print html_header($head),
          }
          http_header('200 OK',"X-File: $file");
          print html_header($head),
@@ -553,7 +557,7 @@ if (-f $data) {
      chomp;
      if ($ra) {
        # allow downloads from same ip
      chomp;
      if ($ra) {
        # allow downloads from same ip
-      $_ = '' if $ra eq $_;
+      $_ = '' if /\Q$ra/;
        # allow downloads from sender ip
        $_ = '' if (readlink("$file/ip")||'') eq $ra;
      }
        # allow downloads from sender ip
        $_ = '' if (readlink("$file/ip")||'') eq $ra;
      }
@@ -746,7 +750,7 @@ sub sendfile {
      # another stupid IE bug-workaround 
      # http://drupal.org/node/163445
      # http://support.microsoft.com/kb/323308
      # another stupid IE bug-workaround 
      # http://drupal.org/node/163445
      # http://support.microsoft.com/kb/323308
-    if ($http_client =~ /MSIE/) {
+    if ($http_client =~ /MSIE/ and not $nowarning) {
        # $type = 'application/x-msdownload';
        if ($ignorewarning) {
          $type .= "; filename=$filename";
        # $type = 'application/x-msdownload';
        if ($ignorewarning) {
          $type .= "; filename=$filename";
diff --git a/cgi-bin/fuc b/cgi-bin/fuc

index 864a3de5966ab1c1b5ef971a323260697531e385..c18aa454fddb2f9b003cfdb0293c4ca8cf22d037 100755 (executable)
--- a/cgi-bin/fuc
+++ b/cgi-bin/fuc
@@ -6,14 +6,11 @@
  # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
  #
  
  # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
  #
  
-use CGI         qw(:standard);
-use CGI::Carp  qw(fatalsToBrowser);
+BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
+
  use Fcntl      qw(:flock);
  use Digest::MD5        qw(md5_hex);
  
  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;
  # add fex lib
  ($FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
  die "$0: no $FEXLIB\n" unless -d $FEXLIB;
@@ -49,10 +46,12 @@ if ($qs) {
    if ($qs =~ /ab=load/)     { $ab = 'load' }
  }
  
    if ($qs =~ /ab=load/)     { $ab = 'load' }
  }
  
-# look for CGI POST parameters
-foreach my $v (param) {
-  my $vv = param($v);
-  debuglog("Param: $v=\"$vv\"");
+# look for CGI parameters
+our %PARAM;
+&parse_parameters;
+foreach my $v (keys %PARAM) {
+  my $vv = $PARAM{$v};
+  # debuglog("Param: $v=\"$vv\"");
    if ($v =~ /^akey$/i) {
      $akey = $1 if $vv =~ /^(\w+)$/;
      next;
    if ($v =~ /^akey$/i) {
      $akey = $1 if $vv =~ /^(\w+)$/;
      next;
@@ -65,7 +64,7 @@ foreach my $v (param) {
      $v =~ /^notification$/i    ? $notification = checkchars('parameter',$vv):
      $v =~ /^disclaimer$/i      ? $disclaimer   = $vv:
      $v =~ /^encryption$/i      ? $encryption   = checkchars('parameter',$vv):
      $v =~ /^notification$/i    ? $notification = checkchars('parameter',$vv):
      $v =~ /^disclaimer$/i      ? $disclaimer   = $vv:
      $v =~ /^encryption$/i      ? $encryption   = checkchars('parameter',$vv):
-    $v =~ /^pubkey$/i          ? $pubkey       = $vv:
+    $v =~ /^pubkey$/i          ? $pubkey       = $PARAM{$v}{data}:
      $v =~ /^reminder$/i                ? $reminder     = checkchars('parameter',$vv):
      $v =~ /^mime$/i            ? $mime         = checkchars('parameter',$vv):
      $v =~ /^comment$/i         ? $comment      = decode_utf8(normalize($vv)):
      $v =~ /^reminder$/i                ? $reminder     = checkchars('parameter',$vv):
      $v =~ /^mime$/i            ? $mime         = checkchars('parameter',$vv):
      $v =~ /^comment$/i         ? $comment      = decode_utf8(normalize($vv)):
@@ -79,7 +78,10 @@ foreach my $v (param) {
    $ESAC;
  }
  
    $ESAC;
  }
  
-$group = lc $group if $group and $group ne 'NEW';
+if ($group and $group ne 'NEW') {
+  $group = lc $group;
+  $group =~ s/[^\w\*%^+=:,.!-]/_/g;
+}
  $group = '' if $nomail;
  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  
  $group = '' if $nomail;
  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  
@@ -353,6 +355,7 @@ if ($user and $akey and defined $ab) {
        '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
        '</body></html>'
      ));
        '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
        '</body></html>'
      ));
+    exit;
    } else {
      $ab =~ s/[\r<>]//g;
      $ab =~ s/\s*$/\n/;
    } else {
      $ab =~ s/[\r<>]//g;
      $ab =~ s/\s*$/\n/;
@@ -515,9 +518,9 @@ if ($user and $pubkey) {
    local $/;
    local $_;
    
    local $/;
    local $_;
    
-  open $gf,">$gf.pk" or http_die("cannot write $gf - $!\n");
-  print {$gf} <$pubkey>;
-  close $gf;
+  open $pk,">$gf.pk" or http_die("cannot write $gf.pk - $!\n");
+  print {$pk} $pubkey;
+  close $pk;
    unlink $gf;
    system "gpg --batch --no-default-keyring --keyring $gf --import".
           "< $gf.pk >/dev/null 2>&1";
    unlink $gf;
    system "gpg --batch --no-default-keyring --keyring $gf --import".
           "< $gf.pk >/dev/null 2>&1";
@@ -546,7 +549,7 @@ if ($user and $pubkey) {
        '$pk'
        '</pre>'
        '<p>'
        '$pk'
        '</pre>'
        '<p>'
-      '<a href="javascript:history.back()">back</a>'                                                     
+      '<a href="javascript:history.back()">back</a>'
        '</body></html>'
      ));
    }
        '</body></html>'
      ));
    }
@@ -567,7 +570,6 @@ if ($user and $encryption) {
        '<h3>E-mails to you will be sent not encrypted.</h3>'
        '<p>'
        '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
        '<h3>E-mails to you will be sent not encrypted.</h3>'
        '<p>'
        '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
-      '</body></html>'
      ));
    } elsif ($encryption eq 'CHANGE') {
      pq(qq(
      ));
    } elsif ($encryption eq 'CHANGE') {
      pq(qq(
@@ -591,19 +593,19 @@ if ($user and $encryption) {
          '<pre>'
          '$g'
          '</pre>'
          '<pre>'
          '$g'
          '</pre>'
-        '<p><hr><p>'
-        '(*) To extract and verify your GPG public key use:'
-        '<pre>'
-        'gpg -a --export $user > pubkey.gpg'
-        'gpg < pubkey.gpg'
-        '</pre>'
        ));
      }
        ));
      }
-    print "</body></html>\n";
-    exit;
+    pq(qq(
+      '<p><hr><p>'
+      '(*) To extract and verify your GPG public key use:'
+      '<pre>'
+      'gpg -a --export $user > pubkey.gpg'
+      'gpg < pubkey.gpg'
+      '</pre>'
+    ));
    }
    }
-
-  &reexec;
+  print "</body></html>\n";
+  exit;
  }
  
  if ($user and $reminder eq 'yes') {
  }
  
  if ($user and $reminder eq 'yes') {
@@ -647,18 +649,18 @@ if ($nid) {
      '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
      '</body></html>'
    ));
      '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
      '</body></html>'
    ));
-  exit;
+  &reexec;
  }
  
  # empty subuser list POST
  }
  
  # empty subuser list POST
-if (defined(param('ssid')) and $ssid =~ /^\s*$/) {
+if (defined($PARAM{'ssid'}) and $ssid =~ /^\s*$/) {
    unlink "$user/\@SUBUSER";
    pq(qq(
      '<h2>All subusers deleted</h2>\n<ul>'
      '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
      '</body></html>'
    ));
    unlink "$user/\@SUBUSER";
    pq(qq(
      '<h2>All subusers deleted</h2>\n<ul>'
      '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
      '</body></html>'
    ));
-  exit;
+  &reexec;
  }
  
  # update sub-users
  }
  
  # update sub-users
@@ -1152,7 +1154,7 @@ sub handle_group {
          '<p>'
          '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
        ));
          '<p>'
          '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
        ));
-      print end_html();
+      print "</body></html>\n";
        exit;
      } else {
        # no group members -> delete group file
        exit;
      } else {
        # no group members -> delete group file
@@ -1178,6 +1180,7 @@ sub handle_group {
          '  New group name: <input type="text" name="group"> (You MUST fill out this field!)'
          '  </font>'
        ));
          '  New group name: <input type="text" name="group"> (You MUST fill out this field!)'
          '  </font>'
        ));
+      $gm = $user.':'.randstring(8);
      } else {
        if (open $gf,'<',$gf) {
          local $/;
      } else {
        if (open $gf,'<',$gf) {
          local $/;
diff --git a/cgi-bin/fup b/cgi-bin/fup

index d43cda0edcd0402d228427ff2ce36959591a031a..b1e01e631acbe9d0b653e557827a4e4a1c2f7a63 100755 (executable)
--- a/cgi-bin/fup
+++ b/cgi-bin/fup
@@ -8,20 +8,16 @@
  #      Sebastian Zaiser <szcode@arcor.de> (upload status)
  #
  
  #      Sebastian Zaiser <szcode@arcor.de> (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 Encode;
  use Fcntl              qw':flock :seek :mode';
  use IO::Handle;
  use Digest::MD5                qw'md5_hex';
-use CGI::Carp          qw'fatalsToBrowser';
  use Cwd                        qw'abs_path';
  
  use Cwd                        qw'abs_path';
  
-use constant DS => 60*60*24;
-use constant M  => 1024*1024;
-
  # add fex lib
  # add fex lib
-die "$0: no \$FEXLIB\n" unless $ENV{FEXLIB};
  (our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
  (our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
-die "$0: no $FEXLIB\n" unless -d $FEXLIB;
  
  $| = 1;
  
  
  $| = 1;
  
@@ -39,10 +35,12 @@ our (@registration_hosts,@demo,@file_link_dirs);
  
  # import from fex.pp
  our ($FEXHOME);
  
  # import from fex.pp
  our ($FEXHOME);
-our ($spooldir,$durl,$tmpdir,$logdir,$docdir,$hostname,$admin,$fra);
-our ($keep_default,$recipient_quota,$sender_quota);
+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);
  our ($dkeydir,$ukeydir,$akeydir,$skeydir,$gkeydir,$xkeydir);
  our ($sendmail,$mdomain,$fop_auth,$mail_auth,$faillog);
  our ($dkeydir,$ukeydir,$akeydir,$skeydir,$gkeydir,$xkeydir);
+our ($MB,$DS);
+our $RB;               # read POST bytes (total)
  our $akey = '';
  our $dkey = '';
  our $skey = '';
  our $akey = '';
  our $dkey = '';
  our $skey = '';
@@ -54,7 +52,6 @@ our $fpsize = 0;      # file part size (MIME-part)
  
  my $data;
  my $boundary;
  
  my $data;
  my $boundary;
-my $rb = 0;            # read bytes, totally
  my $rid = '';          # real ID
  my @header;            # HTTP entity header
  my $fileid;            # file ID
  my $rid = '';          # real ID
  my @header;            # HTTP entity header
  my $fileid;            # file ID
@@ -62,18 +59,18 @@ my $captive;
  my $muser;             # main user fur sub or group user
    
  # load common code, local config: $FEXLIB/fex.ph
  my $muser;             # main user fur sub or group user
    
  # load common code, local config: $FEXLIB/fex.ph
-require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
+require "$FEXLIB/fex.pp";
  
  # load fup local config
  our ($info_1,$info_2,$info_login);
  
  $locale = $ENV{LOCALE} || 'english';
  
  # load fup local config
  our ($info_1,$info_2,$info_login);
  
  $locale = $ENV{LOCALE} || 'english';
-foreach my $pl (
+foreach (
    "/var/lib/fex/locale/$locale/lib/fup.pl", 
    "$FEXLIB/fup.pl",
  ) {
    "/var/lib/fex/locale/$locale/lib/fup.pl", 
    "$FEXLIB/fup.pl",
  ) {
-  if (-f $pl) {
-    require $pl or die "$0: cannot load $FEXLIB/fup.pl - $!\n";
+  if (-f) {
+    require;
      last;
    }
  }
      last;
    }
  }
@@ -82,7 +79,7 @@ foreach my $pl (
  
  chdir $spooldir or http_die("$spooldir - $!\n");
  
  
  chdir $spooldir or http_die("$spooldir - $!\n");
  
-my $log = "$logdir/fup.log";
+my $log = 'fup.log';
  
  my $http_client = $ENV{HTTP_USER_AGENT} || '';
  my $cl = $ENV{X_CONTENT_LENGTH} || $ENV{CONTENT_LENGTH} || 0;
  
  my $http_client = $ENV{HTTP_USER_AGENT} || '';
  my $cl = $ENV{X_CONTENT_LENGTH} || $ENV{CONTENT_LENGTH} || 0;
@@ -116,6 +113,10 @@ if ($addto) {
  
  $to = join(',',@to);
  
  
  $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
  $uid = randstring(8) unless $uid; # upload ID
  
  # user requests for forgotten ID
@@ -214,6 +215,11 @@ if ($from and $id and not ($gkey or $skey or $public or $okey)) {
    }
  }
  
    }
  }
  
+# 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"||'');
  # forward a copy of a file to another recipient
  if ($akey and $dkey and $command eq 'FORWARD') {
    my $file = untaint(readlink "$dkeydir/$dkey"||'');
@@ -371,7 +377,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
        next if $file =~ m:(.+?)/: and -l $1;
        $size = -s "$file/data";
        next unless $size;
        next if $file =~ m:(.+?)/: and -l $1;
        $size = -s "$file/data";
        next unless $size;
-      $size = int($size/M+0.5);
+      $size = int($size/$MB+0.5);
        $filename = $comment = '';
        my $rto = $file;
        $rto =~ s:/.*::;
        $filename = $comment = '';
        my $rto = $file;
        $rto =~ s:/.*::;
@@ -394,7 +400,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
            close $file;
          }
          my $rkeep = untaint(readlink "$file/keep"||$keep_default)
            close $file;
          }
          my $rkeep = untaint(readlink "$file/keep"||$keep_default)
-                    - int((time-mtime("$file/filename"))/DS);
+                    - int((time-mtime("$file/filename"))/$DS);
          if ($comment =~ /NOMAIL/ or 
             (readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) {
            printf "%8s MB [%s d] %s/%s/%s\n",
          if ($comment =~ /NOMAIL/ or 
             (readlink "$to/\@NOTIFICATION"||'') =~ /^no/i) {
            printf "%8s MB [%s d] %s/%s/%s\n",
@@ -438,11 +444,12 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
          next if $file =~ m:(.+?)/: and -l $1;
          $size = -s "$file/data";
          next unless $size;
          next if $file =~ m:(.+?)/: and -l $1;
          $size = -s "$file/data";
          next unless $size;
-        $size = int($size/M+0.5);
+        $size = int($size/$MB+0.5);
          $filename = $comment = '';
          my $rto = $file;
          $rto =~ s:/.*::;
          if ($dkey = readlink "$file/dkey") {
          $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 ($rto ne $to) {
              $to = $rto;
              print "\nto $to :\n";
@@ -461,7 +468,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
              close $file;
            }
            my $rkeep = untaint(readlink "$file/keep"||$keep_default) 
              close $file;
            }
            my $rkeep = untaint(readlink "$file/keep"||$keep_default) 
-                      - int((time-mtime("$file/filename"))/DS);
+                      - int((time-mtime("$file/filename"))/$DS);
            printf "%8s MB [%s d] <a href=\"%s\">%s</a>%s\n",
                   $size,
                   $rkeep,
            printf "%8s MB [%s d] <a href=\"%s\">%s</a>%s\n",
                   $size,
                   $rkeep,
@@ -493,7 +500,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
            $filename = $comment = '';
            $size = -s "$file/data";
            next unless $size;
            $filename = $comment = '';
            $size = -s "$file/data";
            next unless $size;
-          $size = int($size/M+0.5);
+          $size = int($size/$MB+0.5);
            if ($dkey = readlink "$file/dkey") {
              print "\nfrom $from :\n" unless $url;
              $file =~ m:.*/(.+):;
            if ($dkey = readlink "$file/dkey") {
              print "\nfrom $from :\n" unless $url;
              $file =~ m:.*/(.+):;
@@ -516,7 +523,7 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
                close $file;
              }
              my $rkeep = untaint(readlink "$file/keep"||$keep_default) 
                close $file;
              }
              my $rkeep = untaint(readlink "$file/keep"||$keep_default) 
-                        - int((time-mtime("$file/filename"))/DS);
+                        - int((time-mtime("$file/filename"))/$DS);
              printf "[<a href=\"/fup?akey=%s&dkey=%s&command=DELETE\">delete</a>] ",
                     $akey,$dkey;
              printf "[<a href=\"/fup?akey=%s&dkey=%s&command=COPY\">forward</a>] ",
              printf "[<a href=\"/fup?akey=%s&dkey=%s&command=DELETE\">delete</a>] ",
                     $akey,$dkey;
              printf "[<a href=\"/fup?akey=%s&dkey=%s&command=COPY\">forward</a>] ",
@@ -584,9 +591,9 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
    
    if ($command eq 'RECEIVEDLOG') {
      http_die("illegal command \"$command\"") if $public or $anonymous;
    
    if ($command eq 'RECEIVEDLOG') {
      http_die("illegal command \"$command\"") if $public or $anonymous;
-    if (open my $fuplog,"$logdir/fup.log") {
+    if (open my $log,"$logdir/fup.log") {
        http_header('200 OK');
        http_header('200 OK');
-      while (<$fuplog>) {
+      while (<$log>) {
          next if /\sSTDFEX\s/;
          if (/\d+$/) { 
            my @F = split;
          next if /\sSTDFEX\s/;
          if (/\d+$/) { 
            my @F = split;
@@ -602,9 +609,9 @@ if (($from and $id and $rid eq $id or $gkey or $skey) and $command) {
  
    if ($command eq 'SENDLOG') {
      http_die("illegal command \"$command\"") if $public or $anonymous;
  
    if ($command eq 'SENDLOG') {
      http_die("illegal command \"$command\"") if $public or $anonymous;
-    if (open my $fuplog,"$logdir/fup.log") {
+    if (open my $log,"$logdir/fup.log") {
        http_header('200 OK');
        http_header('200 OK');
-      while (<$fuplog>) {
+      while (<$log>) {
          next if /\sSTDFEX\s/;
          if (/(\S+\@\S+)/ and $1 eq $from) { 
            s/ \[[\d_]+\]//;
          next if /\sSTDFEX\s/;
          if (/(\S+\@\S+)/ and $1 eq $from) { 
            s/ \[[\d_]+\]//;
@@ -694,14 +701,14 @@ if ($from and $id and $rid eq $id and @to and not $flink and not $seek) {
    
    # check sender quota
    ($quota,$du) = check_sender_quota($muser||$from);
    
    # check sender quota
    ($quota,$du) = check_sender_quota($muser||$from);
-  if ($quota and $du+$cl/M > $quota) {
+  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);
      http_die("you are overquota");
    }
    
    # check recipient quota
    foreach my $to (@to) {
      ($quota,$du) = check_recipient_quota($to);
-    if ($quota and $du+$cl/M > $quota) {
+    if ($quota and $du+$cl/$MB > $quota) {
        http_die("$to cannot receive files: is overquota");
      }
    }
        http_die("$to cannot receive files: is overquota");
      }
    }
@@ -717,8 +724,7 @@ if ($id and $id eq $rid and $from and @to and not $public) {
  # (= 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);
  # (= 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 (@to) {
-    my $to = $_;
+  foreach my $to (my @loop = @to) {
      $to =~ s/:\w+=.*//; # remove options from address
      $to_reg = 0;
      # full user?
      $to =~ s/:\w+=.*//; # remove options from address
      $to_reg = 0;
      # full user?
@@ -794,8 +800,8 @@ unless ($file) {
      }
    }
    
      }
    }
    
-  # save default locale for this user
    if (($akey or $skey or $gkey) and $from and -d $from) {
    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;
      }
      if (not $locale and ($ENV{HTTP_COOKIE}||'') =~ /\blocale=(\w+)/) {
        $locale = $1;
      }
@@ -836,8 +842,8 @@ unless ($file) {
      @ab = ("<option></option>");
      
      # select menu from server address book
      @ab = ("<option></option>");
      
      # select menu from server address book
-    if (open my $ab,'<',"$from/\@ADDRESS_BOOK") {
-      while (<$ab>) {
+    if (open my $AB,'<',"$from/\@ADDRESS_BOOK") {
+      while (<$AB>) {
          s/#.*//g;
          if (/(\S+)[=\s]+(\S+@[\w.-]+\S*)/) {
            $_ = "$1 &lt;$2>";
          s/#.*//g;
          if (/(\S+)[=\s]+(\S+@[\w.-]+\S*)/) {
            $_ = "$1 &lt;$2>";
@@ -845,7 +851,7 @@ unless ($file) {
            push @ab,"<option>$_</option>";
          }
        }
            push @ab,"<option>$_</option>";
          }
        }
-      close $ab;
+      close $AB;
      }
      
      unless (@to) {
      }
      
      unless (@to) {
@@ -909,12 +915,11 @@ unless ($file) {
        print "</pre><p>\n";
        close $rr;
      }
        print "</pre><p>\n";
        close $rr;
      }
-    pq(qq(
-      '  <input type="submit" name="submit" value="check recipient(s) and continue">'
-      '  or <input type="submit" name="fexyourself" value="fex yourself">'
-      '</form>'
-      '<p>'
-    ));
+    print qq'  <input type="submit" name="submit" value="check recipient(s) and continue">';
+    if ($fex_yourself =~ /^yes|1/i) {
+      print qq' or <input type="submit" name="fexyourself" value="fex yourself">'
+    }
+    print "\n</form>\n<p>\n";
      if ($akey and -f "$from/\@" and not $captive ) {
        pq(qq(
          '<a href="/foc?akey=$akey">user config & operation control</a>'
      if ($akey and -f "$from/\@" and not $captive ) {
        pq(qq(
          '<a href="/foc?akey=$akey">user config & operation control</a>'
@@ -948,13 +953,14 @@ unless ($file) {
    if ($from and ($id or $okey)) {
      $to = $group if $group;
      present_locales($ENV{REQUEST_URI}) if $skey or $gkey or $okey;
    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(
        '<script type="text/javascript">'
        '  function showstatus() {'
        '    var file  = document.forms["upload"].elements["file"].value;'
        '    if (file != "") {'
        '      window.open('
      pq(qq(
        '<script type="text/javascript">'
        '  function showstatus() {'
        '    var file  = document.forms["upload"].elements["file"].value;'
        '    if (file != "") {'
        '      window.open('
-      "        '$ENV{PROTO}://$ENV{HTTP_HOST}/$cgi?showstatus=$uid',"
+      "        '/$cgi?showstatus=$uid',"
        "        'fup_status',"
        "        'width=700,height=500'"
        '      );'
        "        'fup_status',"
        "        'width=700,height=500'"
        '      );'
@@ -1060,7 +1066,7 @@ unless ($file) {
             ? "<tr><td>sender quota (used):<td>$quota ($du) MB</tr>" 
             : '';
      
             ? "<tr><td>sender quota (used):<td>$quota ($du) MB</tr>" 
             : '';
      
-    $bwl = qq'<td><input type="text" name="bwlimit" size="8" value="$bwlimit"> kB/s';
+    $bwl = qq'<input type="text" name="bwlimit" size="8" value="$bwlimit"> kB/s';
      if (@throttle) {
        foreach (@throttle) {
          if (/\[?(.+?)\]?:(\d+)$/) {
      if (@throttle) {
        foreach (@throttle) {
          if (/\[?(.+?)\]?:(\d+)$/) {
@@ -1069,7 +1075,7 @@ unless ($file) {
            # throttle ip address?
            if ($throttle =~ /^[\w:.-]+$/) {
              if (ipin($ra,$throttle)) {
            # throttle ip address?
            if ($throttle =~ /^[\w:.-]+$/) {
              if (ipin($ra,$throttle)) {
-              $bwl = qq'<td><input type="hidden" name="bwlimit" value="$limit"> $limit kB/s';
+              $bwl = qq'<input type="hidden" name="bwlimit" value="$limit"> $limit kB/s';
                last;
              }
            } 
                last;
              }
            } 
@@ -1079,7 +1085,7 @@ unless ($file) {
              $throttle =~ quotemeta $throttle;
              $throttle =~ s/\*/.*/g;
              if ($from =~ /^$throttle$/i) {
              $throttle =~ quotemeta $throttle;
              $throttle =~ s/\*/.*/g;
              if ($from =~ /^$throttle$/i) {
-              $bwl = qq'<td><input type="hidden" name="bwlimit" value="$limit"> $limit kB/s';
+              $bwl = qq'<input type="hidden" name="bwlimit" value="$limit"> $limit kB/s';
                last;
              }
            }
                last;
              }
            }
@@ -1096,36 +1102,35 @@ unless ($file) {
        elsif (/delay/i) { $adt = 'delete file after download with delay' } 
        elsif (/^\d+$/)  { $adt = "delete file $autodelete days after download" }
      }
        elsif (/delay/i) { $adt = 'delete file after download with delay' } 
        elsif (/^\d+$/)  { $adt = "delete file $autodelete days after download" }
      }
+    $adt .= qq'<input type="hidden" name="autodelete" value="$autodelete">';
  
      my $ctr = my $ktr = '';
      if ($nomail) {
  
      my $ctr = my $ktr = '';
      if ($nomail) {
-      $ctr = qq'<td><input type="hidden" name="comment" value="$comment">'
-            .qq'<em>no notification e-mail will be send</em>';
-      $ktr = qq'<input type="text" name="keep" size="2" value="$keep"> days</tr>';
-      $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep"></tr>';
+      $ctr = qq'<em>no notification e-mail will be send</em>';
      } else {
      } else {
-      $ctr = qq'<td><input type="text" name="comment" size="80" value="$comment">';
-      $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep"></tr>';
+      $ctr = qq'<input type="text" name="comment" size="80" value="$comment">';
      }
      if ($captive) {
      }
      if ($captive) {
-      $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep"></tr>';
+      $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep">';
+    } else {
+      $ktr = qq'$keep days<input type="hidden" name="keep" value="$keep">';
      }
      }
-    
      pq(qq(
      pq(qq(
-      '    <tr title="$adt"><td>autodelete:<td>$adt</tr>'
-      '    <input type="hidden" name="autodelete" value="$autodelete">'
-      '    <tr title="keep file max $keep days, then delete it"><td>keep:<td>'
-      '    $ktr'
+      '    <tr><td>autodelete:'
+      '      <td>$adt'
+      '    </tr>'
+      '    <tr title="keep file max $keep days, then delete it"><td>keep:'
+      '      <td>$ktr'
+      '    </tr>'
        '    $quota'
        '    <tr title="optional, full speed if empty"><td>bandwith limit:'
        '    $quota'
        '    <tr title="optional, full speed if empty"><td>bandwith limit:'
-      '      $bwl'
+      '      <td>$bwl'
        '    </tr>'
        '    <tr title="optional, will be included in notification e-mail"><td>comment:'
        '    </tr>'
        '    <tr title="optional, will be included in notification e-mail"><td>comment:'
-      '      $ctr'
+      '      <td>$ctr'
        '    </tr>'
        '    </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();">'
+      '    <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();">'
        '    </tr>'
        '    <tr><td>file size:<td id="filesize"></td></tr>'
        '  </table>'
        '    </tr>'
        '    <tr><td>file size:<td id="filesize"></td></tr>'
        '  </table>'
@@ -1297,11 +1302,14 @@ if (not $anonymous and $overwrite =~ /^n/i) {
  }
  
  # additional last check
  }
  
  # additional last check
-foreach $to (@to) {
-  checkaddress($to) or 
-    http_die("<code>$to</code> is not a valid e-mail address");
+unless (@group or $gkey or $skey or $public or $okey) {
+  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 
  $to = join(',',@to);
  
  # file overwriting for anonymous is only possible if his client has the 
@@ -1353,14 +1361,9 @@ unless ($nostore) {
      rename $upload,$save or http_die("cannot rename $upload to $save - $!\n");
      
      # log dkey
      rename $upload,$save or http_die("cannot rename $upload to $save - $!\n");
      
      # log dkey
-    my $dlog = "$logdir/dkey.log";
-    if (open $dlog,'>>',$dlog) {
-      flock $dlog,LOCK_EX;
-      seek $dlog,0,SEEK_END;
-      printf {$dlog} "%s %s %s %s %s\n",
-                     isodate(time),$dkey{$to},$from,$to,$fkey;
-      close $dlog;
-    }
+    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
      
      # send notification e-mails if necessary
      if (not $nomail and (readlink "$to/\@NOTIFICATION"||'') !~ /^no/i
@@ -1418,11 +1421,11 @@ if ($nostore) {
  print html_header($head);
  
  if ($nostore) {
  print html_header($head);
  
  if ($nostore) {
-  printf "%s (%s MB) received\n",$file,$ndata/M;
+  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:
  } 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);
+             $ndata<2*$MB   ? sprintf "%s kB",int($ndata/1024):
+                             sprintf "%s MB",int($ndata/$MB);
    pq(qq(
      '<code>$file</code> ($size) received and saved<p>'
      'Download URL for copy & paste:'
    pq(qq(
      '<code>$file</code> ($size) received and saved<p>'
      'Download URL for copy & paste:'
@@ -1435,7 +1438,7 @@ if ($nostore) {
      if (not $boring and not $seek) {
        print "Ehh... $ndata <b>BYTES</b>?! You are kidding?<p>\n";
      }
      if (not $boring and not $seek) {
        print "Ehh... $ndata <b>BYTES</b>?! You are kidding?<p>\n";
      }
-  } elsif ($ndata<2*M) {
+  } elsif ($ndata<2*$MB) {
      $ndata = int($ndata/1024);
      print "<code>$file</code> ($ndata kB) received and saved<p>\n";
      if ($ndata<1024 and not ($boring or $seek)) {
      $ndata = int($ndata/1024);
      print "<code>$file</code> ($ndata kB) received and saved<p>\n";
      if ($ndata<1024 and not ($boring or $seek)) {
@@ -1443,7 +1446,7 @@ if ($nostore) {
          "ever heard of MIME e-mail? &#9786;<p>\n";
      }
    } else {
          "ever heard of MIME e-mail? &#9786;<p>\n";
      }
    } else {
-    $ndata = int($ndata/M);
+    $ndata = int($ndata/$MB);
      print "<code>$file</code> ($ndata MB) received and saved<p>\n";
    }
    print "<ul>\n";
      print "<code>$file</code> ($ndata MB) received and saved<p>\n";
    }
    print "<ul>\n";
@@ -1640,9 +1643,11 @@ sub parse_request {
    }
  
    if ($from) {
    }
  
    if ($from) {
-    $from .= '@'.$mdomain if $mdomain and $from !~ /@/;
-    if ($from ne 'anonymous' and not checkaddress($from)) {
-      http_die("<code>$from</code> is not a valid e-mail address");
+    unless ($skey or $gkey or $okey) {
+      $from .= '@'.$mdomain if $mdomain and $from !~ /@/;
+      if ($from ne 'anonymous' and not checkaddress($from)) {
+        http_die("<code>$from</code> is not a valid e-mail address");
+      }
      }
      $from = untaint($from);
    }
      }
      $from = untaint($from);
    }
@@ -1678,12 +1683,10 @@ sub parse_request {
  
      # look for recipient's options and eliminate dupes
      %to = ();
  
      # look for recipient's options and eliminate dupes
      %to = ();
-    foreach (@to) {
-     my $to = $_;
+    foreach my $to (my @loop = @to) {
       # address book alias?
       # address book alias?
-      if ($ab{$to}) {
-        foreach (@{$ab{$to}}) {
-          my $address = $_;
+      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'}) {
            $address .= '@'.$mdomain if $mdomain and $address !~ /@/;
            $to{$address} = $address; # ignore dupes
            if ($specific{'autodelete'}) {
@@ -1694,8 +1697,8 @@ sub parse_request {
              $autodelete{$address} = readlink "$address/\@AUTODELETE" 
                                      || $autodelete;
            }
              $autodelete{$address} = readlink "$address/\@AUTODELETE" 
                                      || $autodelete;
            }
-          if ($_ = readlink "$address/\@LOCALE") {
-            $locale{$address} = $_;
+          if (my $locale = readlink "$address/\@LOCALE") {
+            $locale{$address} = $locale;
            } elsif ($locale{$to}) {
              $locale{$address} = $locale{$to};
            } else {
            } elsif ($locale{$to}) {
              $locale{$address} = $locale{$to};
            } else {
@@ -1746,8 +1749,8 @@ sub parse_request {
            http_die("You cannot send to more than one group") if @to > 1;
            http_die("Group <code>$to</code> does not exist") unless -f "$from/\@GROUP/$1";
          } else {
            http_die("You cannot send to more than one group") if @to > 1;
            http_die("Group <code>$to</code> does not exist") unless -f "$from/\@GROUP/$1";
          } else {
-          $to .= '@'.$mdomain if $mdomain and $to !~ /@/;
-          if (checkaddress($to)) {
+          if ($skey or $gkey or $okey or checkaddress($to)) {
+            $to .= '@'.$mdomain if $mdomain and $to !~ /@/;
              $to{$to} = untaint($to);
            } else {
              http_die("<code>$to</code> is not a valid e-mail address");
              $to{$to} = untaint($to);
            } else {
              http_die("<code>$to</code> is not a valid e-mail address");
@@ -2014,6 +2017,7 @@ sub get_file {
               "$filed/speed",
               "$filed/replyto",
               "$filed/useragent",
               "$filed/speed",
               "$filed/replyto",
               "$filed/useragent",
+             "$filed/uurl",
               "$filed/comment",
               "$filed/notify";
        unlink "$filed/size" unless $seek;
               "$filed/comment",
               "$filed/notify";
        unlink "$filed/size" unless $seek;
@@ -2026,7 +2030,7 @@ sub get_file {
        close $fh;
        if ($::filesize > 0 or $cl > 0) {
          if ($::filesize > 0) { $filesize = $fpsize || $::filesize }
        close $fh;
        if ($::filesize > 0 or $cl > 0) {
          if ($::filesize > 0) { $filesize = $fpsize || $::filesize }
-        else                 { $filesize = $cl-$rb-$ebl+$seek }
+        else                 { $filesize = $cl-$RB-$ebl+$seek }
          # new file
          unless ($seek) {
            if ($::filesize > 0) {
          # new file
          unless ($seek) {
            if ($::filesize > 0) {
@@ -2041,9 +2045,14 @@ sub get_file {
          }
        }
      
          }
        }
      
-      $autodelete{$to} = $autodelete unless $autodelete{$to};
-      if ($autodelete{$to} =~ /^(DELAY|NO|\d+)$/i) {
-        mksymlink("$filed/autodelete",$autodelete{$to});
+      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) {
        }
  
        if (my $keep = $keep{$to} || $::keep) {
@@ -2051,6 +2060,9 @@ sub get_file {
        }
        mksymlink("$filed/id",$fileid) if $fileid;
        mksymlink("$filed/ip",$ra)     if $ra;
        }
        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 ($http_client and open $http_client,'>',"$filed/useragent") {
          print {$http_client} $http_client,"\n";
          close $http_client;
@@ -2140,8 +2152,9 @@ sub get_file {
      if ($cl == -1) {
        alarm($timeout*2);
        # read until EOF, including MIME end boundary
      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)) {
        while ($n = read(STDIN,$_,$bs)) {
-        $rb += $n;
+        $RB += $n;
          $fb += $n;
          syswrite $upload,$_ unless $nostore;
          alarm($timeout*2);
          $fb += $n;
          syswrite $upload,$_ unless $nostore;
          alarm($timeout*2);
@@ -2156,31 +2169,31 @@ sub get_file {
        if ($fpsize) {
          debuglog(sprintf("still awaiting %d+%d = %d bytes",
                   $fpsize,$ebl,$fpsize+$ebl));
        if ($fpsize) {
          debuglog(sprintf("still awaiting %d+%d = %d bytes",
                   $fpsize,$ebl,$fpsize+$ebl));
-        $cl = $rb+$fpsize+$ebl; # recalculate CONTENT_LENGTH
+        $cl = $RB+$fpsize+$ebl; # recalculate CONTENT_LENGTH
        } else {
          if ($::filesize) {
        } else {
          if ($::filesize) {
-          $cl = $rb+$::filesize+$ebl; # recalculate CONTENT_LENGTH
+          $cl = $RB+$::filesize+$ebl; # recalculate CONTENT_LENGTH
          }
          debuglog(sprintf("still awaiting %d-%d = %d bytes",
          }
          debuglog(sprintf("still awaiting %d-%d = %d bytes",
-                         $cl,$rb,$cl-$rb));
+                         $cl,$RB,$cl-$RB));
        }
        # read until end boundary, not EOF
        }
        # read until end boundary, not EOF
-      while ($rb < $cl-$ebl) {
-        $b = $cl-$ebl-$rb; 
+      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)) {
          $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;
+          $RB += $n;
            $fb += $n;
            # syswrite is much faster than print
            syswrite $upload,$_ unless $nostore;
            if ($bwlimit) {
              alarm(0);
              $tt = (time-$t0) || 1;
            $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) {
+            while ($RB/$tt/1024 > $bwlimit) {
                sleep 1;
                $tt = time-$t0;
              }
                sleep 1;
                $tt = time-$t0;
              }
@@ -2198,7 +2211,7 @@ sub get_file {
            http_die("found no MIME end boundary in upload ($_)");
          }
        }
            http_die("found no MIME end boundary in upload ($_)");
          }
        }
-      $rb += $ebl;
+      $RB += $ebl;
        $ndata = untaint($fb);
      } 
  
        $ndata = untaint($fb);
      } 
  
@@ -2239,12 +2252,12 @@ sub get_file {
          # truncate $upload,$ndata+$uss if -s $upload > $ndata+$uss;
        
          # incomplete?
          # truncate $upload,$ndata+$uss if -s $upload > $ndata+$uss;
        
          # incomplete?
-        if ($cl != $rb) {
+        if ($cl != $RB) {
            fuplog($to,$fkey,$ndata,'(aborted)');
            if ($fpsize) {
            fuplog($to,$fkey,$ndata,'(aborted)');
            if ($fpsize) {
-            http_die("read $rb bytes, but Content-Length announces $fpsize bytes");
+            http_die("read $RB bytes, but Content-Length announces $fpsize bytes");
            } else {
            } else {
-            http_die("read $rb bytes, but CONTENT_LENGTH announces $cl bytes");
+            http_die("read $RB bytes, but CONTENT_LENGTH announces $cl bytes");
            }
          }
        
            }
          }
        
@@ -2328,8 +2341,7 @@ sub expand {
    my @users = @_;
    my @ua;
    
    my @users = @_;
    my @ua;
    
-  foreach (@users) {
-    my $u = $_;
+  foreach my $u (my @loop = @users) {
      if ($u =~ /^anonymous(_\d+)?$/) { 
        $u = "$u\@$hostname";
      }
      if ($u =~ /^anonymous(_\d+)?$/) { 
        $u = "$u\@$hostname";
      }
@@ -2381,8 +2393,7 @@ sub forward {
      }
  
      # collect addresses
      }
  
      # collect addresses
-    foreach (@to) {
-      my $to = $_;
+    foreach my $to (my @loop = @to) {
        if ($ab{$to}) {
          foreach my $address (@{$ab{$to}}) {
            $to{$address} = $address;
        if ($ab{$to}) {
          foreach my $address (@{$ab{$to}}) {
            $to{$address} = $address;
@@ -2398,8 +2409,7 @@ sub forward {
  
      @to = keys %to;
      
  
      @to = keys %to;
      
-    foreach (@to) {
-      my $to = $_;
+    foreach my $to (my @loop = @to) {
        $to =~ s/:\w+=.*//; # remove options from address
        $nfile = $file;
        $nfile =~ s:.*?/:$to/:;
        $to =~ s/:\w+=.*//; # remove options from address
        $nfile = $file;
        $nfile =~ s:.*?/:$to/:;
@@ -2535,29 +2545,6 @@ sub calcsize {
  }
  
  
  }
  
  
-# read one line from STDIN (net socket) and assign it to $_
-# returns number of read bytes
-sub nvt_read {
-  my $len = 0;
-
-  if (defined ($_ = <STDIN>)) {
-    debuglog($_);
-    $len = length;
-    $rb += $len;
-    s/\r?\n//;
-  }
-  return $len;
-}
-
-
-# read forward to given pattern
-sub nvt_skip_to {
-  my $pattern = shift;
-
-  while (&nvt_read) { return if /$pattern/ }
-}
-
-
  # set parameter variables
  sub setparam {
    my ($v,$vv) = @_;
  # set parameter variables
  sub setparam {
    my ($v,$vv) = @_;
@@ -2604,7 +2591,8 @@ sub setparam {
      $from = normalize_email($vv);
      $from = untaint(expand($from));
      checkchars('from address',$from);
      $from = normalize_email($vv);
      $from = untaint(expand($from));
      checkchars('from address',$from);
-    checkaddress($from) or http_die("FROM $from is no legal e-mail address");
+    # 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);
    } elsif ($v eq 'REPLYTO') { 
      $replyto = normalize_email($vv);
      checkchars('replyto address',$replyto);
@@ -2891,7 +2879,7 @@ sub check_space {
      while (<$df>) {
        if (/^.+?\s+\d+\s+\d+\s+(\d+)/ and $req/1024 > $1) {
          $free = int($1/1024);
      while (<$df>) {
        if (/^.+?\s+\d+\s+\d+\s+(\d+)/ and $req/1024 > $1) {
          $free = int($1/1024);
-        $uprq = int($req/M);
+        $uprq = int($req/$MB);
          if (not $nomail and open P,"|$sendmail -t") {
            pq(P,qq(
              'From: $admin'
          if (not $nomail and open P,"|$sendmail -t") {
            pq(P,qq(
              'From: $admin'
@@ -2929,14 +2917,9 @@ sub fuplog {
    
    $msg =~ s/\n/ /g;
    $msg =~ s/\s+$//;
    
    $msg =~ s/\n/ /g;
    $msg =~ s/\s+$//;
-  
-  if (open $log,'>>',$log) {
-    flock $log,LOCK_EX;
-    seek $log,0,SEEK_END;
-    printf {$log} "%s [%s_%s] %s (%s) %s\n",
-                  isodate(time),$$,$ENV{REQUESTCOUNT},$from,$fra,$msg;
-    close $log;
-  }
+  $msg = sprintf "%s [%s_%s] %s (%s) %s\n",
+                 isodate(time),$$,$ENV{REQUESTCOUNT},$from,$fra,$msg;
+  writelog($log,$msg);
  }
  
  
  }
  
  
@@ -2958,19 +2941,17 @@ sub sigexit {
    $msg = @_ ? "@_" : '???';
    $msg =~ s/\n/ /g;
    $msg =~ s/\s+$//;
    $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 (open $log,'>>',$log) {
-    printf {$log} 
-           "%s %s (%s) %s %s caught SIGNAL %s %s\n",
-           isodate(time),
-           $from||'-',
-           $fra||'-',
-           $to||'-',
-           encode_Q($file||'-'),
-           $msg,
-           $rb?"(after $rb bytes)":"";
-    close $log;
-  }
    if ($sig eq 'DIE') {
      shift;
      die "$msg\n";
    if ($sig eq 'DIE') {
      shift;
      die "$msg\n";
@@ -2980,12 +2961,6 @@ sub sigexit {
  }
  
  
  }
  
  
-sub mtime {
-  my @s = lstat shift;
-  return @s ? $s[9] : undef;
-}
-
-
  sub present_locales {
    my $url = shift;
    my @locales = @::locales; # from fex.ph
  sub present_locales {
    my $url = shift;
    my @locales = @::locales; # from fex.ph
@@ -3006,8 +2981,7 @@ sub present_locales {
  
    if (@locales > 1) {
      print "<h3>";
  
    if (@locales > 1) {
      print "<h3>";
-    foreach (@locales) {
-      $locale = $_;
+    foreach my $locale (my @loop = @locales) {
        if (-x "$locale/cgi-bin/fup") {
          $lang = "$locale/lang.html";
          $locale =~ s:.*/::;
        if (-x "$locale/cgi-bin/fup") {
          $lang = "$locale/lang.html";
          $locale =~ s:.*/::;
diff --git a/cgi-bin/fur b/cgi-bin/fur

index 3d91f55878fba93e29eb35fa66341297cc0aba89..94f6a1e4af831b541fcb5ce8fa60d87a3209d9a4 100755 (executable)
--- a/cgi-bin/fur
+++ b/cgi-bin/fur
@@ -5,12 +5,9 @@
  # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
  #
  
  # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
  #
  
-use CGI         qw(:standard);
-use CGI::Carp  qw(fatalsToBrowser);
-use Fcntl      qw(:flock :seek :mode);
+BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
  
  
-$CGI::LIST_CONTEXT_WARN = 0;
-$CGI::LIST_CONTEXT_WARN = 0;
+use Fcntl      qw(:flock :seek :mode);
  
  # import from fex.ph
  our (@local_hosts,@local_domains,@local_rhosts,@local_rdomains);
  
  # import from fex.ph
  our (@local_hosts,@local_domains,@local_rhosts,@local_rdomains);
@@ -18,7 +15,7 @@ our (@registration_hosts,@registration_domains);
  our ($usage_conditions);
  
  # import from fex.pp
  our ($usage_conditions);
  
  # import from fex.pp
-our ($mdomain,$logdir,$spooldir,$fra,$hostname,$sendmail,$admin,$bcc);
+our ($mdomain,@logdir,$spooldir,$fra,$hostname,$sendmail,$admin,$bcc);
  
  our $error = "F*EX user registration ERROR";
  
  
  our $error = "F*EX user registration ERROR";
  
@@ -33,7 +30,7 @@ die "$0: no $FEXLIB\n" unless -d $FEXLIB;
  # load common code, local config: $HOME/lib/fex.ph
  require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
  
  # load common code, local config: $HOME/lib/fex.ph
  require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
  
-my $log = "$logdir/fur.log";
+my $log = 'fur.log';
  my $head = "$ENV{SERVER_NAME} F*EX user registration";
  
  chdir $spooldir or die "$spooldir - $!\n";
  my $head = "$ENV{SERVER_NAME} F*EX user registration";
  
  chdir $spooldir or die "$spooldir - $!\n";
@@ -50,9 +47,11 @@ unless (@local_domains or @local_rdomains) {
  }
  
  # look for CGI parameters
  }
  
  # look for CGI parameters
-foreach my $v (param) {
-  my $vv = despace(param($v));
-  debuglog("Param: $v=\"$vv\"");
+our %PARAM;
+&parse_parameters;
+foreach my $v (keys %PARAM) {
+  my $vv = despace($PARAM{$v});
+  # debuglog("Param: $v=\"$vv\"");
    $CASE =
      $v =~ /^user$/i    ? $user         = normalize_address($vv):
      $v =~ /^exuser$/i  ? $exuser       = normalize_address($vv):
    $CASE =
      $v =~ /^user$/i    ? $user         = normalize_address($vv):
      $v =~ /^exuser$/i  ? $exuser       = normalize_address($vv):
@@ -339,7 +338,7 @@ if ($verify eq 'no') {
    http_header("200 OK",'Content-Type: text/plain');
    print "$ENV{PROTO}://$ENV{HTTP_HOST}/fup?from=$user&ID=$id\n";
    furlog("direct: account $user created");
    http_header("200 OK",'Content-Type: text/plain');
    print "$ENV{PROTO}://$ENV{HTTP_HOST}/fup?from=$user&ID=$id\n";
    furlog("direct: account $user created");
-  if ($bcc and open my $mail,"|$sendmail '$bcc' 2>>$log") {
+  if ($bcc and open my $mail,"|$sendmail '$bcc' 2>>$logdir[0]/$log") {
      pq($mail,qq(
        'From: fex'
        'To: $bcc'
      pq($mail,qq(
        'From: fex'
        'To: $bcc'
@@ -395,14 +394,10 @@ sub furlog {
    
    $msg =~ s/\n/ /g;
    $msg =~ s/\s+$//;
    
    $msg =~ s/\n/ /g;
    $msg =~ s/\s+$//;
+  $msg = sprintf "%s [%s_%s] %s %s\n",
+                 isodate(time),$$,$ENV{REQUESTCOUNT},$fra,$msg;
    
    
-  if (open $log,'>>',$log) {
-    flock $log,LOCK_EX;
-    seek $log,0,SEEK_END;
-    printf {$log} "%s [%s_%s] %s %s\n",
-                  isodate(time),$$,$ENV{REQUESTCOUNT},$fra,$msg;
-    close $log;
-  }
+  writelog($log,$msg);
  }
  
  sub normalize_address {
  }
  
  sub normalize_address {
diff --git a/cgi-bin/pup b/cgi-bin/pup

index 4ddac701b4e2d1f4a22590a2d18f95d3478023c4..241e2d35b351e64660759be0b9e36d09679e2d05 100755 (executable)
--- a/cgi-bin/pup
+++ b/cgi-bin/pup
@@ -5,7 +5,7 @@
  # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
  #
  
  # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
  #
  
-use CGI::Carp qw(fatalsToBrowser);
+BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
  
  # add fex lib
  (our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
  
  # add fex lib
  (our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
@@ -182,17 +182,3 @@ sub setparam {
      $to        = normalize_email($vv);
    }
  }
      $to        = normalize_email($vv);
    }
  }
-
-
-# read one line from STDIN (net socket) and assign it to $_
-# returns number of read bytes
-sub nvt_read {
-  my $len = 0;
-
-  if (defined ($_ = <STDIN>)) {
-    debuglog($_);
-    $len = length;
-    s/\r?\n//;
-  }
-  return $len;
-}
diff --git a/cgi-bin/rup b/cgi-bin/rup

index 10a78b6e771d67a5e89ba8133c617240733b253a..53fa952147635755a06d679693d56cf596c45fdc 100755 (executable)
--- a/cgi-bin/rup
+++ b/cgi-bin/rup
@@ -5,17 +5,16 @@
  # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
  #
  
  # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
  #
  
+BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
+
  use Fcntl      qw(:flock :seek :mode);
  use Fcntl      qw(:flock :seek :mode);
-use CGI         qw(:standard);
-use CGI::Carp  qw(fatalsToBrowser);
-use Fcntl      qw(:flock);
  use Digest::MD5        qw(md5_hex);
  
  # add fex lib
  (our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
  die "$0: no $FEXLIB\n" unless -d $FEXLIB;
  
  use Digest::MD5        qw(md5_hex);
  
  # add fex lib
  (our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
  die "$0: no $FEXLIB\n" unless -d $FEXLIB;
  
-our ($keep_default,$dkeydir,$akeydir,$mdomain,$logdir,$fra);
+our ($keep_default,$dkeydir,$akeydir,$mdomain,@logdir,$fra);
  our $akey = '';
  
  # load common code, local config : $HOME/lib/fex.ph
  our $akey = '';
  
  # load common code, local config : $HOME/lib/fex.ph
@@ -25,13 +24,13 @@ our $error = 'F*EX redirect ERROR';
  
  chdir $spooldir or die "$spooldir - $!\n";
  
  
  chdir $spooldir or die "$spooldir - $!\n";
  
-my $log = "$logdir/rup.log";
-
  $from = $id = $oto = $nto = $file = '';
  
  # look for CGI parameters
  $from = $id = $oto = $nto = $file = '';
  
  # look for CGI parameters
-foreach my $v (param) {
-  $vv = param($v);
+our %PARAM;
+&parse_parameters;
+foreach my $v (keys %PARAM) {
+  my $vv = $PARAM{$v};
    $vv =~ s/[<>\'\`\"\000-\037]//g;
    if ($v =~ /^akey$/i and $vv =~ /^(\w+)$/) { 
      $akey = $1;
    $vv =~ s/[<>\'\`\"\000-\037]//g;
    if ($v =~ /^akey$/i and $vv =~ /^(\w+)$/) { 
      $akey = $1;
@@ -201,7 +200,7 @@ if (rename "$oto/$from/$fkey","$nto/$from/$fkey") {
    unlink "$nto/$from/$fkey/notify";
    unlink "$nto/$from/$fkey/error";
    unlink "$nto/$from/$fkey/download";
    unlink "$nto/$from/$fkey/notify";
    unlink "$nto/$from/$fkey/error";
    unlink "$nto/$from/$fkey/download";
-  if (slurp("$oto/$from/$fkey/$comment") =~ 'NOMAIL') {
+  if (slurp("$oto/$from/$fkey/comment")||'' =~ /NOMAIL/) {
      unlink "$nto/$from/$fkey/comment";
    }
    $dkey = randstring(8);
      unlink "$nto/$from/$fkey/comment";
    }
    $dkey = randstring(8);
@@ -239,12 +238,15 @@ sub ruplog {
    
    $msg =~ s/\n/ /g;
    $msg =~ s/\s+$//;
    
    $msg =~ s/\n/ /g;
    $msg =~ s/\s+$//;
-  
-  if (open $log,'>>',$log) {
-    flock $log,LOCK_EX;
-    seek $log,0,SEEK_END;
-    printf {$log} "%s [%s_%s] (%s) %s\n",
-                  isodate(time),$$,$ENV{REQUESTCOUNT},$fra,$msg;
-    close $log;
+  $msg = sprintf "%s [%s_%s] (%s) %s\n",
+                 isodate(time),$$,$ENV{REQUESTCOUNT},$fra,$msg;
+
+  foreach my $log (@logdir) {
+    if (open $log,'>>',"$log/rup.log") {
+      flock $log,LOCK_EX;
+      seek $log,0,SEEK_END;
+      printf {$log} $msg;
+      close $log;
+    }
    }
  }
    }
  }
diff --git a/cgi-bin/sex b/cgi-bin/sex

index d483ebe3ba0cf490edd364d36dc4f8374fe2e6a7..62a914a44ea44a5e12b281e2c23bbe0cf454936c 100755 (executable)
--- a/cgi-bin/sex
+++ b/cgi-bin/sex
@@ -15,14 +15,14 @@ die "$0: no $FEXLIB\n" unless -d $FEXLIB;
  $| = 1;
  
  # import from fex.pp
  $| = 1;
  
  # import from fex.pp
-our ($tmpdir,$logdir,$timeout,$fra,$bs);
+our ($tmpdir,@logdir,$timeout,$fra,$bs);
  
  # load common code, local config: $HOME/lib/fex.ph
  require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
  
  chdir $spooldir or error(500,"$spooldir - $!");
  
  
  # load common code, local config: $HOME/lib/fex.ph
  require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
  
  chdir $spooldir or error(500,"$spooldir - $!");
  
-my $debuglog = "$tmpdir/sex.log";
+# my $debuglog = "$tmpdir/sex.log";
  my $ra = $ENV{REMOTE_ADDR}||0;
  $fra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
  $timeout *= 10;
  my $ra = $ENV{REMOTE_ADDR}||0;
  $fra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
  $timeout *= 10;
@@ -166,12 +166,20 @@ sub setparam {
  }
  
  sub sexlog {
  }
  
  sub sexlog {
-  if (open my $log,'>>',"$logdir/sex.log") {
-    flock $log,LOCK_EX;
-    seek $log,0,SEEK_END;
-    printf {$log} "%s [%s_%s] %s (%s) %s\n",
-                  isodate(time),$$,$ENV{REQUESTCOUNT},$user,$fra,"@_";
-    close $log;
+  my $msg = "@_";
+  
+  $msg =~ s/\n/ /g;
+  $msg =~ s/\s+$//;
+  $msg = sprintf "%s [%s_%s] %s (%s) %s\n",
+                  isodate(time),$$,$ENV{REQUESTCOUNT},$user,$fra,$msg;
+  
+  foreach my $log (@logdir) {
+    if (open $log,'>>',"$log/sex.log") {
+      flock $log,LOCK_EX;
+      seek $log,0,SEEK_END;
+      printf {$log} $msg;
+      close $log;
+    }
    }
  }
  
    }
  }
  
@@ -183,10 +191,20 @@ sub sigdie {
  
  sub sigexit {
    my ($sig) = @_;
  
  sub sigexit {
    my ($sig) = @_;
-  if (open my $log,'>>',"$logdir/sex.log") {
-    printf {$log} "%s %s (%s) caught SIGNAL %s\n",
-                  isodate(time),$user||'-',$fra||'-',"@_";
-    close $log;
+  my $msg = "@_";
+  
+  $msg =~ s/\n/ /g;
+  $msg =~ s/\s+$//;
+  $msg = sprintf "%s %s (%s) caught SIGNAL %s\n",
+                 isodate(time),$user||'-',$fra||'-',$msg;
+  
+  foreach my $log (@logdir) {
+    if (open $log,'>>',"$log/sex.log") {
+      flock $log,LOCK_EX;
+      seek $log,0,SEEK_END;
+      printf {$log} $msg;
+      close $log;
+    }
    }
    if ($sig eq 'DIE') {
      shift;
    }
    if ($sig eq 'DIE') {
      shift;
diff --git a/doc/Changes b/doc/Changes

index 6074da1b1563020620e049bd8439c138bf4ddc73..daf60e89b75077c0f5d8fd63095d70446a268710 100644 (file)
--- a/doc/Changes
+++ b/doc/Changes
@@ -1,3 +1,38 @@
+2015-06-10 fexsrv: fixed warning with https and SIGCHLD
+2015-05-16 fexsrv/dop: added active and passive redirect support
+2015-05-12 fuc: fixed bug undefined subroutine end_html
+2015-04-30 fex_cleanup: fixed bug runtime error with mtime (symlinks)
+2015-04-24 fixed bug wrong quota calculation for uploads
+2015-04-23 fex_cleanup: follow symbolic links if they contain a /
+2015-04-22 fexsend: 60 s timeout for file transfer socket (sys)write
+2015-04-22 fup: fixed bug fexsend hangs with SKEY or GKEY recipient URL
+2015-04-02 fixed several severe bugs in install script
+2015-04-01 group name may only contain (some) ASCII characters
+2015-03-29 fop: fixed bug no more download from same (recipient) ip
+2015-03-18 added local URL redirect service
+2015-03-08 fup: fixed bug uninitialized value $address if alias address is 
+                used twice
+2015-03-07 disallow email addresses starting with "-"
+           fex_cleanup: do not terminate on sendmail error
+2015-03-01 no file name in email subject if notification is encrypted
+2015-02-28 fexsrv: restrict HTTP header to 64 kB ($bs) and POST (not fup) to 
+                   128 MB
+2015-02-27 no more usage of CGI.pm at all
+2015-02-25 fup: added $auth_hook
+2015-02-24 fac(CGI): no more usage of CGI.pm
+2015-02-18 fuc: fixed bug no gpg usage help
+2015-02-17 fexsend: check SSLeay version and adjust SSL_verify_mode
+2015-02-16 fup: save upload URL in spool
+           in notification+reminder emails use same protocol for download URL
+           like in upload
+2015-02-08 rup: fixed various bugs (not working at all)
+2015-02-05 fup: fixed bug cannot send to groups 
+2015-01-27 fup: set autodelete=no if sender == recipient
+                (use case: provide download link for mailing lists)
+           new fex.ph config variable $fex_yourself (default yes)
+2015-01-25 fexsend: fixed bug cannot forward a file name with "&"
+2015-01-21 main user is always first member of a new group
+           substituted CGI::Carp with web error handler via PERLINIT environment
  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
  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
@@ -198,7 +233,7 @@
  2012-11-07 fixed security bug restricted user can redirect files
  2012-11-06 fup: show download-URL after upload if sender = recipient
             fup,fop,fac: added user up/download IP restriction by admin
  2012-11-07 fixed security bug restricted user can redirect files
  2012-11-06 fup: show download-URL after upload if sender = recipient
             fup,fop,fac: added user up/download IP restriction by admin
-2012-11-05 added HTTP Strict Transport Security if $force_https is enabled
+2012-11-05 added HTTP Strict Transport Security (HSTS) if $force_https is set
             fixed bug afex accessible via xkey from everywhere
  2012-11-02 fup: fixed bug one time upload URL gives "no recipient specified" 
                  error
             fixed bug afex accessible via xkey from everywhere
  2012-11-02 fup: fixed bug one time upload URL gives "no recipient specified" 
                  error
@@ -802,4 +837,5 @@
             fex.pp: umask 077
  2008-03-23 fup: fixed bug in using multiple recipients
  2008-03-22 first public release
             fex.pp: umask 077
  2008-03-23 fup: fixed bug in using multiple recipients
  2008-03-22 first public release
+2007-01-27 first file fexed via fex.rus.uni-stuttgart.de
  2006-11-?? first code
  2006-11-?? first code
diff --git a/doc/SSL b/doc/SSL

index fccd4488f0298e34c4883b9f1f8f11b0d45d88f6..d0e95f62f6a4e039d4c976182078fce03c1d532a 100644 (file)
--- a/doc/SSL
+++ b/doc/SSL
@@ -2,6 +2,8 @@
  
  # execute this as root!
  
  
  # execute this as root!
  
+# Redhat : stunnel-4 does not work! you need to install stunnel-5
+
  mkdir /home/fex/etc
  cd /home/fex/etc/
  
  mkdir /home/fex/etc
  cd /home/fex/etc/
  
diff --git a/doc/concept b/doc/concept

index ead53878c1dff9d91c1033cc703f8a790c21925e..f64ba9a13e2de7b470953d5ccc6a99a85ff0d801 100644 (file)
--- a/doc/concept
+++ b/doc/concept
@@ -121,8 +121,7 @@ A SKEY is made of md5_hex("$mainuser:$subuser:$subuserid")
  A GKEY is made of md5_hex("$mainuser:$groupname:$groupuser:$groupuserid")
  
  Note: the AKEY, SKEY and GKEY always can be stolen by a network sniffer!
  A GKEY is made of md5_hex("$mainuser:$groupname:$groupuser:$groupuserid")
  
  Note: the AKEY, SKEY and GKEY always can be stolen by a network sniffer!
-If you need true security, then you have to use https (SSL) instead of
-http! 
+If you need true security, then you have to use https instead of http! 
  
  After download the file will be deleted after a grace time of 1 minute.
  This grace time allows a recipient to get the file again if he had
  
  After download the file will be deleted after a grace time of 1 minute.
  This grace time allows a recipient to get the file again if he had
@@ -247,6 +246,7 @@ Files in spool:
         $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/filename        original file name
         $to/$from/$file/size            original file size
         $to/$from/$file/useragent       HTTP header User-Agent
+       $to/$from/$file/uurl            upload URL
         $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
         $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
diff --git a/doc/new b/doc/new

index de4bd973c06e6392e5e520859ffe69df36848452..568080d556810f9ea5f2693c91bc8459084c6958 100644 (file)
--- a/doc/new
+++ b/doc/new
@@ -1,7 +1,13 @@
-New release on http://fex.rus.uni-stuttgart.de/fex.html
-                                                           
+New release on http://fex.belwue.de/fex.html
+
  Important changes:
  
  Important changes:
  
-- workaround for upload problem with chaching proxies
+- moved to new distribution site fex.belwue.de
+
+- autodelete=no if sender == recipient
+
+- no file name in email subject if notification is encrypted
+
+- added active and passive redirect support for standard HTTP documents
  
  
-- some small bug fixes
+- fixed various bugs
diff --git a/doc/version b/doc/version

index 733bf4c92641baeb2524090ea7e69a195a37f2f9..db58082350ef45e94d51e7cc9ab6e6dd9a9ec8ac 100644 (file)
--- a/doc/version
+++ b/doc/version
@@ -1 +1 @@
-fex-20150120
+fex-20150615
diff --git a/htdocs/FAQ.html b/htdocs/FAQ.html

new file mode 100644 (file)

index 0000000..a096645
--- /dev/null
+++ b/htdocs/FAQ.html
@@ -0,0 +1,12 @@
+<html>
+<head><title>F*EX FAQ</title></head>
+<body>
+
+## <pre>
+## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
+## </pre>
+
+<< require "./faq.pl" or print $! >>
+
+</body>
+</html>
diff --git a/htdocs/FAQ/admin.faq b/htdocs/FAQ/admin.faq

index 35b8b3ca8650bb1635bd368c8e812347bca2a1e7..5a6a301318a832f24e2b141ce463f2d49746f410 100644 (file)
--- a/htdocs/FAQ/admin.faq
+++ b/htdocs/FAQ/admin.faq
@@ -37,7 +37,7 @@ A: Check your routing, ipfilters and firewall setup.
     F*EX needs port 80/tcp for HTTP and optionally port 443/tcp for HTTPS.
  
  Q: What is the difference between all these user types (full, sub, group, external, ...)?
     F*EX needs port 80/tcp for HTTP and optionally port 443/tcp for HTTPS.
  
  Q: What is the difference between all these user types (full, sub, group, external, ...)?
-A: See http://fex.rus.uni-stuttgart.de/users.html
+A: See http://fex.belwue.de/users.html
  
  Q: 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.
  
  Q: 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.
@@ -111,8 +111,8 @@ A: Set variable $bcc in /home/fex/lib/fex.ph
  
  Q: I need more security! How can I enable (https) encryption?
  A: Read doc/SSL and also look for "fop_auth" in doc/concept 
  
  Q: I need more security! How can I enable (https) encryption?
  A: Read doc/SSL and also look for "fop_auth" in doc/concept 
-   (doc is a local directory in your installation or online http://fex.rus.uni-stuttgart.de/doc/)
-   For email encryption see http://fex.rus.uni-stuttgart.de/gpg.html
+   (doc is a local directory in your installation or online http://fex.belwue.de/doc/)
+   For email encryption see http://fex.belwue.de/gpg.html
  
  Q: I need a corporate identity look. How can I configure F*EX in this way?
  A: * See variable @H1_extra in /home/fex/lib/fex.ph and you can add HTML code to /home/fex/htdocs/header.html
  
  Q: I need a corporate identity look. How can I configure F*EX in this way?
  A: * See variable @H1_extra in /home/fex/lib/fex.ph and you can add HTML code to /home/fex/htdocs/header.html
@@ -121,13 +121,13 @@ A: * See variable @H1_extra in /home/fex/lib/fex.ph and you can add HTML code to
  
  Q: F*EX is too complicated for my tie users. I need a simplified upload form.
  A: See /home/fex/htdocs/fup_template.html and /home/fex/htdocs/sup.html 
  
  Q: F*EX is too complicated for my tie users. I need a simplified upload form.
  A: See /home/fex/htdocs/fup_template.html and /home/fex/htdocs/sup.html 
-   or use public upload, see http://fex.rus.uni-stuttgart.de/usecases/foreign.html
+   or use public upload, see http://fex.belwue.de/usecases/foreign.html
  
  Q: F*EX is still too complicated! I need something more simplified.
  
  Q: F*EX is still too complicated! I need something more simplified.
-A: Try http://fex.rus.uni-stuttgart.de/fstools/woos.html or use F*EX mail (see next question).
+A: Try http://fex.belwue.de/fstools/woos.html or use F*EX mail (see next question).
  
  Q: Can I integrate F*EX in my users MUAs (thunderbird, outlook, etc)?
  
  Q: Can I integrate F*EX in my users MUAs (thunderbird, outlook, etc)?
-A: See http://fex.rus.uni-stuttgart.de/usecases/BIGMAIL.html
+A: See http://fex.belwue.de/usecases/BIGMAIL.html
  
  Q: Can I get a localized version in my native languange?
  A: With your help, yes. Please contact <framstag@rus.uni-stuttgart.de>
  
  Q: Can I get a localized version in my native languange?
  A: With your help, yes. Please contact <framstag@rus.uni-stuttgart.de>
diff --git a/htdocs/FAQ/meta.faq b/htdocs/FAQ/meta.faq

index 2bda920ae4f4923adea1899d89aead310a219c98..bc232d78db853481c32d75a41844f7b75a40d591 100644 (file)
--- a/htdocs/FAQ/meta.faq
+++ b/htdocs/FAQ/meta.faq
@@ -1,6 +1,6 @@
  Q: What is so special about F*EX?
  Q: What is so special about F*EX?
-A: See feature list http://fex.rus.uni-stuttgart.de/features.html
-   and use cases http://fex.rus.uni-stuttgart.de/usecases/
+A: See feature list http://fex.belwue.de/features.html
+   and use cases http://fex.belwue.de/usecases/
  
  Q: Why not use one of the commercial services like DropLoad, ALLPeers, YouSendIt, etc?
  A: * They have a file size limit of 2 GB or even less.
  
  Q: Why not use one of the commercial services like DropLoad, ALLPeers, YouSendIt, etc?
  A: * They have a file size limit of 2 GB or even less.
@@ -20,7 +20,7 @@ A: The main author is Ulli Horlacher <framstag@rus.uni-stuttgart.de><br>
  Q: 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.
  Q: 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.
-   http://fex.rus.uni-stuttgart.de/Vortrag/tosa.html
+   http://fex.belwue.de/Vortrag/tosa.html
  
  Q: What do I need to install F*EX?
  A: A UNIX or Windows server with a DNS entry, smtp for outgoing email and one open and free incoming tcp port.
  
  Q: What do I need to install F*EX?
  A: A UNIX or Windows server with a DNS entry, smtp for outgoing email and one open and free incoming tcp port.
@@ -34,21 +34,21 @@ A: Yes.
  
  Q: Can I run F*EX on Windows?
  A: On client side all operating systems are supported, even Windows.
  
  Q: Can I run F*EX on Windows?
  A: On client side all operating systems are supported, even Windows.
-   If you want to run a F*EX server on Windows, then see http://fex.rus.uni-stuttgart.de/fexwix.html
+   If you want to run a F*EX server on Windows, then see http://fex.belwue.de/fexwix.html
  
  Q: Where can I get the F*EX sources?
  
  Q: Where can I get the F*EX sources?
-A: F*EX server for UNIX: http://fex.rus.uni-stuttgart.de/fex.html
+A: F*EX server for UNIX: http://fex.belwue.de/fex.html
  
  Q: I do not want to install a F*EX server of my own, but where can I use it?
  A: Contact <fex@nepustil.net> http://www.nepustil.net/ for F*EX hosting.
  
  Q: The F*EX server is all in Perl?! Isn't Perl too slow for this job?
  
  Q: I do not want to install a F*EX server of my own, but where can I use it?
  A: Contact <fex@nepustil.net> http://www.nepustil.net/ for F*EX hosting.
  
  Q: The F*EX server is all in Perl?! Isn't Perl too slow for this job?
-A: fex.rus.uni-stuttgart.de runs on an office PC and F*EX is able to handle uploads with more than 300 MB/s.
+A: fex.belwue.de runs on a PC and F*EX is able to handle uploads with more than 300 MB/s.
     Try this with an ordinary webserver like Apache!
  
  Q: Which licence does F*EX have? And why?
  A: Perl Artistic free software with a special anti-military clause: 
     Try this with an ordinary webserver like Apache!
  
  Q: Which licence does F*EX have? And why?
  A: Perl Artistic free software with a special anti-military clause: 
-   http://fex.rus.uni-stuttgart.de/doc/Licence
+   http://fex.belwue.de/doc/Licence
     "I want peace on earth and goodwill towards men"
     http://www.youtube.com/watch?v=JHU0HinVhYc
  
     "I want peace on earth and goodwill towards men"
     http://www.youtube.com/watch?v=JHU0HinVhYc
  
diff --git a/htdocs/FAQ/user.faq b/htdocs/FAQ/user.faq

index 5c62df9fda3acbe0745204c3c5aa598f46328fa0..4c75028ab3da5abe124c0bd3be12ab830102ca4f 100644 (file)
--- a/htdocs/FAQ/user.faq
+++ b/htdocs/FAQ/user.faq
@@ -2,7 +2,7 @@ Q: 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.
  
  Q: What is the difference between all these user types (full, sub, group, external, ...)?
  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.
  
  Q: What is the difference between all these user types (full, sub, group, external, ...)?
-A: See http://fex.rus.uni-stuttgart.de/users.html
+A: See http://fex.belwue.de/users.html
  
  Q: I have uploaded a HUGE file but misspelled my recipient's address. Now I have got an error bounce email. Must I re-upload the HUGE file?
  A: No, it is not necessary. You can redirect the file with "user config & operation control"
  
  Q: I have uploaded a HUGE file but misspelled my recipient's address. Now I have got an error bounce email. Must I re-upload the HUGE file?
  A: No, it is not necessary. You can redirect the file with "user config & operation control"
@@ -26,7 +26,7 @@ A: When you are using F*EX with your webbrowser, you are limited to its restrict
     * send several files or even whole directory trees at once
     * stream files
     * transfer files via command line
     * 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
+   * use an Internet clipboard http://fex.belwue.de/usecases/xx.html
     * do much more :-)
  
  Q: How can I upload several files at once?
     * do much more :-)
  
  Q: How can I upload several files at once?
@@ -40,6 +40,7 @@ A: Many web browsers have bugs in their HTML-FORM implementation. The limit most
  
  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: I need to send a file bigger than my quota allows. What can I do?
  A: Simply ask $SERVER_ADMIN$ to raise your quota.
+   If you want to send a REALLY big file, you also have to tell the recipient's address because his quota also has to be raised.
  
  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.
  
  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.
@@ -56,7 +57,7 @@ A: F*EX supports resuming at upload, but your client also has to support it.
  
  Q: Can I integrate F*EX in my mail program (thunderbird, outlook, etc)?
  A: Yes, if your mail admin has set up a "fexmail" smtp relay.
  
  Q: Can I integrate F*EX in my mail program (thunderbird, outlook, etc)?
  A: Yes, if your mail admin has set up a "fexmail" smtp relay.
-   http://fex.rus.uni-stuttgart.de/usecases/BIGMAIL.html
+   http://fex.belwue.de/usecases/BIGMAIL.html
  
  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.
  
  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.
@@ -69,7 +70,7 @@ A: This is a built-in feature of firefox: ESC terminates the current operation.
  
  Q: Sending as a F*EX user is easy, but how to receive files from others, outside?
  A: Register them as your subusers, create a F*EX group or a one-time upload key with "user config & operation control"
  
  Q: Sending as a F*EX user is easy, but how to receive files from others, outside?
  A: Register them as your subusers, create a F*EX group or a one-time upload key with "user config & operation control"
-   See also http://fex.rus.uni-stuttgart.de/usecases/foreign.html
+   See also http://fex.belwue.de/usecases/foreign.html
  
  Q: 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 request the file several times at once. Otherwise they would report an error to the user.
  
  Q: 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 request the file several times at once. Otherwise they would report an error to the user.
@@ -111,7 +112,7 @@ A: No.
     With email you also have no acknowledgement of receipt.
  
  Q: Can I have encrypted emails?
     With email you also have no acknowledgement of receipt.
  
  Q: Can I have encrypted emails?
-A: See http://fex.rus.uni-stuttgart.de/gpg.html
+A: See http://fex.belwue.de/gpg.html
  
  Q: 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.
  
  Q: 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.
diff --git a/htdocs/download/fexget b/htdocs/download/fexget

index 034ced112fa3d6e581ea7a092c602f9c6e2ff436..6c0126f807183cfad1d17b438e2419a4b7e82aa0 100755 (executable)
--- 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 ($fexhome,$idf,$tmpdir,$windoof,$useragent);
  our ($xv,%autoview);
  our $bs = 2**16; # blocksize for tcp-reading and writing file
-our $version = 20150120;
+our $version = 20150615;
  our $CTYPE = 'ISO-8859-1';
  our $fexsend = $ENV{FEXSEND} || 'fexsend';
  
  our $CTYPE = 'ISO-8859-1';
  our $fexsend = $ENV{FEXSEND} || 'fexsend';
  
@@ -157,48 +157,7 @@ if ($opt_H) {
    exit;
  }
  
    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)
  
  
  my $ffl = "$tmpdir/fexget";            # F*EX files list (cache)
  
diff --git a/htdocs/download/fexsend b/htdocs/download/fexsend

index 607d1391f9de05c5362701ae806199a02d6424a6..a0eabe189aadc858c4d80a7dfa06c5a29ebae23a 100755 (executable)
--- a/htdocs/download/fexsend
+++ b/htdocs/download/fexsend
@@ -37,7 +37,7 @@ our ($tpid,$frecipient);
  our ($FEXID,$FEXXX,$HOME);
  our (%alias);
  our $chunksize = 0;
  our ($FEXID,$FEXXX,$HOME);
  our (%alias);
  our $chunksize = 0;
-our $version = 20150120;
+our $version = 20150615;
  our $_0 = $0;
  our $DEBUG;
  
  our $_0 = $0;
  our $DEBUG;
  
@@ -199,6 +199,10 @@ and then copy-forward it with:
    $0 -b # other\@address
  Where # is the file number.
  
    $0 -b # other\@address
  Where # is the file number.
  
+You can list an uploaded file in more detail with
+  $0 -l #
+Where # is the file number.
+  
  If you want to modify the keep time, comment or auto-delete behaviour of an
  already uploaded file then you first have to query the file number with:
    $0 -l
  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
@@ -625,8 +629,10 @@ sub init_id {
    if ($fexcgi =~ /\?/) {
      $from = $1 if $fexcgi =~ /\bfrom=(.+?)(&|$)/i;
      $id   = $1 if $fexcgi =~ /\bid=(.+?)(&|$)/i;
    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;
+    # $skey = $1 if $fexcgi =~ /\bskey=(.+?)(&|$)/i;
+    # $gkey = $1 if $fexcgi =~ /\bgkey=(.+?)(&|$)/i;
+    die "$0: cannot use GKEY URL in ID file\n" if $fexcgi =~ /gkey=/i;
+    die "$0: cannot use SKEY URL in ID file\n" if $fexcgi =~ /skey=/i;
      $fexcgi =~ s/\?.*//;
    }
    unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) {
      $fexcgi =~ s/\?.*//;
    }
    unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) {
@@ -1001,6 +1007,9 @@ sub list {
        else                              { $dkey = '' }
  #      $_ = encode_utf8($_);
        s/<.*?>//g;
        else                              { $dkey = '' }
  #      $_ = encode_utf8($_);
        s/<.*?>//g;
+      s/&amp;/&/g;
+      s/&quot;/\"/g;
+      s/&lt;/</g;
        if (/^(to .* :)/) {
          print "\n$1\n";
          print {$fexlist} "\n$1\n";
        if (/^(to .* :)/) {
          print "\n$1\n";
          print {$fexlist} "\n$1\n";
@@ -1135,7 +1144,6 @@ sub send_fex {
    my @files = ();
    my ($data,$aname,$alias);
    my (@r,$r);
    my @files = ();
    my ($data,$aname,$alias);
    my (@r,$r);
-  my $ma = $HOME.'/.mutt/aliases';
    my $t0 = time;
    my $transferfile;
    my @transferfiles;
    my $t0 = time;
    my $transferfile;
    my @transferfiles;
@@ -1254,38 +1262,18 @@ sub send_fex {
            # $to = $AB{$to};
          } 
          # look for mutt aliases
            # $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;
+        elsif ($to !~ /@/ and $to ne $from) {
+          $to = get_mutt_alias($to);
          }
        }
      }
    
      $to = join(',',grep /./,@to) or exit;
          }
        }
      }
    
      $to = join(',',grep /./,@to) or exit;
-    warn "Server/User: $fexcgi/$from\n" unless $opt_q;
+    # warn "Server/User: $fexcgi/$from\n" unless $opt_q;
    
      if (
        not $skey and not $gkey
    
      if (
        not $skey and not $gkey
+      and $from ne $to
        and $features =~ /CHECKRECIPIENT/ 
        and $opt_C !~ /^(DELETE|LIST|RECEIVEDLOG|SENDLOG|FOPLOG)$/
      ) {
        and $features =~ /CHECKRECIPIENT/ 
        and $opt_C !~ /^(DELETE|LIST|RECEIVEDLOG|SENDLOG|FOPLOG)$/
      ) {
@@ -1497,7 +1485,7 @@ sub send_fex {
  sub forward {
    my (@r);
    my ($to,$n,$dkey,$file,$req);
  sub forward {
    my (@r);
    my ($to,$n,$dkey,$file,$req);
-  my $status = 1;
+  my ($status,$fp);
    local $_;
    
    # look for single @ in arguments
    local $_;
    
    # look for single @ in arguments
@@ -1512,6 +1500,9 @@ sub forward {
    # if ($windoof and not @ARGV) { &inquire }
    $to = pop @ARGV or die $usage;
    $to = $from if $to eq '.';
    # if ($windoof and not @ARGV) { &inquire }
    $to = pop @ARGV or die $usage;
    $to = $from if $to eq '.';
+  if ($to !~ /@/ and $to ne $from) {
+    $to = get_mutt_alias($to);
+  }
  
    open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
    while (<$fexlist>) {
  
    open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
    while (<$fexlist>) {
@@ -1545,16 +1536,12 @@ sub forward {
    $req .= " HTTP/1.1";
    sendheader("$server:$port",$req);
    http_response();
    $req .= " HTTP/1.1";
    sendheader("$server:$port",$req);
    http_response();
+  $fp = $file;
+  $fp =~ s/[^\w_.-]/.+/g; # because of UTF8 filename
+  $status = 1;
    while (<$SH>) { 
    while (<$SH>) { 
-    if ($opt_v) {
-      print;
-      $status = 0 if /\Q"$file"/;
-    } else {
-      if (/\Q"$file"/) {
-        print;
-        $status = 0;
-      }
-    }
+    $status = 0 if /"$fp"/;
+    print if $opt_v or /"$fp"/;
    }
    
    if ($status) {
    }
    
    if ($status) {
@@ -1723,7 +1710,11 @@ sub get_xx {
      if (/^n/i) {
        print "keeping $transferfile\n";
      } else {
      if (/^n/i) {
        print "keeping $transferfile\n";
      } else {
-      system("tar xvf $transferfile && rm $transferfile");
+      my $untar = "tar xvf";
+      # if ($> == 0 and `tar --help 2>&1` =~ /gnu/) {
+      #  $untar = "tar --no-same-owner -xvf";
+      # }
+      system("$untar $transferfile && rm $transferfile");
        die "$0: error while untaring, see $transferfile\n" if -f $transferfile;
      }
    } else {
        die "$0: error while untaring, see $transferfile\n" if -f $transferfile;
      }
    } else {
@@ -2058,8 +2049,11 @@ sub formdatapost {
        
        print $rcamel[0] if ${'opt_+'};
  
        
        print $rcamel[0] if ${'opt_+'};
  
+      $SIG{ALRM} = sub { retry("timed out") };
        while (my $b = read $file,$buf,$bs) {
        while (my $b = read $file,$buf,$bs) {
-        print {$SH} $buf or &sigpipehandler;
+        alarm($timeout*2);
+        syswrite $SH,$buf or &sigpipehandler;
+        alarm(0);
          $bytes += $b;
          if ($filesize > 0 and $bytes+$seek > $filesize) {
            die "$0: $file filesize has grown while uploading\n";
          $bytes += $b;
          if ($filesize > 0 and $bytes+$seek > $filesize) {
            die "$0: $file filesize has grown while uploading\n";
@@ -2611,21 +2605,27 @@ sub ts {
    
  
  sub sigpipehandler {
    
  
  sub sigpipehandler {
-  $SIG{ALRM} = sub { };
+  retry("died");
+}
+
+sub retry {
+  my $reason = shift;
+  local $SIG{ALRM} = sub { };
+  
    if (fileno $SH) {
      alarm(1);
    if (fileno $SH) {
      alarm(1);
-    @_ = <$SH>;
+    my @r = <$SH>;
      alarm(0);
      kill 9,$tpid if $tpid;
      alarm(0);
      kill 9,$tpid if $tpid;
-    if (@_ and $opt_v) {
-      die "\n$0: ($$) server error: @_\n";
+    if (@r and $opt_v) {
+      die "\n$0: ($$) server error: @r\n";
      }
      }
-    if (@_ and $_[0] =~ /^HTTP.* \d+ (.*)/) {
+    if (@r and $r[0] =~ /^HTTP.* \d+ (.*)/) {
        die "\n$0: server error: $1\n";
      }
    }
    $timeout *= 2;
        die "\n$0: server error: $1\n";
      }
    }
    $timeout *= 2;
-  warn "\n$0: connection to $server died\n";
+  warn "\n$0: connection to $server $reason\n";
    warn "retrying after $timeout seconds...\n";
    sleep $timeout;
    if ($windoof) { exec $^X,$0,@_ARGV }
    warn "retrying after $timeout seconds...\n";
    sleep $timeout;
    if ($windoof) { exec $^X,$0,@_ARGV }
@@ -2736,6 +2736,37 @@ sub fileid {
  }
  
  
  }
  
  
+sub get_mutt_alias {
+  my $to = shift;
+  my $ma = $HOME.'/.mutt/aliases';
+  my $alias;
+  local $_;
+  
+  open $ma,$ma or return $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;
+  return ($alias||$to);
+}
+
+
  # collect file meta data (filename, inode, mtime)
  sub fmd {
    my @files = @_;
  # collect file meta data (filename, inode, mtime)
  sub fmd {
    my @files = @_;
@@ -2815,6 +2846,7 @@ sub http_response {
    unless (defined $_ and /\w/) {
      die "$0: no response from server\n";
    }
    unless (defined $_ and /\w/) {
      die "$0: no response from server\n";
    }
+  print "<-- $_\n" if $opt_v;
    s/\r?\n//;
    # CGI fatalsToBrowser
    if (/^HTTP.* 500/) {
    s/\r?\n//;
    # CGI fatalsToBrowser
    if (/^HTTP.* 500/) {
@@ -2825,9 +2857,12 @@ sub http_response {
    unless (/^HTTP.* 200/) {
      $error = $_;
      $error =~ s/HTTP.[\s\d.]+//;
    unless (/^HTTP.* 200/) {
      $error = $_;
      $error =~ s/HTTP.[\s\d.]+//;
-    if ($opt_v) {
-      print "<-- $_";
-      print "<-- $_" while <$SH>;
+    @r = <$SH> unless @r;
+    @r = ()    unless @r;
+    foreach (@r) {
+      chomp;
+      $error .= "\n".$_ if /^Location/;
+      print "<-- $_\n" if $opt_v;
      }
      die "$0: server error: $error\n";
    }
      }
      die "$0: server error: $error\n";
    }
@@ -2937,12 +2972,6 @@ sub serverconnect {
    my $connect = "CONNECT $server:$port HTTP/1.1";
    local $_;
    
    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) {
    if ($proxy) {
      tcpconnect(split(':',$proxy));
      if ($port == 443) {
@@ -2954,8 +2983,7 @@ sub serverconnect {
        unless (/^HTTP.1.. 200/) {
          die "$0: proxy error : $_";
        }
        unless (/^HTTP.1.. 200/) {
          die "$0: proxy error : $_";
        }
-      eval "use IO::Socket::SSL";
-      die "$0: cannot load IO::Socket::SSL\n" if $@;
+      &enable_ssl;
        $SH = IO::Socket::SSL->start_SSL($SH,%SSL);
      }
    } else {
        $SH = IO::Socket::SSL->start_SSL($SH,%SSL);
      }
    } else {
@@ -2978,8 +3006,7 @@ sub tcpconnect {
    
    if ($port == 443) {
      # eval "use IO::Socket::SSL qw(debug3)";
    
    if ($port == 443) {
      # eval "use IO::Socket::SSL qw(debug3)";
-    eval "use IO::Socket::SSL";
-    die "$0: cannot load IO::Socket::SSL\n" if $@;
+    &enable_ssl;
      $SH = IO::Socket::SSL->new(
        PeerAddr => $server,
        PeerPort => $port,
      $SH = IO::Socket::SSL->new(
        PeerAddr => $server,
        PeerPort => $port,
@@ -3004,6 +3031,18 @@ sub tcpconnect {
  }
  
  
  }
  
  
+sub enable_ssl {
+  eval "use IO::Socket::SSL";
+  die "$0: cannot load IO::Socket::SSL\n" if $@;
+  eval '$SSL{SSL_verify_mode} = 0 if Net::SSLeay::SSLeay() <= 9470143';
+  if ($opt_v) {
+    foreach my $v (keys %SSL) {
+      printf "%s => %s\n",$v,$SSL{$v};
+    }
+  }
+}
+
+
  sub sendheader {
    my $sp = shift;
    my @head = @_;
  sub sendheader {
    my $sp = shift;
    my @head = @_;
diff --git a/htdocs/download/sexsend b/htdocs/download/sexsend

index 7340e497e98b97a984f2de429cba3699d947e7e7..1fedac8935f7ae1e825824f764ba53ba81fa25ff 100755 (executable)
--- a/htdocs/download/sexsend
+++ b/htdocs/download/sexsend
@@ -19,7 +19,7 @@ use constant M => 2**20;
  
  eval 'use Net::INET6Glue::INET_is_INET6';
  
  
  eval 'use Net::INET6Glue::INET_is_INET6';
  
-our $version = 20150120;
+our $version = 20150615;
  
  my %SSL = (SSL_version => 'TLSv1');
  my $sigpipe;
  
  my %SSL = (SSL_version => 'TLSv1');
  my $sigpipe;
diff --git a/htdocs/features.html b/htdocs/features.html

deleted file mode 100644 (file)

index a68df17..0000000
--- a/htdocs/features.html
+++ /dev/null
@@ -1,69 +0,0 @@
-<HTML> \r
-<HEAD><TITLE>F*EX feature list</TITLE></HEAD>\r
-<BODY>\r
-<h1><a href="/">F*EX</a> feature list</h1>\r
-<ul>\r
-  <li>file transfer of virtually unlimited file size\r
-  <li>recipient and sender only need an e-mail program and a web browser -\r
-      of any kind, they do not have to install any software<br>\r
-      (the F*EX server itself is UNIX based)\r
-  <li>RESEND and REGET for resuming after link failures at last sent byte\r
-  <li>auto-notification of recipient\r
-  <li>auto-deletion after download\r
-  <li>auto-deletion after expiration date (default: 5 days)\r
-  <li>full-users can create one time upload URLs for foreign users\r
-  <li>full-users can create sub-users, who can send only to this full-user\r
-  <li>full-users can create groups, an analogy to mailing lists, but for files\r
-  <li>admin can allow (internal or external) user self-registration\r
-  <li>admin can allow upload to public recipients without authentification\r
-  <li>admin can allow upload for LAN users without registration \r
-      (<a href="/usecases/anonymous.html">anonymous upload</a>)\r
-  <li>user can forward a file to a second recipient without re-uploading it\r
-  <li>user can forward a received file without download\r
-  <li>adminstration by CLI or Web\r
-  <li>server based user address books\r
-  <li>user and admin can throttle bandwith usage\r
-  <li>admin can restrict access based on e-mail or ip addresses \r
-  <li>sending to multiple recipients needs storage on the server only once\r
-  <li>quotas for sending and receiving\r
-  <li>support for named based virtual hosts \r
-      (multiple server instances with different hostnames on same IP)\r
-  <li>support for streams, including streaming recursive file transfer\r
-  <li>support for file linking (upload just a link, not the file itself)\r
-  <li>integrated web server with special features:\r
-      <ul>\r
-        <li>HTML with inline perl code\r
-        <li>HTML with conditional if..then..elseif..end blocks\r
-        <li>HTML with include statement\r
-        <li>on-the-fly zip, tar and tgz streaming output \r
-        <li>(restricted) directory file viewer\r
-      </ul>\r
-  <li>for real UNIX users, there are the shell programs \r
-       <a href="/fstools/fexsend.html">fexsend</a> and\r
-       <a href="/fstools/fexget.html">fexget</a><br>\r
-       to avoid annoying web browser usage and with a lot of additional\r
-       features,<br>\r
-       also there is an <a href="/usecases/xx.html">Internet clipboard</a>\r
-       and <a href="/usecases/anonymous.html">anonymous usage</a>\r
-  <li><a href="/fex.html">protocol and source-code free available</a>\r
-  <li>localization for <a href="http://fex.rus.uni-stuttgart.de:8080/">\r
-      many languanges</a> available\r
-  <li>optional authentification by LDAP, RADIUS, POP, IMAP, mailman\r
-  <li>server available for UNIX and Windows hosts\r
-  <li>about 10 times faster than apache\r
-  <li><b>very</b> low memory usage\r
-  <li>(reverse) proxy support\r
-  <li>F*EX is a HTTP web-service and needs no firewall-tunnels\r
-  <li>works with NAT or DHCP clients, too\r
-  <li><a href="/usecases/BIGMAIL.html">postfix filter</a> available to send\r
-      e-mails with attachments of <b>any</b> size\r
-  <li>maintenance-free: no admin interaction necessary \r
-  <li>minimal software & hardware requirements for the server\r
-  <li>no external database necessary, but possible (LDAP)\r
-  <li>full IPv6 support\r
-  <li>easy server installation, no installation necessary on client side\r
-  <li>great <a href="/FAQ/">FAQ</a>, <a href="/usecases/">use cases</a> \r
-      and detailed <a href="/doc/concept">internal documentation</a>\r
-</ul>\r
-</BODY>\r
-</HTML> \r
diff --git a/htdocs/index.html b/htdocs/index.html

index 548e82ae34e0e9616711af644c5fb85b1a5fac71..5fda09df28242a06a4e0f06048dc0417ab667f68 100644 (file)
--- a/htdocs/index.html
+++ b/htdocs/index.html
@@ -74,7 +74,7 @@ You have the following possibilities (and problems):<p>
          <li>Very few http servers can handle files greater than 2 GB
        </ul>
        <p>
          <li>Very few http servers can handle files greater than 2 GB
        </ul>
        <p>
-  <li><h3><a href ="http://fex.rus.uni-stuttgart.de/saft/">
+  <li><h3><a href ="http://fex.belwue.de/saft/">
            sendfile</a></h3><p>
        <ul>
          <li>You run UNIX and have sendfile installed?
            sendfile</a></h3><p>
        <ul>
          <li>You run UNIX and have sendfile installed?
@@ -130,8 +130,9 @@ the shell-tools sexsend and sexget.
  Authentication is the same as with F*EX.
  
  <h2>Still questions?</h2>
  Authentication is the same as with F*EX.
  
  <h2>Still questions?</h2>
-See the <a href="/FAQ/FAQ.html">FAQ</a>
-and the <a href="http://fex.rus.uni-stuttgart.de/usecases/">use cases</a>.
+See the <a href="http://fex.belwue.de/features.html">full feature list</a>, 
+the <a href="/FAQ/FAQ.html">FAQ</a>
+and the <a href="http://fex.belwue.de/usecases/">use cases</a>.
  
  <p>
  <ADDRESS>contact: <A HREF="mailto:$SERVER_ADMIN$">fexmaster</A></ADDRESS>
  
  <p>
  <ADDRESS>contact: <A HREF="mailto:$SERVER_ADMIN$">fexmaster</A></ADDRESS>
diff --git a/htdocs/version b/htdocs/version

index 733bf4c92641baeb2524090ea7e69a195a37f2f9..db58082350ef45e94d51e7cc9ab6e6dd9a9ec8ac 100644 (file)
--- a/htdocs/version
+++ b/htdocs/version
@@ -1 +1 @@
-fex-20150120
+fex-20150615
diff --git a/install b/install

index 7ffdfc00aaf4b9277bd7bf2b4f77e4221a95f17c..9c49c06cf4d54193ba27a1ebc6aec17ddfadeec1 100755 (executable)
--- a/install
+++ b/install
@@ -18,18 +18,11 @@ if ($<) {
    die "you must be root to install F*EX\n";
  }
  
    die "you must be root to install F*EX\n";
  }
  
-goto INSTALL if $0 =~ /upgrade$/;
-
  $fex = 'fex.rus.uni-stuttgart.de';
  if (system("host $fex >/dev/null") != 0) {
    die "host $fex is not resolvable - check /etc/resolv.conf\n";
  }
  
  $fex = 'fex.rus.uni-stuttgart.de';
  if (system("host $fex >/dev/null") != 0) {
    die "host $fex is not resolvable - check /etc/resolv.conf\n";
  }
  
-if (`uname` =~ /^SunOS/) {
-  die "Solaris is currently not supported. "
-     ."Please contact framstag\@rus.uni-stuttgart.de for details.\n";
-}
-
  $opt_p = 80;
  
  if (open $xinetd,$xinetd) {
  $opt_p = 80;
  
  if (open $xinetd,$xinetd) {
@@ -37,13 +30,20 @@ if (open $xinetd,$xinetd) {
      if (/^\s*port\s*=\s*(\d+)/) {
        $opt_p = $fexport = $1;
      }
      if (/^\s*port\s*=\s*(\d+)/) {
        $opt_p = $fexport = $1;
      }
-    if (/^\s*bind\s*=\s*([\d.]+)/) {
+    if (/^\s*bind\s*=\s*([\d.]+)$/) {
        $fexip = $ip = $1;
      }
    }
    close $xinetd;
  }
  
        $fexip = $ip = $1;
      }
    }
    close $xinetd;
  }
  
+goto INSTALL if $0 =~ /upgrade$/;
+
+if (`uname` =~ /^SunOS/) {
+  die "Solaris is currently not supported. "
+     ."Please contact framstag\@rus.uni-stuttgart.de for details.\n";
+}
+
  getopts('p:') or die $usage;
  
  $arg = shift;
  getopts('p:') or die $usage;
  
  $arg = shift;
@@ -53,7 +53,6 @@ if ($arg and -f "locale/$arg/lib/fup.pl") {
    $ip = $arg || $fexip || 0;
  }
  
    $ip = $arg || $fexip || 0;
  }
  
-
  # if (not $ip and open P,"ifconfig 2>/dev/null |") {
  if (not $ip and open P,'host $(hostname)|') {
    $guessed_ip = 0;
  # if (not $ip and open P,"ifconfig 2>/dev/null |") {
  if (not $ip and open P,'host $(hostname)|') {
    $guessed_ip = 0;
@@ -69,7 +68,6 @@ if (not $ip and open P,'host $(hostname)|') {
    $ip ||= $guessed_ip;
  }
  
    $ip ||= $guessed_ip;
  }
  
-$ip =~ /^\d+\.\d+\.\d+\.\d+$/ or die $usage;
  
  ($hostname) = gethostbyaddr(gethostbyname($ip),AF_INET);
  die "cannot find hostname for IP $ip\n" unless $hostname;
  
  ($hostname) = gethostbyaddr(gethostbyname($ip),AF_INET);
  die "cannot find hostname for IP $ip\n" unless $hostname;
@@ -141,11 +139,31 @@ umask 077;
  
  @FEX = getpwnam('fex') or die "no user fex\n";
  $FEXHOME  = $FEX[7];
  
  @FEX = getpwnam('fex') or die "no user fex\n";
  $FEXHOME  = $FEX[7];
+$ENV{HOME} = $FEXHOME; # needed for later eval fex.ph
  
  die "no HOME directory for user fex\n" unless -d $FEXHOME;
  
  die "no HOME directory for user fex\n" unless -d $FEXHOME;
+if ($FEXHOME !~ /fex/) {
+  print "HOME=$FEXHOME for user fex does not contain \"fex\"\n";
+  print "REALLY continue?! ";
+  $_ = <STDIN>;
+  exit unless /^y/i;
+}
  
  print "Installing:\n";
  
  
  print "Installing:\n";
  
+$pecl = "$FEXHOME/perl/Encode/ConfigLocal.pm";
+unless (-f $pecl) {
+  mkdir "$FEXHOME/perl";
+  mkdir "$FEXHOME/perl/Encode";
+  open $pecl,'>',$pecl or die "$0: cannot write $pecl - $!\n";
+  print {$pecl} 
+    "# hack for broken Perl in SuSe and Solaris, used via \@INC in fexsrv\n",
+    "1;\n";
+  close $pecl;
+  print $pecl,"\n";
+  chownr('fex:root',"$FEXHOME/perl");
+}
+
  @save = (
    "lib/fex.ph",
    "lib/fup.pl",
  @save = (
    "lib/fex.ph",
    "lib/fup.pl",
@@ -171,29 +189,28 @@ unlink "$FEXHOME/htdocs/License";
  $hl = "$FEXHOME/htdocs/locale";
  unless (-d $hl) { mkdir $hl or die "$0: cannot mkdir $hl - $!\n" }
  
  $hl = "$FEXHOME/htdocs/locale";
  unless (-d $hl) { mkdir $hl or die "$0: cannot mkdir $hl - $!\n" }
  
-if  (-d "$FEXHOME/spool") {
-  warn "checking spool ...\n";
-  &convert_spool;
-  system "chown -R fex $spooldir/";
-} else {
-  $newinstall = $FEXHOME;
-  chmod 0700,$FEXHOME;
-  mkdir "$FEXHOME/spool",0700 or die "cannot mkdir $FEXHOME/spool - $!\n";
-  mkdir "$FEXHOME/spool/.error",0700;
-  system "chown -R fex $FEXHOME/spool";
-}
-
  foreach $s (@save) {
    $f = "$FEXHOME/$s";
    $fs = $f.'_save';
    $fn = $f.'_new';
    if (-e $fs) {
  foreach $s (@save) {
    $f = "$FEXHOME/$s";
    $fs = $f.'_save';
    $fn = $f.'_new';
    if (-e $fs) {
-    system "rm -rf $fn";
+    unlink $fn;
      rename $f,$fn and print "$f --> $fn\n";
      rename $fs,$f and print "$fs --> $f\n";
    }
  }
  
      rename $f,$fn and print "$f --> $fn\n";
      rename $fs,$f and print "$fs --> $f\n";
    }
  }
  
+if (-d "$FEXHOME/spool") {
+  warn "checking $FEXHOME/spool ...\n";
+  &convert_spool;
+} else {
+  $newinstall = $FEXHOME;
+  chmod 0700,$FEXHOME;
+  mkdir "$FEXHOME/spool",0700 or die "cannot mkdir $FEXHOME/spool - $!\n";
+  mkdir "$FEXHOME/spool/.error",0700;
+}
+chownr('fex',"$FEXHOME/spool/.");
+
  system(qw'perl -p -i -e',
    's:href="/?FAQ.html":href="/FAQ/FAQ.html":',
    "$FEXHOME/lib/fup.pl"
  system(qw'perl -p -i -e',
    's:href="/?FAQ.html":href="/FAQ/FAQ.html":',
    "$FEXHOME/lib/fup.pl"
@@ -208,12 +225,20 @@ while (<$fph>) {
  close $fph;
  
  eval $conf;
  close $fph;
  
  eval $conf;
-$spooldir ||= "$FEXHOME/spool";
+
+die "no \$spooldir in $fph\n" unless $spooldir;
+die "\$spooldir=$spooldir is not a directory, see $fph\n" unless -d $spooldir;
+symlink $spooldir,"$FEXHOME/spool" unless -e "$FEXHOME/spool";
+@sds1 = stat "$spooldir/.";
+@sds2 = stat "$FEXHOME/spool/.";
+if ("@sds1" ne "@sds2") {
+  die "$FEXHOME/spool is not a symbolic link to \$spooldir=$spooldir\n";
+}
  
  $fid = "$FEXHOME/.fex/id";
  $aa = "$spooldir/$admin/@";
  
  
  $fid = "$FEXHOME/.fex/id";
  $aa = "$spooldir/$admin/@";
  
-if ($newinstall) {
+if ($newinstall or not -s $aa) {
    print "\n";
    for (;;) {
      print "Server hostname [$hostname] : ";
    print "\n";
    for (;;) {
      print "Server hostname [$hostname] : ";
@@ -261,24 +286,6 @@ if ($newinstall) {
    }
  }
  
    }
  }
  
-sub mkfid {
-  my $ad = dirname($aa);
-  mkdir $ad;
-  open $aa,'>',$aa or die "$0: cannot create $aa - $!\n";
-  print {$aa} "$admin_pw\n";
-  close $aa;
-  my $fd = dirname($fid);
-  mkdir $fd;
-  rename $fid,$fid.'_save';
-  open $fid,'>',$fid or die "$0: cannot create $fid - $!\n";
-  print {$fid} "$hostname:$opt_p\n";
-  print {$fid} "$admin\n";
-  print {$fid} "$admin_pw\n";
-  close $fid;
-  chmod 0700,$fd;
-  system "chown -R fex $fd $ad";
-}
-
  open $fph,">$fph.new" or die "$0: cannot write $fph.new - $!\n";
  print {$fph} $conf;
  close $fph;
  open $fph,">$fph.new" or die "$0: cannot write $fph.new - $!\n";
  print {$fph} $conf;
  close $fph;
@@ -287,15 +294,12 @@ rename "$fph.new",$fph or die "$0: cannot rename $fph.new to $fph - $!\n";
  
  do $fph or die "$0: error in new $fph - $!\n";
  
  
  do $fph or die "$0: error in new $fph - $!\n";
  
-rename "locale/deutsch","locale/german"  if -d "locale/deutsch";
-rename "locale/espanol","locale/spanish" if -d "locale/espanol";
-
  if (@locales = glob "locale/*/lib/fup.pl") {
    foreach (@locales) {
      m{locale/(.+?)/} and $locale = $1;
      if (-f "$FEXHOME/$_") { 
        system 'locale/translate',$locale;
  if (@locales = glob "locale/*/lib/fup.pl") {
    foreach (@locales) {
      m{locale/(.+?)/} and $locale = $1;
      if (-f "$FEXHOME/$_") { 
        system 'locale/translate',$locale;
-      system "chown -R fex $FEXHOME/locale/$locale";
+      chownr('fex',"$FEXHOME/locale/$locale");
        $hl = "$FEXHOME/htdocs/locale/$locale";
        symlink "$FEXHOME/locale/$locale/htdocs",$hl unless -l $hl;
      } else { 
        $hl = "$FEXHOME/htdocs/locale/$locale";
        symlink "$FEXHOME/locale/$locale/htdocs",$hl unless -l $hl;
      } else { 
@@ -354,8 +358,8 @@ unless (-f $xinetd) {
      system qw(crontab -u fex fex.cron);
    }
  
      system qw(crontab -u fex fex.cron);
    }
  
-  system "chown -R fex:root $FEXHOME $FEXHOME/spool/";
-  system "chmod -R go-r $FEXHOME/lib $FEXHOME/cgi-bin $FEXHOME/spool/";
+  chownr('fex:root',"$FEXHOME $FEXHOME/spool/.");
+  chmodr('go-r',"$FEXHOME/lib","$FEXHOME/cgi-bin","$FEXHOME/spool/.");
  
    print "\n";
    print "Now check configuration file $FEXHOME/lib/fex.ph and run\n";
  
    print "\n";
    print "Now check configuration file $FEXHOME/lib/fex.ph and run\n";
@@ -363,7 +367,7 @@ unless (-f $xinetd) {
    print "(You can do this as user \"fex\")\n";
  } else {
    
    print "(You can do this as user \"fex\")\n";
  } else {
    
-  system "chmod -R go-r $FEXHOME/lib $FEXHOME/cgi-bin";
+  chmodr('go-r',"$FEXHOME/lib","$FEXHOME/cgi-bin");
    
    print "\n";
    print "F*EX update installed.\n";
    
    print "\n";
    print "F*EX update installed.\n";
@@ -386,18 +390,60 @@ if (`$sendmail -h 2>&1` =~ /exim/ and
    print "You MUST set in your exim4.conf:\n";
    print "trusted_users = mail : uucp : fex\n";
  }
    print "You MUST set in your exim4.conf:\n";
    print "trusted_users = mail : uucp : fex\n";
  }
+
  exit;
  
  exit;
  
+sub mkfid {
+  my $ad = dirname($aa);
+  mkdir $ad;
+  open $aa,'>',$aa or die "$0: cannot create $aa - $!\n";
+  print {$aa} "$admin_pw\n";
+  close $aa;
+  my $fd = dirname($fid);
+  mkdir $fd;
+  rename $fid,$fid.'_save';
+  open $fid,'>',$fid or die "$0: cannot create $fid - $!\n";
+  print {$fid} "$hostname:$opt_p\n";
+  print {$fid} "$admin\n";
+  print {$fid} "$admin_pw\n";
+  close $fid;
+  chownr('fex',$ad,$fd);
+  chmod 0700,$ad,$fd;
+}
+
+sub chownr {
+  my $user = shift;
+  local $_;
+  foreach (@_) {
+    if (m:^/*(lib|usr|home)?/*$:) {
+      die "ERROR: short path in chownr $user @_\n";
+    }
+  }
+  system qw'chown -R',$user,@_;
+}
+
+sub chmodr {
+  my $mod = shift;
+  local $_;
+  foreach (@_) {
+    if (m:^/*(lib|usr|home)?/*$:) {
+      die "ERROR: short path in chmodr $mod @_\n";
+    }
+  }
+  system qw'chmod -R',$mod,@_;
+}
  
  sub convert_spool {
    my ($f,$d,$to,$from,$link);
    
    local $) = $FEX[3];
  
  sub convert_spool {
    my ($f,$d,$to,$from,$link);
    
    local $) = $FEX[3];
-  local $> = $FEX[2];
+  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";
  
    our ($spooldir,$skeydir,$gkeydir);
    $ENV{FEXLIB} = $FEXLIB = "$FEXHOME/lib";
    require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
+  die "no \$spooldir in $FEXLIB/fex.pp\n" unless $spooldir;
+  die "\$spooldir=$spooldir/" if $spooldir =~ m:^/*(root)?$:;
  
    # User --> user@maildomain
    if ($mdomain) {
  
    # User --> user@maildomain
    if ($mdomain) {
@@ -475,6 +521,16 @@ sub convert_spool {
    # create new GKEYs
    foreach my $gf (glob "$spooldir/*/\@GROUP/*") {
      next unless -f $gf;
    # create new GKEYs
    foreach my $gf (glob "$spooldir/*/\@GROUP/*") {
      next unless -f $gf;
+    # normalize group name
+    if ($gf =~ m:(.+)/(.+):) {
+      my $gd = $1;
+      my $g1 = $2;
+      my $g2 = $2;
+      $g2 =~ s/[^\w\*%^+=:,.!-]/_/g;
+      if ($g1 ne $g2) {
+        rename "$gd/$g1","$gd/$g2" and $gf = "$gd/$g2";
+      }
+    }
      $group = (split '/',$gf)[-1];
      $user  = (split '/',$gf)[-3];
      if (open $gf,$gf) {
      $group = (split '/',$gf)[-1];
      $user  = (split '/',$gf)[-3];
      if (open $gf,$gf) {
diff --git a/lib/dop b/lib/dop

index df9511b70538fcd64f69ac88444d05805ea74283..d8166247c3f922e5256debb874e649aa21b97a63 100755 (executable)
--- a/lib/dop
+++ b/lib/dop
@@ -16,7 +16,7 @@ use Cwd       qw(getcwd abs_path);
  # import from fex.pp
  our ($bs,$tmpdir,@doc_dirs);
  
  # import from fex.pp
  our ($bs,$tmpdir,@doc_dirs);
  
-my $log = "$logdir/dop.log";
+my $log = 'dop.log';
  
  # POSIX time format needed for HTTP header
  setlocale(LC_TIME,'POSIX');
  
  # POSIX time format needed for HTTP header
  setlocale(LC_TIME,'POSIX');
@@ -307,6 +307,7 @@ sub http_output {
      if ($type eq 'text/html') {
        alarm($timeout*10);
        print $htmldoc;
      if ($type eq 'text/html') {
        alarm($timeout*10);
        print $htmldoc;
+      $s = $size;
      } else {
        # binary data # can be stream!
        seek $file,$seek,0 if $seek;
      } else {
        # binary data # can be stream!
        seek $file,$seek,0 if $seek;
@@ -417,11 +418,6 @@ sub showindex {
  }
  
  
  }
  
  
-sub mtime {
-  return (lstat shift)[9];
-}
-
-
  sub d3 {
    local $_ = shift;
    while (s/(\d)(\d\d\d\b)/$1,$2/) {};
  sub d3 {
    local $_ = shift;
    while (s/(\d)(\d\d\d\b)/$1,$2/) {};
diff --git a/lib/fex.ph b/lib/fex.ph

index f7d26e56b25b686411a9f649acdcc9b84b03d942..50c4d0919ca3bc978300006fd62ec7c9f5a40ccf 100644 (file)
--- a/lib/fex.ph
+++ b/lib/fex.ph
@@ -1,8 +1,10 @@
+# -*- perl -*- #
+
  ## your F*EX server host name (with domain)
  $hostname = 'MYHOSTNAME.MYDOMAIN';
  
  ## admin email address used in notification emails
  ## your F*EX server host name (with domain)
  $hostname = 'MYHOSTNAME.MYDOMAIN';
  
  ## admin email address used in notification emails
-## to change it, you must call: fac -/ admin-email-address auth-id
+## to change it, you MUST call: fac -/ admin-email-address auth-id
  $admin = 'fex@'.$hostname;
  
  ## server admin email address shown on web page 
  $admin = 'fex@'.$hostname;
  
  ## server admin email address shown on web page 
@@ -11,10 +13,10 @@ $ENV{SERVER_ADMIN} = $admin;
  ## restrict web administration to ip range(s)
  @admin_hosts = qw(127.0.0.1 10.0.0.0-10.10.255.255);
  
  ## restrict web administration to ip range(s)
  @admin_hosts = qw(127.0.0.1 10.0.0.0-10.10.255.255);
  
-## Bcc address for notification emails
+## Bcc address for notification emails, must not be empty
  $bcc = 'fex';
  
  $bcc = 'fex';
  
-## send notifications about new F*EX releases
+## send notifications about new F*EX releases (bugfixes!)
  $notify_newrelease = $admin;
  
  ## optional: download-URLs sent in notification emails
  $notify_newrelease = $admin;
  
  ## optional: download-URLs sent in notification emails
@@ -50,6 +52,9 @@ $mailmode = 'AUTO';
  ## optional: suppress funny messages
  # $boring = 1;
  
  ## optional: suppress funny messages
  # $boring = 1;
  
+## optional: suppress warning messages about incompatible web browsers
+# $nowarning = 'YES';
+
  # locales to present (must be installed!)
  # if empty, present all installed locales
  # @locales = qw(english swabian);
  # locales to present (must be installed!)
  # if empty, present all installed locales
  # @locales = qw(english swabian);
@@ -61,19 +66,19 @@ $mailmode = 'AUTO';
  # $spooldir = "$ENV{HOME}/spool";
  # $logdir = $spooldir;
  
  # $spooldir = "$ENV{HOME}/spool";
  # $logdir = $spooldir;
  
-## Default quota in MB for recipient; 0 means "no quota"
+## default quota in MB for recipient; 0 means "no quota"
  $recipient_quota = 0; 
  
  $recipient_quota = 0; 
  
-## Default quota in MB for sender; 0 means "no quota"
+## default quota in MB for sender; 0 means "no quota"
  $sender_quota = 0; 
  
  $sender_quota = 0; 
  
-## Expiration: keep files that number of days (default)
+## expiration: keep files that number of days (default)
  $keep = 5; 
  
  $keep = 5; 
  
-## Expiration: keep files that number of days (maximum)
+## expiration: keep files that number of days (maximum)
  $keep_max = 99;
  
  $keep_max = 99;
  
-## Autodelete: delete files after download (automatically)
+## autodelete: delete files after download (automatically)
  ##     YES     ==> immediatelly (1 minute grace time)
  ##     DELAY   ==> after download at next fex_cleanup cronjob run 
  ##      2       ==> 2 days after download (can be any number!)
  ##     YES     ==> immediatelly (1 minute grace time)
  ##     DELAY   ==> after download at next fex_cleanup cronjob run 
  ##      2       ==> 2 days after download (can be any number!)
@@ -85,10 +90,15 @@ $autodelete = 'YES';
  ## to prevent unwanted file sharing
  $limited_download = 'YES';
  
  ## to prevent unwanted file sharing
  $limited_download = 'YES';
  
-## Allow or disallow overwriting of files
+## allow RECIPIENT = SENDER
+## in this case subsequentials downloads from any ip are possible until 
+## regular file expiration (KEEP); exception for $limited_download
+$fex_yourself = 'YES';
+
+## allow overwriting of files
  $overwrite = 'YES';
  
  $overwrite = 'YES';
  
-## Allow user requests for forgotten auth-IDs (then send by email)
+## 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 
  $mail_authid = 'YES';
                                                    
  ## optional: from which hosts and for which mail domains users may 
@@ -148,9 +158,16 @@ $mail_authid = 'YES';
  # @file_link_dirs = qw(/sw /nfs/home/exampleuser);
  
  ## optional: allow additional directories with static documents
  # @file_link_dirs = qw(/sw /nfs/home/exampleuser);
  
  ## optional: allow additional directories with static documents
-##           ($docdir (/home/fex/htdocs) is always allowed implicitly)
+##           $docdir (/home/fex/htdocs) is always allowed implicitly
  # @doc_dirs = qw(/sw /nfs/home/exampleuser/htdocs);
  
  ## optional: text file with your conditions of using
  # @doc_dirs = qw(/sw /nfs/home/exampleuser/htdocs);
  
  ## optional: text file with your conditions of using
-## will be append to registrations request replies
+##           will be append to registrations request replies
  # $usage_conditions = "$docdir/usage_conditions.txt";
  # $usage_conditions = "$docdir/usage_conditions.txt";
+
+## optional: redirect URIs
+##           URLs with leading ! are active http redirects
+# %redirect = (
+#   '/fstools/'   => '!http://fex.belwue.de/fstools/',
+#   '/usecases/'  => 'http://fex.belwue.de/usecases/',
+# );
diff --git a/lib/fex.pp b/lib/fex.pp

index bb72a4ea37e673abc3037b9561834f4e9edc5ca0..352b41298ebc5c47194e26c4368fdae9d94c0c77 100644 (file)
--- a/lib/fex.pp
+++ b/lib/fex.pp
@@ -13,7 +13,7 @@ use Symbol            qw'gensym';
  # set and untaint ENV if not in CLI (fexsrv provides clean ENV)
  unless (-t) {
    foreach my $v (keys %ENV) {
  # set and untaint ENV if not in CLI (fexsrv provides clean ENV)
  unless (-t) {
    foreach my $v (keys %ENV) {
-    ($ENV{$v}) = ($ENV{$v} =~ /(.*)/s);
+    ($ENV{$v}) = ($ENV{$v} =~ /(.*)/s) if defined $ENV{$v};
    }
    $ENV{PATH}     = '/usr/local/bin:/bin:/usr/bin';
    $ENV{IFS}      = " \t\n";
    }
    $ENV{PATH}     = '/usr/local/bin:/bin:/usr/bin';
    $ENV{IFS}      = " \t\n";
@@ -43,11 +43,14 @@ $logdir = $spooldir;
  $autodelete = 'YES';
  $overwrite = 'YES';
  $limited_download = 'YES';     # multiple downloads only from same client
  $autodelete = 'YES';
  $overwrite = 'YES';
  $limited_download = 'YES';     # multiple downloads only from same client
+$fex_yourself = 'YES';         # allow SENDER = RECIPIENT
  $keep = 5;                     # days
  $recipient_quota = 0;          # MB
  $sender_quota = 0;             # MB
  $timeout = 30;                 # seconds
  $bs = 2**16;                   # I/O blocksize
  $keep = 5;                     # days
  $recipient_quota = 0;          # MB
  $sender_quota = 0;             # MB
  $timeout = 30;                 # seconds
  $bs = 2**16;                   # I/O blocksize
+$DS = 60*60*24;                        # seconds in a day
+$MB = 1024*1024;               # binary Mega
  $use_cookies = 1;
  $sendmail = '/usr/lib/sendmail';
  $sendmail = '/usr/sbin/sendmail' unless -x $sendmail;
  $use_cookies = 1;
  $sendmail = '/usr/lib/sendmail';
  $sendmail = '/usr/sbin/sendmail' unless -x $sendmail;
@@ -82,10 +85,15 @@ $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;
  $mail_authid   = 0 if $mail_authid     =~ /no/i;
  $force_https   = 0 if $force_https     =~ /no/i;
  $debug         = 0 if $debug           =~ /no/i;
-  
+
+@logdir = ($logdir) unless @logdir;
+$logdir = $logdir[0];
+
  # check for name based virtual host
  $vhost = vhost($ENV{'HTTP_HOST'});
  
  # check for name based virtual host
  $vhost = vhost($ENV{'HTTP_HOST'});
  
+$RB = 0; # read POST bytes
+
  push @doc_dirs,$docdir;
  foreach my $ld (glob "$FEXHOME/locale/*/htdocs") {
    push @doc_dirs,$ld;
  push @doc_dirs,$docdir;
  foreach my $ld (glob "$FEXHOME/locale/*/htdocs") {
    push @doc_dirs,$ld;
@@ -94,7 +102,7 @@ foreach my $ld (glob "$FEXHOME/locale/*/htdocs") {
  $nomail = ($mailmode =~ /^MANUAL|nomail$/i);
  
  if (not $nomail and not -x $sendmail) {
  $nomail = ($mailmode =~ /^MANUAL|nomail$/i);
  
  if (not $nomail and not -x $sendmail) {
-  http_die("found no sendmail\n");
+  http_die("found no sendmail");
  }
  http_die("cannot determine the server hostname") unless $hostname;
  
  }
  http_die("cannot determine the server hostname") unless $hostname;
  
@@ -143,36 +151,42 @@ if (@locales) {
  
  $default_locale ||= 'english';
  
  
  $default_locale ||= 'english';
  
+# $durl is first default fop download URL
+# @durl is optional mandatory fop download URL list (from fex.ph)
  unless ($durl) {
  unless ($durl) {
-  my $host = '';
-  my $port = 0;
-  
-  ($host,$port) = split(':',$ENV{HTTP_HOST}||'');
-  $host = $hostname;
-  
-  unless ($port) {
-    $port = 80;
-    if (open my $xinetd,'<',"/etc/xinetd.d/fex") {
-      while (<$xinetd>) {
-        if (/^\s*port\s*=\s*(\d+)/) {
-          $port = $1;
-          last;
+  if (@durl) {
+    $durl = $durl[0];
+  } elsif ($ENV{HTTP_HOST} and $ENV{PROTO}) {
+    my $host = '';
+    my $port = 0;
+  
+    ($host,$port) = split(':',$ENV{HTTP_HOST}||'');
+    $host = $hostname;
+  
+    unless ($port) {
+      $port = 80;
+      if (open my $xinetd,'<',"/etc/xinetd.d/fex") {
+        while (<$xinetd>) {
+          if (/^\s*port\s*=\s*(\d+)/) {
+            $port = $1;
+            last;
+          }
          }
          }
+        close $xinetd;
        }
        }
-      close $xinetd;
      }
      }
-  }
    
    
-  # use same protocal as uploader for download
-  if ($ENV{PROTO} eq 'https' and $port == 443 or $port == 80) {
-    $durl = "$ENV{PROTO}://$host/fop";
+    # use same protocal as uploader for download
+    if ($ENV{PROTO} eq 'https' and $port == 443 or $port == 80) {
+      $durl = "$ENV{PROTO}://$host/fop";
+    } else {
+      $durl = "$ENV{PROTO}://$host:$port/fop";
+    }
    } else {
    } else {
-    $durl = "$ENV{PROTO}://$host:$port/fop";
+    $durl = "http://$hostname/fop";
    }
  }
  
    }
  }
  
-@durl = ($durl) unless @durl;
-
  
  sub reexec {
    exec($FEXHOME.'/bin/fexsrv') if $ENV{KEEP_ALIVE};
  
  sub reexec {
    exec($FEXHOME.'/bin/fexsrv') if $ENV{KEEP_ALIVE};
@@ -344,7 +358,10 @@ sub html_error {
  sub http_die {
    
    # not in CGI mode
  sub http_die {
    
    # not in CGI mode
-  die "$0: @_\n" unless $ENV{GATEWAY_INTERFACE};
+  unless ($ENV{GATEWAY_INTERFACE}) {
+    warn "$0: @_\n"; # must not die, because of fex_cleanup!
+    return;
+  }
    
    debuglog(@_);
    
    
    debuglog(@_);
    
@@ -584,6 +601,23 @@ sub normalize_email {
  }
  
  
  }
  
  
+sub normalize_user {
+  my $user = shift;
+  
+  $user = lc(urldecode(despace($user)));
+  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
+  checkaddress($user) or http_die("$user is not a valid e-mail address");
+  return untaint($user);
+}
+
+
+sub urldecode {
+  local $_ = shift;
+  s/%([a-f0-9]{2})/chr(hex($1))/gie;
+  return $_;
+}
+
+
  sub untaint {
    local $_ = shift;
    /(.*)/s;
  sub untaint {
    local $_ = shift;
    /(.*)/s;
@@ -621,8 +655,10 @@ sub checkaddress {
    $a =~ s/:\w+=.*//; # remove options from address
    
    return $a if $a eq 'anonymous';
    $a =~ s/:\w+=.*//; # remove options from address
    
    return $a if $a eq 'anonymous';
-  
-  $re = '^[.@]|@.*@|local(host|domain)$|["\'\`\|\s()<>/;,]';
+
+  $a .= '@'.$mdomain if $mdomain and $a !~ /@/;
+
+  $re = '^[.@-]|@.*@|local(host|domain)$|["\'\`\|\s()<>/;,]';
    if ($a =~ /$re/i) {
      debuglog("$a has illegal syntax ($re)");
      return '';
    if ($a =~ /$re/i) {
      debuglog("$a has illegal syntax ($re)");
      return '';
@@ -696,13 +732,13 @@ sub mkdirp {
    
    return if -d $dir;
    $dir =~ s:/+$::;
    
    return if -d $dir;
    $dir =~ s:/+$::;
-  http_die("cannot mkdir /\n") unless $dir;
+  http_die("cannot mkdir /") unless $dir;
    $pdir = $dir;
    if ($pdir =~ s:/[^/]+$::) {
      mkdirp($pdir) unless -d $pdir;
    }
    unless (-d $dir) {
    $pdir = $dir;
    if ($pdir =~ s:/[^/]+$::) {
      mkdirp($pdir) unless -d $pdir;
    }
    unless (-d $dir) {
-    mkdir $dir,0770 or http_die("mkdir $dir - $!\n");
+    mkdir $dir,0770 or http_die("mkdir $dir - $!");
    }
  }
  
    }
  }
  
@@ -789,20 +825,16 @@ sub urlencode {
  # file and document log
  sub fdlog {
    my ($log,$file,$s,$size) = @_;
  # file and document log
  sub fdlog {
    my ($log,$file,$s,$size) = @_;
-  my $ra;
-  
-  if (open $log,'>>',$log) {
-    flock $log,LOCK_EX;
-    seek $log,0,SEEK_END;
-    $ra = $ENV{REMOTE_ADDR}||'-';
-    $ra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
-    $ra =~ s/\s//g;
-    $file =~ s:/data$::;
-    printf {$log} 
-           "%s [%s_%s] %s %s %s/%s\n",
-           isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file),$s,$size;
-    close $log;
-  }
+  my $ra = $ENV{REMOTE_ADDR}||'-';
+  my $msg;
+
+  $ra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
+  $ra =~ s/\s//g;
+  $file =~ s:/data$::;
+  $msg = sprintf "%s [%s_%s] %s %s %s/%s\n",
+         isodate(time),$$,$ENV{REQUESTCOUNT},$ra,encode_Q($file),$s,$size;
+
+  writelog($log,$msg);
  }
  
  
  }
  
  
@@ -813,11 +845,12 @@ sub debuglog {
    
    return unless $debug and @_;
    unless ($debuglog and fileno $debuglog) {
    
    return unless $debug and @_;
    unless ($debuglog and fileno $debuglog) {
-    mkdir "$logdir/.debug",0770 unless -d "$logdir/.debug";
+    my $ddir = "$spooldir/.debug";
+    mkdir $ddir,0770 unless -d $ddir;
      $prg =~ s:.*/::;
      $prg = untaint($prg);
      $prg =~ s:.*/::;
      $prg = untaint($prg);
-    $debuglog = sprintf("%s/.debug/%s_%s_%s.%s",
-                        $logdir,time,$$,$ENV{REQUESTCOUNT}||0,$prg);
+    $debuglog = sprintf("%s/%s_%s_%s.%s",
+                        $ddir,time,$$,$ENV{REQUESTCOUNT}||0,$prg);
      $debuglog =~ s/\s/_/g;
      # open $debuglog,'>>:encoding(UTF-8)',$debuglog or return;
      open $debuglog,'>>',$debuglog or return;
      $debuglog =~ s/\s/_/g;
      # open $debuglog,'>>:encoding(UTF-8)',$debuglog or return;
      open $debuglog,'>>',$debuglog or return;
@@ -836,22 +869,32 @@ sub debuglog {
  # extra debug log
  sub errorlog {
    my $prg = $0;
  # extra debug log
  sub errorlog {
    my $prg = $0;
-  my $log = "$logdir/error.log";
    my $msg = "@_";
    my $msg = "@_";
+  my $ra = $ENV{REMOTE_ADDR}||'-';
  
  
+  $ra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
+  $ra =~ s/\s//g;
    $prg =~ s:.*/::;
    $msg =~ s/[\r\n]+$//;
    $msg =~ s/[\r\n]+/ /;
    $msg =~ s/\s*<p>.*//;
    $prg =~ s:.*/::;
    $msg =~ s/[\r\n]+$//;
    $msg =~ s/[\r\n]+/ /;
    $msg =~ s/\s*<p>.*//;
+  $msg = sprintf "%s %s %s %s\n",isodate(time),$prg,$ra,$msg;
  
  
-  if (open $log,'>>',$log) {
-    flock $log,LOCK_EX;
-    seek $log,0,SEEK_END;
-    $ra = $ENV{REMOTE_ADDR}||'-';
-    $ra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
-    $ra =~ s/\s//g;
-    printf {$log} "%s %s %s %s\n",isodate(time),$prg,$ra,$msg;
-    close $log;
+  writelog('error.log',$msg);
+}
+
+
+sub writelog {
+  my $log = shift;
+  my $msg = shift;
+  
+  foreach my $logdir (@logdir) {
+    if (open $log,'>>',"$logdir/$log") {
+      flock $log,LOCK_EX;
+      seek $log,0,SEEK_END;
+      print {$log} $msg;
+      close $log;
+    }
    }
  }
  
    }
  }
  
@@ -931,7 +974,7 @@ sub check_sender_quota {
    my $sender = shift;
    my $squota = $sender_quota||0;
    my $du = 0;
    my $sender = shift;
    my $squota = $sender_quota||0;
    my $du = 0;
-  my ($file,$size,%file,$data);
+  my ($file,$size,%file,$data,$upload);
    local $_;
    
    if (open $qf,'<',"$sender/\@QUOTA") {
    local $_;
    
    if (open $qf,'<',"$sender/\@QUOTA") {
@@ -944,6 +987,7 @@ sub check_sender_quota {
    
    foreach $file (glob "*/$sender/*") {
      $data = "$file/data";
    
    foreach $file (glob "*/$sender/*") {
      $data = "$file/data";
+    $upload = "$file/upload";
      if (not -l $data and $size = -s $data) {
        # count hard links only once (= same inode)
        my $i = (stat($data))[1]||0;
      if (not -l $data and $size = -s $data) {
        # count hard links only once (= same inode)
        my $i = (stat($data))[1]||0;
@@ -951,8 +995,13 @@ sub check_sender_quota {
          $du += $size;
          $file{$i} = $i;
        }
          $du += $size;
          $file{$i} = $i;
        }
-    } elsif (-f "$file/upload" and $size = readlink "$file/size") {
-      $du += $size;
+    } elsif (-f $upload) {
+      # count hard links only once (= same inode)
+      my $i = (stat($upload))[1]||0;
+      unless ($file{$i}) {
+        $size = readlink "$file/size" and $du += $size;
+        $file{$i} = $i;
+      }
      }
    }
    
      }
    }
    
@@ -1094,6 +1143,89 @@ sub slurp {
  }
  
  
  }
  
  
+# read one line from STDIN (net socket) and assign it to $_
+# return number of read bytes
+# also set global variable $RB (read bytes)
+sub nvt_read {
+  my $len = 0;
+
+  if (defined ($_ = <STDIN>)) {
+    debuglog($_);
+    $len = length;
+    $RB += $len;
+    s/\r?\n//;
+  }
+  return $len;
+}
+
+
+# read forward to given pattern
+sub nvt_skip_to {
+  my $pattern = shift;
+
+  while (&nvt_read) { return if /$pattern/ }
+}
+
+
+# HTTP GET and POST parameters
+# (not used by fup)
+# fills global variable %PARAM :
+# normal parameter is $PARAM{$parameter}
+# file parameter is $PARAM{$parameter}{filename} $PARAM{$parameter}{data}
+sub parse_parameters {
+  my $cl = $ENV{X_CONTENT_LENGTH} || $ENV{CONTENT_LENGTH} || 0;
+  my $data = '';
+  my $filename;
+  local $_;
+  
+  if ($cl > 128*$MB) {
+    http_die("request too large");
+  }
+  
+  foreach (split('&',$ENV{QUERY_STRING})) {
+    if (/(.+?)=(.*)/) { $PARAM{$1} = $2 }
+    else              { $PARAM{$_} = $_ }
+  }
+  $_ = $ENV{CONTENT_TYPE}||'';
+  if ($ENV{REQUEST_METHOD} eq 'POST' and /boundary=\"?([\w\-\+\/_]+)/) {
+    my $boundary = $1;
+    while ($RB<$cl and &nvt_read) { last if /^--\Q$boundary/ }
+    # continuation lines are not checked!
+    while ($RB<$cl and &nvt_read) {
+      $filename = '';
+      if (/^Content-Disposition:.*\s*filename="(.+?)"/i) {
+        $filename = $1;
+      }
+      if (/^Content-Disposition:\s*form-data;\s*name="(.+?)"/i) {
+        my $p = $1;
+        # skip rest of mime part header
+        while ($RB<$cl and &nvt_read) { last if /^\s*$/ }
+        $data = '';
+        while (<STDIN>) {
+          if ($p =~ /password/i) {
+            debuglog('*' x length)
+          } else {
+            debuglog($_)
+          }
+          $RB += length;
+          last if /^--\Q$boundary/;
+          $data .= $_;
+        }
+        unless (defined $_) { die "premature end of HTTP POST\n" }
+        $data =~ s/\r?\n$//;
+        if ($filename) {
+          $PARAM{$p}{filename} = $filename;
+          $PARAM{$p}{data} = $data;
+        } else {
+          $PARAM{$p} = $data;
+        }
+        last if /^--\Q$boundary--/;
+      }
+    }
+  }
+}
+
+
  # name based virtual host?
  sub vhost {
    my $hh = shift; # HTTP_HOST
  # name based virtual host?
  sub vhost {
    my $hh = shift; # HTTP_HOST
@@ -1109,6 +1241,7 @@ sub vhost {
        $ENV{FEXLIB} = $FEXLIB = "$vhost/lib";
        $logdir = $spooldir    = "$vhost/spool";
        $docdir                = "$vhost/htdocs";
        $ENV{FEXLIB} = $FEXLIB = "$vhost/lib";
        $logdir = $spooldir    = "$vhost/spool";
        $docdir                = "$vhost/htdocs";
+      @logdir = ($logdir);
        if ($locale and -e "$vhost/locale/$locale/lib/fex.ph") {
          $ENV{FEXLIB} = $FEXLIB = "$vhost/locale/$locale/lib";
        }
        if ($locale and -e "$vhost/locale/$locale/lib/fex.ph") {
          $ENV{FEXLIB} = $FEXLIB = "$vhost/locale/$locale/lib";
        }
@@ -1151,6 +1284,12 @@ sub gpg_encrypt {
  }
  
  
  }
  
  
+sub mtime {
+  my @s = stat(shift) or return;
+  return $s[9];
+}
+
+
  # extract locale functions into hash of subroutine references
  # e.g. \&german ==> $notify{german}
  sub locale_functions {
  # extract locale functions into hash of subroutine references
  # e.g. \&german ==> $notify{german}
  sub locale_functions {
@@ -1207,7 +1346,7 @@ sub notify_locale {
      status     => $status,
      dkey       => $dkey,
      filename   => $filename,
      status     => $status,
      dkey       => $dkey,
      filename   => $filename,
-    keep       => $keep-int((time-$mtime)/DS),
+    keep       => $keep-int((time-$mtime)/$DS),
      comment    => $comment,
      autodelete => $autodelete,
      replyto    => $replyto,
      comment    => $comment,
      autodelete => $autodelete,
      replyto    => $replyto,
@@ -1222,8 +1361,10 @@ sub notify {
    # my ($status,$dkey,$filename,$keep,$warn,$comment,$autodelete) = @_;
    my %P = @_;
    my ($to,$from,$file,$mimefilename,$receiver,$warn,$comment,$autodelete);
    # my ($status,$dkey,$filename,$keep,$warn,$comment,$autodelete) = @_;
    my %P = @_;
    my ($to,$from,$file,$mimefilename,$receiver,$warn,$comment,$autodelete);
-  my ($size,$bytes,$days,$header,$data,$replyto);
+  my ($size,$bytes,$days,$header,$data,$replyto,$uurl);
    my ($mfrom,$mto,$dfrom,$dto);
    my ($mfrom,$mto,$dfrom,$dto);
+  my $proto = 'http';
+  my $durl = $::durl;
    my $index;
    my $fileid = 0;
    my $fua = $ENV{HTTP_USER_AGENT}||'';
    my $index;
    my $fileid = 0;
    my $fua = $ENV{HTTP_USER_AGENT}||'';
@@ -1240,10 +1381,16 @@ sub notify {
    $comment = encode_utf8($P{comment}||'');
    $comment =~ s/^!\*!//; # multi download allow flag
    $autodelete = $P{autodelete}||$::autodelete;
    $comment = encode_utf8($P{comment}||'');
    $comment =~ s/^!\*!//; # multi download allow flag
    $autodelete = $P{autodelete}||$::autodelete;
-  $index = $durl;
-  $index =~ s/fop/index.html/;
-
-  (undef,$to,$from,$file) = split('/',untaint(readlink("$dkeydir/$P{dkey}")));
+  
+  $file = untaint(readlink("$dkeydir/$P{dkey}"));
+  $file =~ s/^\.\.\///;
+  # make download protocal same as upload protocol
+  if ($uurl = readlink("$file/uurl") and $uurl =~ /^(\w+):/) {
+    $proto = $1;
+    $durl =~ s/^\w+::/$proto::/;
+  }
+  $index = "$proto://$hostname/index.html";
+  ($to,$from,$file) = split('/',$file);
    $filename = strip_path($P{filename});
    $mfrom = $from;
    $mto = $to;
    $filename = strip_path($P{filename});
    $mfrom = $from;
    $mto = $to;
@@ -1258,10 +1405,14 @@ sub notify {
    $data = "$dkeydir/$P{dkey}/data";
    $size = $bytes = -s $data;
    return unless $size;
    $data = "$dkeydir/$P{dkey}/data";
    $size = $bytes = -s $data;
    return unless $size;
-  $warning = 
-    "Please avoid download with Internet Explorer, ".
-    "because it has too many bugs.\n".
-    "We recommend Firefox or wget.";
+  if ($nowarning) {
+    $warning = '';
+  } else {
+    $warning = 
+      "Please avoid download with Internet Explorer, ".
+      "because it has too many bugs.\n".
+      "We recommend Firefox or wget.";
+  }
    if ($filename =~ /\.(tar|zip|7z|arj|rar)$/) {
      $warning .= "\n\n".
        "$filename is a container file.\n".
    if ($filename =~ /\.(tar|zip|7z|arj|rar)$/) {
      $warning .= "\n\n".
        "$filename is a container file.\n".
@@ -1288,11 +1439,16 @@ sub notify {
    } else {
      $autodelete = '';
    }
    } else {
      $autodelete = '';
    }
-  $mimefilename = $filename;
-  if ($mimefilename =~ s{([_\?\=\x00-\x1F\x7F-\xFF])}{sprintf("=%02X",ord($1))}eog) {
-    $mimefilename =~ s/ /_/g;
-    $mimefilename = '=?UTF-8?Q?'.$mimefilename.'?=';
-  }
+
+  if (-s $keyring) {
+    $mimefilename = '';
+  } else {
+    $mimefilename = $filename;
+    if ($mimefilename =~ s/([_\?\=\x00-\x1F\x7F-\xFF])/sprintf("=%02X",ord($1))/eog) {
+      $mimefilename =~ s/ /_/g;
+      $mimefilename = '=?UTF-8?Q?'.$mimefilename.'?=';
+    }
+  }  
    
    unless ($fileid = readlink("$dkeydir/$P{dkey}/id")) {
      my @s = stat($data);
    
    unless ($fileid = readlink("$dkeydir/$P{dkey}/id")) {
      my @s = stat($data);
@@ -1308,7 +1464,7 @@ sub notify {
    }
    $header .= "X-FEX-Client-Address: $fra\n" if $fra;
    $header .= "X-FEX-Client-Agent: $fua\n"   if $fua;
    }
    $header .= "X-FEX-Client-Address: $fra\n" if $fra;
    $header .= "X-FEX-Client-Agent: $fua\n"   if $fua;
-  foreach my $u (@durl) {
+  foreach my $u (@durl?@durl:($durl)) {
      my $durl = sprintf("%s/%s/%s",$u,$P{dkey},normalize_filename($filename));
      $header .= "X-FEX-URL: $durl\n" unless -s $keyring;
      $download .= "$durl\n";
      my $durl = sprintf("%s/%s/%s",$u,$P{dkey},normalize_filename($filename));
      $header .= "X-FEX-URL: $durl\n" unless -s $keyring;
      $download .= "$durl\n";
@@ -1334,7 +1490,7 @@ sub notify {
    if ($sender_from) {
      map { s/^From: <$mfrom/From: <$sender_from/ } $header;
      open $sendmail,'|-',$sendmail,$mto,$bcc
    if ($sender_from) {
      map { s/^From: <$mfrom/From: <$sender_from/ } $header;
      open $sendmail,'|-',$sendmail,$mto,$bcc
-      or http_die("cannot start sendmail - $!\n");
+      or http_die("cannot start sendmail - $!");
    } else {
      # for special remote domains do not use same domain in From, 
      # because remote MTA will probably reject this e-mail
    } else {
      # for special remote domains do not use same domain in From, 
      # because remote MTA will probably reject this e-mail
@@ -1347,10 +1503,10 @@ sub notify {
      {
        $header =~ s/(From: <)\Q$mfrom\E(.*?)\n/$1$admin$2\nReply-To: $mfrom\n/;
        open $sendmail,'|-',$sendmail,$mto,$bcc
      {
        $header =~ s/(From: <)\Q$mfrom\E(.*?)\n/$1$admin$2\nReply-To: $mfrom\n/;
        open $sendmail,'|-',$sendmail,$mto,$bcc
-        or http_die("cannot start sendmail - $!\n");
+        or http_die("cannot start sendmail - $!");
      } else {
        open $sendmail,'|-',$sendmail,'-f',$mfrom,$mto,$bcc
      } else {
        open $sendmail,'|-',$sendmail,'-f',$mfrom,$mto,$bcc
-        or http_die("cannot start sendmail - $!\n");
+        or http_die("cannot start sendmail - $!");
      }
    }
    if ($comment =~ s/^!(shortmail|\.)!\s*//i 
      }
    }
    if ($comment =~ s/^!(shortmail|\.)!\s*//i 
@@ -1387,6 +1543,7 @@ sub notify {
        '$disclaimer'
      ));
    }
        '$disclaimer'
      ));
    }
+  $body =~ s/\n\n+/\n\n/g;
    if (-s $keyring) {
      $enc_body = gpg_encrypt($body,$to,$keyring,$from);
    }
    if (-s $keyring) {
      $enc_body = gpg_encrypt($body,$to,$keyring,$from);
    }
@@ -1417,9 +1574,8 @@ sub notify {
        "Content-Transfer-Encoding: 8bit\n";
    }
    print {$sendmail} $header,"\n",$body;
        "Content-Transfer-Encoding: 8bit\n";
    }
    print {$sendmail} $header,"\n",$body;
-  close $sendmail
-    or $! and http_die("cannot send notification e-mail (sendmail error $!)\n");
-  return $to;
+  close $sendmail and return $to;
+  http_die("cannot send notification e-mail (sendmail error $!)");
  }
  
  
  }
  
  
diff --git a/lib/fup.pl b/lib/fup.pl

index dd53f4c18d4fbdecf712feef292568277857ca14..25ec8e1badc91f3df0279fc9cb7474298a2189d6 100644 (file)
--- a/lib/fup.pl
+++ b/lib/fup.pl
@@ -11,7 +11,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/">questions & answers</a> and
  F*EX is not an archive!
  <p>
  See also <a href="/FAQ/">questions & answers</a> and
-<a href="http://fex.rus.uni-stuttgart.de/usecases/">use cases</a>.
+<a href="http://fex.belwue.de/usecases/">use cases</a>.
  <p><hr><p>
  <address>
    <a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a><br>
  <p><hr><p>
  <address>
    <a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a><br>
@@ -32,7 +32,7 @@ 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/user.html">FAQ<a> and
  e.g. with <a href="http://www.7-zip.org/download.html">7-Zip</a>.
  <p>
  See also the <a href="/FAQ/user.html">FAQ<a> and
-<a href="http://fex.rus.uni-stuttgart.de/usecases/">use cases</a>.
+<a href="http://fex.belwue.de/usecases/">use cases</a>.
  <p><hr><p>
  <address>
    <a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a><br>
  <p><hr><p>
  <address>
    <a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a><br>
author	fextracker <fextracker@treefish.org>
	Tue, 16 Jun 2015 20:08:16 +0000 (22:08 +0200)
committer	fextracker <fextracker@treefish.org>
	Tue, 16 Jun 2015 20:08:16 +0000 (22:08 +0200)
bin/fac		patch \| blob \| history
bin/fbm		patch \| blob \| history
bin/fex_cleanup		patch \| blob \| history
bin/fexget		patch \| blob \| history
bin/fexsend		patch \| blob \| history
bin/fexsrv		patch \| blob \| history
bin/fexwall		patch \| blob \| history
bin/l		patch \| blob \| history
bin/logwatch		patch \| blob \| history
bin/sexsend		patch \| blob \| history
bin/zz		patch \| blob \| history
cgi-bin/fac		patch \| blob \| history
cgi-bin/foc		patch \| blob \| history
cgi-bin/fop		patch \| blob \| history
cgi-bin/fuc		patch \| blob \| history
cgi-bin/fup		patch \| blob \| history
cgi-bin/fur		patch \| blob \| history
cgi-bin/pup		patch \| blob \| history
cgi-bin/rup		patch \| blob \| history
cgi-bin/sex		patch \| blob \| history
doc/Changes		patch \| blob \| history
doc/SSL		patch \| blob \| history
doc/concept		patch \| blob \| history
doc/new		patch \| blob \| history
doc/version		patch \| blob \| history
htdocs/FAQ.html	[new file with mode: 0644]	patch \| blob
htdocs/FAQ/admin.faq		patch \| blob \| history
htdocs/FAQ/meta.faq		patch \| blob \| history
htdocs/FAQ/user.faq		patch \| blob \| history
htdocs/download/fexget		patch \| blob \| history
htdocs/download/fexsend		patch \| blob \| history
htdocs/download/sexsend		patch \| blob \| history
htdocs/features.html	[deleted file]	patch \| blob \| history
htdocs/index.html		patch \| blob \| history
htdocs/version		patch \| blob \| history
install		patch \| blob \| history
lib/dop		patch \| blob \| history
lib/fex.ph		patch \| blob \| history
lib/fex.pp		patch \| blob \| history
lib/fup.pl		patch \| blob \| history