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