fex 20160104-1 / usr / bin / fac

#!/usr/bin/perl -w

# CLI admin client for the FEX service
#
# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#

use 5.006;
use Getopt::Std;
use File::Basename;
use Cwd 'abs_path';
use Digest::MD5	'md5_hex';

use constant M => 1024*1024;
use constant DS => 60*60*24;

# do not run as CGI!
exit if $ENV{SCRIPT_NAME};

unless ($FEXLIB = $ENV{FEXLIB}) {
  if ($ENV{FEXHOME}) {
    $FEXLIB = $ENV{FEXHOME}.'/lib';
  } elsif (-f '/usr/share/fex/lib/fex.ph') {
    $FEXLIB = '/usr/share/fex/lib';
  } else {
    $FEXLIB = dirname(dirname(abs_path($0))).'/lib';
  }
  $ENV{FEXLIB} = $FEXLIB;
}
die "$0: no FEXLIB\n" unless -f "$FEXLIB/fex.pp";

# become effective user fex
unless ($<) {
  if (my @pw = getpwnam('fex')) {
    $)         = $pw[3];
    $>         = $pw[2];
    $ENV{HOME} = $pw[7];
  } else {
    die "$0: no such user 'fex'\n";
  }
}

umask 077;

# import from fex.pp
our ($FEXHOME,$FHS,$hostname,$spooldir,@logdir,$logdir,$akeydir,$docdir);
our ($durl,@durl,$mdomain,$admin,$mailmode);
our ($autodelete,$keep_default,$keep_max,$recipient_quota,$sender_quota);
our (@local_rdomains);
local $notification = 'full';

# load common code, local config : $HOME/lib/fex.ph
require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";

die "$0: \$admin not configured in $FEXLIB/fex.ph\n" unless $admin;

$EDITOR = $ENV{EDITOR} || $ENV{VISUAL} ||
          (-x '/usr/bin/editor' ? '/usr/bin/editor' : 'vi');

$opt_c = $opt_v = $opt_l = $opt_L = $opt_h = $opt_w = $opt_u = 0;
$opt_M = $opt_E = 0;
$opt_r = $opt_d = $opt_q = $opt_a = $opt_n = $opt_k = $opt_m = '';
$opt_y = $opt_S = $opt_C = $opt_D = $opt_A = $opt_V = $opt_P =  $opt_R = '';
${'opt_/'} = '';

@__ = @ARGV;
while (my $a = shift @__) {
  if ($a eq '-V') {
    shift @__;
  } else {
    push @_ARGV,$a;
  }
}

chdir $spooldir or die "$0: no $spooldir\n";

@stat = stat $spooldir or die "$0: cannot access $spooldir - $!\n";
warn "WARNING: $spooldir with owner=root !?\n" unless $stat[4];
if (abs_path($spooldir) ne abs_path("$FEXHOME/spool")) {
  warn "WARNING: \$spooldir differs from $FEXHOME/spool !\n";
}

getopts('hcvlLwuME/q:r:d:a:n:k:m:y:S:C:A:V:D:P:R:') or usage(2);
usage(0)   if $opt_h;
examples() if $opt_E;

