#!/usr/bin/perl -w

# CLI admin client for the FEX service
#
# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#

use 5.006;
use Getopt::Std;
use File::Basename;
use Digest::MD5		qw(md5_hex);

use constant M => 1024*1024;

# do not run as CGI!
exit if $ENV{SCRIPT_NAME};

# search for fex lib
foreach my $lib (
  dirname(dirname($0)),
  '/usr/local/fex',
  '/usr/local/share/fex',
  '/usr/share/fex',
) {
  $ENV{FEXLIB} = $FEXLIB = $lib       and last if -f "$lib/fex.pp";
  $ENV{FEXLIB} = $FEXLIB = "$lib/lib" and last if -f "$lib/lib/fex.pp";
}
die "$0: no FEXLIB\n" unless $FEXLIB;

$0 =~ s:.*/::;

# become effective user fex
unless ($<) {
  if (my @pw = getpwnam('fex')) {
    $) = $pw[3];
    $> = $pw[2];
    $ENV{HOME} = $pw[7];
  } else {
    die "$0: no such user 'fex'\n";
  }
}

# import from fex.pp
our ($FEXHOME,$hostname,$spooldir,$logdir,$akeydir,$docdir);
our ($durl,$mdomain,$admin);
our ($autodelete,$keep_default,$recipient_quota,$sender_quota);

# load common code, local config : $HOME/lib/fex.ph
require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";

die "$0: \$admin not configured in $FEXLIB/fex.ph\n" if $admin =~ /example.org/;

$EDITOR = $ENV{VISUAL} || $ENV{EDITOR} || 
          (-x '/usr/bin/editor' ? '/usr/bin/editor' : 'vi');

$opt_c = $opt_v = $opt_l = $opt_h = $opt_w = 0;
$opt_u = $opt_r = $opt_d = $opt_q = $opt_a = $opt_k = $opt_S = '';

getopts('hcvlwu:q:r:d:a:k:S:') or usage(2);
usage(0) if $opt_h;

unless (-d $spooldir) {
  die "$0: no $spooldir - create it (mkdir)\n";
}

@stat = stat $spooldir or die "$0: cannot access $spooldir - $!\n";
warn "$0: $spooldir with owner=root !?\n" unless $stat[4];
$) = $stat[5];
$> = $stat[4];

$fup = $durl;
$fup =~ s:/[^/]+$:/fup:;

# list files and download URLs
if ($opt_w) {
  $log = "$logdir/fexsrv.log";
  warn "$0: polling $log\n\n";
  exec "$FEXHOME/bin/logwatch",$log;
  die "$0: logwatch not found\n";
}

# list files and download URLs
if ($opt_l) {
  my ($file,$dkey);
  chdir $spooldir or die "$0: $spooldir - $!\n";
  foreach $file (glob "*/*/*") {
    if (-s "$file/data" and 
        $dkey = readlink("$file/dkey") and 
        -l ".dkeys/$dkey") {
      ($to,$from,$file) = split "/",$file;
      print "$from --> $to : $durl/$dkey/$file\n";
    }
  }
  exit;
}

# delete user 
if ($opt_d) {
  $idf = "$spooldir/$opt_d/\@";
  die "$0: no such user $opt_d\n" unless -f $idf;
  unlink $idf or die "$0: cannot remove $idf - $!\n";
  unlink "$spooldir/$opt_d/\@ALLOWED_RECIPIENTS";
  print "$opt_d deleted\n";
  exit;
}

# edit user restriction file
if ($opt_r) {
  if    ($opt_r =~ /^r/i) { $opt_r = 'ALLOWED_RECIPIENTS' }
  elsif ($opt_r =~ /^u/i) { $opt_r = 'UPLOAD_HOSTS' }
  elsif ($opt_r =~ /^d/i) { $opt_r = 'DOWNLOAD_HOSTS' }
  else                    { usage(2) }
  $user = shift or usage(2);
  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  die "$0: no user $user\n" unless -d "$spooldir/$user";
  my $rf = "$spooldir/$user/\@$opt_r";
  unless (-f $rf) {
    open $rf,'>',$rf or die "$0: cannot open $rf - $!";
    if ($opt_r eq 'ALLOWED_RECIPIENTS') {
      print {$rf}<<EOD;
# Restrict allowed recipients. Only listed addresses are allowed as recipients.
# Make this file COMPLETLY empty if you want to disable the restriction.
# An allowed recipient is an e-mail address. You can use * as wildcard.
# Examples:
#    framstag\@rus.uni-stuttgart.de
#    *\@flupp.org
EOD
    } else {
      print {$rf}<<EOD;
# Restrict allowed upload hosts. 
# Only listed addresses are allowed as upload hosts.
# Make this file COMPLETLY empty if you want to disable the restriction.
# You can add single ip adresses or ip ranges.
# Examples:
#    129.69.1.11
#    10.0.10.0-10.0.10.255
EOD
    }
    close $rf;
  }
  system $EDITOR,$rf;
  unlink $rf if -s $rf<5;
  exit;
}

