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