if (${'opt_/'}) {
  my $admin = shift;
  my $id = shift or die "usage: $0 -/ admin-email-address auth-ID\n";
  if ($admin !~ /.\@[\w.-]+\.[a-z]+$/) {
    die "$0: $admin is not an email address\n";
  }
  mkdir $admin;
  my $aa = "$spooldir/$admin/@";
  open $aa,'>',$aa or die "$0: cannot write $aa - $!\n";
  print {$aa} $id,"\n";
  close $aa or die "$0: cannot write $aa - $!\n";
  my $fph = "$FEXLIB/fex.ph";
  $_ = slurp($fph) or die "$0: cannot read $fph\n";
  s/^\s*\$admin\s*=.*/\$admin = '$admin';/m or
  $_ = "\$admin = '$admin';\n".$_;
  open $fph,">$fph.new" or die "$0: cannot write $fph.new\n";
  print {$fph} $_;
  close $fph;
  rename "$fph.new",$fph or die "$0: cannot rename $fph.new to $fph\n";
  my $fid = "$ENV{HOME}/.fex/id";
  mkdir dirname($fid);
  rename $fid,$fid.'_save';
  open $fid,'>',$fid or die "$0: cannot create $fid - $!\n";
  if ($durl =~ m{(https?://.+?)/}) {
    print {$fid} "$1\n";
  } else {
    print {$fid} "$hostname\n";
  }
  print {$fid} "$admin\n";
  print {$fid} "$id\n";
  close $fid;
  print "new admin account: $admin\n";
  exit;
}

&check_admin;

if ($opt_V) {
  while (my ($hh,$vh) = each (%vhost)) {
    if ($opt_V eq basename($vh) or $opt_V eq $hh) {
      $ENV{HTTP_HOST} = $hh;
      $ENV{VHOST} = "$hh:$vh";
      $ENV{FEXLIB} = "$vh/lib";
      die "$0: no $ENV{FEXLIB}/fex.ph\n" unless -f "$ENV{FEXLIB}/fex.ph";
      exec $0,@_ARGV;
      die "$0: cannot re-exec\n";
    }
  }
  die "$0: no virtual host $opt_V defined\n";
}

$fup = $durl;
$fup =~ s:/[^/]+$:/fup:;

# maintenance mode
if ($opt_m) {
  if ($opt_m eq 'exit') {
    if (unlink '@MAINTENANCE') {
      warn "$0: leaving maintenance mode\n";
    } else {
      warn "$0: no maintenance mode\n";
    }
  } else {
    unlink '@MAINTENANCE';
    symlink $opt_m,'@MAINTENANCE'
      or die "$0: cannot write $spooldir/\@MAINTENANCE - $!";
    warn "$0: entering maintenance mode\n";
  }
  exit;
}

# list files or resend notification e-mails
if ($opt_M) {
  my ($mtime,$comment,$file,$keep);
  local $_;

  if (@ARGV) {
    foreach $file (glob("@ARGV")) {
      $mtime = mtime("$file/data") or next;
      $comment = slurp("$file/comment")||'';
      next if $comment =~ /NOMAIL/;
      $keep = readlink "$file/keep"
           || readlink "$file/../../\@KEEP"
           || $keep_default;
      $keep = $keep - int((time-mtime("$file/data"))/60/60/24);

      notify(
        status     => 'new',
        dkey       => readlink "$file/dkey",
        filename   => filename($file),
        keep       => $keep,
        comment    => $comment,
        warn       => int(($mtime-time)/DS)+$keep,
        autodelete => readlink "$file/autodelete" || $autodelete,
      );
      print "send notification e-mail for $file\n";
    }
  } else {
    # just list files
    foreach $file (glob "*/*/*/data") {
      next if $file =~ /^_?(anonymous|fexmail)/;
      $file =~ s:/data$::;
      $comment = "$file/comment";
      if (open $comment,$comment and <$comment> =~ /NOMAIL/) {
        next;
      }
      print "$file\n";
    }
  }
  exit;
}

# show logfile
if ($opt_w) {
  $log = "$logdir/fexsrv.log";
  warn "$0: polling $log\n\n";
  exec "$FEXHOME/bin/logwatch",$log;
  die "$0: logwatch not found\n";
}

# list files and download URLs
if ($opt_l) {
  my ($file,$dkey,@L);
  chdir $spooldir or die "$0: $spooldir - $!\n";
  foreach $file (glob "*/*/*") {
    if (-s "$file/data" and
        $dkey = readlink("$file/dkey") and
        -l ".dkeys/$dkey"
    ) {
      push @L,sprintf "%2\$s --> %1\$s : $durl/$dkey/%3\$s\n",split "/",$file;
    }
  }
  print sort @L if @L;
  exit;
}

# list files detailed
if ($opt_L) {
  my $filter = shift;
  my ($comment,$file,$keep,$old,$size,$download);
  local $_;

  foreach $file (glob "*/*/*/data") {
    next if $file =~ m:(.+?)/: and -l $1;
    $size = -s $file or next;
    $file =~ s:/data$::;
    next if $filter and $file !~ /$filter/;
    $comment = slurp("$file/comment")||'';
    $dkey = readlink("$file/dkey")||'';
    $keep = readlink("$file/keep")||$keep_default;
    $old = int((time-mtime("$file/data"))/60/60/24);
    $download = join(' & ',split("\n",(slurp("$file/download")||'')));
    print "\n$file\n";
    printf "  comment: %s\n",decode_utf8($comment);
    printf "  size: %s\n",d3($size);
    printf "  sender ip: %s\n",readlink("$file/ip")||'';
    printf "  expire in: %s days\n",$keep-$old;
    printf "  upload speed: %s kB/s\n",readlink("$file/speed")||0;
    printf "  URL: $durl/$dkey/%3\$s\n",split "/",$file;
    printf "  download: %s\n",$download;
  }
  exit;
}

# delete user
if ($opt_d) {
  $idf = "$spooldir/$opt_d/\@";
  die "$0: no such user $opt_d\n" unless -f $idf;
  unlink $idf or die "$0: cannot remove $idf - $!\n";
  foreach $rf (glob "$spooldir/$opt_d/\@*") { unlink $rf }
  print "$opt_d deleted\n";
  exit;
}

# set user restriction file
if ($opt_R) {
  if ($opt_R eq 'i') {
    $user = shift or die "usage: $0 -Ri user\n";
    $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
    die "$0: no user $user\n" unless -d "$spooldir/$user";
    unless (@local_rdomains) {
      die "$0: no \@local_rdomains in server config\n";
    }
    my $rf = "$spooldir/$user/\@ALLOWED_RECIPIENTS";
    open $rf,'>',$rf or die "$0: cannot open $rf - $!";
    print {$rf} "\@LOCAL_RDOMAINS\n";
    close $rf;
    print "$user restricted to internal recipients\n";
    exit;
  } elsif ($opt_R eq 'l') {
    $user = shift or die "usage: $0 -Rl user\n";
    $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
    die "$0: no user $user\n" unless -d "$spooldir/$user";
    my $rf = "$spooldir/$user/\@ALLOWED_RECIPIENTS";
    open $rf,'>',$rf or die "$0: cannot open $rf - $!";
    print {$rf} "\@LOCAL_USERS\n";
    close $rf;
    print "$user restricted to local recipients\n";
    exit;
  } else {
    usage(2);
  }
  exit;
}

# edit user restriction file
if ($opt_r) {
  if    ($opt_r =~ /^r/i) { $opt_r = 'ALLOWED_RECIPIENTS' }
  elsif ($opt_r =~ /^u/i) { $opt_r = 'UPLOAD_HOSTS' }
  elsif ($opt_r =~ /^d/i) { $opt_r = 'DOWNLOAD_HOSTS' }
  else                    { usage(2) }
  $user = shift or usage(2);
  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  die "$0: no user $user\n" unless -d "$spooldir/$user";
  my $rf = "$spooldir/$user/\@$opt_r";
  unless (-s $rf) {
    open $rf,'>',$rf or die "$0: cannot open $rf - $!";
    if ($opt_r eq 'ALLOWED_RECIPIENTS') {
      print {$rf}<<EOD;
# Restrict allowed recipients. Only listed addresses are allowed as recipients.
# 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.
# Examples:
#    framstag\@rus.uni-stuttgart.de
#    *\@flupp.org
EOD
    } elsif ($opt_r eq 'UPLOAD_HOSTS') {
      print {$rf}<<EOD;
# Restrict allowed upload hosts.
# Only listed addresses are allowed as upload hosts.
# Make this file COMPLETLY empty if you want to disable the restriction.
# You can add single ip adresses or ip ranges.
# Examples:
#    129.69.1.11
#    10.0.10.0-10.0.10.255
EOD
    } elsif ($opt_r eq 'DOWNLOAD_HOSTS') {
      print {$rf}<<EOD;
# Restrict allowed download hosts.
# Only listed addresses are allowed as download hosts.
# Make this file COMPLETLY empty if you want to disable the restriction.
# You can add single ip adresses or ip ranges.
# Examples:
#    129.69.1.11
#    10.0.10.0-10.0.10.255
EOD
    } else {
      die "$0: unknown option -r $opt_r\n";
    }
    close $rf;
  }
  system $EDITOR,$rf;
  unlink $rf if -s $rf<5;
  exit;
}

# edit configuration
if ($opt_c) {
  exec $EDITOR,"$FEXLIB/fex.ph";
}

# add virtual server
if ($opt_A) {
  if ($opt_A =~ /(.+):(.+)/) {
    $vhost = $1;
    $hhost = $2;
  } else {
    die "usage: $0 -A alias:hostname\n".
        "example: $0 -A flupp:fex.flupp.org\n";
  }
  if ($FHS) {
    $vhd = "/var/lib/fex/vhosts/$vhost";
    mkdir $vhd or die "$0: cannot mkdir $vhd - $!\n";
    mkdir   "/etc/fex/vhosts/$vhost";
    symlink "/etc/fex/vhosts/$vhost", "$vhd/lib";
    mkdir   "$spooldir/vhosts/$vhost";
    symlink "$spooldir/vhosts/$vhost","$vhd/spool";
  } else {
    $vhd = "$FEXHOME/$vhost";
    mkdir $vhd or die "$0: cannot mkdir $vhd - $!\n";
    mkdir "$vhd/lib";
    mkdir "$vhd/spool";
  }

  mkdir "$vhd/htdocs";
  mkdir "$vhd/htdocs/locale";
  $_ = slurp("$FEXLIB/fex.ph");
  s/\$hostname\s*=.*/\$hostname = '$hhost';/ or s/^/\$hostname = '$hhost';\n/;
  $fph = "$vhd/lib/fex.ph";
  open $fph,">$fph" or die "$0: cannot write to $fph - $!\n";
  print {$fph} $_;
  close $fph;
  cpa("$FEXLIB/fup.pl","$vhd/lib");
  foreach $i (qw'dop fex.pp fup.pl lf.pl reactivation.txt') {
    # symlink "$FEXLIB/$i","$vhd/lib/$i";
    symlink "../../lib/$i","$vhd/lib/$i";
  }
  foreach $i (qw(
    index.html tools.html SEX.html robots.txt
    logo.jpg small_logo.jpg action-fex-camel.gif favicon.ico
    FAQ
  )) {
    cpa("$docdir/$i","$vhd/htdocs");
  }
  symlink "$docdir/version","../../htdocs/version";
  symlink "$docdir/download","../../htdocs/download";
  cpa("$FEXHOME/locale",$vhd);
  foreach $ld (glob "$vhd/locale/*") {
    if (not -l $ld and -d "$ld/cgi-bin") {
      $locale = basename($ld);
      rmrf("$ld/cgi-bin");
      # symlink "../../../locale/$locale/cgi-bin","$ld/cgi-bin";
      symlink "../../../locale/$locale/htdocs","$vhd/htdocs/locale/$locale";
      unlink "$ld/lib/fex.ph";
      symlink "../../../lib/fex.ph","$ld/lib/fex.ph";
      symlink "../../../../locale/$locale/lib","$ld/lib/master";
      foreach $f (qw'dop fex.pp lf.pl reactivation.txt') {
        unlink "$ld/lib/$f";
        symlink "master/$f","$ld/lib/$f";
      }
    }
  }
  $fph = "$FEXLIB/fex.ph";
  open $fph,">>$fph" or die "$0: cannot write to $fph = $!\n";
  print {$fph} "\n\$vhost{'$hhost'} = '$vhd';\n";
  close $fph;
  print "You must now edit and configure $vhd/lib/fex.ph\n";
  print "or execute: $0 -V $vhost -c\n";
  exit;
}

# show config
if ($opt_v and not @ARGV) {
  print  "config from $FEXLIB/fex.ph :\n";
  print  "  spooldir        = $spooldir\n";
  print  "  logdir          = @logdir\n";
  print  "  docdir          = $docdir\n";
  print  "  durl            = @durl\n";
  print  "  admin           = $admin\n";
  print  "  mdomain         = $mdomain\n";
  print  "  mailmode        = $mailmode\n";
  print  "  autodelete      = $autodelete\n";
  print  "  keep_default    = $keep_default\n";
  printf "  keep_max        = %s\n",$keep_max||'unlimited';
  printf "  recipient_quota = %d GB\n",int($recipient_quota/1024);
  printf "  sender_quota    = %d GB\n",int($sender_quota/1024);
  while (($hh,$vh) = each %vhost) {
    printf "  virtual server %s : %s\n",basename($vh),$hh;
  }
#  unless (@ARGV) {
#    foreach $ph (glob "$ENV{HOME}/*/lib/fex.ph") {
#      $ENV{FEXLIB} = dirname($ph);
#      print "\n";
#      system $0,'-v',$ph;
#    }
#  }
  if ($m = readlink '@MAINTENANCE') {
    print "server is in maintenance mode ($m)!\n" ;
  }
  exit;
}

# 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;
    $idf = "$user/@";
    if (open $idf,$idf) {
      chomp($ido = <$idf>||'');
      close $idf;
    }
    unless ($id) {
      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";
    }
    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";
    close F or die "$0: cannot write $idf - $!\n";
    showuser($user,$id);
  } else {
    print "Users in $spooldir:\n";
    foreach $user (glob "*/@") {
      $user =~ s:.*/(.+)/@:$1:;
      print "$user\n";
    }
  }
  exit;
}