# edit configuration
if ($opt_c) {
  exec $EDITOR,"$FEXLIB/fex.ph";
}

# show config
if ($opt_v) {
  print "config from $FEXLIB/fex.ph :\n";
  print "\tspooldir        = $spooldir\n";
  print "\tlogdir          = $logdir\n";
  print "\tdocdir          = $docdir\n";
  print "\tdurl            = $durl\n";
  print "\tmdomain         = $mdomain\n";
  print "\tautodelete      = $autodelete\n";
  print "\tkeep            = $keep_default\n";
  print "\trecipient_quota = $recipient_quota\n";
  print "\tsender_quota    = $sender_quota\n";
  print "\tadmin           = $admin\n";
  exit;
}

# add user or show user config
if ($opt_u) {
  $user = lc $opt_u;
  $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
  $id = shift;
  $idf = "$spooldir/$user/@";
  if (open $idf,$idf) {
    chomp($ido = <$idf>||'');
    close $idf;
  }
  unless ($id) {
    die "$0: $user is not a FEX user\n" unless -f "$spooldir/$user/@";
    showuser($user,$ido);
    exit;
  }
  unless ($user =~ /\w@[\w\.\-]+\.[a-z]+$/) {
    die "$0: $user is not a valid e-mail-address!\n";
  }
  unless (-d "$spooldir/$user") {
    mkdir "$spooldir/$user",0755 
      or die "$0: cannot mkdir $spooldir/$user - $!\n";
  }
  open F,">$idf" or die "$0: cannot write $idf - $!\n";
  print F $id,"\n";
  close F or die "$0: cannot write $idf - $!\n";
  showuser($user,$id);
  exit;
}

# set user autodelete default
if ($opt_a) {
  $user = lc $opt_a;
  $user .= '@'.$mdomain if $user !~ /@/;
  $_ = shift @ARGV || '';
  if    (/^n/i) { $autodelete = 'no' } 
  elsif (/^y/i) { $autodelete = 'yes' } 
  elsif (/^d/i) { $autodelete = 'delay' } 
  else          { usage(2) }
  mkdir "$spooldir/$user",0755;
  my $adf = "$spooldir/$user/\@AUTODELETE";
  unlink $adf;
  symlink $autodelete,$adf or die "$0: cannot create symlink $adf - $!\n";
  exit;
}

# set user keep default
if ($opt_k) {
  $user = lc $opt_k;
  $user .= '@'.$mdomain if $user !~ /@/;
  my $keep = shift @ARGV || '';
  die usage(2) if $keep !~ /^\d+$/;
  mkdir "$spooldir/$user",0755;
  my $kf = "$spooldir/$user/\@KEEP";
  unlink $kf;
  symlink $keep,$kf or die "$0: cannot create symlink $kf - $!\n";
  exit;
}

# quota
if ($opt_q) {
  $user = lc $opt_q;
  $user .= '@'.$mdomain if $user !~ /@/;
  unless (-d "$spooldir/$user") {
    die "$0: $user is not a regular FEX user\n";
  }
  
  quota($user,@ARGV);
  exit;
}

if ($opt_S eq 'fup') { 
  &fupstat;
  exit;
}

if ($opt_S eq 'fop') {
  &fopstat;
  exit;
}

usage(3);

sub showuser {
  my $user = shift;
  my $id = shift;
  my ($keep,$autodelete);
  
  printf "%s/%s\n",$fup,b64("from=$user&id=$id");
  print "$fup?from=$user\n";
  print "auth-ID: $id\n";
  $autodelete = readlink "$spooldir/$user/\@AUTODELETE" || $::autodelete;
  print "autodelete default: $autodelete\n";
  $keep = readlink "$spooldir/$user/\@KEEP" || $keep_default;
  print "keep default: $keep\n";
  quota($user);
}

