#!/usr/bin/perl -w

# cleanup for F*EX service
#
# run this program via cron-job once at night!
#
# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#

use Getopt::Std;
use File::Basename;
use IO::Socket::INET;
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};

unless ($FEXLIB = $ENV{FEXLIB}) {
  if ($ENV{FEXHOME}) {
    $FEXLIB = $ENV{FEXHOME}.'/lib';
  } elsif (-f '/usr/share/fex/lib/fex.ph') {
    $FEXLIB = '/usr/share/fex/lib';
  } else {
    $FEXLIB = dirname(dirname(abs_path($0))).'/lib';
  }
  $ENV{FEXLIB} = $FEXLIB;
}
die "$0: no FEXLIB\n" unless -r "$FEXLIB/fex.pp";

# program name
$_0 = $0;
$0 =~ s:.*/::;

$| = 1;

# use fex.ph for site configuration!
our ($FEXHOME);
our ($spooldir,@logdir,$docdir);
our ($akeydir,$ukeydir,$dkeydir,$skeydir,$gkeydir,$xkeydir,$lockdir);
our ($durl,$debug,$autodelete,$hostname,$admin,$admin_pw,$bcc,$reminder);
our ($keep_default,$keep_max,$purge);

# 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
# (needed for reminder and account reactivation e-mails)
foreach my $lf (glob "$FEXHOME/locale/*/lib/lf.pl") { require $lf }

# default locale functions (from fex.pp)
$notify{english} = \&notify;
$reactivation{english} = \&reactivation;

@_ARGV = @ARGV;

$opt_V = $opt_d = 0;
$opt_v = -t STDIN;
getopts('vVd') or die "usage: $ [-v] [-d]\n";
$opt_v = $opt_d if $opt_d;  # debug mode, no real action

$today = time;
$isodate = isodate($today);

chdir $spooldir or die "$0: $spooldir - $!\n";

