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 }