#!/usr/bin/perl
# checkpassword-assign.pl
# David J. Weller-Fahy <dave-checkpassword-assign@weller-fahy.com>
#
# Usage: checkkpassword-assign.pl program
#
# Implements the checkpassword interface.
#   see http://cr.yp.to/checkpwd/interface.html
#
# This implementation accepts only full email addresses as the login name, and
# places that email address in the USER environment variable.  It ignores the
# timestamp, and is not able to perform APOP authentication.
#
# Uses the following files:
#   /var/qmail/control/virtualdomains
#       (see man page for qmail-send)
#   /var/qmail/users/assign
#       (see man page for qmail-users)
#   ~mail_user/.password
#       contains a hash of user's password created using unix_md5_crypt
#
# System user is determined using /var/qmail/control/virtualdomains.  Mail
# users home directory is determined using /var/qmail/users/assign (only lines
# beginning with '=' are used).  The password passed on fd 3 is checked against
# the hashed password in a .password file in the mail user's home directory.
#

#
# [loosely] based on:
# checkpassword.pl
# Larry M. Smith <chains-chkpass@FahQ2.com>
# (see http://qmail.org/top.html#checkpassword)
#
use strict;
use warnings;

use Crypt::PasswdMD5 qw(unix_md5_crypt);

my ($assign, $vdomains);

# Set QMAIL_USERS_ASSIGN to override assign file location.
$assign = $ENV{'QMAIL_USERS_ASSIGN'}
    or $assign = "/var/qmail/users/assign";

# Set QMAIL_CONTROL_VIRTUALDOMAINS to override virtualdomains file location.
$vdomains = $ENV{'QMAIL_CONTROL_VIRTUALDOMAINS'}
    or $vdomains = "/var/qmail/control/virtualdomains";

# don't buffer output
$|=1;

%ENV=(); # wipe current environment

# read the login/password/timestamp
my ($length, $buffer);
error("unable to read from fd3", 0, -3)
    unless open(USER, "<&=3");
$length = read(USER, $buffer, 512);
close(USER);
error("login/password/timestamp string too short", 0, -3)
    if $length < 4;

# get the email and password
my ($email, $pass) = split(/\x00/, $buffer);
$buffer = "\x00" x $length; # wipe the buffer

error("$email not an email address", 5, 2)
    unless $email =~ m/@/; # error unless username contains an @

$email = lc($email); # lowercase the email address

# separate user and domain parts of the email address
my ($user, $domain) = split(/@/, $email);

# find the system user responsible for the domain
my $vdomains_line = get_line_from_file($vdomains, ":", $domain);
error("$domain not in virtualdomains", 5, 2)
    unless $vdomains_line;
chomp($vdomains_line);
my (undef, $system_user) = split(/:/, $vdomains_line);

# get the mail user's home directory
my $assign_line = get_line_from_file($assign, ":", ('=' . "$system_user-$user"));
error("invalid user $system_user-$user (not in assign)", 5, 2)
    unless $assign_line;
chomp($assign_line);
my (undef, undef, $uid, $gid, $home) = split(/:/, $assign_line);
error("$home is a symlink", 0, 2)
    if readlink($home); # error if home is a symlink

# get the users password
my $apass = get_line_from_file("$home/.password");
error("password unset for $email in $home", 0, 111)
    unless $apass;
chomp($pass);
chomp($apass);
error("invalid password for $email", 5, 1)
    unless unix_md5_crypt($pass, $apass) eq $apass;

$ENV{USER}=$email;
$ENV{UID}=$uid+0;
$ENV{HOME}=$home;
$ENV{SHELL}="/bin/false";

error("could not set UID: $uid", 0, -4) unless $ENV{UID};

chdir $ENV{HOME};
$) = "$gid $gid";
$( = "$gid";
$> = $ENV{UID};
$< = $ENV{UID};

# Wipe user/password information.
$email = "\x00" x length($email);
$user = "\x00" x length($user);
$domain = "\x00" x length($domain);
$pass = "\x00" x length($pass);

exec @ARGV or exit(-4);

sub get_line_from_file {
# parameters: $file, $split, $match
my ($file, $split, $match) = @_;
    my $line = "";

    open(FILE, $file) or error("unable to open $file", 0, 111);
    while (<FILE>) {
        chomp; # rid ourselves of the pesky EOL stuff

        if ($split) { # is there a split char?
            last if m/^\.$/; # indicates EOF for assign file
            next if m/^\+/; # assign for muser-ext (not used)
            if (m/^=/) {
                $line = $_ if m/^$match$split/;
                last if $line;
            } else {
                my ($temp, undef) = split(/:/, $_) if m/^\./;
                $line = $_ if ((m/^\./ and ($match =~ m/^[-.a-zA-Z0-9]+$temp/))
                                or m/^$match$split/);
                last if $line;
            }
        } else {
            $line = $_;
            last;
        }
    }
    close(FILE);
    return $line;
}

sub error {
my ($message, $sleep, $exitcode) = @_;
    print(STDERR "stop: $message");
    sleep($sleep);
    exit($exitcode);
}