]> git.treefish.org Git - fex.git/blob - bin/fac
1458ef8ce64afc14b6d4bf46a77e3af2fd22116d
[fex.git] / 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 = $opt_R = 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 = '';
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('hcvlLwuMRE/q:r:d:a:n:k:m:y:S:C:A:V:D:P:') 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   $user = shift or die "usage: $0 -R user\n";
264   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
265   die "$0: no user $user\n" unless -d "$spooldir/$user";
266   unless (@local_rdomains) {
267     die "$0: no \@local_rdomains in server config\n";
268   }
269   my $rf = "$spooldir/$user/\@ALLOWED_RECIPIENTS";
270   open $rf,'>',$rf or die "$0: cannot open $rf - $!";
271   print {$rf} "\@LOCAL_RDOMAINS\n";
272   close $rf;
273   print "$user restricted\n";
274   exit;
275 }
276
277 # edit user restriction file
278 if ($opt_r) {
279   if    ($opt_r =~ /^r/i) { $opt_r = 'ALLOWED_RECIPIENTS' }
280   elsif ($opt_r =~ /^u/i) { $opt_r = 'UPLOAD_HOSTS' }
281   elsif ($opt_r =~ /^d/i) { $opt_r = 'DOWNLOAD_HOSTS' }
282   else                    { usage(2) }
283   $user = shift or usage(2);
284   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
285   die "$0: no user $user\n" unless -d "$spooldir/$user";
286   my $rf = "$spooldir/$user/\@$opt_r";
287   unless (-s $rf) {
288     open $rf,'>',$rf or die "$0: cannot open $rf - $!";
289     if ($opt_r eq 'ALLOWED_RECIPIENTS') {
290       print {$rf}<<EOD;
291 # Restrict allowed recipients. Only listed addresses are allowed as recipients.
292 # Make this file COMPLETLY empty if you want to disable the restriction.
293 # An allowed recipient is an e-mail address. You can use * as wildcard.
294 # Examples:
295 #    framstag\@rus.uni-stuttgart.de
296 #    *\@flupp.org
297 EOD
298     } elsif ($opt_r eq 'UPLOAD_HOSTS') {
299       print {$rf}<<EOD;
300 # Restrict allowed upload hosts.
301 # Only listed addresses are allowed as upload hosts.
302 # Make this file COMPLETLY empty if you want to disable the restriction.
303 # You can add single ip adresses or ip ranges.
304 # Examples:
305 #    129.69.1.11
306 #    10.0.10.0-10.0.10.255
307 EOD
308     } elsif ($opt_r eq 'DOWNLOAD_HOSTS') {
309       print {$rf}<<EOD;
310 # Restrict allowed download hosts.
311 # Only listed addresses are allowed as download hosts.
312 # Make this file COMPLETLY empty if you want to disable the restriction.
313 # You can add single ip adresses or ip ranges.
314 # Examples:
315 #    129.69.1.11
316 #    10.0.10.0-10.0.10.255
317 EOD
318     } else {
319       die "$0: unknown option -r $opt_r\n";
320     }
321     close $rf;
322   }
323   system $EDITOR,$rf;
324   unlink $rf if -s $rf<5;
325   exit;
326 }
327
328 # edit configuration
329 if ($opt_c) {
330   exec $EDITOR,"$FEXLIB/fex.ph";
331 }
332
333 # add virtual server
334 if ($opt_A) {
335   if ($opt_A =~ /(.+):(.+)/) {
336     $vhost = $1;
337     $hhost = $2;
338   } else {
339     die "usage: $0 -A alias:hostname\n".
340         "example: $0 -A flupp:fex.flupp.org\n";
341   }
342   if ($FHS) {
343     $vhd = "/var/lib/fex/vhosts/$vhost";
344     mkdir $vhd or die "$0: cannot mkdir $vhd - $!\n";
345     mkdir   "/etc/fex/vhosts/$vhost";
346     symlink "/etc/fex/vhosts/$vhost", "$vhd/lib";
347     mkdir   "$spooldir/vhosts/$vhost";
348     symlink "$spooldir/vhosts/$vhost","$vhd/spool";
349   } else {
350     $vhd = "$FEXHOME/$vhost";
351     mkdir $vhd or die "$0: cannot mkdir $vhd - $!\n";
352     mkdir "$vhd/lib";
353     mkdir "$vhd/spool";
354   }
355
356   mkdir "$vhd/htdocs";
357   mkdir "$vhd/htdocs/locale";
358   $_ = slurp("$FEXLIB/fex.ph");
359   s/\$hostname\s*=.*/\$hostname = '$hhost';/ or s/^/\$hostname = '$hhost';\n/;
360   $fph = "$vhd/lib/fex.ph";
361   open $fph,">$fph" or die "$0: cannot write to $fph - $!\n";
362   print {$fph} $_;
363   close $fph;
364   cpa("$FEXLIB/fup.pl","$vhd/lib");
365   foreach $i (qw'dop fex.pp fup.pl lf.pl reactivation.txt') {
366     # symlink "$FEXLIB/$i","$vhd/lib/$i";
367     symlink "../../lib/$i","$vhd/lib/$i";
368   }
369   foreach $i (qw(
370     index.html tools.html SEX.html robots.txt
371     logo.jpg small_logo.jpg action-fex-camel.gif favicon.ico
372     FAQ
373   )) {
374     cpa("$docdir/$i","$vhd/htdocs");
375   }
376   symlink "$docdir/version","../../htdocs/version";
377   symlink "$docdir/download","../../htdocs/download";
378   cpa("$FEXHOME/locale",$vhd);
379   foreach $ld (glob "$vhd/locale/*") {
380     if (not -l $ld and -d "$ld/cgi-bin") {
381       $locale = basename($ld);
382       rmrf("$ld/cgi-bin");
383       # symlink "../../../locale/$locale/cgi-bin","$ld/cgi-bin";
384       symlink "../../../locale/$locale/htdocs","$vhd/htdocs/locale/$locale";
385       unlink "$ld/lib/fex.ph";
386       symlink "../../../lib/fex.ph","$ld/lib/fex.ph";
387       symlink "../../../../locale/$locale/lib","$ld/lib/master";
388       foreach $f (qw'dop fex.pp lf.pl reactivation.txt') {
389         unlink "$ld/lib/$f";
390         symlink "master/$f","$ld/lib/$f";
391       }
392     }
393   }
394   $fph = "$FEXLIB/fex.ph";
395   open $fph,">>$fph" or die "$0: cannot write to $fph = $!\n";
396   print {$fph} "\n\$vhost{'$hhost'} = '$vhd';\n";
397   close $fph;
398   print "You must now edit and configure $vhd/lib/fex.ph\n";
399   print "or execute: $0 -V $vhost -c\n";
400   exit;
401 }
402
403 # show config
404 if ($opt_v and not @ARGV) {
405   print  "config from $FEXLIB/fex.ph :\n";
406   print  "  spooldir        = $spooldir\n";
407   print  "  logdir          = @logdir\n";
408   print  "  docdir          = $docdir\n";
409   print  "  durl            = @durl\n";
410   print  "  admin           = $admin\n";
411   print  "  mdomain         = $mdomain\n";
412   print  "  mailmode        = $mailmode\n";
413   print  "  autodelete      = $autodelete\n";
414   print  "  keep_default    = $keep_default\n";
415   printf "  keep_max        = %s\n",$keep_max||'unlimited';
416   printf "  recipient_quota = %d GB\n",int($recipient_quota/1024);
417   printf "  sender_quota    = %d GB\n",int($sender_quota/1024);
418   while (($hh,$vh) = each %vhost) {
419     printf "  virtual server %s : %s\n",basename($vh),$hh;
420   }
421 #  unless (@ARGV) {
422 #    foreach $ph (glob "$ENV{HOME}/*/lib/fex.ph") {
423 #      $ENV{FEXLIB} = dirname($ph);
424 #      print "\n";
425 #      system $0,'-v',$ph;
426 #    }
427 #  }
428   if ($m = readlink '@MAINTENANCE') {
429     print "server is in maintenance mode ($m)!\n" ;
430   }
431   exit;
432 }
433
434 # add user or show user config
435 if ($opt_u) {
436   chdir $spooldir or die "$0: cannot chdir $spooldir = $!\n";
437   if ($opt_u = shift @ARGV) {
438     $user = lc $opt_u;
439     $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
440     $id = shift @ARGV;
441     $idf = "$user/@";
442     if (open $idf,$idf) {
443       chomp($ido = <$idf>||'');
444       close $idf;
445     }
446     unless ($id) {
447       die "$0: $user is not a regular FEX user\n" unless -f "$user/@";
448       showuser($user,$ido);
449       exit;
450     }
451     unless ($user =~ /\w@[\w.-]+\.[a-z]+$/) {
452       die "$0: $user is not a valid email-address!\n";
453     }
454     unless (-d $user) {
455       mkdir $user,0755
456         or die "$0: cannot mkdir $user - $!\n";
457     }
458     open F,">$idf" or die "$0: cannot write $idf - $!\n";
459     print F $id,"\n";
460     close F or die "$0: cannot write $idf - $!\n";
461     showuser($user,$id);
462   } else {
463     print "Users in $spooldir:\n";
464     foreach $user (glob "*/@") {
465       $user =~ s:.*/(.+)/@:$1:;
466       print "$user\n";
467     }
468   }
469   exit;
470 }
471
472 # set user autodelete default
473 if ($opt_a) {
474   $user = lc $opt_a;
475   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
476   $_ = shift @ARGV || '';
477   if    (/^n/i) { $autodelete = 'no' }
478   elsif (/^y/i) { $autodelete = 'yes' }
479   elsif (/^d/i) { $autodelete = 'delay' }
480   else {
481     die "usage: $0 -a user yes\n".
482         "usage: $0 -a user no\n".
483         "usage: $0 -a user delay\n".
484         "example: $0 -a framstag\@rus.uni-stuttgart.de no\n";
485   }
486   mkdir "$spooldir/$user",0755;
487   my $adf = "$spooldir/$user/\@AUTODELETE";
488   unlink $adf;
489   symlink $autodelete,$adf or die "$0: cannot create symlink $adf - $!\n";
490   exit;
491 }
492
493 # set user notification default
494 if ($opt_n) {
495   $user = lc $opt_n;
496   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
497   $_ = shift @ARGV || '';
498   if    (/^n/i)    { $notification = 'no' }
499   elsif (/^[sb]/i) { $notification = 'short' }
500   elsif (/^[fd]/i) { $notification = '' }
501   else {
502     die "usage: $0 -n user no\n".
503         "usage: $0 -n user brief\n".
504         "usage: $0 -n user detailed\n".
505         "example: $0 -n framstag\@rus.uni-stuttgart.de brief\n";
506   }
507   mkdir "$spooldir/$user",0755;
508   my $ndf = "$spooldir/$user/\@NOTIFICATION";
509   unlink $ndf;
510   if ($notification) {
511     symlink $notification,$ndf or die "$0: cannot create symlink $ndf - $!\n";
512   }
513   exit;
514 }
515
516 # set user keep default
517 if ($opt_k) {
518   $user = lc $opt_k;
519   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
520   my $keep = shift @ARGV || '';
521   if ($keep !~ /^\d+$/) {
522     die "usage: $0 -k user keep_days\n".
523         "example: $0 -k framstag\@rus.uni-stuttgart.de 30\n";
524   }
525   mkdir "$spooldir/$user",0755;
526   my $kf = "$spooldir/$user/\@KEEP";
527   unlink $kf;
528   symlink $keep,$kf or die "$0: cannot create symlink $kf - $!\n";
529   exit;
530 }
531
532 # quota
533 if ($opt_q) {
534   $user = lc $opt_q;
535   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
536   unless (-d "$spooldir/$user") {
537     die "$0: $user is not a FEX user\n";
538   }
539   quota($user,@ARGV);
540   exit;
541 }
542
543 if ($opt_C) {
544   $user = lc $opt_C;
545   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
546   unless (-f "$spooldir/$user/@") {
547     die "$0: $user is not a regular FEX user\n";
548   }
549   $_ = shift @ARGV || '';
550   if (/^y/i) {
551     open $user,">>$spooldir/$user/\@CAPTIVE";
552     close $user;
553     print "$user is now captive\n";
554   } elsif (/^n/i) {
555     unlink "$spooldir/$user/\@CAPTIVE";
556     print "$user is no more captive\n";
557   } else {
558     die "usage: $0 -C user yes\n".
559         "usage: $0 -C user no\n".
560         "example: $0 -C framstag\@rus.uni-stuttgart.de no\n";
561   }
562   exit;
563 }
564
565 # FEXYOURSELF = user can only fex to himself via web interface
566 if ($opt_y) {
567   $user = lc $opt_y;
568   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
569   unless (-f "$spooldir/$user/@") {
570     die "$0: $user is not a regular FEX user\n";
571   }
572   $_ = shift @ARGV || '';
573   if (/^y/i) {
574     open $user,">>$spooldir/$user/\@FEXYOURSELF";
575     close $user;
576     print "$user has now \"fex yourself\" web default\n";
577   } elsif (/^n/i) {
578     unlink "$spooldir/$user/\@FEXYOURSELF";
579     print "$user has no \"fex yourself\" web default\n";
580   } else {
581     die "usage: $0 -y user yes\n".
582         "usage: $0 -y user no\n".
583         "example: $0 -y framstag\@rus.uni-stuttgart.de no\n";
584   }
585   exit;
586 }
587
588 if ($opt_D) {
589   $user = lc $opt_D;
590   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
591   $_ = $ARGV[0] || '';
592   if (/^no?$/i) {
593     unlink "$spooldir/$user/\@DISABLED";
594     print "$user is now enabled\n";
595   } else {
596     open $user,">>$spooldir/$user/\@DISABLED";
597     print {$user} "@ARGV\n";
598     close $user;
599     print "$user is now disabled\n";
600   }
601   exit;
602 }
603
604 if ($opt_P) {
605   $user = lc $opt_P;
606   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
607   $_ = shift @ARGV || '';
608   if (/^y/i) {
609     open $user,">>$spooldir/$user/\@PERSISTENT";
610     close $user;
611     print "$user is now persistent\n";
612   } elsif (/^n/i) {
613     unlink "$spooldir/$user/\@PERSISTENT";
614     print "$user is no more persistent\n";
615   } else {
616     die "usage: $0 -P user yes\n".
617         "usage: $0 -P user no\n".
618         "example: $0 -P framstag\@rus.uni-stuttgart.de yes\n";
619   }
620   exit;
621 }
622
623 if ($opt_S eq 'fup') {
624   &fupstat;
625   exit;
626 }
627
628 if ($opt_S eq 'fop') {
629   &fopstat;
630   exit;
631 }
632
633 usage(3);
634
635 sub showuser {
636   my $user = shift;
637   my $id = shift;
638   my ($keep,$autodelete,$notification,$login);
639
640   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
641
642   print "[using config $FEXLIB/fex.ph]\n";
643   print "$fup?from=$user&id=$id\n";
644   printf "%s/%s\n",$fup,b64("from=$user&id=$id");
645   # printf "%s/%s\n",$fup,b64("from=$user&to=$user&id=$id&submit=.");
646   print "spool: $spooldir/$user/\n";
647   if ($login_check and $login = readlink "$user/.login") {
648     my $lc = &$login_check($login);
649     if ($lc) {
650       print "login: $login\n";
651     } else {
652       print "login: DELETED\n";
653     }
654   }
655   my $disabled = 'no';
656   if (-e "$spooldir/$user/\@DISABLED") {
657     $disabled = slurp("$spooldir/$user/\@DISABLED");
658     chomp $disabled;
659     $disabled ||= 'yes';
660   }
661   printf "fex yourself web default: %s\n",
662          -e "$spooldir/$user/\@FEXYOURSELF" ? 'yes' : 'no';
663   printf "persistent: %s\n",
664          -e "$spooldir/$user/\@PERSISTENT" ? 'yes' : 'no';
665   printf "captive: %s\n",
666          -e "$spooldir/$user/\@CAPTIVE" ? 'yes' : 'no';
667   printf "disabled: %s\n",$disabled;
668   printf "recipients restrictions: %s\n",
669          -e "$spooldir/$user/\@ALLOWED_RECIPIENTS" ? 'yes' : 'no';
670   printf "upload restrictions: %s\n",
671          -e "$spooldir/$user/\@UPLOAD_HOSTS" ? 'yes' : 'no';
672   printf "download restrictions: %s\n",
673          -e "$spooldir/$user/\@DOWNLOAD_HOSTS" ? 'yes' : 'no';
674   $autodelete = lc(readlink "$spooldir/$user/\@AUTODELETE" || $::autodelete);
675   print "autodelete default: $autodelete\n";
676   $notification = lc(readlink "$spooldir/$user/\@NOTIFICATION" || $::notification);
677   print "notification default: $notification\n";
678   $keep = readlink "$spooldir/$user/\@KEEP" || $keep_default;
679   print "keep default: $keep\n";
680   quota($user);
681   printf "account creation: %s\n",slurp("$spooldir/$user/.auto")||'manual';
682 }
683
684 # set or show disk quota
685 sub quota {
686   my $user = shift;
687   my $rquota = '';
688   my $squota = '';
689   my $qf = "$spooldir/$user/\@QUOTA";
690   local $_;
691
692   if (open $qf,$qf) {
693     while (<$qf>) {
694       s/#.*//;
695       $rquota = $1 if /recipient.*?(\d+)/i;
696       $squota = $1 if /sender.*?(\d+)/i;
697     }
698     close $qf;
699   }
700
701   if (@_) {
702     for (@_) {
703       $rquota = $1 if /^r.*:(\d*)/i;
704       $squota = $1 if /^s.*:(\d*)/i;
705     }
706     open $qf,'>',$qf or die "$0: cannot write $qf - $!\n";
707     print {$qf} "recipient:$rquota\n" if $rquota;
708     print {$qf} "sender:$squota\n"    if $squota;
709     close $qf;
710   }
711
712   printf "recpient quota (used): %d (%d) MB\n",check_recipient_quota($user);
713   printf "sender quota (used): %d (%d) MB\n",check_sender_quota($user);
714 }
715
716
717 sub fupstat {
718   my (%user,%domain,%du);
719   my ($log,$u,$d,$z);
720   my $Z = 0;
721
722   if (-t) { $log = "$logdir/fup.log" }
723   else    { $log = '>&=STDIN' }
724   open $log,$log or die "$0: cannot open $log - $!\n";
725
726   while (<$log>) {
727     if (/^([\d: -]+) (\[[\d_]+\] )?(\w\S*) .* (\d+)$/) {
728       $z = $4;
729       $u = $3;
730       $u .= '@'.$mdomain if $mdomain and $u !~ /@/;
731       $user{$u} += $z;
732       $d = $u;
733       $d =~ s/.*@//;
734       $d =~ s/.*\.(.+\.\w+)/$1/;
735       $domain{$d} += $z;
736       $du{$d}{$u}++;
737       $Z += $z;
738     }
739   }
740
741   foreach $u (sort {$user{$a} <=> $user{$b}} keys %user) {
742     printf "%s : %d\n",$u,$user{$u}/M;
743   }
744   print "========================================================\n";
745   foreach $d (sort {$domain{$a} <=> $domain{$b}} keys %domain) {
746     printf "%s : %d MB, %d user\n",$d,$domain{$d}/M,scalar(keys %{$du{$d}});
747   }
748   printf "Total: %d GB\n",$Z/M/1024;
749
750   exit;
751 }
752
753
754 sub fopstat {
755   my $Z = 0;
756   my ($log,$u,$d,$z);
757   my (%user,%domain,%du);
758
759   if (-t) { $log = "$logdir/fop.log" }
760   else    { $log = '>&=STDIN' }
761   open $log,$log or die "$0: cannot open $log - $!\n";
762
763   while (<$log>) {
764     if (/^([\d: -]+) (\[[\d_]+\] )?[\d.]+ (.+?)\/.* (\d+)\/\d+/) {
765       $z = $4;
766       $u = $3;
767       $u .= '@'.$mdomain if $mdomain and $u !~ /@/;
768       $user{$u} += $z;
769       $d = $u;
770       $d =~ s/.*@//;
771       $d =~ s/.*\.(.+\.\w+)/$1/;
772       $domain{$d} += $z;
773       $du{$d}{$u}++;
774       $Z += $z;
775     }
776   }
777
778   foreach $u (sort {$user{$a} <=> $user{$b}} keys %user) {
779     printf "%s : %d\n",$u,$user{$u}/M;
780   }
781   print "========================================================\n";
782   foreach $d (sort {$domain{$a} <=> $domain{$b}} keys %domain) {
783     printf "%s : %d MB, %d user\n",$d,$domain{$d}/M,scalar(keys %{$du{$d}});
784   }
785   printf "Total: %d GB\n",$Z/M/1024;
786
787   exit;
788 }
789
790
791 sub cpa {
792   my $dd = pop @_;
793
794   die "(cpa): $dd is not a directory" unless -d $dd;
795   system "rsync -a @_ $dd/" ;
796 }
797
798
799 sub check_admin {
800
801   my $admin_id = slurp("$spooldir/$admin/@") or
802     die "$0: no admin account - you have to create it with:\n".
803         "$0 -/ $admin ".randstring(8)."\n";
804
805   chomp $admin_id;
806
807   my $fid = "$ENV{HOME}/.fex/id";
808   if (open $fid,$fid) {
809     $_ = <$fid>;
810     chomp($_ = <$fid>||'');
811     if ($_ ne $admin) {
812       warn "WARNING: user $admin not in $fid\n";
813       $mismatch++;
814     }
815     chomp($_ = <$fid>||'');
816     if ($_ ne $admin_id) {
817       warn "WARNING: $admin auth-ID mismatch in $fid\n";
818       $mismatch++;
819     }
820     close $fid;
821     if ($mismatch) {
822       warn "$0: moving $fid to ${fid}_save\n";
823       rename $fid,$fid.'_save';
824     }
825   }
826   unless (-f $fid) {
827     mkdir dirname($fid);
828     open $fid,'>',$fid or die "$0: cannot create $fid - $!\n";
829     if ($durl =~ m{(https?://.+?)/}) {
830       print {$fid} "$1\n";
831     } else {
832       print {$fid} "$hostname\n";
833     }
834     print {$fid} "$admin\n";
835     print {$fid} "$admin_id\n";
836     close $fid;
837     warn "$0: new $fid created\n";
838   }
839 }
840
841
842 sub d3 {
843   local $_ = shift;
844   while (s/(\d)(\d\d\d\b)/$1,$2/) {};
845   return $_;
846 }
847
848
849 sub usage {
850   my $port = '';
851   my $proto = 'http';
852
853   if ($durl =~ /:(\d+)/)    { $port = ":$1" }
854   if ($durl =~ /^(https?)/) { $proto = $1 }
855
856   $0 =~ s:.*/::;
857   print <<EOD;
858 Usages:
859 $0 -u                 # list full users
860 $0 -u user            # show user config
861 $0 -u user auth-ID    # create new user or set new auth-ID
862 $0 -/ admin auth-ID   # set new admin and auth-ID
863 $0 -q user s:quota    # set new disk quota (MB) for sender user
864 $0 -q user r:quota    # set new disk quota (MB) for recipient user
865 $0 -R user            # restrict user: only internal recipients allowed
866 $0 -rr user           # edit user recipients restriction
867 $0 -ru user           # edit user upload restriction
868 $0 -rd user           # edit user download restriction
869 $0 -d user            # delete user
870 $0 -D user "reason"   # disable user
871 $0 -D user "no"       # re-enable user
872 $0 -P user [yn]       # make user persistent = no account expiration (yes,no)
873 $0 -a user [ynd]      # set user autodelete default (yes,no,delay)
874 $0 -n user [dbn]      # set user notification default (detailed,brief,no)
875 $0 -k user days       # set user keep default in days
876 $0 -C user [yn]       # set user captive (yes,no)
877 $0 -y user [yn]       # set user "fex yourself" web default (yes,no)
878 $0 -S fup             # file upload statistics
879 $0 -S fop             # file download statistics
880 $0 -v                 # show server config
881 $0 -c                 # edit server config
882 $0 -w                 # watch fexsrv.log (continously)
883 $0 -l                 # list pending files with download URLs
884 $0 -L [filter]        # list pending files in detail
885 $0 -M                 # list pending files with TO/FROM/FILE
886 $0 -M TO/FROM/FILE    # resend notification email
887 $0 -m "reason"        # enter maintenance mode (reason "exit" to leave)
888 $0 -E                 # show usage examples
889 EOD
890 # $0 -A alias:hostname  # add new virtual server
891 # $0 -V virtualhost ... # operations on virtualhost (alias or hostname)
892   if (-x "$FEXHOME/cgi-bin/fac") {
893     print "See also web admin interface $proto://$hostname$port/fac\n";
894   }
895   exit shift;
896 }
897
898 sub examples {
899   $0 =~ s:.*/::;
900   print <<EOD;
901 create new user:
902 $0 -u framstag\@rus.uni-stuttgart.de schwubbeldidu
903
904 set 10 GB sender quota for this user:
905 $0 -q framstag\@rus.uni-stuttgart.de s:10240
906
907 set file expiration to 30 days for this user:
908 $0 -k framstag\@rus.uni-stuttgart.de 30
909
910 disable account expiration for this user:
911 $0 -P framstag\@rus.uni-stuttgart.de y
912
913 list spooled files and resend notification email for this file:
914 $0 -M | grep frams
915 $0 -M framstag\@rus.uni-stuttgart.de/hoppel\@flupp.org/jump.avi
916 EOD
917   exit;
918 }