#!/usr/local/bin/perl
# @(#)chkpoppass 0.18 -- check pop password, setup and call qmail-pop3d if OK
# 27 november 1997
# jbackus@plex.nl

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

use CDB_File;
use MD5;    # APOP support needs this

$mailhome = "/var/mailhome";
$shell = '/bin/sh';
$delim = ':';
$break = '-';     # the qmail `break' character

# support for the following POP3 USER syntax extensions
$use_prefix = 0;  # acme-joeuser
$use_domain = 0;  # joeuser@acme.com
$at_sign = '@';   # ...and if the latter, which delimiter to use? @,%

# no user-serviceable parts below this line!

sub usage {
  if ($debug) {
    warn "usage: $program -d user passwd apop_ts user_program [args]\n";
  } else {
    warn "usage: $program user_program [args]\n";
  }
  exit 2;
}

sub info {
  warn "$program: @_\n" if $debug;
}

sub read_uinfo {
  my($user,$passwd,$apop_ts);
  open X,"<&=3" or exit 111;
  $_ = <X>;
  # ugly; should use sysread instead
  ($user,$passwd,$apop_ts) = /^(.*)\0(.*)\0(.*)\0/;
  while (<X>) {};
  close X;
  return ($user,$passwd,$apop_ts);
}

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

sub apop {
  my ($sent_user,$sent_digest,$apop_ts) = @_;
  my($user,$passwd,$found);
  ($user,$passwd) = getpopnam($sent_user);
  $found = $passwd?MD5->hexhash("$apop_ts$passwd") eq $sent_digest:undef;
  info "apop: $found";
  return $found;
}

sub popuser {
  my ($sent_user,$sent_passwd) = @_;
  my($passwd,$found);
  $passwd = (getpopnam($sent_user))[1];
  $found = $passwd?$passwd eq crypt($sent_passwd,$passwd):undef;
  info "popuser: $found";
  return $found;
}

sub etcpasswd {
  my ($sent_user,$sent_passwd) = @_;
  my($user,$passwd,$dir,$found);
  ($user,$passwd,$dir) = (getpwnam($sent_user))[0,1,7];
  $found = ($user and $passwd eq crypt($sent_passwd,$passwd));
  info "etcpasswd: $found";
  return ($found,$dir);
}

sub rpop {
  my ($sent_user,$sent_passwd) = (@_);
  my($rport,$found);
  if ($sent_user eq $sent_passwd) {
    $rport = $ENV{"TCPREMOTEPORT"};
    $found = ($rport&&$rport < 1024);   # IPPORT_RESERVED in <netinet/in.h>
    info "rpop: $found";
  }
  return $found;
}

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

# main routine

{
last unless $ARGV[0] =~ /^-/;
$_ = shift;
last if /^--$/;
$debug++, redo if /-d/;
warn "bad flag: $_\n"; usage;
}

usage if @ARGV<($debug?4:1);

($user,$passwd,$apop_ts)=$debug?(shift,shift,shift):read_uinfo;
$user_program = shift;

info "args: user=$user, passwd=$passwd, apop_ts=$apop_ts, "
    ."user_program=$user_program";

open V,"$mailhome/virtualpopdomains" or exit 111;
chomp(@v = <V>);
close V;

# find domaindir:
# use_prefix: use 'USER dom-joe' and use dom to look up some.domain
# use_domain: use 'USER joe@some.domain' and look up some.domain

$domaindir = "";

if (!$domaindir && $use_domain) {
  if (($u,$d) = $user =~ /(.+?)$at_sign(.+)/) {
    info "domain: user=$u, domain=$d";
    %v = map {(split "$delim")[0,2]} @v;
    $domaindir = $v{$d};
    $user = $u;
  }
}
if (!$domaindir && $use_prefix) {
  if (($p,$u) = $user =~ /(.+?)$break(.+)/) {
    info "prefix: user=$u, prefix=$p";
    %v = map {(split "$delim")[3,2]} @v;
    $domaindir = $v{$p};
    $user = $u;
  }
}
if (!$domaindir) {
  %v = map {(split "$delim")[1,2]} @v;
  # if TCPLOCALHOST not set (e.g. when running under inetd),
  # use first virtualpopdomains entry as a default
  $domaindir = defined $ENV{'TCPLOCALHOST'}
               ? $v{$ENV{'TCPLOCALHOST'}}
               : (split "$delim", $v[0])[2];
}

info "domaindir=$domaindir";

exit 111 unless $domaindir;

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

tie %popdb, 'CDB_File',$poppassdb or exit 111 if -f $poppassdb;

$found = 0;

# check if APOP auth
if (!$found) {
  ($found) = apop $user,$passwd,$apop_ts;
  if ($found) { 
    $d = hashdir($user);
    $home = "$mailhome/$domaindir/$d/$user";
    unless (-d $home) { # no pop-only dir, try users's home dir 
      ($found,$dir) = etcpasswd $user,$passwd;
      if ($found) {
        $home = "$dir";
      } 
    }  
  }
}

# check if regular POP user
if (!$found) {
  ($found) = popuser $user,$passwd;
  if ($found) {
    $d = hashdir($user);
    $home = "$mailhome/$domaindir/$d/$user";
  }
}

# check /etc/passwd
if (!$found) {
  ($found,$dir) = etcpasswd $user,$passwd;
  if ($found) {
    $home = "$dir";
  }
}

# check if RPOP user
if (!$found) {
  ($found) = rpop $user,$passwd;
  if ($found) {
    if (getpopnam($user)) {
      $d = hashdir($user);
      $home = "$mailhome/$domaindir/$d/$user";
    } else {
      $home = (getpwnam($user))[7];   # hides errors, oh well
    }
  }
}

untie %popdb if tied %popdb;

if ($found) {
  @ENV{"SHELL","USER","HOME"} = ($shell,$user,$home);
  info "shell=$shell, user=$user, home=$home";
  chdir $home or exit 111;
  exec $user_program, @ARGV; 
  die "$program: can't exec $user_program: $!\n";
}

exit 2;
