X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/e60096926213ce02293a261254ff065cae44c1c8..3aae246cf7f4af7ae49da09e5ed0c180f31f0c12:/bin/fex_cleanup

diff --git a/bin/fex_cleanup b/bin/fex_cleanup
index 1adec4e..1f38d6b 100755
--- a/bin/fex_cleanup
+++ b/bin/fex_cleanup
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w 
+#!/usr/bin/perl -w
 
 # cleanup for F*EX service
 #
@@ -14,7 +14,7 @@ use Cwd 	'abs_path';
 use Digest::MD5	'md5_hex';
 
 use constant DS => 60*60*24;
-  
+
 # do not run as CGI!
 exit if $ENV{SCRIPT_NAME};
 
@@ -41,14 +41,15 @@ our ($FEXHOME);
 our ($spooldir,@logdir,$docdir);
 our ($akeydir,$ukeydir,$dkeydir,$skeydir,$gkeydir,$xkeydir,$lockdir);
 our ($durl,$debug,$autodelete,$hostname,$admin,$admin_pw,$bcc);
-$keep_default = 5;
+our $keep_default = 5;
+our $purge = $keep_default*3;
 
 # load common code, local config : $HOME/lib/fex.ph
 require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
 
 my $logdir = $logdir[0];
 
-# localized functions 
+# localized functions
 # (needed for reminder and account reactivation e-mails)
 foreach my $lf (glob "$FEXHOME/locale/*/lib/lf.pl") { require $lf }
 
