]> git.treefish.org Git - fex.git/blob - bin/fac
cec687a3b81023d28153ea712c3a0ed157aaf0e7
[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,$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[0]."/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   system "cp $FEXLIB/fup.pl $vhd/lib/fup.pl";
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   $_ = shift @ARGV || '';
592   if (/^y/i) {
593     open $user,">>$spooldir/$user/\@DISABLED";
594     close $user;
595     print "$user is now disabled\n";
596   } elsif (/^n/i) {
597     unlink "$spooldir/$user/\@DISABLED";
598     print "$user is now enabled\n";
599   } else {
600     die "usage: $0 -D user yes\n".
601         "usage: $0 -D user no\n".
602         "example: $0 -D framstag\@rus.uni-stuttgart.de no\n";
603   }
604   exit;
605 }
606
607 if ($opt_P) {
608   $user = lc $opt_P;
609   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
610   $_ = shift @ARGV || '';
611   if (/^y/i) {
612     open $user,">>$spooldir/$user/\@PERSISTENT";
613     close $user;
614     print "$user is now persistent\n";
615   } elsif (/^n/i) {
616     unlink "$spooldir/$user/\@PERSISTENT";
617     print "$user is no more persistent\n";
618   } else {
619     die "usage: $0 -P user yes\n".
620         "usage: $0 -P user no\n".
621         "example: $0 -P framstag\@rus.uni-stuttgart.de yes\n";
622   }
623   exit;
624 }
625
626 if ($opt_S eq 'fup') {
627   &fupstat;
628   exit;
629 }
630
631 if ($opt_S eq 'fop') {
632   &fopstat;
633   exit;
634 }
635
636 usage(3);
637
638 sub showuser {
639   my $user = shift;
640   my $id = shift;
641   my ($keep,$autodelete,$notification,$login);
642
643   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
644
645   print "[using config $FEXLIB/fex.ph]\n";
646   print "$fup?from=$user&id=$id\n";
647   printf "%s/%s\n",$fup,b64("from=$user&id=$id");
648   # printf "%s/%s\n",$fup,b64("from=$user&to=$user&id=$id&submit=.");
649   print "spool: $spooldir/$user/\n";
650   if ($login_check and $login = readlink "$user/.login") {
651     my $lc = &$login_check($login);
652     if ($lc) {
653       print "login: $login\n";
654     } else {
655       print "login: DELETED\n";
656     }
657   }
658   printf "fex yourself web default: %s\n",
659          -e "$spooldir/$user/\@FEXYOURSELF" ? 'yes' : 'no';
660   printf "persistent: %s\n",
661          -e "$spooldir/$user/\@PERSISTENT" ? 'yes' : 'no';
662   printf "captive: %s\n",
663          -e "$spooldir/$user/\@CAPTIVE" ? 'yes' : 'no';
664   printf "disabled: %s\n",
665          -e "$spooldir/$user/\@DISABLED" ? 'yes' : 'no';
666   printf "recipients restrictions: %s\n",
667          -e "$spooldir/$user/\@ALLOWED_RECIPIENTS" ? 'yes' : 'no';
668   printf "upload restrictions: %s\n",
669          -e "$spooldir/$user/\@UPLOAD_HOSTS" ? 'yes' : 'no';
670   printf "download restrictions: %s\n",
671          -e "$spooldir/$user/\@DOWNLOAD_HOSTS" ? 'yes' : 'no';
672   $autodelete = lc(readlink "$spooldir/$user/\@AUTODELETE" || $::autodelete);
673   print "autodelete default: $autodelete\n";
674   $notification = lc(readlink "$spooldir/$user/\@NOTIFICATION" || $::notification);
675   print "notification default: $notification\n";
676   $keep = readlink "$spooldir/$user/\@KEEP" || $keep_default;
677   print "keep default: $keep\n";
678   quota($user);
679   printf "account creation: %s\n",slurp("$spooldir/$user/.auto")||'manual';
680 }
681
682 # set or show disk quota
683 sub quota {
684   my $user = shift;
685   my $rquota = '';
686   my $squota = '';
687   my $qf = "$spooldir/$user/\@QUOTA";
688   local $_;
689
690   if (open $qf,$qf) {
691     while (<$qf>) {
692       s/#.*//;
693       $rquota = $1 if /recipient.*?(\d+)/i;
694       $squota = $1 if /sender.*?(\d+)/i;
695     }
696     close $qf;
697   }
698
699   if (@_) {
700     for (@_) {
701       $rquota = $1 if /^r.*:(\d*)/i;
702       $squota = $1 if /^s.*:(\d*)/i;
703     }
704     open $qf,'>',$qf or die "$0: cannot write $qf - $!\n";
705     print {$qf} "recipient:$rquota\n" if $rquota =~ /\d/;
706     print {$qf} "sender:$squota\n"    if $squota =~ /\d/;
707     close $qf;
708   }
709
710   $rquota = $recipient_quota if $rquota !~ /\d/;
711   $squota = $sender_quota    if $squota !~ /\d/;
712   printf "recpient quota (used): %d (%d) MB\n",
713          check_recipient_quota($user) if $rquota;
714   printf "sender quota (used): %d (%d) MB\n",
715          check_sender_quota($user) if $squota;
716 }
717
718
719 sub fupstat {
720   my (%user,%domain,%du);
721   my ($log,$u,$d,$z);
722   my $Z = 0;
723
724   if (-t) { $log = $logdir[0].'/fup.log' }
725   else    { $log = '>&=STDIN' }
726   open $log,$log or die "$0: cannot open $log - $!\n";
727
728   while (<$log>) {
729     if (/^([\d: -]+) (\[[\d_]+\] )?(\w\S*) .* (\d+)$/) {
730       $z = $4;
731       $u = $3;
732       $u .= '@'.$mdomain if $mdomain and $u !~ /@/;
733       $user{$u} += $z;
734       $d = $u;
735       $d =~ s/.*@//;
736       $d =~ s/.*\.(.+\.\w+)/$1/;
737       $domain{$d} += $z;
738       $du{$d}{$u}++;
739       $Z += $z;
740     }
741   }
742
743   foreach $u (sort {$user{$a} <=> $user{$b}} keys %user) {
744     printf "%s : %d\n",$u,$user{$u}/M;
745   }
746   print "========================================================\n";
747   foreach $d (sort {$domain{$a} <=> $domain{$b}} keys %domain) {
748     printf "%s : %d MB, %d user\n",$d,$domain{$d}/M,scalar(keys %{$du{$d}});
749   }
750   printf "Total: %d GB\n",$Z/M/1024;
751
752   exit;
753 }
754
755
756 sub fopstat {
757   my $Z = 0;
758   my ($log,$u,$d,$z);
759   my (%user,%domain,%du);
760
761   if (-t) { $log = $logdir[0].'/fop.log' }
762   else    { $log = '>&=STDIN' }
763   open $log,$log or die "$0: cannot open $log - $!\n";
764
765   while (<$log>) {
766     if (/^([\d: -]+) (\[[\d_]+\] )?[\d.]+ (.+?)\/.* (\d+)\/\d+/) {
767       $z = $4;
768       $u = $3;
769       $u .= '@'.$mdomain if $mdomain and $u !~ /@/;
770       $user{$u} += $z;
771       $d = $u;
772       $d =~ s/.*@//;
773       $d =~ s/.*\.(.+\.\w+)/$1/;
774       $domain{$d} += $z;
775       $du{$d}{$u}++;
776       $Z += $z;
777     }
778   }
779
780   foreach $u (sort {$user{$a} <=> $user{$b}} keys %user) {
781     printf "%s : %d\n",$u,$user{$u}/M;
782   }
783   print "========================================================\n";
784   foreach $d (sort {$domain{$a} <=> $domain{$b}} keys %domain) {
785     printf "%s : %d MB, %d user\n",$d,$domain{$d}/M,scalar(keys %{$du{$d}});
786   }
787   printf "Total: %d GB\n",$Z/M/1024;
788
789   exit;
790 }
791
792
793 sub cpa {
794   my $dd = pop @_;
795
796   die "(cpa): $dd is not a directory" unless -d $dd;
797   system "rsync -a @_ $dd/" ;
798 }
799
800
801 sub check_admin {
802   
803   my $admin_id = slurp("$spooldir/$admin/@") or
804     die "$0: no admin account - you have to create it with:\n".
805         "$0 -/ $admin ".randstring(8)."\n";
806
807   chomp $admin_id;
808
809   my $fid = "$ENV{HOME}/.fex/id";
810   if (open $fid,$fid) {
811     $_ = <$fid>;
812     chomp($_ = <$fid>||'');
813     if ($_ ne $admin) {
814       warn "WARNING: user $admin not in $fid\n";
815       $mismatch++;
816     }
817     chomp($_ = <$fid>||'');
818     if ($_ ne $admin_id) {
819       warn "WARNING: $admin auth-ID mismatch in $fid\n";
820       $mismatch++;
821     }
822     close $fid;
823     if ($mismatch) {
824       warn "$0: moving $fid to ${fid}_save\n";
825       rename $fid,$fid.'_save';
826     }
827   } 
828   unless (-f $fid) {
829     mkdir dirname($fid);
830     open $fid,'>',$fid or die "$0: cannot create $fid - $!\n";
831     if ($durl =~ m{(https?://.+?)/}) {
832       print {$fid} "$1\n";
833     } else {
834       print {$fid} "$hostname\n";
835     }
836     print {$fid} "$admin\n";
837     print {$fid} "$admin_id\n";
838     close $fid;
839     warn "$0: new $fid created\n";
840   }
841 }
842
843
844 sub d3 {
845   local $_ = shift;
846   while (s/(\d)(\d\d\d\b)/$1,$2/) {};
847   return $_;
848 }
849
850
851 sub usage {
852   my $port = '';
853   my $proto = 'http';
854
855   if ($durl =~ /:(\d+)/)    { $port = ":$1" }
856   if ($durl =~ /^(https?)/) { $proto = $1 }
857
858   $0 =~ s:.*/::;
859   print <<EOD;
860 Usages:
861 $0 -u                 # list full users
862 $0 -u user            # show user config
863 $0 -u user auth-ID    # create new user or set new auth-ID
864 $0 -/ admin auth-ID   # set new admin and auth-ID
865 $0 -q user s:quota    # set new disk quota (MB) for sender user
866 $0 -q user r:quota    # set new disk quota (MB) for recipient user
867 $0 -R user            # restrict user: only internal recipients allowed
868 $0 -rr user           # edit user recipients restriction
869 $0 -ru user           # edit user upload restriction
870 $0 -rd user           # edit user download restriction
871 $0 -d user            # delete user
872 $0 -D user [yn]       # disable user (yes,no)
873 $0 -P user [yn]       # make user persistent = no account expiration (yes,no)
874 $0 -a user [ynd]      # set user autodelete default (yes,no,delay)
875 $0 -n user [dbn]      # set user notification default (detailed,brief,no)
876 $0 -k user days       # set user keep default in days
877 $0 -C user [yn]       # set user captive (yes,no)
878 $0 -y user [yn]       # set user "fex yourself" web default (yes,no)
879 $0 -S fup             # file upload statistics
880 $0 -S fop             # file download statistics
881 $0 -v                 # show server config
882 $0 -c                 # edit server config
883 $0 -w                 # watch fexsrv.log (continously)
884 $0 -l                 # list pending files with download URLs
885 $0 -L [filter]        # list pending files in detail
886 $0 -M                 # list pending files with TO/FROM/FILE
887 $0 -M TO/FROM/FILE    # resend notification email
888 $0 -m "reason"        # enter maintenance mode (reason "exit" to leave)
889 $0 -A alias:hostname  # add new virtual server
890 $0 -V virtualhost ... # operations on virtualhost (alias or hostname)
891 $0 -E                 # show usage examples
892 EOD
893   if (-x "$FEXHOME/cgi-bin/fac") {
894     print "See also web admin interface $proto://$hostname$port/fac\n";
895   }
896   exit shift;
897 }
898
899 sub examples {
900   $0 =~ s:.*/::;
901   print <<EOD;
902 create new user:
903 $0 -u framstag\@rus.uni-stuttgart.de schwubbeldidu
904
905 set 10 GB sender quota for this user:
906 $0 -q framstag\@rus.uni-stuttgart.de s:10240
907
908 set file expiration to 30 days for this user:
909 $0 -k framstag\@rus.uni-stuttgart.de 30
910
911 disable account expiration for this user:
912 $0 -P framstag\@rus.uni-stuttgart.de y
913
914 list spooled files and resend notification email for this file:
915 $0 -M | grep frams
916 $0 -M framstag\@rus.uni-stuttgart.de/hoppel\@flupp.org/jump.avi
917 EOD
918   exit;
919 }