# set user autodelete default
if ($opt_a) {
  $user = lc $opt_a;
  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  $_ = shift @ARGV || '';
  if    (/^n/i) { $autodelete = 'no' }
  elsif (/^y/i) { $autodelete = 'yes' }
  elsif (/^d/i) { $autodelete = 'delay' }
  else {
    die "usage: $0 -a user yes\n".
        "usage: $0 -a user no\n".
        "usage: $0 -a user delay\n".
        "example: $0 -a framstag\@rus.uni-stuttgart.de no\n";
  }
  mkdir "$spooldir/$user",0755;
  my $adf = "$spooldir/$user/\@AUTODELETE";
  unlink $adf;
  symlink $autodelete,$adf or die "$0: cannot create symlink $adf - $!\n";
  exit;
}

# set user notification default
if ($opt_n) {
  $user = lc $opt_n;
  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  $_ = shift @ARGV || '';
  if    (/^n/i)    { $notification = 'no' }
  elsif (/^[sb]/i) { $notification = 'short' }
  elsif (/^[fd]/i) { $notification = '' }
  else {
    die "usage: $0 -n user no\n".
        "usage: $0 -n user brief\n".
        "usage: $0 -n user detailed\n".
        "example: $0 -n framstag\@rus.uni-stuttgart.de brief\n";
  }
  mkdir "$spooldir/$user",0755;
  my $ndf = "$spooldir/$user/\@NOTIFICATION";
  unlink $ndf;
  if ($notification) {
    symlink $notification,$ndf or die "$0: cannot create symlink $ndf - $!\n";
  }
  exit;
}

