]> git.treefish.org Git - fex.git/blob - bin/fac
0946704adbcb94c0ba54b6f011d5ef7c4a7aa7e1
[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/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) {
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   if ($opt_u = shift @ARGV) {
437     $user = lc $opt_u;
438     $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
439     $id = shift @ARGV;
440     $idf = "$spooldir/$user/@";
441     if (open $idf,$idf) {
442       chomp($ido = <$idf>||'');
443       close $idf;
444     }
445     unless ($id) {
446       die "$0: $user is not a FEX user\n" unless -f "$spooldir/$user/@";
447       showuser($user,$ido);
448       exit;
449     }
450     unless ($user =~ /\w@[\w.-]+\.[a-z]+$/) {
451       die "$0: $user is not a valid email-address!\n";
452     }
453     unless (-d "$spooldir/$user") {
454       mkdir "$spooldir/$user",0755
455         or die "$0: cannot mkdir $spooldir/$user - $!\n";
456     }
457     open F,">$idf" or die "$0: cannot write $idf - $!\n";
458     print F $id,"\n";
459     close F or die "$0: cannot write $idf - $!\n";
460     showuser($user,$id);
461   } else {
462     print "Users in $spooldir:\n";
463     foreach $user (glob "$spooldir/*/@") {
464       $user =~ s:.*/(.+)/@:$1:;
465       print "$user\n";
466     }
467   }
468   exit;
469 }
470
471 # set user autodelete default
472 if ($opt_a) {
473   $user = lc $opt_a;
474   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
475   $_ = shift @ARGV || '';
476   if    (/^n/i) { $autodelete = 'no' }
477   elsif (/^y/i) { $autodelete = 'yes' }
478   elsif (/^d/i) { $autodelete = 'delay' }
479   else { 
480     die "usage: $0 -a user yes\n".
481         "usage: $0 -a user no\n".
482         "usage: $0 -a user delay\n".
483         "example: $0 -a framstag\@rus.uni-stuttgart.de no\n";
484   }
485   mkdir "$spooldir/$user",0755;
486   my $adf = "$spooldir/$user/\@AUTODELETE";
487   unlink $adf;
488   symlink $autodelete,$adf or die "$0: cannot create symlink $adf - $!\n";
489   exit;
490 }
491
492 # set user notification default
493 if ($opt_n) {
494   $user = lc $opt_n;
495   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
496   $_ = shift @ARGV || '';
497   if    (/^n/i)    { $notification = 'no' }
498   elsif (/^[sb]/i) { $notification = 'short' }
499   elsif (/^[fd]/i) { $notification = '' }
500   else { 
501     die "usage: $0 -n user no\n".
502         "usage: $0 -n user brief\n".
503         "usage: $0 -n user detailed\n".
504         "example: $0 -n framstag\@rus.uni-stuttgart.de brief\n";
505   }
506   mkdir "$spooldir/$user",0755;
507   my $ndf = "$spooldir/$user/\@NOTIFICATION";
508   unlink $ndf;
509   if ($notification) {
510     symlink $notification,$ndf or die "$0: cannot create symlink $ndf - $!\n";
511   }
512   exit;
513 }
514
515 # set user keep default
516 if ($opt_k) {
517   $user = lc $opt_k;
518   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
519   my $keep = shift @ARGV || '';
520   if ($keep !~ /^\d+$/) {
521     die "usage: $0 -k user keep_days\n".
522         "example: $0 -k framstag\@rus.uni-stuttgart.de 30\n";
523   }
524   mkdir "$spooldir/$user",0755;
525   my $kf = "$spooldir/$user/\@KEEP";
526   unlink $kf;
527   symlink $keep,$kf or die "$0: cannot create symlink $kf - $!\n";
528   exit;
529 }
530
531 # quota
532 if ($opt_q) {
533   $user = lc $opt_q;
534   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
535   unless (-d "$spooldir/$user") {
536     die "$0: $user is not a regular FEX user\n";
537   }
538   quota($user,@ARGV);
539   exit;
540 }
541
542 if ($opt_C) {
543   $user = lc $opt_C;
544   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
545   unless (-f "$spooldir/$user/@") {
546     die "$0: $user is not a regular FEX user\n";
547   }
548   $_ = shift @ARGV || '';
549   if (/^y/i) {
550     open $user,">>$spooldir/$user/\@CAPTIVE";
551     close $user;
552     print "$user is now captive\n";
553   } elsif (/^n/i) {
554     unlink "$spooldir/$user/\@CAPTIVE";
555     print "$user is no more captive\n";
556   } else {
557     die "usage: $0 -C user yes\n".
558         "usage: $0 -C user no\n".
559         "example: $0 -C framstag\@rus.uni-stuttgart.de no\n";
560   }
561   exit;
562 }
563
564 # FEXYOURSELF = user can only fex to himself via web interface
565 if ($opt_y) {
566   $user = lc $opt_y;
567   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
568   unless (-f "$spooldir/$user/@") {
569     die "$0: $user is not a regular FEX user\n";
570   }
571   $_ = shift @ARGV || '';
572   if (/^y/i) {
573     open $user,">>$spooldir/$user/\@FEXYOURSELF";
574     close $user;
575     print "$user has now \"fex yourself\" web default\n";
576   } elsif (/^n/i) {
577     unlink "$spooldir/$user/\@FEXYOURSELF";
578     print "$user has no \"fex yourself\" web default\n";
579   } else {
580     die "usage: $0 -y user yes\n".
581         "usage: $0 -y user no\n".
582         "example: $0 -y framstag\@rus.uni-stuttgart.de no\n";
583   }
584   exit;
585 }
586
587 if ($opt_D) {
588   $user = lc $opt_D;
589   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
590   $_ = shift @ARGV || '';
591   if (/^y/i) {
592     open $user,">>$spooldir/$user/\@DISABLED";
593     close $user;
594     print "$user is now disabled\n";
595   } elsif (/^n/i) {
596     unlink "$spooldir/$user/\@DISABLED";
597     print "$user is now enabled\n";
598   } else {
599     die "usage: $0 -D user yes\n".
600         "usage: $0 -D user no\n".
601         "example: $0 -D framstag\@rus.uni-stuttgart.de no\n";
602   }
603   exit;
604 }
605
606 if ($opt_P) {
607   $user = lc $opt_P;
608   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
609   $_ = shift @ARGV || '';
610   if (/^y/i) {
611     open $user,">>$spooldir/$user/\@PERSISTENT";
612     close $user;
613     print "$user is now persistent\n";
614   } elsif (/^n/i) {
615     unlink "$spooldir/$user/\@PERSISTENT";
616     print "$user is no more persistent\n";
617   } else {
618     die "usage: $0 -P user yes\n".
619         "usage: $0 -P user no\n".
620         "example: $0 -P framstag\@rus.uni-stuttgart.de yes\n";
621   }
622   exit;
623 }
624
625 if ($opt_S eq 'fup') {
626   &fupstat;
627   exit;
628 }
629
630 if ($opt_S eq 'fop') {
631   &fopstat;
632   exit;
633 }
634
635 usage(3);
636
637 sub showuser {
638   my $user = shift;
639   my $id = shift;
640   my ($keep,$autodelete,$notification);
641
642   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
643
644   print "[using config $FEXLIB/fex.ph]\n";
645   print "$fup?from=$user&id=$id\n";
646   printf "%s/%s\n",$fup,b64("from=$user&id=$id");
647   # printf "%s/%s\n",$fup,b64("from=$user&to=$user&id=$id&submit=.");
648   print "spool: $spooldir/$user/\n";
649   printf "fex yourself web default: %s\n",
650          -e "$spooldir/$user/\@FEXYOURSELF" ? 'yes' : 'no';
651   printf "persistent: %s\n",
652          -e "$spooldir/$user/\@PERSISTENT" ? 'yes' : 'no';
653   printf "captive: %s\n",
654          -e "$spooldir/$user/\@CAPTIVE" ? 'yes' : 'no';
655   printf "disabled: %s\n",
656          -e "$spooldir/$user/\@DISABLED" ? 'yes' : 'no';
657   printf "recipients restrictions: %s\n",
658          -e "$spooldir/$user/\@ALLOWED_RECIPIENTS" ? 'yes' : 'no';
659   printf "upload restrictions: %s\n",
660          -e "$spooldir/$user/\@UPLOAD_HOSTS" ? 'yes' : 'no';
661   printf "download restrictions: %s\n",
662          -e "$spooldir/$user/\@DOWNLOAD_HOSTS" ? 'yes' : 'no';
663   $autodelete = lc(readlink "$spooldir/$user/\@AUTODELETE" || $::autodelete);
664   print "autodelete default: $autodelete\n";
665   $notification = lc(readlink "$spooldir/$user/\@NOTIFICATION" || $::notification);
666   print "notification default: $notification\n";
667   $keep = readlink "$spooldir/$user/\@KEEP" || $keep_default;
668   print "keep default: $keep\n";
669   quota($user);
670   printf "account creation: %s\n",slurp("$spooldir/$user/.auto")||'manual';
671 }
672
673 # set or show disk quota
674 sub quota {
675   my $user = shift;
676   my $rquota = '';
677   my $squota = '';
678   my $qf = "$spooldir/$user/\@QUOTA";
679   local $_;
680
681   if (open $qf,$qf) {
682     while (<$qf>) {
683       s/#.*//;
684       $rquota = $1 if /recipient.*?(\d+)/i;
685       $squota = $1 if /sender.*?(\d+)/i;
686     }
687     close $qf;
688   }
689
690   if (@_) {
691     for (@_) {
692       $rquota = $1 if /^r.*:(\d*)/i;
693       $squota = $1 if /^s.*:(\d*)/i;
694     }
695     open $qf,'>',$qf or die "$0: cannot write $qf - $!\n";
696     print {$qf} "recipient:$rquota\n" if $rquota =~ /\d/;
697     print {$qf} "sender:$squota\n"    if $squota =~ /\d/;
698     close $qf;
699   }
700
701   $rquota = $recipient_quota if $rquota !~ /\d/;
702   $squota = $sender_quota    if $squota !~ /\d/;
703   printf "recpient quota (used): %d (%d) MB\n",
704          check_recipient_quota($user) if $rquota;
705   printf "sender quota (used): %d (%d) MB\n",
706          check_sender_quota($user) if $squota;
707 }
708
709
710 sub fupstat {
711   my (%user,%domain,%du);
712   my ($log,$u,$d,$z);
713   my $Z = 0;
714
715   if (-t) { $log = "$logdir/fup.log" }
716   else    { $log = '>&=STDIN' }
717   open $log,$log or die "$0: cannot open $log - $!\n";
718
719   while (<$log>) {
720     if (/^([\d: -]+) (\[[\d_]+\] )?(\w\S*) .* (\d+)$/) {
721       $z = $4;
722       $u = $3;
723       $u .= '@'.$mdomain if $mdomain and $u !~ /@/;
724       $user{$u} += $z;
725       $d = $u;
726       $d =~ s/.*@//;
727       $d =~ s/.*\.(.+\.\w+)/$1/;
728       $domain{$d} += $z;
729       $du{$d}{$u}++;
730       $Z += $z;
731     }
732   }
733
734   foreach $u (sort {$user{$a} <=> $user{$b}} keys %user) {
735     printf "%s : %d\n",$u,$user{$u}/M;
736   }
737   print "========================================================\n";
738   foreach $d (sort {$domain{$a} <=> $domain{$b}} keys %domain) {
739     printf "%s : %d MB, %d user\n",$d,$domain{$d}/M,scalar(keys %{$du{$d}});
740   }
741   printf "Total: %d GB\n",$Z/M/1024;
742
743   exit;
744 }
745
746
747 sub fopstat {
748   my $Z = 0;
749   my ($log,$u,$d,$z);
750   my (%user,%domain,%du);
751
752   if (-t) { $log = "$logdir/fop.log" }
753   else    { $log = '>&=STDIN' }
754   open $log,$log or die "$0: cannot open $log - $!\n";
755
756   while (<$log>) {
757     if (/^([\d: -]+) (\[[\d_]+\] )?[\d.]+ (.+?)\/.* (\d+)\/\d+/) {
758       $z = $4;
759       $u = $3;
760       $u .= '@'.$mdomain if $mdomain and $u !~ /@/;
761       $user{$u} += $z;
762       $d = $u;
763       $d =~ s/.*@//;
764       $d =~ s/.*\.(.+\.\w+)/$1/;
765       $domain{$d} += $z;
766       $du{$d}{$u}++;
767       $Z += $z;
768     }
769   }
770
771   foreach $u (sort {$user{$a} <=> $user{$b}} keys %user) {
772     printf "%s : %d\n",$u,$user{$u}/M;
773   }
774   print "========================================================\n";
775   foreach $d (sort {$domain{$a} <=> $domain{$b}} keys %domain) {
776     printf "%s : %d MB, %d user\n",$d,$domain{$d}/M,scalar(keys %{$du{$d}});
777   }
778   printf "Total: %d GB\n",$Z/M/1024;
779
780   exit;
781 }
782
783
784 sub cpa {
785   my $dd = pop @_;
786
787   die "(cpa): $dd is not a directory" unless -d $dd;
788   system "rsync -a @_ $dd/" ;
789 }
790
791
792 sub mtime {
793   my @s = lstat shift;
794   return @s ? $s[9] : undef;
795 }
796
797 sub check_admin {
798   
799   my $admin_id = slurp("$spooldir/$admin/@") or
800     die "$0: no admin account - you have to create it with:\n".
801         "$0 -/ $admin ".randstring(8)."\n";
802
803   chomp $admin_id;
804
805   my $fid = "$ENV{HOME}/.fex/id";
806   if (open $fid,$fid) {
807     $_ = <$fid>;
808     chomp($_ = <$fid>||'');
809     if ($_ ne $admin) {
810       warn "WARNING: user $admin not in $fid\n";
811       $mismatch++;
812     }
813     chomp($_ = <$fid>||'');
814     if ($_ ne $admin_id) {
815       warn "WARNING: $admin auth-ID mismatch in $fid\n";
816       $mismatch++;
817     }
818     close $fid;
819     if ($mismatch) {
820       warn "$0: moving $fid to ${fid}_save\n";
821       rename $fid,$fid.'_save';
822     }
823   } 
824   unless (-f $fid) {
825     mkdir dirname($fid);
826     open $fid,'>',$fid or die "$0: cannot create $fid - $!\n";
827     if ($durl =~ m{(https?://.+?)/}) {
828       print {$fid} "$1\n";
829     } else {
830       print {$fid} "$hostname\n";
831     }
832     print {$fid} "$admin\n";
833     print {$fid} "$admin_id\n";
834     close $fid;
835     warn "$0: new $fid created\n";
836   }
837 }
838
839
840 sub d3 {
841   local $_ = shift;
842   while (s/(\d)(\d\d\d\b)/$1,$2/) {};
843   return $_;
844 }
845
846
847 sub usage {
848   my $port = '';
849   my $proto = 'http';
850
851   if ($durl =~ /:(\d+)/)    { $port = ":$1" }
852   if ($durl =~ /^(https?)/) { $proto = $1 }
853
854   $0 =~ s:.*/::;
855   print <<EOD;
856 Usages:
857 $0 -u                 # list full users
858 $0 -u user            # show user config
859 $0 -u user auth-ID    # create new user or set new auth-ID
860 $0 -/ admin auth-ID   # set new admin and auth-ID
861 $0 -q user s:quota    # set new disk quota (MB) for sender user
862 $0 -q user r:quota    # set new disk quota (MB) for recipient user
863 $0 -R user            # restrict user: only internal recipients allowed
864 $0 -rr user           # edit user recipients restriction
865 $0 -ru user           # edit user upload restriction
866 $0 -rd user           # edit user download restriction
867 $0 -d user            # delete user
868 $0 -D user [yn]       # disable user (yes,no)
869 $0 -P user [yn]       # make user persistent = no account expiration (yes,no)
870 $0 -a user [ynd]      # set user autodelete default (yes,no,delay)
871 $0 -n user [dbn]      # set user notification default (detailed,brief,no)
872 $0 -k user days       # set user keep default in days
873 $0 -C user [yn]       # set user captive (yes,no)
874 $0 -y user [yn]       # set user "fex yourself" web default (yes,no)
875 $0 -S fup             # file upload statistics
876 $0 -S fop             # file download statistics
877 $0 -v                 # show server config
878 $0 -c                 # edit server config
879 $0 -w                 # watch fexsrv.log (continously)
880 $0 -l                 # list pending files with download URLs
881 $0 -L [filter]        # list pending files in detail
882 $0 -M                 # list pending files with TO/FROM/FILE
883 $0 -M TO/FROM/FILE    # resend notification email
884 $0 -m "reason"        # enter maintenance mode (reason "exit" to leave)
885 $0 -A alias:hostname  # add new virtual server
886 $0 -V virtualhost ... # operations on virtualhost (alias or hostname)
887 $0 -E                 # show usage examples
888 EOD
889   if (-x "$FEXHOME/cgi-bin/fac") {
890     print "See also web admin interface $proto://$hostname$port/fac\n";
891   }
892   exit shift;
893 }
894
895 sub examples {
896   $0 =~ s:.*/::;
897   print <<EOD;
898 create new user:
899 $0 -u framstag\@rus.uni-stuttgart.de schwubbeldidu
900
901 set 10 GB sender quota for this user:
902 $0 -q framstag\@rus.uni-stuttgart.de s:10240
903
904 set file expiration to 30 days for this user:
905 $0 -k framstag\@rus.uni-stuttgart.de 30
906
907 disable account expiration for this user:
908 $0 -P framstag\@rus.uni-stuttgart.de y
909
910 list spooled files and resend notification email for this file:
911 $0 -M | grep frams
912 $0 -M framstag\@rus.uni-stuttgart.de/hoppel\@flupp.org/jump.avi
913 EOD
914   exit;
915 }