# rebuild dkey lookup directory
mkdir $dkeydir;
foreach my $file (glob("*@*/*@*/*")) {
  if (-f "$file/data" and my $dkey = readlink "$file/dkey") {
    unless (-l "$dkeydir/$dkey") {
      if ($opt_d) {
        logv("restoring missing dkey $dkey for $file");
      } else {
        if (symlink "../$file","$dkeydir/$dkey") {
          logv("restoring missing dkey $dkey for $file");
        } else {
          logv("cannot restore $dkeydir/$dkey - $!\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/DOX") {
    print "calculating disk usage of $to/DOX\n" if -t or $opt_v;
    foreach my $d (glob "$to/DOX/.*.du") {
      unlink untaint($d);
    }
    doxdu($to);
  }
  unless (opendir TO,$to) {
    warn "$0: $spooldir/$to - $!\n";
    next;
  }
  while ($from = readdir TO) {
    next if $from =~ /^\./;
    if ($from eq '@GROUP') {
      foreach my $group (glob "$to/\@GROUP/*") {
        if (-l $group and not -f $group) {
          logdel($group,"$group deleted (master has gone)");
        }
      }
    } elsif ($from eq 'SHARE') {
      foreach my $sup (glob "$to/SHARE/*/archives/*/*/upload") {
        my $mtime = lmtime($sup);
        if ($mtime and $today > $mtime+DS) {
          my $av = dirname($sup);
          logdel($av,"$av deleted (aborted upload)");
        }
      }
    } elsif ($from eq 'STREAM') {
      foreach my $stream (glob "$to/STREAM/*") {
        my $mtime = lmtime($stream);
        if ($mtime and $today > $mtime+DS) {
          logdel($stream,"$stream deleted");
        }
      }
    } elsif ($from eq 'CCC') {
      foreach my $ccc (glob "$to/CCC/*") {
        my $mtime = lmtime($ccc);
        if ($mtime and $today > $mtime+DS) {
          logdel($ccc,"$ccc deleted");
        }
      }
    } elsif ($from eq 'DOX') {
      foreach my $dox (glob "$to/DOX/*") {
        if (-f $dox) {
          logdel($dox,"$dox deleted");
        }
      }
    } elsif (-d "$to/$from" and $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 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");
      next;
    }
    $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 $spooldir;

# clean up download key lookup directory
if (chdir $dkeydir and opendir D,'.') {
  while ($file = readdir D) {
    if (-l $file and readlink_("$file/dkey") ne $file) {
      logdel($file,".dkeys/$file deleted");
    }
  }
  closedir D;
}

# clean up upload key lookup directory
if (chdir $ukeydir and opendir D,'.') {
  while ($file = readdir D) {
    next if $file eq '.' or $file eq '..';
    if (($link = readlink $file and not -e "$link/upload"
         or -f $file and time > lmtime($file)+DS)
         or not -e $file)
    { logdel($file,".ukeys/$file deleted") }
  }
  closedir D;
}

# clean up authorization key lookup directory
if (chdir $akeydir and opendir D,'.') {
  while ($file = readdir D) {
    if (-l $file and time > (lmtime($file)||0)+DS or not -e $file)
    { logdel($file,".akeys/$file deleted") }
  }
  closedir D;
}

# clean up extra download key lookup directory
if (chdir $xkeydir and opendir D,'.') {
  while ($file = readdir D) {
    next if $file eq '.' or $file eq '..';
    if (-l $file and not (-f "$file/upload" or -f "$file/data")
        or not -e $file)
    { logdel($file,".xkeys/$file deleted") }
  }
  closedir D;
}

# clean up lock directory
if (chdir $lockdir and opendir D,'.') {
  while ($file = readdir D) {
    if (-f $file and time > lmtime($file)+DS) {
      logdel($file,".locks/$file deleted");
    }
  }
  closedir D;
}

# clean up error directory
if (chdir "$spooldir/.error" and opendir D,'.') {
  while ($file = readdir D) {
    if (-f $file) {
      $mtime = lmtime($file);
      if ($mtime and $today > 2*$keep_max*DS+$mtime) {
        if ($opt_d) { print "unlink .error/$file\n" }
        else        { logdel($file,".error/$file deleted") }
      }
    }
  }
  closedir D;
}

# clean up debug directory
if (chdir "$spooldir/.debug" and opendir D,'.') {
  while ($file = readdir D) {
    if (-f $file) {
      $mtime = lmtime($file);
      if ($mtime and $today > $keep_default*DS+$mtime) {
        # logdel($file,".debug/$file deleted");
        if ($opt_d) { print "unlink .debug/$file\n" }
        else        { unlink $file }
      }
    }
  }
  closedir D;
}

# clean up subuser keys directory
if (chdir $skeydir and opendir D,'.') {
  while ($file = readdir D) {
    if (my $user = readlink $file) {
      if ($file ne md5_hex(readline1("$spooldir/$user/@")||'')) {
        logdel($file,".skeys/$file deleted");
      }
    } elsif (-f $file and open F,$file) {
      $delete = 1;
      $from = $to = $id = '';
      while (<F>) {
        if (/^(\w+)=(.+)/) {
          $from = $2 if $1 eq 'from';
          $to   = $2 if $1 eq 'to';
          $id   = $2 if $1 eq 'id';
        }
      }
      close F;
      if ($from and $to and $id and open F,"$spooldir/$to/\@SUBUSER") {
        while (<F>) {
          if (/^\Q$from:$id\E$/) {
            $delete = 0;
            last;
          }
        }
        close F;
      }
      if ($delete) {
        logdel($file,".skeys/$file deleted");
      }
    }
  }
  closedir D;
}

# clean up orphan subuser links
chdir $spooldir;
foreach $subuser (glob '*/@MAINUSER/*') {
  if ($skey = readlink $subuser and not -f "$skeydir/$skey") {
    logdel($subuser,"$subuser deleted");
  }
}
foreach $subuser (glob '*/@MAINUSER') {
  unlink $subuser unless $opt_d;
}

# clean up old OKEYs
chdir $spooldir;
foreach my $okey (glob '*/@OKEY/*') {
  if (time > lmtime($okey)+$keep_default*DS) {
    logdel($okey,"$okey deleted");
  }
}


# clean up group keys directory
if (chdir $gkeydir and opendir D,'.') {
  while ($gkey = readdir D) {
    if (-f $gkey and open F,$gkey) {
      $delete = 1;
      $from = $group = $id = '';
      while (<F>) {
        if (/^(\w+)=(.+)/) {
          $from  = $2 if $1 eq 'from';
          $group = $2 if $1 eq 'to';
          $id    = $2 if $1 eq 'id';
        }
      }
      close F;
      $group =~ s/^@//;
      $gf = "$spooldir/$from/\@GROUP/$group";
      if ($from and $group and $id and open F,$gf) {
        while (<F>) {
          if (/^\Q$from:$id\E$/) {
            $delete = 0;
            last;
          }
        }
        close F;
      }
      if ($delete) {
        logdel($gkey,".gkeys/$gkey deleted");
        logdel($gf,"$gf deleted") if -l $gf;
      }
    }
  }
  closedir D;
}

# clean up self registration directory
if (chdir "$spooldir/.reg" and opendir D,'.') {
  while ($file = readdir D) {
    if (-f $file) {
      $mtime = lmtime($file);
      if ($mtime and $today > $mtime+DS) {
        logdel($file,".reg/$file deleted");
      }
    }
  }
  closedir D;
}

# send account expiration warning
chdir $spooldir;
if ($account_expire and $account_expire =~ /^(\d+)/) {
  my $expire = $1;
  chomp($admin_pw = slurp("$admin/\@")||'');
  unless ($admin_pw) {
    warn "create new fex account for $admin\n";
    $admin_pw = randstring(8);
    system("$FEXHOME/bin/fac -u $admin $admin_pw");
  }
  my $fid = "$FEXHOME/.fex/id";
  unless (-f $fid) {
    mkdir "$FEXHOME/.fex",0700;
    if (open $fid,'>',$fid) {
      if ($durl =~ m{(https?://.+?)/}) {
        print {$fid} "$1\n";
      } else {
        print {$fid} "$hostname\n";
      }
      print {$fid} "$admin\n";
      print {$fid} "$admin_pw\n";
      close $fid;
    } else {
      warn"$0: cannot create $fid - $!";
    }
  }
  chmod 0600,$fid;
  opendir $spooldir,'.';
  while ($user = readdir $spooldir) {
    next unless -f "$user/\@";
    next if -e "$user/$admin/reactivation.txt";
    next if -e "$user/\@PERSISTENT";
    next if $user !~ /@/ or -l $user;
    next if $user =~ /^(fexmaster|fexmail)/ or $user eq $admin;
    next if -l "$user/.login";

    if (time > lmtime($user)+$expire*DS) {
      # print "$spooldir/$user\n";
      local $locale = readlink "$user/\@LOCALE";
      $locale = 'english' unless $locale and $reactivation{$locale};
      if ($opt_d) {
        print "fex reactivation.txt to $user\n";
      } else {
        &{$reactivation{$locale}}($expire,$user);
      }
      sleep 1;
    }
  }
  closedir $spooldir;
}

# vhosts
exit if $opt_V;
if (%vhost) {
  foreach $vhost (keys %vhost) {
    my $fexlib = $vhost{$vhost}.'/lib';
    if (-f "$fexlib/fex.ph") {
      warn "run $0 for $vhost :\n" if -t or $opt_v;
      my $cmd = "HTTP_HOST=$vhost FEXLIB=$fexlib $_0 -V @_ARGV";
      if ($opt_d) { print "$cmd\n" }
      else        { system $cmd }
    }
  }
}

if ($notify_newrelease and $notify_newrelease !~ /^no$/i
    or not defined $notify_newrelease) {
  $notify_newrelease ||= $admin;
  $newnew = $new = '';
  $snew = $FEXHOME.'/doc/new';
  $new = slurp($snew)||'';
  $_ = 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`;
    last if $newnew =~ /release/;
    # $newnew = `wget -qO- http://fex.rus.uni-stuttgart.de/$qn 2>/dev/null`;
    # last if $newnew =~ /release/;
  };
  if ($newnew =~ /release/) {
    if ($newnew ne $new) {
      if (open $sendmail,"|$sendmail $notify_newrelease $bcc") {
        pq($sendmail,qq(
          'From: fex\@$hostname'
          'To: $notify_newrelease'
          'Subject: new F*EX release'
          ''
          '$newnew'
        ));
        close $sendmail;
        if (open $snew,'>',$snew) {
          print {$snew} $newnew;
          close $snew;
        }
      }
    }
  }
}

exit;


# file clean up
sub cleanup {
  my ($to,$from,$file) = @_;
  my ($data,$download,$notify,$mtime,$warn,$dir,$filed,$filename,$dkey,$delay);
  my $keep = $keep_default;
  my $purge = $::purge || 3*$keep_default;
  my $comment = '';
  my $kf = "$to/$from/$file/keep";
  my $ef = "$to/$from/$file/error";
  local $_;

  $keep = readlink $kf || readlink "$to/\@KEEP" || $keep_default;
  $purge = $1*$keep_default if $purge =~ /(\d+).*keep/;

  $filed      = "$to/$from/$file";
  $data       = "$filed/data";
  $download   = "$filed/download";
  $notify     = "$filed/notify";

  if ($filed =~ /\/ADDRESS_BOOK/) {
    logdel($filed,"$filed deleted");
  } elsif (-d $filed and not -f $data) {
    if (my $err = readline1($download) and not -e $ef) {
      # old bug workaround
      if ($err =~ /^([\d-]+ [\d:]+) (\S+)/) {
        $err = sprintf
          "%s has been autodeleted after download from %s at %s\n",
          filename($filed),$2,$1;
      }
      if (open $ef,'>',$ef) {
        printf {$ef} $err;
        close $ef;
      }
    } else {
      if ($mtime = lmtime("$filed/upload")) {
        if ($today > $mtime+DS) {
          verbose("rmrf $filed (today=$today mtime_upload=$mtime)");
          logdel($filed,"$filed deleted");
        }
      } elsif ($mtime = lmtime("$filed/error")) {
        if ($filed =~ m:/xxx_\d{8}_\d{6}\.:) {
          verbose("rmrf $filed ($filed/error)");
          logdel($filed,"$filed deleted");
        } elsif ($today > $purge*DS+$mtime) {
          verbose("rmrf $filed (today=$today mtime_error=$mtime keep=$keep purge=$purge)");
          logdel($filed,"$filed deleted");
        }
      } else {
        logdel($filed,"$filed deleted");
      }
    }
  } elsif (-s $download and -s $data and autodelete($filed) !~ /NO/i) {
    $delay = autodelete($filed);
    $delay = 1 if $delay !~ /^\d+$/;
    $delay--;
    $mtime = lmtime($download);
    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",
                     filename($filed),isodate(lmtime($download));
        close $ef;
      }
    }
  } elsif (-f $data) {
    my $reactivation = $filed =~ m{/\Q$admin/reactivation.txt\E$};
    $warn = $reactivation ? $keep-5 : $keep-2;
    $mtime = lmtime("$filed/keep") || lmtime($data) || 0;
    if ($today > $mtime+$keep*DS) {
      if ($account_expire and $reactivation) {
        if ($account_expire =~ /delete/) {
          logdel($to,"$to removed - expired");
        } else {
          if (open $sendmail,"|$sendmail $admin $bcc") {
            $account_expire =~ /(\d+)/;
            my $expire = $1 || 0;
            pq($sendmail,qq(
              'From: fex\@$hostname'
              'To: $admin'
              'Subject: user $to expired'
              ''
              'F*EX user $to has been inactive for $expire days'
              'and has ignored the account reactivation mail.'
              'You may want to delete this account.'
            ));
            close $sendmail;
            unlink $data;
          } else {
            warn "$0: cannot send mail - $!\n";
          }
        }
      } else {
        if ($filed =~ /^anonymous.*\/afex_\d/ or $to =~ /^_.+_/) {
          # also _fexmail_*
          logdel($filed,"$filed deleted") and
          verbose("rmrf $filed (today=$today mtime_upload=$mtime)");
        } elsif (logdel($data,"$data deleted")) {
          verbose("unlink $data (today=$today mtime=$mtime keep=$keep)");
          if (open $ef,'>',$ef) {
            $filename = $filed;
            $filename =~ s:.*/::;
            print $ef "$filename is expired\n";
            close $ef;
          }
        }
      }
    }
    elsif ($file !~ /STDFEX$/ and
           $mtime+$warn*DS < $today and
           $dkey = readlink("$filed/dkey") and
           not -s $download and
           not -f $notify and
           (readlink("$to/\@REMINDER")||$reminder||'yes') =~ /yes/i)
    {
      my $locale = readlink "$to/\@LOCALE" || readlink "$filed/\@LOCALE";
      $locale = 'english' unless $locale and $notify{$locale};
      if (open my $c,"$filed/comment") {
        chomp ($comment = <$c>||'');
        close $c;
      }
      if ($opt_d) {
        print "sent reminder for $filed\n";
      } else {
        if (&{$notify{$locale}}(
          status     => 'remind',
          dkey       => $dkey,
          filename   => filename($filed),
          keep       => $keep,
          comment    => $comment,
          warn       => int(($mtime-$today)/DS)+$keep,
          autodelete => autodelete($filed),
        )) {
          open $notify,'>',$notify;
          close $notify;
          print "sent reminder for $filed\n" if -t or $opt_v;
        } else {
          warn "$0: reminder notification for $filed failed\n";
        }
      }
    }
  }
}

sub autodelete {
  my $file = shift;
  my $adf = "$file/autodelete";
  my $autodelete;

  if (-l $adf) {
    $autodelete = readlink $adf || '';
  } elsif (open $adf,$adf) {
    chomp($autodelete = <$adf>||'');
    close $adf;
  }

  # # no autodelete for sender == recipient
  # if ($file =~ m:(.+)/(.+)/: and $1 eq $2) {
  #  $autodelete = 'NO';
  # }

  return $autodelete||$::autodelete;
}

sub logdel {
  my ($file,$msg) = @_;
  my $n = 0;

#  if ($opt_d and $file !~ /^framstag/) {
  if ($opt_d) {
    print "$msg\n";
  } else {
    if (-l $file or -f $file) {
      if ($n = unlink $file) {
        logv($msg);
      } else {
        logv("$file DEL FAILED : $!");
      }
    } elsif (-d $file) {
      if ($n = rmrf($file)) {
        logv($msg);
      } else {
        logv("$file/ DEL FAILED");
      }
    } else {
      # fallback
      $n = unlink $file;
    }
  }

  return $n;
}


sub logv {
  my $msg = shift;

  print "$msg\n" if -t or $opt_v;

  unless ($opt_d) {
    foreach my $ld (@logdir) {
      if (open my $log,">>$ld/cleanup.log") {
        print {$log} "$isodate $msg\n";
        close $log;
      }
    }
  }
}


sub verbose {
  local $_;
  if ($opt_v) {
    while ($_ = shift @_) {
      s/\n*$/\n/;
      print;
    }
  }
}