# set user keep default
if ($opt_k) {
  $user = lc $opt_k;
  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  my $keep = shift @ARGV || '';
  if ($keep !~ /^\d+$/) {
    die "usage: $0 -k user keep_days\n".
        "example: $0 -k framstag\@rus.uni-stuttgart.de 30\n";
  }
  mkdir "$spooldir/$user",0755;
  my $kf = "$spooldir/$user/\@KEEP";
  unlink $kf;
  symlink $keep,$kf or die "$0: cannot create symlink $kf - $!\n";
  exit;
}

# quota
if ($opt_q) {
  $user = lc $opt_q;
  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  unless (-d "$spooldir/$user") {
    die "$0: $user is not a FEX user\n";
  }
  quota($user,@ARGV);
  exit;
}

if ($opt_C) {
  $user = lc $opt_C;
  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  unless (-f "$spooldir/$user/@") {
    die "$0: $user is not a regular FEX user\n";
  }
  $_ = shift @ARGV || '';
  if (/^y/i) {
    open $user,">>$spooldir/$user/\@CAPTIVE";
    close $user;
    print "$user is now captive\n";
  } elsif (/^n/i) {
    unlink "$spooldir/$user/\@CAPTIVE";
    print "$user is no more captive\n";
  } else {
    die "usage: $0 -C user yes\n".
        "usage: $0 -C user no\n".
        "example: $0 -C framstag\@rus.uni-stuttgart.de no\n";
  }
  exit;
}