@@ -71,60 +72,60 @@ chdir $spooldir or die "$0: $spooldir - $!\n";
 # clean up regular spool
 opendir $spooldir,'.' or die "$0: $spooldir - $!\n";
 while ($to = readdir $spooldir) {
+  next if $to =~ /^\./;
   next if $to !~ /@/ or $_ = readlink($to) and not /\//;
+  next unless -d $to;
   if (@demo and -f "$to/.demo" and time > lmtime("$to/.demo")+$demo[1]*DS) {
     logdel($to,"demo user $to deleted");
     next;
   }
-  if (-d $to and $to !~ /^\./) {
-    unless (opendir TO,$to) {
-      warn "$0: $spooldir/$to - $!\n";
-      next;
-    }
-    while ($from = readdir TO) {
-      next if $from !~ /@/;
-      if ($from eq '@GROUP') {
-        foreach $group (glob "$to/$from/*") {
-          if (readlink $group and not -f $group) {
-            logdel($group,"$group deleted (master has gone)");
-          }
+  unless (opendir TO,$to) {
+    warn "$0: $spooldir/$to - $!\n";
+    next;
+  }
+  while ($from = readdir TO) {
+    next if $from !~ /@/;
+    if ($from eq '@GROUP') {
+      foreach $group (glob "$to/$from/*") {
+        if (readlink $group and not -f $group) {
+          logdel($group,"$group deleted (master has gone)");
         }
-      } else {
-        if (-d "$to/$from" and $from !~ /^\./) {
-          unless (opendir FROM,"$to/$from") {
-            warn "$0: $spooldir/$to/$from - $!\n";
-            next;
-          }
-          while ($file = readdir FROM) {
-            next if $file eq '.' or $file eq '..';
-            if (-d "$to/$from/$file" and $file !~ /^\./) {
-              cleanup($to,$from,$file);
-              rmdir "$to/$from/$file" unless $opt_d;
-            }
+      }
+    } else {
+      if (-d "$to/$from" and $from !~ /^\./) {
+        unless (opendir FROM,"$to/$from") {
+          warn "$0: $spooldir/$to/$from - $!\n";
+          next;
+        }
+        while ($file = readdir FROM) {
+          next if $file eq '.' or $file eq '..';
+          if (-d "$to/$from/$file" and $file !~ /^\./) {
+            cleanup($to,$from,$file);
+            rmdir "$to/$from/$file" unless $opt_d;
           }
-          closedir FROM;
-          rmdir "$to/$from" unless $opt_d;
         }
+        closedir FROM;
+        rmdir "$to/$from" unless $opt_d;
       }
     }
-    closedir TO;
-    unless (-f "$to/\@PERSISTENT" or $to eq $admin) {
-      @glob = glob "$to/*/* $to/\@MAINUSER/* $to/\@GROUP/*";
-      unless (@glob or -f "$to/\@") {
-        logdel($to,"$to deleted");
-      }
-      $user = $to;
-      if ($login_check and -l "$user/.login") {
-        my $lc = &$login_check(readlink("$user/.login"));
-        if ($lc) {
-          if (-f "$user/\@~" and not "$user/@") {
-            rename "$user/\@~","$user/@" unless $opt_d;
-            logv("$user reanimated (login_check)");
-          }
-        } else {
-          rename "$user/@","$user/\@~" unless $opt_d;
-          logv("$user deactivated (login_check)");
+  }
+  closedir TO;
+  unless (-f "$to/\@PERSISTENT" or $to eq $admin) {
+    @glob = glob "$to/*/* $to/\@MAINUSER/* $to/\@GROUP/*";
+    unless (@glob or -f "$to/\@") {
+      logdel($to,"$to deleted");
+    }
+    $user = $to;
+    if ($login_check and -l "$user/.login") {
+      my $lc = &$login_check(readlink("$user/.login"));
+      if ($lc) {
+        if (-f "$user/\@~" and not "$user/@") {
+          rename "$user/\@~","$user/@" unless $opt_d;
+          logv("$user reanimated (login_check)");
         }
+      } else {
+        rename "$user/@","$user/\@~" unless $opt_d;
+        logv("$user deactivated (login_check)");
       }
     }
   }
@@ -134,7 +135,7 @@ closedir $spooldir;
 # clean up download key lookup directory
 if (chdir $dkeydir and opendir D,'.') {
   while ($file = readdir D) {
-    if ($link = readlink $file and 
+    if ($link = readlink $file and
         (not -l "$link/dkey" or readlink "$link/dkey" ne $file)) {
       logdel($file,".dkeys/$file deleted");
     }
@@ -312,7 +313,7 @@ if (chdir "$spooldir/.reg" and opendir D,'.') {
   closedir D;
 }
 
-# send account expiration warning 
+# send account expiration warning
 if ($account_expire and $account_expire =~ /^(\d+)/) {
   my $expire = $1;
   if (chdir $spooldir) {
@@ -350,7 +351,7 @@ if ($account_expire and $account_expire =~ /^(\d+)/) {
 
       if (time > lmtime($user)+$expire*DS) {
         # print "$spooldir/$user\n";
-        my $locale = readlink "$user/\@LOCALE";
+        local $locale = readlink "$user/\@LOCALE";
         $locale = 'english' unless $locale and $reactivation{$locale};
         &{$reactivation{$locale}}($expire,$user);
         sleep 1;
@@ -374,7 +375,7 @@ if (%vhost) {
   }
 }
 
-if ($notify_newrelease and $notify_newrelease !~ /^no$/i 
+if ($notify_newrelease and $notify_newrelease !~ /^no$/i
     or not defined $notify_newrelease) {
   $notify_newrelease ||= $admin;
   $newnew = $new = '';
@@ -383,6 +384,7 @@ if ($notify_newrelease and $notify_newrelease !~ /^no$/i
   $_ = slurp("$FEXHOME/doc/version")||'';
   if (/(\d+)/) { $qn = "new?$hostname:$1" }
   else         { $qn = "new?$hostname:0" }
+  print "checking for new F*EX release\n" if $opt_v;
   for (1..3) {
     sleep rand(10);
     $newnew = `wget -qO- http://fex.belwue.de/$qn 2>/dev/null`;
@@ -417,12 +419,13 @@ exit;
 sub cleanup {
   my ($to,$from,$file) = @_;
   my ($data,$download,$notify,$mtime,$warn,$dir,$filename,$dkey,$delay);
-  my $comment = '';
   my $keep = $keep_default;
+  my $purge = $::purge || 3*$keep;
+  my $comment = '';
   my $kf = "$to/$from/$file/keep";
   my $ef = "$to/$from/$file/error";
   local $_;
-  
+
   $keep = readlink $kf || readlink "$to/\@KEEP" || $keep_default;
 
   $file       = "$to/$from/$file";
@@ -439,8 +442,9 @@ sub cleanup {
         logdel($file,"$file deleted");
       }
     } elsif ($mtime = lmtime("$file/error")) {
-      if ($today > 3*$keep*DS+$mtime) {
-        verbose("rmrf $file (today=$today mtime_error=$mtime keep=$keep)");
+      $purge = $1*$keep if $purge =~ /(\d+).*keep/;
+      if ($today > $purge*DS+$mtime) {
+        verbose("rmrf $file (today=$today mtime_error=$mtime keep=$keep purge=$purge)");
         logdel($file,"$file deleted");
       }
     } else {
@@ -451,7 +455,7 @@ sub cleanup {
     $delay = 1 if $delay !~ /^\d+$/;
     $delay--;
     $mtime = lmtime($download);
-    if ($mtime and $today > $delay*DS+$mtime 
+    if ($mtime and $today > $delay*DS+$mtime
         and logdel($data,"$data deleted")) {
       if (open $ef,'>',$ef) {
         printf {$ef} "%s has been autodeleted after download at %s\n",
@@ -491,7 +495,7 @@ sub cleanup {
           # also _fexmail_*
           logdel($file,"$file deleted") and
           verbose("rmrf $file (today=$today mtime_upload=$mtime)");
-        } elsif (logdel($data,"$data deleted")) { 
+        } elsif (logdel($data,"$data deleted")) {
           verbose("unlink $data (today=$today mtime=$mtime keep=$keep)");
           if (open $ef,'>',$ef) {
             $filename = $file;
@@ -501,13 +505,13 @@ sub cleanup {
           }
         }
       }
-    } 
+    }
     elsif ($file !~ /STDFEX$/ and
-           $mtime+$warn*DS < $today and 
+           $mtime+$warn*DS < $today and
            $dkey = readlink("$file/dkey") and
-           not -s $download and 
-           not -f $notify and 
-           (readlink("$to/\@REMINDER")||'yes') ne 'no') 
+           not -s $download and
+           not -f $notify and
+           (readlink("$to/\@REMINDER")||'yes') ne 'no')
     {
       my $locale = readlink "$to/\@LOCALE" || readlink "$file/\@LOCALE";
       $locale = 'english' unless $locale and $notify{$locale};
@@ -545,7 +549,7 @@ sub autodelete {
     chomp($autodelete = <$adf>||'');
     close $adf;
   }
-  
+
   return $autodelete||$::autodelete;
 }
 
@@ -563,7 +567,7 @@ sub logdel {
       warn "$file DEL FAILED : $!\n" if -t or $opt_v;
     }
   }
-  
+
   return $status;
 }