qpsmtpd/plugins/auth/auth_vpopmail

#!perl -Tw
use strict;

=head1 NAME

auth_vpopmail - Authenticate against libvpopmail.a

=head1 DESCRIPTION

This plugin authenticates vpopmail users using p5-vpopmail.
Using CRAM-MD5 requires that vpopmail be built with the
'--enable-clear-passwd=y' option.

=head1 CONFIGURATION

This module will only work if qpsmtpd is running as the 'vpopmail' user.

CRAM-MD5 authentication will only work with p5-vpopmail 0.09 or higher.
    http://github.com/sscanlon/vpopmail

Decide which authentication methods you are willing to support and uncomment
the lines in the register() sub. See the POD for Qspmtpd::Auth for more
details on the ramifications of supporting various authentication methods.

=head1 SEE ALSO

For an overview of the vpopmail authentication plugins and their merits,
please read the VPOPMAIL section in docs/authentication.pod

=head1 AUTHOR

Matt Simerson <msimerson@cpan.org>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2010 Matt Simerson

This plugin is licensed under the same terms as the qpsmtpd package itself.
Please see the LICENSE file included with qpsmtpd for details.

=cut

sub register {
    my ($self, $qp) = @_;

    $self->register_hook("auth-plain", "auth_vpopmail" );
    $self->register_hook("auth-login", "auth_vpopmail" );
    $self->register_hook("auth-cram-md5", "auth_vpopmail");
}

sub auth_vpopmail {
    use vpopmail;
    use Qpsmtpd::Constants;
    use Digest::HMAC_MD5 qw(hmac_md5_hex);

    my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) =
      @_;
    my ($pw_name, $pw_domain) = split "@", lc($user);

    $self->log(LOGINFO, "Authenticating against vpopmail: $user");

    return (DECLINED, "authvpopmail/$method - plugin not configured correctly")
      if !test_vpopmail();

    my $pw              = vauth_getpw($pw_name, $pw_domain);
    my $pw_clear_passwd = $pw->{pw_clear_passwd};
    my $pw_passwd       = $pw->{pw_passwd};

    # make sure the user exists
    if (!$pw || (!$pw_clear_passwd && !$pw_passwd)) {
        return (DENY, "authvpopmail/$method - invalid user");

        # change DENY to DECLINED to support multiple auth plugins
    }

    return (OK, "authvpopmail/$method")
      if $pw_passwd eq crypt($passClear, $pw_passwd);

    # simplest case: clear text passwords
    if (defined $passClear && defined $pw_clear_passwd) {
        return (DENY, "authvpopmail/$method - incorrect password")
          if $passClear ne $pw_clear_passwd;
        return (OK, "authvpopmail/$method");
    }

    if ($method =~ /CRAM-MD5/i) {

        # clear_passwd isn't defined so we cannot support CRAM-MD5
        return (DECLINED, "authvpopmail/$method") if !defined $pw_clear_passwd;

        if (defined $passHash
            and $passHash eq hmac_md5_hex($ticket, $pw_clear_passwd))
        {
        }
    }

    return (OK, "authvpopmail/$method")
      if (defined $passHash
          && $passHash eq hmac_md5_hex($ticket, $pw_clear_passwd));

    return (DENY, "authvpopmail/$method - unknown error");
}

sub test_vpopmail {

# vpopmail will not allow vauth_getpw to succeed unless the requesting user is vpopmail or root.
# by default, qpsmtpd runs as the user 'qpsmtpd' and does not have permission.
    eval "use vpopmail";
    if ( $@ ) {
        warn "vpopmail perl module not installed.\n";
        return;
    };
    my ($domain) = vpopmail::vlistdomains();
    my $r = vauth_getpw('postmaster', $domain);
    return if !$r;
    return 1;
}