# FEXYOURSELF = user can only fex to himself via web interface
if ($opt_y) {
  $user = lc $opt_y;
  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  unless (-f "$spooldir/$user/@") {
    die "$0: $user is not a regular FEX user\n";
  }
  $_ = shift @ARGV || '';
  if (/^y/i) {
    open $user,">>$spooldir/$user/\@FEXYOURSELF";
    close $user;
    print "$user has now \"fex yourself\" web default\n";
  } elsif (/^n/i) {
    unlink "$spooldir/$user/\@FEXYOURSELF";
    print "$user has no \"fex yourself\" web default\n";
  } else {
    die "usage: $0 -y user yes\n".
        "usage: $0 -y user no\n".
        "example: $0 -y framstag\@rus.uni-stuttgart.de no\n";
  }
  exit;
}

if ($opt_D) {
  $user = lc $opt_D;
  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  $_ = $ARGV[0] || '';
  if (/^no?$/i) {
    unlink "$spooldir/$user/\@DISABLED";
    print "$user is now enabled\n";
  } else {
    open $user,">>$spooldir/$user/\@DISABLED";
    print {$user} "@ARGV\n";
    close $user;
    print "$user is now disabled\n";
  }
  exit;
}

if ($opt_P) {
  $user = lc $opt_P;
  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  $_ = shift @ARGV || '';
  if (/^y/i) {
    open $user,">>$spooldir/$user/\@PERSISTENT";
    close $user;
    print "$user is now persistent\n";
  } elsif (/^n/i) {
    unlink "$spooldir/$user/\@PERSISTENT";
    print "$user is no more persistent\n";
  } else {
    die "usage: $0 -P user yes\n".
        "usage: $0 -P user no\n".
        "example: $0 -P framstag\@rus.uni-stuttgart.de yes\n";
  }
  exit;
}