# set or show disk quota
sub quota {
  my $user = shift;
  my $rquota = '';
  my $squota = '';
  my $qf = "$spooldir/$user/\@QUOTA";
  local $_;
  
  if (open $qf,$qf) {
    while (<$qf>) {
      s/#.*//;
      $rquota = $1 if /recipient.*?(\d+)/i;
      $squota = $1 if /sender.*?(\d+)/i;
    }
    close $qf;
  }
  
  if (@_) {
    while (@_) {
      $_ = shift;
      $rquota = $1 if /^r.*:(\d*)/i;
      $squota = $1 if /^s.*:(\d*)/i;
    }
    open $qf,'>',$qf or die "$0: cannot write $qf - $!\n";
    print {$qf} "recipient:$rquota\n" if $rquota =~ /\d/;
    print {$qf} "sender:$squota\n"    if $squota =~ /\d/;
    close $qf;
  } 
  
  $rquota = $recipient_quota if $rquota !~ /\d/;
  $squota = $sender_quota    if $squota !~ /\d/;
  print "recpient quota: $rquota\n";
  print "sender quota:   $squota\n";
}


sub usage {
  my $port = '';
  my $proto = 'http';
  
  if ($durl =~ /:(\d+)/)    { $port = ":$1" }
  if ($durl =~ /^(https?)/) { $proto = $1 }

  print <<EOD;
usage: $0 -u user          # show user config
usage: $0 -u user auth-ID  # create new user or set new auth-ID
usage: $0 -q user s:quota  # set new disk quota (MB) for sender user
usage: $0 -q user r:quota  # set new disk quota (MB) for recipient user
usage: $0 -rr user         # edit user recipients restriction file
usage: $0 -ru user         # edit user upload restriction file
usage: $0 -rd user         # edit user download restriction file
usage: $0 -d user          # delete user
usage: $0 -a user [ynd]    # set user autodelete default (yes, no, delay)
usage: $0 -k user days     # set user keep default in days
usage: $0 -S fup           # file upload statistics
usage: $0 -S fop           # file download statistics
usage: $0 -v               # show server config
usage: $0 -c               # edit server config
usage: $0 -l               # list current files
usage: $0 -w               # watch fexsrv.log (continously)
examples: $0 -u framstag\@rus.uni-stuttgart.de schwubbeldidu
          $0 -q framstag\@rus.uni-stuttgart.de s:10000
EOD
  if (-x "$FEXHOME/cgi-bin/fac") {
    print "See also web admin interface $proto://$hostname$port/fac\n";
  }
  exit shift;
}


sub fupstat {
  my (%user,%domain,%du);
  my ($log,$u,$d,$z);
  my $Z = 0;
    
  if (-t) { $log = "$logdir/fup.log" } 
  else    { $log = '>&=STDIN' }
  open $log,$log or die "$0: cannot open $log - $!\n";
  
  while (<$log>) {
    if (/^([\d: -]+) (\[[\d_]+\] )?(\w\S*) .* (\d+)$/) {
      $z = $4;
      $u = $3;
      $u .= '@'.$mdomain if $mdomain and $u !~ /@/;
      $user{$u} += $z;
      $d = $u;
      $d =~ s/.*@//;
      $d =~ s/.*\.(.+\.\w+)/$1/;
      $domain{$d} += $z;
      $du{$d}{$u}++;
      $Z += $z;
    }
  }

  foreach $u (sort {$user{$a} <=> $user{$b}} keys %user) {
    printf "%s : %d\n",$u,$user{$u}/M;
  }
  print "========================================================\n";
  foreach $d (sort {$domain{$a} <=> $domain{$b}} keys %domain) {
    printf "%s : %d MB, %d user\n",$d,$domain{$d}/M,scalar(keys %{$du{$d}});
  }
  printf "Total: %d GB\n",$Z/M/1024;
  
  exit;
}


sub fopstat {
  my $Z = 0;
  my ($log,$u,$d,$z);
  my (%user,%domain,%du);
    
  if (-t) { $log = "$logdir/fop.log" } 
  else    { $log = '>&=STDIN' }
  open $log,$log or die "$0: cannot open $log - $!\n";
  
  while (<$log>) {
    if (/^([\d: -]+) (\[[\d_]+\] )?[\d.]+ (.+?)\/.* (\d+)\/\d+/) {
      $z = $4;
      $u = $3;
      $u .= '@'.$mdomain if $mdomain and $u !~ /@/;
      $user{$u} += $z;
      $d = $u;
      $d =~ s/.*@//;
      $d =~ s/.*\.(.+\.\w+)/$1/;
      $domain{$d} += $z;
      $du{$d}{$u}++;
      $Z += $z;
    }
  }

  foreach $u (sort {$user{$a} <=> $user{$b}} keys %user) {
    printf "%s : %d\n",$u,$user{$u}/M;
  }
  print "========================================================\n";
  foreach $d (sort {$domain{$a} <=> $domain{$b}} keys %domain) {
    printf "%s : %d MB, %d user\n",$d,$domain{$d}/M,scalar(keys %{$du{$d}});
  }
  printf "Total: %d GB\n",$Z/M/1024;
  
  exit;
}
