]> git.treefish.org Git - fex.git/blob - bin/fex_cleanup
1d87dcfe9e59cfc861cd6767f22fb3ce836d84e1
[fex.git] / bin / fex_cleanup
1 #!/usr/bin/perl -w
2
3 # cleanup for F*EX service
4 #
5 # run this program via cron-job once at night!
6 #
7 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
8 #
9
10 use Getopt::Std;
11 use File::Basename;
12 use IO::Socket::INET;
13 use Cwd         'abs_path';
14 use Digest::MD5 'md5_hex';
15
16 use constant DS => 60*60*24;
17
18 # do not run as CGI!
19 exit if $ENV{SCRIPT_NAME};
20
21 unless ($FEXLIB = $ENV{FEXLIB}) {
22   if ($ENV{FEXHOME}) {
23     $FEXLIB = $ENV{FEXHOME}.'/lib';
24   } elsif (-f '/usr/share/fex/lib/fex.ph') {
25     $FEXLIB = '/usr/share/fex/lib';
26   } else {
27     $FEXLIB = dirname(dirname(abs_path($0))).'/lib';
28   }
29   $ENV{FEXLIB} = $FEXLIB;
30 }
31 die "$0: no FEXLIB\n" unless -r "$FEXLIB/fex.pp";
32
33 # program name
34 $_0 = $0;
35 $0 =~ s:.*/::;
36
37 $| = 1;
38
39 # use fex.ph for site configuration!
40 our ($FEXHOME);
41 our ($spooldir,@logdir,$docdir);
42 our ($akeydir,$ukeydir,$dkeydir,$skeydir,$gkeydir,$xkeydir,$lockdir);
43 our ($durl,$debug,$autodelete,$hostname,$admin,$admin_pw,$bcc);
44 $keep_default = 5;
45
46 # load common code, local config : $HOME/lib/fex.ph
47 require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
48
49 my $logdir = $logdir[0];
50
51 # localized functions
52 # (needed for reminder and account reactivation e-mails)
53 foreach my $lf (glob "$FEXHOME/locale/*/lib/lf.pl") { require $lf }
54
55 # default locale functions (from fex.pp)
56 $notify{english} = \&notify;
57 $reactivation{english} = \&reactivation;
58
59 @_ARGV = @ARGV;
60
61 $opt_v = $opt_V = $opt_d = 0;
62 getopts('vVd');
63 $opt_v = $opt_d if $opt_d;  # debug mode, no real action
64
65 $today = time;
66 $isodate = isodate($today);
67
68 chdir $spooldir or die "$0: $spooldir - $!\n";
69 # open L,">>$logdir/cleanup.log";
70
71 # clean up regular spool
72 opendir $spooldir,'.' or die "$0: $spooldir - $!\n";
73 while ($to = readdir $spooldir) {
74   next if $to =~ /^\./;
75   next if $to !~ /@/ or $_ = readlink($to) and not /\//;
76   next unless -d $to;
77   if (@demo and -f "$to/.demo" and time > lmtime("$to/.demo")+$demo[1]*DS) {
78     logdel($to,"demo user $to deleted");
79     next;
80   }
81   unless (opendir TO,$to) {
82     warn "$0: $spooldir/$to - $!\n";
83     next;
84   }
85   while ($from = readdir TO) {
86     next if $from !~ /@/;
87     if ($from eq '@GROUP') {
88       foreach $group (glob "$to/$from/*") {
89         if (readlink $group and not -f $group) {
90           logdel($group,"$group deleted (master has gone)");
91         }
92       }
93     } else {
94       if (-d "$to/$from" and $from !~ /^\./) {
95         unless (opendir FROM,"$to/$from") {
96           warn "$0: $spooldir/$to/$from - $!\n";
97           next;
98         }
99         while ($file = readdir FROM) {
100           next if $file eq '.' or $file eq '..';
101           if (-d "$to/$from/$file" and $file !~ /^\./) {
102             cleanup($to,$from,$file);
103             rmdir "$to/$from/$file" unless $opt_d;
104           }
105         }
106         closedir FROM;
107         rmdir "$to/$from" unless $opt_d;
108       }
109     }
110   }
111   closedir TO;
112   unless (-f "$to/\@PERSISTENT" or $to eq $admin) {
113     @glob = glob "$to/*/* $to/\@MAINUSER/* $to/\@GROUP/*";
114     unless (@glob or -f "$to/\@") {
115       logdel($to,"$to deleted");
116     }
117     $user = $to;
118     if ($login_check and -l "$user/.login") {
119       my $lc = &$login_check(readlink("$user/.login"));
120       if ($lc) {
121         if (-f "$user/\@~" and not "$user/@") {
122           rename "$user/\@~","$user/@" unless $opt_d;
123           logv("$user reanimated (login_check)");
124         }
125       } else {
126         rename "$user/@","$user/\@~" unless $opt_d;
127         logv("$user deactivated (login_check)");
128       }
129     }
130   }
131 }
132 closedir $spooldir;
133
134 # clean up download key lookup directory
135 if (chdir $dkeydir and opendir D,'.') {
136   while ($file = readdir D) {
137     if ($link = readlink $file and
138         (not -l "$link/dkey" or readlink "$link/dkey" ne $file)) {
139       logdel($file,".dkeys/$file deleted");
140     }
141   }
142   closedir D;
143 }
144
145 # clean up upload key lookup directory
146 if (chdir $ukeydir and opendir D,'.') {
147   while ($file = readdir D) {
148     next if $file eq '.' or $file eq '..';
149     if (($link = readlink $file and not -e "$link/upload"
150          or -f $file and time > lmtime($file)+DS)) {
151       logdel($file,".ukeys/$file deleted");
152     }
153   }
154   closedir D;
155 }
156
157 # clean up authorization key lookup directory
158 if (chdir $akeydir and opendir D,'.') {
159   while ($file = readdir D) {
160     if (-l $file and time > (lmtime($file)||0)+DS) {
161       logdel($file,".akeys/$file deleted");
162     }
163   }
164   closedir D;
165 }
166
167 # clean up extra download key lookup directory
168 if (chdir $xkeydir and opendir D,'.') {
169   while ($file = readdir D) {
170     next if $file eq '.' or $file eq '..';
171     if (-l $file and not (-f "$file/upload" or -f "$file/data")) {
172       logdel($file,".xkeys/$file deleted");
173     }
174   }
175   closedir D;
176 }
177
178 # clean up lock directory
179 if (chdir $lockdir and opendir D,'.') {
180   while ($file = readdir D) {
181     if (-f $file and time > lmtime($file)+DS) {
182       logdel($file,".locks/$file deleted");
183     }
184   }
185   closedir D;
186 }
187
188 # clean up error directory
189 if (chdir "$spooldir/.error" and opendir D,'.') {
190   while ($file = readdir D) {
191     if (-f $file) {
192       $mtime = lmtime($file);
193       if ($mtime and $today > 10*$keep_default*DS+$mtime) {
194         if ($opt_d) { print "unlink .error/$file\n" }
195         else        { logdel($file,".error/$file deleted") }
196       }
197     }
198   }
199   closedir D;
200 }
201
202 # clean up debug directory
203 if (chdir "$spooldir/.debug" and opendir D,'.') {
204   while ($file = readdir D) {
205     if (-f $file) {
206       $mtime = lmtime($file);
207       if ($mtime and $today > $keep_default*DS+$mtime) {
208         # logdel($file,".debug/$file deleted");
209         if ($opt_d) { print "unlink .debug/$file\n" }
210         else        { unlink $file }
211       }
212     }
213   }
214   closedir D;
215 }
216
217 # clean up subuser keys directory
218 if (chdir $skeydir and opendir D,'.') {
219   while ($file = readdir D) {
220     if (-f $file and open F,$file) {
221       $delete = 1;
222       $from = $to = $id = '';
223       while (<F>) {
224         if (/^(\w+)=(.+)/) {
225           $from = $2 if $1 eq 'from';
226           $to   = $2 if $1 eq 'to';
227           $id   = $2 if $1 eq 'id';
228         }
229       }
230       close F;
231       if ($from and $to and $id and open F,"$spooldir/$to/\@SUBUSER") {
232         while (<F>) {
233           if (/^\Q$from:$id\E$/) {
234             $delete = 0;
235             last;
236           }
237         }
238         close F;
239       }
240       if ($delete) {
241         logdel($file,".skeys/$file deleted");
242       }
243     }
244   }
245   closedir D;
246 }
247
248 # clean up orphan subuser links
249 chdir $spooldir;
250 foreach $subuser (glob '*/@MAINUSER/*') {
251   if ($skey = readlink $subuser and not -f "$skeydir/$skey") {
252     logdel($subuser,"$subuser deleted");
253   }
254 }
255 foreach $subuser (glob '*/@MAINUSER') {
256   unlink $subuser unless $opt_d;
257 }
258
259 # clean up old OKEYs
260 chdir $spooldir;
261 foreach my $okey (glob '*/@OKEY/*') {
262   if (time > lmtime($okey)+30*DS) {
263     logdel($okey,"$okey deleted");
264   }
265 }
266
267
268 # clean up group keys directory
269 if (chdir $gkeydir and opendir D,'.') {
270   while ($gkey = readdir D) {
271     if (-f $gkey and open F,$gkey) {
272       $delete = 1;
273       $from = $group = $id = '';
274       while (<F>) {
275         if (/^(\w+)=(.+)/) {
276           $from  = $2 if $1 eq 'from';
277           $group = $2 if $1 eq 'to';
278           $id    = $2 if $1 eq 'id';
279         }
280       }
281       close F;
282       $group =~ s/^@//;
283       $gf = "$spooldir/$from/\@GROUP/$group";
284       if ($from and $group and $id and open F,$gf) {
285         while (<F>) {
286           if (/^\Q$from:$id\E$/) {
287             $delete = 0;
288             last;
289           }
290         }
291         close F;
292       }
293       if ($delete) {
294         logdel($gkey,".gkeys/$gkey deleted");
295         logdel($gf,"$gf deleted") if -l $gf;
296       }
297     }
298   }
299   closedir D;
300 }
301
302 # clean up self registration directory
303 if (chdir "$spooldir/.reg" and opendir D,'.') {
304   while ($file = readdir D) {
305     if (-f $file) {
306       $mtime = lmtime($file);
307       if ($mtime and $today > $mtime+DS) {
308         logdel($file,".reg/$file deleted");
309       }
310     }
311   }
312   closedir D;
313 }
314
315 # send account expiration warning
316 if ($account_expire and $account_expire =~ /^(\d+)/) {
317   my $expire = $1;
318   if (chdir $spooldir) {
319     chomp($admin_pw = slurp("$admin/\@")||'');
320     unless ($admin_pw) {
321       warn "create new fex account for $admin\n";
322       $admin_pw = randstring(8);
323       system("$FEXHOME/bin/fac -u $admin $admin_pw");
324     }
325     my $fid = "$FEXHOME/.fex/id";
326     unless (-f $fid) {
327       mkdir "$FEXHOME/.fex",0700;
328       if (open $fid,'>',$fid) {
329         if ($durl =~ m{(https?://.+?)/}) {
330           print {$fid} "$1\n";
331         } else {
332           print {$fid} "$hostname\n";
333         }
334         print {$fid} "$admin\n";
335         print {$fid} "$admin_pw\n";
336         close $fid;
337       } else {
338         warn"$0: cannot create $fid - $!";
339       }
340     }
341     chmod 0600,$fid;
342     opendir $spooldir,'.';
343     while ($user = readdir $spooldir) {
344       next unless -f "$user/\@";
345       next if -e "$user/$admin/reactivation.txt";
346       next if -e "$user/\@PERSISTENT";
347       next if $user !~ /@/ or -l $user;
348       next if $user =~ /^(fexmaster|fexmail)/ or $user eq $admin;
349       next if -l "$user/.login";
350
351       if (time > lmtime($user)+$expire*DS) {
352         # print "$spooldir/$user\n";
353         local $locale = readlink "$user/\@LOCALE";
354         $locale = 'english' unless $locale and $reactivation{$locale};
355         &{$reactivation{$locale}}($expire,$user);
356         sleep 1;
357       }
358     }
359     closedir $spooldir;
360   }
361 }
362
363 # vhosts
364 exit if $opt_V;
365 if (%vhost) {
366   foreach $vhost (keys %vhost) {
367     my $fexlib = $vhost{$vhost}.'/lib';
368     if (-f "$fexlib/fex.ph") {
369       warn "run $0 for $vhost :\n" if -t or $opt_v;
370       my $cmd = "HTTP_HOST=$vhost FEXLIB=$fexlib $_0 -V @_ARGV";
371       if ($opt_d) { print "$cmd\n" }
372       else        { system $cmd }
373     }
374   }
375 }
376
377 if ($notify_newrelease and $notify_newrelease !~ /^no$/i
378     or not defined $notify_newrelease) {
379   $notify_newrelease ||= $admin;
380   $newnew = $new = '';
381   $snew = $FEXHOME.'/doc/new';
382   $new = slurp($snew)||'';
383   $_ = slurp("$FEXHOME/doc/version")||'';
384   if (/(\d+)/) { $qn = "new?$hostname:$1" }
385   else         { $qn = "new?$hostname:0" }
386   print "checking for new F*EX release\n" if $opt_v;
387   for (1..3) {
388     sleep rand(10);
389     $newnew = `wget -qO- http://fex.belwue.de/$qn 2>/dev/null`;
390     last if $newnew =~ /release/;
391     # $newnew = `wget -qO- http://fex.rus.uni-stuttgart.de/$qn 2>/dev/null`;
392     # last if $newnew =~ /release/;
393   };
394   if ($newnew =~ /release/) {
395     if ($newnew ne $new) {
396       if (open $sendmail,"|$sendmail $notify_newrelease $bcc") {
397         pq($sendmail,qq(
398           'From: fex\@$hostname'
399           'To: $notify_newrelease'
400           'Subject: new F*EX release'
401           ''
402           '$newnew'
403         ));
404         close $sendmail;
405         if (open $snew,'>',$snew) {
406           print {$snew} $newnew;
407           close $snew;
408         }
409       }
410     }
411   }
412 }
413
414 exit;
415
416
417 # file clean up
418 sub cleanup {
419   my ($to,$from,$file) = @_;
420   my ($data,$download,$notify,$mtime,$warn,$dir,$filename,$dkey,$delay);
421   my $comment = '';
422   my $keep = $keep_default;
423   my $kf = "$to/$from/$file/keep";
424   my $ef = "$to/$from/$file/error";
425   local $_;
426
427   $keep = readlink $kf || readlink "$to/\@KEEP" || $keep_default;
428
429   $file       = "$to/$from/$file";
430   $data       = "$file/data";
431   $download   = "$file/download";
432   $notify     = "$file/notify";
433
434   if ($file =~ /\/ADDRESS_BOOK/) {
435     logdel($file,"$file deleted");
436   } elsif (-d $file and not -f $data) {
437     if ($mtime = lmtime("$file/upload")) {
438       if ($today > $mtime+DS) {
439         verbose("rmrf $file (today=$today mtime_upload=$mtime)");
440         logdel($file,"$file deleted");
441       }
442     } elsif ($mtime = lmtime("$file/error")) {
443       if ($today > 3*$keep*DS+$mtime) {
444         verbose("rmrf $file (today=$today mtime_error=$mtime keep=$keep)");
445         logdel($file,"$file deleted");
446       }
447     } else {
448       logdel($file,"$file deleted");
449     }
450   } elsif (-s $download and -s $data and autodelete($file) !~ /NO/i) {
451     $delay = autodelete($file);
452     $delay = 1 if $delay !~ /^\d+$/;
453     $delay--;
454     $mtime = lmtime($download);
455     if ($mtime and $today > $delay*DS+$mtime
456         and logdel($data,"$data deleted")) {
457       if (open $ef,'>',$ef) {
458         printf {$ef} "%s has been autodeleted after download at %s\n",
459                      filename($file),isodate(lmtime($download));
460         close $ef;
461       }
462     }
463   } elsif (-f $data) {
464     my $reactivation = $file =~ m{/\Q$admin/reactivation.txt\E$};
465     $warn = $reactivation ? $keep-5 : $keep-2;
466     $mtime = lmtime("$file/filename") || lmtime($data) || 0;
467     if ($today > $mtime+$keep*DS) {
468       if ($account_expire and $reactivation) {
469         if ($account_expire =~ /delete/) {
470           logdel($to,"$to removed - expired");
471         } else {
472           if (open $sendmail,"|$sendmail $admin $bcc") {
473             $account_expire =~ /(\d+)/;
474             my $expire = $1 || 0;
475             pq($sendmail,qq(
476               'From: fex\@$hostname'
477               'To: $admin'
478               'Subject: user $to expired'
479               ''
480               'F*EX user $to has been inactive for $expire days'
481               'and has ignored the account reactivation mail.'
482               'You may want to delete this account.'
483             ));
484             close $sendmail;
485             unlink $data;
486           } else {
487             warn "$0: cannot send mail - $!\n";
488           }
489         }
490       } else {
491         if ($file =~ /^anonymous.*\/afex_\d/ or $to =~ /^_.+_/) {
492           # also _fexmail_*
493           logdel($file,"$file deleted") and
494           verbose("rmrf $file (today=$today mtime_upload=$mtime)");
495         } elsif (logdel($data,"$data deleted")) {
496           verbose("unlink $data (today=$today mtime=$mtime keep=$keep)");
497           if (open $ef,'>',$ef) {
498             $filename = $file;
499             $filename =~ s:.*/::;
500             print $ef "$filename is expired";
501             close $ef;
502           }
503         }
504       }
505     }
506     elsif ($file !~ /STDFEX$/ and
507            $mtime+$warn*DS < $today and
508            $dkey = readlink("$file/dkey") and
509            not -s $download and
510            not -f $notify and
511            (readlink("$to/\@REMINDER")||'yes') ne 'no')
512     {
513       my $locale = readlink "$to/\@LOCALE" || readlink "$file/\@LOCALE";
514       $locale = 'english' unless $locale and $notify{$locale};
515       if (open my $c,"$file/comment") {
516         chomp ($comment = <$c>||'');
517         close $c;
518       }
519       if (&{$notify{$locale}}(
520         status     => 'remind',
521         dkey       => $dkey,
522         filename   => filename($file),
523         keep       => $keep,
524         comment    => $comment,
525         warn       => int(($mtime-$today)/DS)+$keep,
526         autodelete => autodelete($file),
527       )) {
528         open $notify,'>',$notify;
529         close $notify;
530         print "sent reminder for $file\n" if -t or $opt_v;
531       } else {
532         warn "$0: reminder notification for $file failed\n";
533       }
534     }
535   }
536 }
537
538 sub autodelete {
539   my $file = shift;
540   my $adf = "$file/autodelete";
541   my $autodelete;
542
543   if (-l $adf) {
544     $autodelete = readlink $adf || '';
545   } elsif (open $adf,$adf) {
546     chomp($autodelete = <$adf>||'');
547     close $adf;
548   }
549
550   return $autodelete||$::autodelete;
551 }
552
553 sub logdel {
554   my ($file,$msg) = @_;
555   my $status = 0;
556
557   if ($opt_d) {
558     print "$msg\n";
559   } else {
560     if ($status = rmrf($file)) {
561       logv($msg);
562     } else {
563       logv("$file DEL FAILED : $!");
564       warn "$file DEL FAILED : $!\n" if -t or $opt_v;
565     }
566   }
567
568   return $status;
569 }
570
571
572 sub logv {
573   my $msg = shift;
574
575   print "$msg\n" if -t or $opt_v;
576
577   unless ($opt_d) {
578     foreach my $ld (@logdir) {
579       if (open my $log,">>$ld/cleanup.log") {
580         print {$log} "$isodate $msg\n";
581         close $log;
582       }
583     }
584   }
585 }
586
587
588 sub verbose {
589   local $_;
590   if ($opt_v) {
591     while ($_ = shift @_) {
592       s/\n*$/\n/;
593       print;
594     }
595   }
596 }
597
598
599 sub lmtime {
600   my @s = lstat(shift);
601   return @s?$s[9]:0;
602 }