if ($opt_S eq 'fup') {
  &fupstat;
  exit;
}

if ($opt_S eq 'fop') {
  &fopstat;
  exit;
}

usage(3);

sub showuser {
  my $user = shift;
  my $id = shift;
  my ($keep,$autodelete,$notification,$login);

  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;

  print "[using config $FEXLIB/fex.ph]\n";
  print "$fup?from=$user&id=$id\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";
    }
  }
  my $disabled = 'no';
  if (-e "$spooldir/$user/\@DISABLED") {
    $disabled = slurp("$spooldir/$user/\@DISABLED");
    chomp $disabled;
    $disabled ||= 'yes';
  }
  printf "fex yourself web default: %s\n",
         -e "$spooldir/$user/\@FEXYOURSELF" ? 'yes' : 'no';
  printf "persistent: %s\n",
         -e "$spooldir/$user/\@PERSISTENT" ? 'yes' : 'no';
  printf "captive: %s\n",
         -e "$spooldir/$user/\@CAPTIVE" ? 'yes' : 'no';
  printf "disabled: %s\n",$disabled;
  printf "recipients restrictions: %s\n",
         -e "$spooldir/$user/\@ALLOWED_RECIPIENTS" ? 'yes' : 'no';
  printf "upload restrictions: %s\n",
         -e "$spooldir/$user/\@UPLOAD_HOSTS" ? 'yes' : 'no';
  printf "download restrictions: %s\n",
         -e "$spooldir/$user/\@DOWNLOAD_HOSTS" ? 'yes' : 'no';
  $autodelete = lc(readlink "$spooldir/$user/\@AUTODELETE" || $::autodelete);
  print "autodelete default: $autodelete\n";
  $notification = lc(readlink "$spooldir/$user/\@NOTIFICATION" || $::notification);
  print "notification default: $notification\n";
  $keep = readlink "$spooldir/$user/\@KEEP" || $keep_default;
  print "keep default: $keep\n";
  quota($user);
  printf "account creation: %s\n",slurp("$spooldir/$user/.auto")||'manual';
}

