#!/usr/local/bin/perl
# @(#)mkpopdb 0.20 -- poppasswd db maintenance
# 18 august 1997
# jbackus@plex.nl

use DB_File;
use Fcntl qw/O_RDWR O_CREAT/;

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

$delim=":";
$break="-";                # the qmail 'break' character
$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";

sub usage {
print STDERR <<EOT;
usage: $program <-adcsq> [-f file] [-l [auq]] popdomain [user] [password]
       -a = add user
       -d = delete user
       -c = check user/password
       -s = treat password as an APOP secret
       -l = list, a=all (default), u=users, formats: c=cdbmake, q=qmail-users
       -f = load db contents from file
       -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/;
$list = shift||"a", redo if /-l/;
$loadfile = shift, redo if /-f/;
$check++, redo if /-c/;
$secret++, redo if /-s/;
$quiet++, redo if /-q/;
warn "bad flag: $_\n"; usage;
}

sub makenewpasswd {
  my ($passwd) = shift;
  my ($setting,$cpw,$historical_crypt,@saltchars);
  $historical_crypt=1;
  srand(time ^ ($$ + ($$ << 15)));
  @saltchars=('a'..'z','A'..'Z',0..9,'.','/');
  if ($historical_crypt) {
    # construct setting consisting of 2-character salt
    $setting = "";
    for (1..2) {
      $setting.=$saltchars[int(rand($#saltchars+1))];
    }
  } else { # this section is not finished!
    $setting="_"; # new style crypt call, allowing wide passwords
    # $setting.=$itercount; # $itercount == 4 bytes
    for (1..4) { # add 4 bytes of salt
      $setting.=$saltchars[int(rand($#saltchars+1))];
    }
  }
  $cpw=crypt($passwd,$setting);
  $cpw=crypt($passwd,$cpw);
}

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

sub list {
  my ($list) = shift;
  my ($key,$val,$akey,$d);
  if ($list eq "u") {
    while (($key,$val) = each %popdb) {
      $akey = $prefix?"$prefix$break$key":"$key";
      print "$akey\n";
    }
  }
  if ($list eq "a") {
    while (($key,$val) = each %popdb) {
      print "$val\n";
    }
  }
  if ($list eq "q") {
    while (($key,$val) = each %popdb) {
      $d = hashdir($key);
      # add virtualpopdomains prefix if non-empty
      $akey = $prefix?"$prefix$break$key":"$key";
      print "=$akey:$pop_user:$pop_uid:$pop_gid:"
           ."$mailhome/$domaindir/$d/$key\:::\n";
      print "+$akey$break:$pop_user:$pop_uid:$pop_gid:"
           ."$mailhome/$domaindir/$d/$key:$break\::\n";
    }
  }
  if ($list eq "c") {
    while (($key,$val) = each %popdb) {
      printf "+%d,%d:%s->%s\n",length($key),length($val),$key,$val;
    }
  }
}

sub cleanup {
  print STDERR "@_\n" if @_;
  untie %popdb if tied %popdb;
  system 'stty echo';
}

sub sigint {
  cleanup "Interrupt"; exit 2;
}

sub askpass {
  my ($secret,$user) = @_;
  my ($passwd1,$passwd2,$what);
  $what=$secret?"Secret":"Password";
  print STDERR "$what for $user: ";
  system 'stty -echo';
  chop($passwd1=<STDIN>);
  print STDERR "\n";
  print STDERR "Verification: ";
  chop($passwd2=<STDIN>);
  system 'stty echo';
  print STDERR "\n";
  if ($passwd1 ne $passwd2) { cleanup "Mismatch - nothing changed."; exit 2; }
  $passwd1;
}

sub add {
  my ($user,$passwd) = @_;
  usage if !$user;
  $passwd = askpass $secret,$user if !$passwd;
  if ($secret) {
    # store passwd as is
  } else {
    $passwd = makenewpasswd $passwd;
  }
  info $popdb{$user}?"updating":"adding","entry for $user";
  $popdb{$user} = join $delim,$user,$passwd;
}

sub del {
  my ($user) = shift;
  usage if !$user;
  if ($popdb{$user}) {
    delete $popdb{$user};
  } else {
    info "no such user: $user";
  }
}

sub check {
  my ($user,$passwd) = @_;
  my $ok;
  if ($popdb{$user}) {
    $passwd = askpass $secret,$user if !$passwd;
    $stored_passwd = (split $delim,$popdb{$user})[1];
    if ($secret) {
      $ok = $passwd eq $stored_passwd;
    } else {
      $ok = ($stored_passwd eq crypt($passwd,$stored_passwd));
    }
    print $ok ? "ok" : "error","\n";
  } else {
    info "no such user: $user";
  }
}

sub loadfile {
  my ($file) = shift;
  my ($user,$passwd);
  usage if !$file or ! -r $file;
  info "loading popdb from $file";
  open F,$file or die "can't open $file: $!\n";
  while(<F>) {
    next if /^\s*$/ or /\s*#/;
    chomp;
    ($user,$passwd) = split /\s*$delim\s*/;
    info $popdb{$user}?"updating":"adding","entry for $user";
    $popdb{$user} = join $delim,$user,$passwd;
  }
  close F;
}

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;
}

$SIG{"INT"} = 'sigint';

$popdomain = shift or usage;
$user = shift;
$passwd = shift;

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

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

tie %popdb, DB_File,$poppassdb,O_RDWR|O_CREAT,0640,$DB_HASH
  or die "can't tie $poppassdb: $!\n";

if ($list) { list $list }
elsif ($add) { add $user,$passwd }
elsif ($del) { del $user }
elsif ($check) { check $user,$passwd }
elsif ($loadfile) { loadfile $loadfile }
else { usage }

untie %popdb;

exit 0;
