#!/usr/local/bin/perl
# @(#)mkpopuser 0.21 -- manage pop user directories/files
# 12 september 1997
# jbackus@plex.nl

($program=$0)=~s%.*/%%;

use Fcntl qw/O_RDONLY/;
use File::Find;
use DB_File;
use CDB_File;

$qhome="/var/qmail";
$delim=':';
$break='-';
$mailhome="/var/mailhome";
$pop_user="alias";

($pop_uid,$pop_gid)=(getpwnam($pop_user))[2,3] or
  die "can't get passwd info on user $pop_user!\n";

$ENV{"PATH"}="$qhome/bin:/usr/bin:/usr/etc:/usr/ucb";

sub usage {
print STDERR <<EOT;
usage: $program [-adsq] popdomain user
       -a = add user
       -d = delete user
       -s = show user
       -q = be quiet
EOT
exit 2;
}

sub info {
  print STDERR "$program: @_\n" if !$quiet;
}

{
last unless $ARGV[0] =~ /^-/;
$_ = shift;
last if /^--$/;
$add++, redo if /-a/;
$del++, redo if /-d/;
$show++, redo if /-s/;
$quiet++, redo if /-q/;
warn "bad flag: $_\n"; usage;
}

sub hashdir($) {
  my $key=shift;
  substr($key,0,1);
}

sub get_dominfo {
  my ($popdomain) = shift;
  my ($vpfile,$domain,$host,$domaindir,$prefix,$found);
  $vpfile = "$mailhome/virtualpopdomains";
  info "popdomain is $popdomain";
  undef $found;
  open VP, $vpfile or die "can't open $vpfile: $!\n";
  while (<VP>) {
    chomp;
    ($domain,$host,$domaindir,$prefix) = split /\s*$delim\s*/;
    $found = ($domain eq $popdomain);
    last if $found;
  }
  close VP;
  info "prefix is $prefix" if $found;
  return $found?($domain,$host,$domaindir,$prefix):undef;
}

sub getpopnam {
  my ($user)=shift;
  my ($passwd);
  if ($popdb{$user}) {
    return ($user,$passwd) = split $delim, $popdb{$user};
  } else {
    return undef;
  }
}

sub getqunam_assign {
  my ($user)=shift;
  info "prefix is $prefix";
  my $auser=$prefix?"$prefix$break$user":"$user";
  if (open A,"$qhome/users/assign") {
    chop(@_=grep /=$auser:/,<A>);
    close A;
    return split ':',shift @_;
  } else {
    return undef;
  }
}

sub getqunam {
  my ($user)=shift;
  my $auser=$prefix?"$prefix$break$user":"$user";
  my (@u);
  info "prefix is $prefix";
  tie %userscdb, 'CDB_File',"$qhome/users/cdb"
    or die "can't tie $qhome/users/cdb: $!\n";
  $auser="\x21$auser\0"; # users/cdb hash key encoding
  @u=split '\0',$userscdb{$auser};
  untie %userscdb;
  return @u;
}

sub uinfo {
my ($user)=shift;
($uid,$gid)=(getqunam($user))[1,2] or
  die "can't get qmail-users info on user $user!\n";
($uid,$gid);
}

sub mychown($) {
  $_=$_[@_>1?1:0];  # we can be called by find() or directly
  chown $uid,$gid, $_ or die "chown $_: $!\n";
}

sub mkmaildir {
  local ($uid,$gid,$home)=@_;
  my ($old_umask);
  info "uid=$uid,gid=$gid";
  info "creating $home/Maildir";
  system "maildirmake $home/Maildir";
  info "fixing ownership of $home/Maildir";
  find(\&mychown,"$home/Maildir");
  $old_umask=umask 077;
  info "creating $home/.qmail file pointing to ./Maildir/";
  open Q,">$home/.qmail" or die "create $home/.qmail: $!\n";
  print Q "./Maildir/\n";
  close Q;
  chmod 0600,"$home/.qmail" or die "chmod $home/.qmail: $!\n";
  info "fixing ownership of $home/.qmail";
  mychown "$home/.qmail";
}

sub add {
  my ($user)=shift;
  local ($d,$uid,$gid);
  $d=hashdir($user);
  if ((getpopnam($user))[0]) {
    ($uid,$gid)=($pop_uid,$pop_gid);
    $home0="$mailhome/$domaindir/$d";
    unless (-d "$home0") {
      info "creating $home0";
      mkdir "$home0",0700 or die "mkdir $home0: $!\n";
      find(\&mychown,$home0);
    }
    $home="$home0/$user";
    info "creating $home";
    mkdir $home,0700 or die "mkdir $home: $!\n";
    info "fixing ownership of $home";
    mychown $home;
    mkmaildir $uid,$gid,$home;
  } else {
    info "user $user not in popdb";
    if ($home=(getqunam($user))[3]) {
      info "user $user in users/cdb file";
      ($uid,$gid)=uinfo $user;
      mkmaildir $uid,$gid,$home;
    } else {
      info "$user does not exist in this popdomain";
    }
  }
}

sub del {
  my ($user)=shift;
  my ($home,$d,$h,$rmhome);
  $d=hashdir($user);
  if (getpopnam($user)) {
    info "$user in popdb";
    $home="$mailhome/$domaindir/$d/$user";
    $rmhome=1;
  } elsif ($h=(getqunam($user))[3]) {
    info "$user in users/cdb";
    $home="$h";
    $rmhome=0;
  }
  if ($home && -d $home) {
    info "removing $home/{Maildir,.qmail}";
    system "rm -rf $home/Maildir $home/.qmail";
    if ($rmhome) {
      info "removing $home";
      system "rm -rf $home";
    }
  } else {
    info "$user has no mailbox, nothing removed";
  }
}

sub show {
  my ($user)=shift;
  local ($d,$uid,$gid);
  @u=getqunam($user);
  if (@u) {
    info "users/cdb info: $user -> @u";
  } else {
    info "$user does not exist in this popdomain";
  }
}

$add++ if !($add or $del or $show); # default == add
$popdomain = shift || usage;
$user = shift || usage;

# lookup popdomain
($domaindir,$prefix) = (get_dominfo $popdomain)[2,3];

$poppassdb="$mailhome/$domaindir/poppasswd.db";

info "popdb is $poppassdb";
tie %popdb, DB_File,$poppassdb,O_RDONLY,0,$DB_HASH
  or die "can't tie $poppassdb: $!\n";

if ($add) { add $user };
if ($del) { del $user };
if ($show) { show $user };

untie %popdb;

exit 0;