# set or show disk quota
sub quota {
  my $user = shift;
  my $rquota = '';
  my $squota = '';
  my $qf = "$spooldir/$user/\@QUOTA";
  local $_;

  if (open $qf,$qf) {
    while (<$qf>) {
      s/#.*//;
      $rquota = $1 if /recipient.*?(\d+)/i;
      $squota = $1 if /sender.*?(\d+)/i;
    }
    close $qf;
  }

  if (@_) {
    for (@_) {
      $rquota = $1 if /^r.*:(\d*)/i;
      $squota = $1 if /^s.*:(\d*)/i;
    }
    open $qf,'>',$qf or die "$0: cannot write $qf - $!\n";
    print {$qf} "recipient:$rquota\n" if $rquota;
    print {$qf} "sender:$squota\n"    if $squota;
    close $qf;
  }

  printf "recpient quota (used): %d (%d) MB\n",check_recipient_quota($user);
  printf "sender quota (used): %d (%d) MB\n",check_sender_quota($user);
}


sub fupstat {
  my (%user,%domain,%du);
  my ($log,$u,$d,$z);
  my $Z = 0;

  if (-t) { $log = "$logdir/fup.log" }
  else    { $log = '>&=STDIN' }
  open $log,$log or die "$0: cannot open $log - $!\n";

  while (<$log>) {
    if (/^([\d: -]+) (\[[\d_]+\] )?(\w\S*) .* (\d+)$/) {
      $z = $4;
      $u = $3;
      $u .= '@'.$mdomain if $mdomain and $u !~ /@/;
      $user{$u} += $z;
      $d = $u;
      $d =~ s/.*@//;
      $d =~ s/.*\.(.+\.\w+)/$1/;
      $domain{$d} += $z;
      $du{$d}{$u}++;
      $Z += $z;
    }
  }

  foreach $u (sort {$user{$a} <=> $user{$b}} keys %user) {
    printf "%s : %d\n",$u,$user{$u}/M;
  }
  print "========================================================\n";
  foreach $d (sort {$domain{$a} <=> $domain{$b}} keys %domain) {
    printf "%s : %d MB, %d user\n",$d,$domain{$d}/M,scalar(keys %{$du{$d}});
  }
  printf "Total: %d GB\n",$Z/M/1024;

  exit;
}


sub fopstat {
  my $Z = 0;
  my ($log,$u,$d,$z);
  my (%user,%domain,%du);

  if (-t) { $log = "$logdir/fop.log" }
  else    { $log = '>&=STDIN' }
  open $log,$log or die "$0: cannot open $log - $!\n";

  while (<$log>) {
    if (/^([\d: -]+) (\[[\d_]+\] )?[\d.]+ (.+?)\/.* (\d+)\/\d+/) {
      $z = $4;
      $u = $3;
      $u .= '@'.$mdomain if $mdomain and $u !~ /@/;
      $user{$u} += $z;
      $d = $u;
      $d =~ s/.*@//;
      $d =~ s/.*\.(.+\.\w+)/$1/;
      $domain{$d} += $z;
      $du{$d}{$u}++;
      $Z += $z;
    }
  }

  foreach $u (sort {$user{$a} <=> $user{$b}} keys %user) {
    printf "%s : %d\n",$u,$user{$u}/M;
  }
  print "========================================================\n";
  foreach $d (sort {$domain{$a} <=> $domain{$b}} keys %domain) {
    printf "%s : %d MB, %d user\n",$d,$domain{$d}/M,scalar(keys %{$du{$d}});
  }
  printf "Total: %d GB\n",$Z/M/1024;

  exit;
}


sub cpa {
  my $dd = pop @_;

  die "(cpa): $dd is not a directory" unless -d $dd;
  system "rsync -a @_ $dd/" ;
}


