bin/fac

   1 #!/usr/bin/perl -w
   2
   3 # CLI admin client for the FEX service
   4 #
   5 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
   6 #
   7
   8 use 5.006;
   9 use Getopt::Std;
  10 use File::Basename;
  11 use Cwd 'abs_path';
  12 use Digest::MD5 'md5_hex';
  13
  14 use constant M => 1024*1024;
  15 use constant DS => 60*60*24;
  16
  17 # do not run as CGI!
  18 exit if $ENV{SCRIPT_NAME};
  19
  20 unless ($FEXLIB = $ENV{FEXLIB}) {
  21   if ($ENV{FEXHOME}) {
  22     $FEXLIB = $ENV{FEXHOME}.'/lib';
  23   } elsif (-f '/usr/share/fex/lib/fex.ph') {
  24     $FEXLIB = '/usr/share/fex/lib';
  25   } else {
  26     $FEXLIB = dirname(dirname(abs_path($0))).'/lib';
  27   }
  28   $ENV{FEXLIB} = $FEXLIB;
  29 }
  30 die "$0: no FEXLIB\n" unless -f "$FEXLIB/fex.pp";
  31
  32 # become effective user fex
  33 unless ($<) {
  34   if (my @pw = getpwnam('fex')) {
  35     $)         = $pw[3];
  36     $>         = $pw[2];
  37     $ENV{HOME} = $pw[7];
  38   } else {
  39     die "$0: no such user 'fex'\n";
  40   }
  41 }
  42
  43 umask 077;
  44
  45 # import from fex.pp
  46 our ($FEXHOME,$FHS,$hostname,$spooldir,@logdir,$logdir,$akeydir,$docdir);
  47 our ($durl,@durl,$mdomain,$admin,$mailmode);
  48 our ($autodelete,$keep_default,$keep_max,$recipient_quota,$sender_quota);
  49 our (@local_rdomains);
  50 local $notification = 'full';
  51
  52 # load common code, local config : $HOME/lib/fex.ph
  53 require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
  54
  55 die "$0: \$admin not configured in $FEXLIB/fex.ph\n" unless $admin;
  56
  57 $EDITOR = $ENV{EDITOR} || $ENV{VISUAL} ||
  58           (-x '/usr/bin/editor' ? '/usr/bin/editor' : 'vi');
  59
  60 $opt_c = $opt_v = $opt_l = $opt_L = $opt_h = $opt_w = $opt_u = 0;
  61 $opt_M = $opt_E = 0;
  62 $opt_r = $opt_d = $opt_q = $opt_a = $opt_n = $opt_k = $opt_m = '';
  63 $opt_y = $opt_S = $opt_C = $opt_D = $opt_A = $opt_V = $opt_P =  $opt_R = '';
  64 ${'opt_/'} = '';
  65
  66 @__ = @ARGV;
  67 while (my $a = shift @__) {
  68   if ($a eq '-V') {
  69     shift @__;
  70   } else {
  71     push @_ARGV,$a;
  72   }
  73 }
  74
  75 chdir $spooldir or die "$0: no $spooldir\n";
  76
  77 @stat = stat $spooldir or die "$0: cannot access $spooldir - $!\n";
  78 warn "WARNING: $spooldir with owner=root !?\n" unless $stat[4];
  79 if (abs_path($spooldir) ne abs_path("$FEXHOME/spool")) {
  80   warn "WARNING: \$spooldir differs from $FEXHOME/spool !\n";
  81 }
  82
  83 getopts('hcvlLwuME/q:r:d:a:n:k:m:y:S:C:A:V:D:P:R:') or usage(2);
  84 usage(0)   if $opt_h;
  85 examples() if $opt_E;
  86
  87 if (${'opt_/'}) {
  88   my $admin = shift;
  89   my $id = shift or die "usage: $0 -/ admin-email-address auth-ID\n";
  90   if ($admin !~ /.\@[\w.-]+\.[a-z]+$/) {
  91     die "$0: $admin is not an email address\n";
  92   }
  93   mkdir $admin;
  94   my $aa = "$spooldir/$admin/@";
  95   open $aa,'>',$aa or die "$0: cannot write $aa - $!\n";
  96   print {$aa} $id,"\n";
  97   close $aa or die "$0: cannot write $aa - $!\n";
  98   my $fph = "$FEXLIB/fex.ph";
  99   $_ = slurp($fph) or die "$0: cannot read $fph\n";
 100   s/^\s*\$admin\s*=.*/\$admin = '$admin';/m or
 101   $_ = "\$admin = '$admin';\n".$_;
 102   open $fph,">$fph.new" or die "$0: cannot write $fph.new\n";
 103   print {$fph} $_;
 104   close $fph;
 105   rename "$fph.new",$fph or die "$0: cannot rename $fph.new to $fph\n";
 106   my $fid = "$ENV{HOME}/.fex/id";
 107   mkdir dirname($fid);
 108   rename $fid,$fid.'_save';
 109   open $fid,'>',$fid or die "$0: cannot create $fid - $!\n";
 110   if ($durl =~ m{(https?://.+?)/}) {
 111     print {$fid} "$1\n";
 112   } else {
 113     print {$fid} "$hostname\n";
 114   }
 115   print {$fid} "$admin\n";
 116   print {$fid} "$id\n";
 117   close $fid;
 118   print "new admin account: $admin\n";
 119   exit;
 120 }
 121
 122 &check_admin;
 123
 124 if ($opt_V) {
 125   while (my ($hh,$vh) = each (%vhost)) {
 126     if ($opt_V eq basename($vh) or $opt_V eq $hh) {
 127       $ENV{HTTP_HOST} = $hh;
 128       $ENV{VHOST} = "$hh:$vh";
 129       $ENV{FEXLIB} = "$vh/lib";
 130       die "$0: no $ENV{FEXLIB}/fex.ph\n" unless -f "$ENV{FEXLIB}/fex.ph";
 131       exec $0,@_ARGV;
 132       die "$0: cannot re-exec\n";
 133     }
 134   }
 135   die "$0: no virtual host $opt_V defined\n";
 136 }
 137
 138 $fup = $durl;
 139 $fup =~ s:/[^/]+$:/fup:;
 140
 141 # maintenance mode
 142 if ($opt_m) {
 143   if ($opt_m eq 'exit') {
 144     if (unlink '@MAINTENANCE') {
 145       warn "$0: leaving maintenance mode\n";
 146     } else {
 147       warn "$0: no maintenance mode\n";
 148     }
 149   } else {
 150     unlink '@MAINTENANCE';
 151     symlink $opt_m,'@MAINTENANCE'
 152       or die "$0: cannot write $spooldir/\@MAINTENANCE - $!";
 153     warn "$0: entering maintenance mode\n";
 154   }
 155   exit;
 156 }
 157
 158 # list files or resend notification e-mails
 159 if ($opt_M) {
 160   my ($mtime,$comment,$file,$keep);
 161   local $_;
 162
 163   if (@ARGV) {
 164     foreach $file (glob("@ARGV")) {
 165       $mtime = mtime("$file/data") or next;
 166       $comment = slurp("$file/comment")||'';
 167       next if $comment =~ /NOMAIL/;
 168       $keep = readlink "$file/keep"
 169            || readlink "$file/../../\@KEEP"
 170            || $keep_default;
 171       $keep = $keep - int((time-mtime("$file/data"))/60/60/24);
 172
 173       notify(
 174         status     => 'new',
 175         dkey       => readlink "$file/dkey",
 176         filename   => filename($file),
 177         keep       => $keep,
 178         comment    => $comment,
 179         warn       => int(($mtime-time)/DS)+$keep,
 180         autodelete => readlink "$file/autodelete" || $autodelete,
 181       );
 182       print "send notification e-mail for $file\n";
 183     }
 184   } else {
 185     # just list files
 186     foreach $file (glob "*/*/*/data") {
 187       next if $file =~ /^_?(anonymous|fexmail)/;
 188       $file =~ s:/data$::;
 189       $comment = "$file/comment";
 190       if (open $comment,$comment and <$comment> =~ /NOMAIL/) {
 191         next;
 192       }
 193       print "$file\n";
 194     }
 195   }
 196   exit;
 197 }
 198
 199 # show logfile
 200 if ($opt_w) {
 201   $log = "$logdir/fexsrv.log";
 202   warn "$0: polling $log\n\n";
 203   exec "$FEXHOME/bin/logwatch",$log;
 204   die "$0: logwatch not found\n";
 205 }
 206
 207 # list files and download URLs
 208 if ($opt_l) {
 209   my ($file,$dkey,@L);
 210   chdir $spooldir or die "$0: $spooldir - $!\n";
 211   foreach $file (glob "*/*/*") {
 212     if (-s "$file/data" and
 213         $dkey = readlink("$file/dkey") and
 214         -l ".dkeys/$dkey"
 215     ) {
 216       push @L,sprintf "%2\$s --> %1\$s : $durl/$dkey/%3\$s\n",split "/",$file;
 217     }
 218   }
 219   print sort @L if @L;
 220   exit;
 221 }
 222
 223 # list files detailed
 224 if ($opt_L) {
 225   my $filter = shift;
 226   my ($comment,$file,$keep,$old,$size,$download);
 227   local $_;
 228
 229   foreach $file (glob "*/*/*/data") {
 230     next if $file =~ m:(.+?)/: and -l $1;
 231     $size = -s $file or next;
 232     $file =~ s:/data$::;
 233     next if $filter and $file !~ /$filter/;
 234     $comment = slurp("$file/comment")||'';
 235     $dkey = readlink("$file/dkey")||'';
 236     $keep = readlink("$file/keep")||$keep_default;
 237     $old = int((time-mtime("$file/data"))/60/60/24);
 238     $download = join(' & ',split("\n",(slurp("$file/download")||'')));
 239     print "\n$file\n";
 240     printf "  comment: %s\n",decode_utf8($comment);
 241     printf "  size: %s\n",d3($size);
 242     printf "  sender ip: %s\n",readlink("$file/ip")||'';
 243     printf "  expire in: %s days\n",$keep-$old;
 244     printf "  upload speed: %s kB/s\n",readlink("$file/speed")||0;
 245     printf "  URL: $durl/$dkey/%3\$s\n",split "/",$file;
 246     printf "  download: %s\n",$download;
 247   }
 248   exit;
 249 }
 250
 251 # delete user
 252 if ($opt_d) {
 253   $idf = "$spooldir/$opt_d/\@";
 254   die "$0: no such user $opt_d\n" unless -f $idf;
 255   unlink $idf or die "$0: cannot remove $idf - $!\n";
 256   foreach $rf (glob "$spooldir/$opt_d/\@*") { unlink $rf }
 257   print "$opt_d deleted\n";
 258   exit;
 259 }
 260
 261 # set user restriction file
 262 if ($opt_R) {
 263   if ($opt_R eq 'i') {
 264     $user = shift or die "usage: $0 -Ri user\n";
 265     $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 266     die "$0: no user $user\n" unless -d "$spooldir/$user";
 267     unless (@local_rdomains) {
 268       die "$0: no \@local_rdomains in server config\n";
 269     }
 270     my $rf = "$spooldir/$user/\@ALLOWED_RECIPIENTS";
 271     open $rf,'>',$rf or die "$0: cannot open $rf - $!";
 272     print {$rf} "\@LOCAL_RDOMAINS\n";
 273     close $rf;
 274     print "$user restricted to internal recipients\n";
 275     exit;
 276   } elsif ($opt_R eq 'l') {
 277     $user = shift or die "usage: $0 -Rl user\n";
 278     $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 279     die "$0: no user $user\n" unless -d "$spooldir/$user";
 280     my $rf = "$spooldir/$user/\@ALLOWED_RECIPIENTS";
 281     open $rf,'>',$rf or die "$0: cannot open $rf - $!";
 282     print {$rf} "\@LOCAL_USERS\n";
 283     close $rf;
 284     print "$user restricted to local recipients\n";
 285     exit;
 286   } else {
 287     usage(2);
 288   }
 289   exit;
 290 }
 291
 292 # edit user restriction file
 293 if ($opt_r) {
 294   if    ($opt_r =~ /^r/i) { $opt_r = 'ALLOWED_RECIPIENTS' }
 295   elsif ($opt_r =~ /^u/i) { $opt_r = 'UPLOAD_HOSTS' }
 296   elsif ($opt_r =~ /^d/i) { $opt_r = 'DOWNLOAD_HOSTS' }
 297   else                    { usage(2) }
 298   $user = shift or usage(2);
 299   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 300   die "$0: no user $user\n" unless -d "$spooldir/$user";
 301   my $rf = "$spooldir/$user/\@$opt_r";
 302   unless (-s $rf) {
 303     open $rf,'>',$rf or die "$0: cannot open $rf - $!";
 304     if ($opt_r eq 'ALLOWED_RECIPIENTS') {
 305       print {$rf}<<EOD;
 306 # Restrict allowed recipients. Only listed addresses are allowed as recipients.
 307 # Make this file COMPLETLY empty if you want to disable the restriction.
 308 # An allowed recipient is an e-mail address. You can use * as wildcard.
 309 # Examples:
 310 #    framstag\@rus.uni-stuttgart.de
 311 #    *\@flupp.org
 312 EOD
 313     } elsif ($opt_r eq 'UPLOAD_HOSTS') {
 314       print {$rf}<<EOD;
 315 # Restrict allowed upload hosts.
 316 # Only listed addresses are allowed as upload hosts.
 317 # Make this file COMPLETLY empty if you want to disable the restriction.
 318 # You can add single ip adresses or ip ranges.
 319 # Examples:
 320 #    129.69.1.11
 321 #    10.0.10.0-10.0.10.255
 322 EOD
 323     } elsif ($opt_r eq 'DOWNLOAD_HOSTS') {
 324       print {$rf}<<EOD;
 325 # Restrict allowed download hosts.
 326 # Only listed addresses are allowed as download hosts.
 327 # Make this file COMPLETLY empty if you want to disable the restriction.
 328 # You can add single ip adresses or ip ranges.
 329 # Examples:
 330 #    129.69.1.11
 331 #    10.0.10.0-10.0.10.255
 332 EOD
 333     } else {
 334       die "$0: unknown option -r $opt_r\n";
 335     }
 336     close $rf;
 337   }
 338   system $EDITOR,$rf;
 339   unlink $rf if -s $rf<5;
 340   exit;
 341 }
 342
 343 # edit configuration
 344 if ($opt_c) {
 345   exec $EDITOR,"$FEXLIB/fex.ph";
 346 }
 347
 348 # add virtual server
 349 if ($opt_A) {
 350   if ($opt_A =~ /(.+):(.+)/) {
 351     $vhost = $1;
 352     $hhost = $2;
 353   } else {
 354     die "usage: $0 -A alias:hostname\n".
 355         "example: $0 -A flupp:fex.flupp.org\n";
 356   }
 357   if ($FHS) {
 358     $vhd = "/var/lib/fex/vhosts/$vhost";
 359     mkdir $vhd or die "$0: cannot mkdir $vhd - $!\n";
 360     mkdir   "/etc/fex/vhosts/$vhost";
 361     symlink "/etc/fex/vhosts/$vhost", "$vhd/lib";
 362     mkdir   "$spooldir/vhosts/$vhost";
 363     symlink "$spooldir/vhosts/$vhost","$vhd/spool";
 364   } else {
 365     $vhd = "$FEXHOME/$vhost";
 366     mkdir $vhd or die "$0: cannot mkdir $vhd - $!\n";
 367     mkdir "$vhd/lib";
 368     mkdir "$vhd/spool";
 369   }
 370
 371   mkdir "$vhd/htdocs";
 372   mkdir "$vhd/htdocs/locale";
 373   $_ = slurp("$FEXLIB/fex.ph");
 374   s/\$hostname\s*=.*/\$hostname = '$hhost';/ or s/^/\$hostname = '$hhost';\n/;
 375   $fph = "$vhd/lib/fex.ph";
 376   open $fph,">$fph" or die "$0: cannot write to $fph - $!\n";
 377   print {$fph} $_;
 378   close $fph;
 379   cpa("$FEXLIB/fup.pl","$vhd/lib");
 380   foreach $i (qw'dop fex.pp fup.pl lf.pl reactivation.txt') {
 381     # symlink "$FEXLIB/$i","$vhd/lib/$i";
 382     symlink "../../lib/$i","$vhd/lib/$i";
 383   }
 384   foreach $i (qw(
 385     index.html tools.html SEX.html robots.txt
 386     logo.jpg small_logo.jpg action-fex-camel.gif favicon.ico
 387     FAQ
 388   )) {
 389     cpa("$docdir/$i","$vhd/htdocs");
 390   }
 391   symlink "$docdir/version","../../htdocs/version";
 392   symlink "$docdir/download","../../htdocs/download";
 393   cpa("$FEXHOME/locale",$vhd);
 394   foreach $ld (glob "$vhd/locale/*") {
 395     if (not -l $ld and -d "$ld/cgi-bin") {
 396       $locale = basename($ld);
 397       rmrf("$ld/cgi-bin");
 398       # symlink "../../../locale/$locale/cgi-bin","$ld/cgi-bin";
 399       symlink "../../../locale/$locale/htdocs","$vhd/htdocs/locale/$locale";
 400       unlink "$ld/lib/fex.ph";
 401       symlink "../../../lib/fex.ph","$ld/lib/fex.ph";
 402       symlink "../../../../locale/$locale/lib","$ld/lib/master";
 403       foreach $f (qw'dop fex.pp lf.pl reactivation.txt') {
 404         unlink "$ld/lib/$f";
 405         symlink "master/$f","$ld/lib/$f";
 406       }
 407     }
 408   }
 409   $fph = "$FEXLIB/fex.ph";
 410   open $fph,">>$fph" or die "$0: cannot write to $fph = $!\n";
 411   print {$fph} "\n\$vhost{'$hhost'} = '$vhd';\n";
 412   close $fph;
 413   print "You must now edit and configure $vhd/lib/fex.ph\n";
 414   print "or execute: $0 -V $vhost -c\n";
 415   exit;
 416 }
 417
 418 # show config
 419 if ($opt_v and not @ARGV) {
 420   print  "config from $FEXLIB/fex.ph :\n";
 421   print  "  spooldir        = $spooldir\n";
 422   print  "  logdir          = @logdir\n";
 423   print  "  docdir          = $docdir\n";
 424   print  "  durl            = @durl\n";
 425   print  "  admin           = $admin\n";
 426   print  "  mdomain         = $mdomain\n";
 427   print  "  mailmode        = $mailmode\n";
 428   print  "  autodelete      = $autodelete\n";
 429   print  "  keep_default    = $keep_default\n";
 430   printf "  keep_max        = %s\n",$keep_max||'unlimited';
 431   printf "  recipient_quota = %d GB\n",int($recipient_quota/1024);
 432   printf "  sender_quota    = %d GB\n",int($sender_quota/1024);
 433   while (($hh,$vh) = each %vhost) {
 434     printf "  virtual server %s : %s\n",basename($vh),$hh;
 435   }
 436 #  unless (@ARGV) {
 437 #    foreach $ph (glob "$ENV{HOME}/*/lib/fex.ph") {
 438 #      $ENV{FEXLIB} = dirname($ph);
 439 #      print "\n";
 440 #      system $0,'-v',$ph;
 441 #    }
 442 #  }
 443   if ($m = readlink '@MAINTENANCE') {
 444     print "server is in maintenance mode ($m)!\n" ;
 445   }
 446   exit;
 447 }
 448
 449 # add user or show user config
 450 if ($opt_u) {
 451   chdir $spooldir or die "$0: cannot chdir $spooldir = $!\n";
 452   if ($opt_u = shift @ARGV) {
 453     $user = lc $opt_u;
 454     $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 455     $id = shift @ARGV;
 456     $idf = "$user/@";
 457     if (open $idf,$idf) {
 458       chomp($ido = <$idf>||'');
 459       close $idf;
 460     }
 461     unless ($id) {
 462       die "$0: $user is not a regular FEX user\n" unless -f "$user/@";
 463       showuser($user,$ido);
 464       exit;
 465     }
 466     unless ($user =~ /\w@[\w.-]+\.[a-z]+$/) {
 467       die "$0: $user is not a valid email-address!\n";
 468     }
 469     unless (-d $user) {
 470       mkdir $user,0755
 471         or die "$0: cannot mkdir $user - $!\n";
 472     }
 473     open F,">$idf" or die "$0: cannot write $idf - $!\n";
 474     print F $id,"\n";
 475     close F or die "$0: cannot write $idf - $!\n";
 476     showuser($user,$id);
 477   } else {
 478     print "Users in $spooldir:\n";
 479     foreach $user (glob "*/@") {
 480       $user =~ s:.*/(.+)/@:$1:;
 481       print "$user\n";
 482     }
 483   }
 484   exit;
 485 }
 486
 487 # set user autodelete default
 488 if ($opt_a) {
 489   $user = lc $opt_a;
 490   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 491   $_ = shift @ARGV || '';
 492   if    (/^n/i) { $autodelete = 'no' }
 493   elsif (/^y/i) { $autodelete = 'yes' }
 494   elsif (/^d/i) { $autodelete = 'delay' }
 495   else {
 496     die "usage: $0 -a user yes\n".
 497         "usage: $0 -a user no\n".
 498         "usage: $0 -a user delay\n".
 499         "example: $0 -a framstag\@rus.uni-stuttgart.de no\n";
 500   }
 501   mkdir "$spooldir/$user",0755;
 502   my $adf = "$spooldir/$user/\@AUTODELETE";
 503   unlink $adf;
 504   symlink $autodelete,$adf or die "$0: cannot create symlink $adf - $!\n";
 505   exit;
 506 }
 507
 508 # set user notification default
 509 if ($opt_n) {
 510   $user = lc $opt_n;
 511   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 512   $_ = shift @ARGV || '';
 513   if    (/^n/i)    { $notification = 'no' }
 514   elsif (/^[sb]/i) { $notification = 'short' }
 515   elsif (/^[fd]/i) { $notification = '' }
 516   else {
 517     die "usage: $0 -n user no\n".
 518         "usage: $0 -n user brief\n".
 519         "usage: $0 -n user detailed\n".
 520         "example: $0 -n framstag\@rus.uni-stuttgart.de brief\n";
 521   }
 522   mkdir "$spooldir/$user",0755;
 523   my $ndf = "$spooldir/$user/\@NOTIFICATION";
 524   unlink $ndf;
 525   if ($notification) {
 526     symlink $notification,$ndf or die "$0: cannot create symlink $ndf - $!\n";
 527   }
 528   exit;
 529 }
 530
 531 # set user keep default
 532 if ($opt_k) {
 533   $user = lc $opt_k;
 534   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 535   my $keep = shift @ARGV || '';
 536   if ($keep !~ /^\d+$/) {
 537     die "usage: $0 -k user keep_days\n".
 538         "example: $0 -k framstag\@rus.uni-stuttgart.de 30\n";
 539   }
 540   mkdir "$spooldir/$user",0755;
 541   my $kf = "$spooldir/$user/\@KEEP";
 542   unlink $kf;
 543   symlink $keep,$kf or die "$0: cannot create symlink $kf - $!\n";
 544   exit;
 545 }
 546
 547 # quota
 548 if ($opt_q) {
 549   $user = lc $opt_q;
 550   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 551   unless (-d "$spooldir/$user") {
 552     die "$0: $user is not a FEX user\n";
 553   }
 554   quota($user,@ARGV);
 555   exit;
 556 }
 557
 558 if ($opt_C) {
 559   $user = lc $opt_C;
 560   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 561   unless (-f "$spooldir/$user/@") {
 562     die "$0: $user is not a regular FEX user\n";
 563   }
 564   $_ = shift @ARGV || '';
 565   if (/^y/i) {
 566     open $user,">>$spooldir/$user/\@CAPTIVE";
 567     close $user;
 568     print "$user is now captive\n";
 569   } elsif (/^n/i) {
 570     unlink "$spooldir/$user/\@CAPTIVE";
 571     print "$user is no more captive\n";
 572   } else {
 573     die "usage: $0 -C user yes\n".
 574         "usage: $0 -C user no\n".
 575         "example: $0 -C framstag\@rus.uni-stuttgart.de no\n";
 576   }
 577   exit;
 578 }
 579
 580 # FEXYOURSELF = user can only fex to himself via web interface
 581 if ($opt_y) {
 582   $user = lc $opt_y;
 583   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 584   unless (-f "$spooldir/$user/@") {
 585     die "$0: $user is not a regular FEX user\n";
 586   }
 587   $_ = shift @ARGV || '';
 588   if (/^y/i) {
 589     open $user,">>$spooldir/$user/\@FEXYOURSELF";
 590     close $user;
 591     print "$user has now \"fex yourself\" web default\n";
 592   } elsif (/^n/i) {
 593     unlink "$spooldir/$user/\@FEXYOURSELF";
 594     print "$user has no \"fex yourself\" web default\n";
 595   } else {
 596     die "usage: $0 -y user yes\n".
 597         "usage: $0 -y user no\n".
 598         "example: $0 -y framstag\@rus.uni-stuttgart.de no\n";
 599   }
 600   exit;
 601 }
 602
 603 if ($opt_D) {
 604   $user = lc $opt_D;
 605   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 606   $_ = $ARGV[0] || '';
 607   if (/^no?$/i) {
 608     unlink "$spooldir/$user/\@DISABLED";
 609     print "$user is now enabled\n";
 610   } else {
 611     open $user,">>$spooldir/$user/\@DISABLED";
 612     print {$user} "@ARGV\n";
 613     close $user;
 614     print "$user is now disabled\n";
 615   }
 616   exit;
 617 }
 618
 619 if ($opt_P) {
 620   $user = lc $opt_P;
 621   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 622   $_ = shift @ARGV || '';
 623   if (/^y/i) {
 624     open $user,">>$spooldir/$user/\@PERSISTENT";
 625     close $user;
 626     print "$user is now persistent\n";
 627   } elsif (/^n/i) {
 628     unlink "$spooldir/$user/\@PERSISTENT";
 629     print "$user is no more persistent\n";
 630   } else {
 631     die "usage: $0 -P user yes\n".
 632         "usage: $0 -P user no\n".
 633         "example: $0 -P framstag\@rus.uni-stuttgart.de yes\n";
 634   }
 635   exit;
 636 }
 637
 638 if ($opt_S eq 'fup') {
 639   &fupstat;
 640   exit;
 641 }
 642
 643 if ($opt_S eq 'fop') {
 644   &fopstat;
 645   exit;
 646 }
 647
 648 usage(3);
 649
 650 sub showuser {
 651   my $user = shift;
 652   my $id = shift;
 653   my ($keep,$autodelete,$notification,$login);
 654
 655   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 656
 657   print "[using config $FEXLIB/fex.ph]\n";
 658   print "$fup?from=$user&id=$id\n";
 659   printf "%s/%s\n",$fup,b64("from=$user&id=$id");
 660   # printf "%s/%s\n",$fup,b64("from=$user&to=$user&id=$id&submit=.");
 661   print "spool: $spooldir/$user/\n";
 662   if ($login_check and $login = readlink "$user/.login") {
 663     my $lc = &$login_check($login);
 664     if ($lc) {
 665       print "login: $login\n";
 666     } else {
 667       print "login: DELETED\n";
 668     }
 669   }
 670   my $disabled = 'no';
 671   if (-e "$spooldir/$user/\@DISABLED") {
 672     $disabled = slurp("$spooldir/$user/\@DISABLED");
 673     chomp $disabled;
 674     $disabled ||= 'yes';
 675   }
 676   printf "fex yourself web default: %s\n",
 677          -e "$spooldir/$user/\@FEXYOURSELF" ? 'yes' : 'no';
 678   printf "persistent: %s\n",
 679          -e "$spooldir/$user/\@PERSISTENT" ? 'yes' : 'no';
 680   printf "captive: %s\n",
 681          -e "$spooldir/$user/\@CAPTIVE" ? 'yes' : 'no';
 682   printf "disabled: %s\n",$disabled;
 683   printf "recipients restrictions: %s\n",
 684          -e "$spooldir/$user/\@ALLOWED_RECIPIENTS" ? 'yes' : 'no';
 685   printf "upload restrictions: %s\n",
 686          -e "$spooldir/$user/\@UPLOAD_HOSTS" ? 'yes' : 'no';
 687   printf "download restrictions: %s\n",
 688          -e "$spooldir/$user/\@DOWNLOAD_HOSTS" ? 'yes' : 'no';
 689   $autodelete = lc(readlink "$spooldir/$user/\@AUTODELETE" || $::autodelete);
 690   print "autodelete default: $autodelete\n";
 691   $notification = lc(readlink "$spooldir/$user/\@NOTIFICATION" || $::notification);
 692   print "notification default: $notification\n";
 693   $keep = readlink "$spooldir/$user/\@KEEP" || $keep_default;
 694   print "keep default: $keep\n";
 695   quota($user);
 696   printf "account creation: %s\n",slurp("$spooldir/$user/.auto")||'manual';
 697 }
 698
 699 # set or show disk quota
 700 sub quota {
 701   my $user = shift;
 702   my $rquota = '';
 703   my $squota = '';
 704   my $qf = "$spooldir/$user/\@QUOTA";
 705   local $_;
 706
 707   if (open $qf,$qf) {
 708     while (<$qf>) {
 709       s/#.*//;
 710       $rquota = $1 if /recipient.*?(\d+)/i;
 711       $squota = $1 if /sender.*?(\d+)/i;
 712     }
 713     close $qf;
 714   }
 715
 716   if (@_) {
 717     for (@_) {
 718       $rquota = $1 if /^r.*:(\d*)/i;
 719       $squota = $1 if /^s.*:(\d*)/i;
 720     }
 721     open $qf,'>',$qf or die "$0: cannot write $qf - $!\n";
 722     print {$qf} "recipient:$rquota\n" if $rquota;
 723     print {$qf} "sender:$squota\n"    if $squota;
 724     close $qf;
 725   }
 726
 727   printf "recpient quota (used): %d (%d) MB\n",check_recipient_quota($user);
 728   printf "sender quota (used): %d (%d) MB\n",check_sender_quota($user);
 729 }
 730
 731
 732 sub fupstat {
 733   my (%user,%domain,%du);
 734   my ($log,$u,$d,$z);
 735   my $Z = 0;
 736
 737   if (-t) { $log = "$logdir/fup.log" }
 738   else    { $log = '>&=STDIN' }
 739   open $log,$log or die "$0: cannot open $log - $!\n";
 740
 741   while (<$log>) {
 742     if (/^([\d: -]+) (\[[\d_]+\] )?(\w\S*) .* (\d+)$/) {
 743       $z = $4;
 744       $u = $3;
 745       $u .= '@'.$mdomain if $mdomain and $u !~ /@/;
 746       $user{$u} += $z;
 747       $d = $u;
 748       $d =~ s/.*@//;
 749       $d =~ s/.*\.(.+\.\w+)/$1/;
 750       $domain{$d} += $z;
 751       $du{$d}{$u}++;
 752       $Z += $z;
 753     }
 754   }
 755
 756   foreach $u (sort {$user{$a} <=> $user{$b}} keys %user) {
 757     printf "%s : %d\n",$u,$user{$u}/M;
 758   }
 759   print "========================================================\n";
 760   foreach $d (sort {$domain{$a} <=> $domain{$b}} keys %domain) {
 761     printf "%s : %d MB, %d user\n",$d,$domain{$d}/M,scalar(keys %{$du{$d}});
 762   }
 763   printf "Total: %d GB\n",$Z/M/1024;
 764
 765   exit;
 766 }
 767
 768
 769 sub fopstat {
 770   my $Z = 0;
 771   my ($log,$u,$d,$z);
 772   my (%user,%domain,%du);
 773
 774   if (-t) { $log = "$logdir/fop.log" }
 775   else    { $log = '>&=STDIN' }
 776   open $log,$log or die "$0: cannot open $log - $!\n";
 777
 778   while (<$log>) {
 779     if (/^([\d: -]+) (\[[\d_]+\] )?[\d.]+ (.+?)\/.* (\d+)\/\d+/) {
 780       $z = $4;
 781       $u = $3;
 782       $u .= '@'.$mdomain if $mdomain and $u !~ /@/;
 783       $user{$u} += $z;
 784       $d = $u;
 785       $d =~ s/.*@//;
 786       $d =~ s/.*\.(.+\.\w+)/$1/;
 787       $domain{$d} += $z;
 788       $du{$d}{$u}++;
 789       $Z += $z;
 790     }
 791   }
 792
 793   foreach $u (sort {$user{$a} <=> $user{$b}} keys %user) {
 794     printf "%s : %d\n",$u,$user{$u}/M;
 795   }
 796   print "========================================================\n";
 797   foreach $d (sort {$domain{$a} <=> $domain{$b}} keys %domain) {
 798     printf "%s : %d MB, %d user\n",$d,$domain{$d}/M,scalar(keys %{$du{$d}});
 799   }
 800   printf "Total: %d GB\n",$Z/M/1024;
 801
 802   exit;
 803 }
 804
 805
 806 sub cpa {
 807   my $dd = pop @_;
 808
 809   die "(cpa): $dd is not a directory" unless -d $dd;
 810   system "rsync -a @_ $dd/" ;
 811 }
 812
 813
 814 sub check_admin {
 815
 816   my $admin_id = slurp("$spooldir/$admin/@") or
 817     die "$0: no admin account - you have to create it with:\n".
 818         "$0 -/ $admin ".randstring(8)."\n";
 819
 820   chomp $admin_id;
 821
 822   my $fid = "$ENV{HOME}/.fex/id";
 823   if (open $fid,$fid) {
 824     $_ = <$fid>;
 825     chomp($_ = <$fid>||'');
 826     if ($_ ne $admin) {
 827       warn "WARNING: user $admin not in $fid\n";
 828       $mismatch++;
 829     }
 830     chomp($_ = <$fid>||'');
 831     if ($_ ne $admin_id) {
 832       warn "WARNING: $admin auth-ID mismatch in $fid\n";
 833       $mismatch++;
 834     }
 835     close $fid;
 836     if ($mismatch) {
 837       warn "$0: moving $fid to ${fid}_save\n";
 838       rename $fid,$fid.'_save';
 839     }
 840   }
 841   unless (-f $fid) {
 842     mkdir dirname($fid);
 843     open $fid,'>',$fid or die "$0: cannot create $fid - $!\n";
 844     if ($durl =~ m{(https?://.+?)/}) {
 845       print {$fid} "$1\n";
 846     } else {
 847       print {$fid} "$hostname\n";
 848     }
 849     print {$fid} "$admin\n";
 850     print {$fid} "$admin_id\n";
 851     close $fid;
 852     warn "$0: new $fid created\n";
 853   }
 854 }
 855
 856
 857 sub d3 {
 858   local $_ = shift;
 859   while (s/(\d)(\d\d\d\b)/$1,$2/) {};
 860   return $_;
 861 }
 862
 863
 864 sub usage {
 865   my $port = '';
 866   my $proto = 'http';
 867
 868   if ($durl =~ /:(\d+)/)    { $port = ":$1" }
 869   if ($durl =~ /^(https?)/) { $proto = $1 }
 870
 871   $0 =~ s:.*/::;
 872   print <<EOD;
 873 Usages:
 874 $0 -u                 # list full users
 875 $0 -u user            # show user config
 876 $0 -u user auth-ID    # create new user or set new auth-ID
 877 $0 -/ admin auth-ID   # set new admin and auth-ID
 878 $0 -q user s:quota    # set new disk quota (MB) for sender user
 879 $0 -q user r:quota    # set new disk quota (MB) for recipient user
 880 $0 -Ri user           # restrict user: only internal domain recipients allowed
 881 $0 -Rl user           # restrict user: only local users as recipients allowed
 882 $0 -rr user           # edit user recipients restriction
 883 $0 -ru user           # edit user upload restriction
 884 $0 -rd user           # edit user download restriction
 885 $0 -d user            # delete user
 886 $0 -D user "reason"   # disable user
 887 $0 -D user "no"       # re-enable user
 888 $0 -P user [yn]       # make user persistent = no account expiration (yes,no)
 889 $0 -a user [ynd]      # set user autodelete default (yes,no,delay)
 890 $0 -n user [dbn]      # set user notification default (detailed,brief,no)
 891 $0 -k user days       # set user keep default in days
 892 $0 -C user [yn]       # set user captive (yes,no)
 893 $0 -y user [yn]       # set user "fex yourself" web default (yes,no)
 894 $0 -S fup             # file upload statistics
 895 $0 -S fop             # file download statistics
 896 $0 -v                 # show server config
 897 $0 -c                 # edit server config
 898 $0 -w                 # watch fexsrv.log (continously)
 899 $0 -l                 # list pending files with download URLs
 900 $0 -L [filter]        # list pending files in detail
 901 $0 -M                 # list pending files with TO/FROM/FILE
 902 $0 -M TO/FROM/FILE    # resend notification email
 903 $0 -m "reason"        # enter maintenance mode (reason "exit" to leave)
 904 $0 -E                 # show usage examples
 905 EOD
 906 # $0 -A alias:hostname  # add new virtual server
 907 # $0 -V virtualhost ... # operations on virtualhost (alias or hostname)
 908   if (-x "$FEXHOME/cgi-bin/fac") {
 909     print "See also web admin interface $proto://$hostname$port/fac\n";
 910   }
 911   exit shift;
 912 }
 913
 914 sub examples {
 915   $0 =~ s:.*/::;
 916   print <<EOD;
 917 create new user:
 918 $0 -u framstag\@rus.uni-stuttgart.de schwubbeldidu
 919
 920 set 10 GB sender quota for this user:
 921 $0 -q framstag\@rus.uni-stuttgart.de s:10240
 922
 923 set file expiration to 30 days for this user:
 924 $0 -k framstag\@rus.uni-stuttgart.de 30
 925
 926 disable account expiration for this user:
 927 $0 -P framstag\@rus.uni-stuttgart.de y
 928
 929 list spooled files and resend notification email for this file:
 930 $0 -M | grep frams
 931 $0 -M framstag\@rus.uni-stuttgart.de/hoppel\@flupp.org/jump.avi
 932 EOD
 933   exit;
 934 }