fixed failing auths to auth/vpopmaild, added tests

Apparently the format of vpopmaild responses has been expanded and the responses
are conditional.

* Replaced the 'sometimes works' eq comparison with a regexp that always works.
* added tests for all 3 vpopmail plugins
* added cram-md5 auth support to auth_vpopmaild.

MANIFEST

@@ -145,6 +145,9 @@ t/helo.t
 t/misc.t
 t/plugin_tests.t
 t/plugin_tests/auth/auth_flat_file
+t/plugin_tests/auth/auth_vpopmail
+t/plugin_tests/auth/auth_vpopmail_sql
+t/plugin_tests/auth/auth_vpopmaild
 t/plugin_tests/auth/authdeny
 t/plugin_tests/auth/authnull
 t/plugin_tests/check_badrcptto

plugins/auth/auth_vpopmail

@@ -105,7 +105,11 @@ 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.
-    use vpopmail;
+    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;

plugins/auth/auth_vpopmaild

@@ -1,30 +1,26 @@
-#!/usr/bin/env perl
+#!/usr/bin/perl
 
 use strict;
 use warnings;
 use IO::Socket;
-use version; my $VERSION = qv('1.0.0');
+use version; 
+my $VERSION = qv('1.0.1');
 
 sub register {
     my ($self, $qp, %args) = @_;
 
-    my %DEFAULT = (
-                   host => q{localhost},
-                   port => 89,
-                  );
-
-    $self->{_vpopmaild_host} =
-      defined $args{host} ? $args{host} : $DEFAULT{host};
-    $self->{_vpopmaild_port} =
-      defined $args{port} ? $args{port} : $DEFAULT{port};
+    $self->{_vpopmaild_host} = $args{host} || 'localhost';
+    $self->{_vpopmaild_port} = $args{port} || '89';
 
     $self->register_hook('auth-plain', 'auth_vpopmaild');
     $self->register_hook('auth-login', 'auth_vpopmaild');
+    $self->register_hook('auth-cram-md5', 'auth_vpopmaild');
 }
 
 sub auth_vpopmaild {
-    my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) =
-      @_;
+    my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) = @_;
+
+    use Qpsmtpd::Constants;
 
     # create socket
     my $vpopmaild_socket =
@@ -35,9 +31,15 @@ sub auth_vpopmaild {
                             Type     => SOCK_STREAM
                            ) or return DECLINED;
 
+    #$self->log(LOGINFO, "Attempting $method auth via vpopmaild");
+
     # Get server greeting (+OK)
     my $connect_response = <$vpopmaild_socket>;
-    return DECLINED unless $connect_response eq '+OK \r\n';
+    if ( $connect_response !~ /^\+OK/ ) {
+        $self->log(LOGINFO, "Failed to receive vpopmaild connection response: $connect_response");
+        close($vpopmaild_socket);
+        return DECLINED;
+    };
 
     # send login details
     print $vpopmaild_socket "login $user $passClear\n\r";
@@ -47,13 +49,12 @@ sub auth_vpopmaild {
 
     close($vpopmaild_socket);
 
-    # check for successful login
-    if ($login_response eq '+OK+\r\n') {
-        return (OK, 'authcheckpassword');
-    }
-    else {
-        return DECLINED;
-    }
+    # check for successful login (single line (+OK) or multiline (+OK+))
+    return (OK, 'auth_vpopmaild') if $login_response =~ /^\+OK/;
+
+    $self->log(LOGINFO, "Failed vpopmaild authentication response: $login_response");
+
+    return DECLINED;
 }
 
 __END__
@@ -90,6 +91,8 @@ please read the VPOPMAIL section in doc/authentication.pod
 
 Robin Bowes <robin.bowes@yo61.com>
 
+Matt Simerson (4/2012: added CRAM-MD5 support, updated response parsing)
+
 =head1 COPYRIGHT AND LICENSE
 
 Copyright (c) 2010 Robin Bowes

t/plugin_tests/auth/auth_vpopmail

@@ -0,0 +1,27 @@
+# -*-perl-*- [emacs]
+
+sub register_tests {
+    my $self = shift;
+    $self->register_test("test_auth_vpopmail", 3);
+}
+
+my @u_list = qw ( good bad none );
+my %u_data = (
+	      good => [ 'postmaster@example.com', OK, 'Good Strong Passphrase' ],
+	      bad => [ 'bad@example.com', DENY, 'not_bad_pass' ],
+	      none => [ 'none@example.com', DECLINED, '' ],
+	      );
+
+sub test_auth_vpopmail {
+    my $self = shift;
+    my ($tran, $ret, $note, $u, $r, $p, $a );
+    $tran = $self->qp->transaction;
+    for $u ( @u_list ) {
+	( $a,$r,$p ) = @{$u_data{$u}};
+	($ret, $note) = $self->auth_vpopmail($tran,'CRAMMD5',$a,$p);
+	defined $note or $note='auth_vpopmail: No-Message';
+	is ($ret, $r, $note);
+	# - for debugging.
+	# warn "$note\n";
+    }
+}

t/plugin_tests/auth/auth_vpopmail_sql

@@ -0,0 +1,27 @@
+# -*-perl-*- [emacs]
+
+sub register_tests {
+    my $self = shift;
+    $self->register_test("auth_vpopmail_sql", 3);
+}
+
+my @u_list = qw ( good bad none );
+my %u_data = (
+	      good => [ 'postmaster@example.com', OK, 'Good Strong Passphrase' ],
+	      bad  => [ 'bad@example.com',   DENY, 'not_bad_pass' ],
+	      none => [ 'none@example.com', DECLINED, '' ],
+	      );
+
+sub auth_vpopmail_sql {
+    my $self = shift;
+    my ($tran, $ret, $note, $u, $r, $p, $a );
+    $tran = $self->qp->transaction;
+    for $u ( @u_list ) {
+	( $a,$r,$p ) = @{$u_data{$u}};
+	eval { ($ret, $note) = $self->auth_vmysql($tran,'PLAIN',$a,$p); };
+	defined $note or $note='auth_vpopmail_sql: No-Message';
+	is ($ret, $r, $note);
+	# - for debugging.
+	# warn "$note\n";
+    }
+}

t/plugin_tests/auth/auth_vpopmaild

@@ -0,0 +1,27 @@
+# -*-perl-*- [emacs]
+
+warn "loaded test auth_vpopmaild\n";
+
+sub register_tests {
+    my $self = shift;
+    $self->register_test("test_auth_vpopmaild", 3);
+}
+
+my @u_list = qw ( good bad none );
+my %u_data = (
+	      good => [ 'postmaster@example.com', OK, 'Good Strong Passphrase' ],
+	      bad => [ 'bad@example.com', DENY, 'not_bad_pass' ],
+	      none => [ 'none@example.com', DECLINED, '' ],
+	      );
+
+sub test_auth_vpopmaild {
+    my $self = shift;
+    my ($tran, $ret, $note, $u, $r, $p, $a );
+    $tran = $self->qp->transaction;
+    for $u ( @u_list ) {
+	( $a,$r,$p ) = @{$u_data{$u}};
+	($ret, $note) = $self->auth_vpopmaild($tran,'LOGIN',$a,$p);
+	defined $note or $note='No-Message';
+	is ($ret, $r, $note);
+    }
+}