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   for (1..3) {
 387     sleep rand(10);
 388     $newnew = `wget -qO- http://fex.belwue.de/$qn 2>/dev/null`;
 389     last if $newnew =~ /release/;
 390     # $newnew = `wget -qO- http://fex.rus.uni-stuttgart.de/$qn 2>/dev/null`;
 391     # last if $newnew =~ /release/;
 392   };
 393   if ($newnew =~ /release/) {
 394     if ($newnew ne $new) {
 395       if (open $sendmail,"|$sendmail $notify_newrelease $bcc") {
 396         pq($sendmail,qq(
 397           'From: fex\@$hostname'
 398           'To: $notify_newrelease'
 399           'Subject: new F*EX release'
 400           ''
 401           '$newnew'
 402         ));
 403         close $sendmail;
 404         if (open $snew,'>',$snew) {
 405           print {$snew} $newnew;
 406           close $snew;
 407         }
 408       }
 409     }
 410   }
 411 }
 412
 413 exit;
 414
 415
 416 # file clean up
 417 sub cleanup {
 418   my ($to,$from,$file) = @_;
 419   my ($data,$download,$notify,$mtime,$warn,$dir,$filename,$dkey,$delay);
 420   my $comment = '';
 421   my $keep = $keep_default;
 422   my $kf = "$to/$from/$file/keep";
 423   my $ef = "$to/$from/$file/error";
 424   local $_;
 425
 426   $keep = readlink $kf || readlink "$to/\@KEEP" || $keep_default;
 427
 428   $file       = "$to/$from/$file";
 429   $data       = "$file/data";
 430   $download   = "$file/download";
 431   $notify     = "$file/notify";
 432
 433   if ($file =~ /\/ADDRESS_BOOK/) {
 434     logdel($file,"$file deleted");
 435   } elsif (-d $file and not -f $data) {
 436     if ($mtime = lmtime("$file/upload")) {
 437       if ($today > $mtime+DS) {
 438         verbose("rmrf $file (today=$today mtime_upload=$mtime)");
 439         logdel($file,"$file deleted");
 440       }
 441     } elsif ($mtime = lmtime("$file/error")) {
 442       if ($today > 3*$keep*DS+$mtime) {
 443         verbose("rmrf $file (today=$today mtime_error=$mtime keep=$keep)");
 444         logdel($file,"$file deleted");
 445       }
 446     } else {
 447       logdel($file,"$file deleted");
 448     }
 449   } elsif (-s $download and -s $data and autodelete($file) !~ /NO/i) {
 450     $delay = autodelete($file);
 451     $delay = 1 if $delay !~ /^\d+$/;
 452     $delay--;
 453     $mtime = lmtime($download);
 454     if ($mtime and $today > $delay*DS+$mtime
 455         and logdel($data,"$data deleted")) {
 456       if (open $ef,'>',$ef) {
 457         printf {$ef} "%s has been autodeleted after download at %s\n",
 458                      filename($file),isodate(lmtime($download));
 459         close $ef;
 460       }
 461     }
 462   } elsif (-f $data) {
 463     my $reactivation = $file =~ m{/\Q$admin/reactivation.txt\E$};
 464     $warn = $reactivation ? $keep-5 : $keep-2;
 465     $mtime = lmtime("$file/filename") || lmtime($data) || 0;
 466     if ($today > $mtime+$keep*DS) {
 467       if ($account_expire and $reactivation) {
 468         if ($account_expire =~ /delete/) {
 469           logdel($to,"$to removed - expired");
 470         } else {
 471           if (open $sendmail,"|$sendmail $admin $bcc") {
 472             $account_expire =~ /(\d+)/;
 473             my $expire = $1 || 0;
 474             pq($sendmail,qq(
 475               'From: fex\@$hostname'
 476               'To: $admin'
 477               'Subject: user $to expired'
 478               ''
 479               'F*EX user $to has been inactive for $expire days'
 480               'and has ignored the account reactivation mail.'
 481               'You may want to delete this account.'
 482             ));
 483             close $sendmail;
 484             unlink $data;
 485           } else {
 486             warn "$0: cannot send mail - $!\n";
 487           }
 488         }
 489       } else {
 490         if ($file =~ /^anonymous.*\/afex_\d/ or $to =~ /^_.+_/) {
 491           # also _fexmail_*
 492           logdel($file,"$file deleted") and
 493           verbose("rmrf $file (today=$today mtime_upload=$mtime)");
 494         } elsif (logdel($data,"$data deleted")) {
 495           verbose("unlink $data (today=$today mtime=$mtime keep=$keep)");
 496           if (open $ef,'>',$ef) {
 497             $filename = $file;
 498             $filename =~ s:.*/::;
 499             print $ef "$filename is expired";
 500             close $ef;
 501           }
 502         }
 503       }
 504     }
 505     elsif ($file !~ /STDFEX$/ and
 506            $mtime+$warn*DS < $today and
 507            $dkey = readlink("$file/dkey") and
 508            not -s $download and
 509            not -f $notify and
 510            (readlink("$to/\@REMINDER")||'yes') ne 'no')
 511     {
 512       my $locale = readlink "$to/\@LOCALE" || readlink "$file/\@LOCALE";
 513       $locale = 'english' unless $locale and $notify{$locale};
 514       if (open my $c,"$file/comment") {
 515         chomp ($comment = <$c>||'');
 516         close $c;
 517       }
 518       if (&{$notify{$locale}}(
 519         status     => 'remind',
 520         dkey       => $dkey,
 521         filename   => filename($file),
 522         keep       => $keep,
 523         comment    => $comment,
 524         warn       => int(($mtime-$today)/DS)+$keep,
 525         autodelete => autodelete($file),
 526       )) {
 527         open $notify,'>',$notify;
 528         close $notify;
 529         print "sent reminder for $file\n" if -t or $opt_v;
 530       } else {
 531         warn "$0: reminder notification for $file failed\n";
 532       }
 533     }
 534   }
 535 }
 536
 537 sub autodelete {
 538   my $file = shift;
 539   my $adf = "$file/autodelete";
 540   my $autodelete;
 541
 542   if (-l $adf) {
 543     $autodelete = readlink $adf || '';
 544   } elsif (open $adf,$adf) {
 545     chomp($autodelete = <$adf>||'');
 546     close $adf;
 547   }
 548
 549   return $autodelete||$::autodelete;
 550 }
 551
 552 sub logdel {
 553   my ($file,$msg) = @_;
 554   my $status = 0;
 555
 556   if ($opt_d) {
 557     print "$msg\n";
 558   } else {
 559     if ($status = rmrf($file)) {
 560       logv($msg);
 561     } else {
 562       logv("$file DEL FAILED : $!");
 563       warn "$file DEL FAILED : $!\n" if -t or $opt_v;
 564     }
 565   }
 566
 567   return $status;
 568 }
 569
 570
 571 sub logv {
 572   my $msg = shift;
 573
 574   print "$msg\n" if -t or $opt_v;
 575
 576   unless ($opt_d) {
 577     foreach my $ld (@logdir) {
 578       if (open my $log,">>$ld/cleanup.log") {
 579         print {$log} "$isodate $msg\n";
 580         close $log;
 581       }
 582     }
 583   }
 584 }
 585
 586
 587 sub verbose {
 588   local $_;
 589   if ($opt_v) {
 590     while ($_ = shift @_) {
 591       s/\n*$/\n/;
 592       print;
 593     }
 594   }
 595 }
 596
 597
 598 sub lmtime {
 599   my @s = lstat(shift);
 600   return @s?$s[9]:0;
 601 }