sub check_admin {

  my $admin_id = slurp("$spooldir/$admin/@") or
    die "$0: no admin account - you have to create it with:\n".
        "$0 -/ $admin ".randstring(8)."\n";

  chomp $admin_id;

  my $fid = "$ENV{HOME}/.fex/id";
  if (open $fid,$fid) {
    $_ = <$fid>;
    chomp($_ = <$fid>||'');
    if ($_ ne $admin) {
      warn "WARNING: user $admin not in $fid\n";
      $mismatch++;
    }
    chomp($_ = <$fid>||'');
    if ($_ ne $admin_id) {
      warn "WARNING: $admin auth-ID mismatch in $fid\n";
      $mismatch++;
    }
    close $fid;
    if ($mismatch) {
      warn "$0: moving $fid to ${fid}_save\n";
      rename $fid,$fid.'_save';
    }
  }
  unless (-f $fid) {
    mkdir dirname($fid);
    open $fid,'>',$fid or die "$0: cannot create $fid - $!\n";
    if ($durl =~ m{(https?://.+?)/}) {
      print {$fid} "$1\n";
    } else {
      print {$fid} "$hostname\n";
    }
    print {$fid} "$admin\n";
    print {$fid} "$admin_id\n";
    close $fid;
    warn "$0: new $fid created\n";
  }
}


sub d3 {
  local $_ = shift;
  while (s/(\d)(\d\d\d\b)/$1,$2/) {};
  return $_;
}


sub usage {
  my $port = '';
  my $proto = 'http';

  if ($durl =~ /:(\d+)/)    { $port = ":$1" }
  if ($durl =~ /^(https?)/) { $proto = $1 }

  $0 =~ s:.*/::;
  print <<EOD;
Usages:
$0 -u                 # list full users
$0 -u user            # show user config
$0 -u user auth-ID    # create new user or set new auth-ID
$0 -/ admin auth-ID   # set new admin and auth-ID
$0 -q user s:quota    # set new disk quota (MB) for sender user
$0 -q user r:quota    # set new disk quota (MB) for recipient user
$0 -Ri user           # restrict user: only internal domain recipients allowed
$0 -Rl user           # restrict user: only local users as recipients allowed
$0 -rr user           # edit user recipients restriction
$0 -ru user           # edit user upload restriction
$0 -rd user           # edit user download restriction
$0 -d user            # delete user
$0 -D user "reason"   # disable user
$0 -D user "no"       # re-enable user
$0 -P user [yn]       # make user persistent = no account expiration (yes,no)
$0 -a user [ynd]      # set user autodelete default (yes,no,delay)
$0 -n user [dbn]      # set user notification default (detailed,brief,no)
$0 -k user days       # set user keep default in days
$0 -C user [yn]       # set user captive (yes,no)
$0 -y user [yn]       # set user "fex yourself" web default (yes,no)
$0 -S fup             # file upload statistics
$0 -S fop             # file download statistics
$0 -v                 # show server config
$0 -c                 # edit server config
$0 -w                 # watch fexsrv.log (continously)
$0 -l                 # list pending files with download URLs
$0 -L [filter]        # list pending files in detail
$0 -M                 # list pending files with TO/FROM/FILE
$0 -M TO/FROM/FILE    # resend notification email
$0 -m "reason"        # enter maintenance mode (reason "exit" to leave)
$0 -E                 # show usage examples
EOD
# $0 -A alias:hostname  # add new virtual server
# $0 -V virtualhost ... # operations on virtualhost (alias or hostname)
  if (-x "$FEXHOME/cgi-bin/fac") {
    print "See also web admin interface $proto://$hostname$port/fac\n";
  }
  exit shift;
}

sub examples {
  $0 =~ s:.*/::;
  print <<EOD;
create new user:
$0 -u framstag\@rus.uni-stuttgart.de schwubbeldidu

set 10 GB sender quota for this user:
$0 -q framstag\@rus.uni-stuttgart.de s:10240

set file expiration to 30 days for this user:
$0 -k framstag\@rus.uni-stuttgart.de 30

disable account expiration for this user:
$0 -P framstag\@rus.uni-stuttgart.de y

list spooled files and resend notification email for this file:
$0 -M | grep frams
$0 -M framstag\@rus.uni-stuttgart.de/hoppel\@flupp.org/jump.avi
EOD
  exit;
}