Skip to content

Loading…

pull recent commits. #9

Closed
wants to merge 28 commits into from

1 participant

@msimerson
qpsmtpd member

these are the patches recently posted to mailing list.

msimerson added some commits
@msimerson msimerson added FAQ with 3 answers. b668b1d
@msimerson msimerson moved POD to top of file
all but 3 plugins have their POD at the top of the file. Bring these little lost sheep into the barn.
4903c7b
@msimerson msimerson improved readability of default logging logic f9be992
@msimerson msimerson Merge branch 'logging' 3947bc5
@msimerson msimerson SMTP.pm, add missing ; and remove useless if 5043b07
@msimerson msimerson removed TODO, p0f v3 doesn't need that extra info 54c7ea8
@msimerson msimerson removed extra ) char 2e74eb1
@msimerson msimerson Merge branch 'logging' e64e766
@msimerson msimerson improve readability in SMTP::auth_parse_respond bf78e72
@msimerson msimerson Merge branch 'auth' d036cf1
@msimerson msimerson confine SMTP.pm duplicate logging to LOGDEBUG 3798164
@msimerson msimerson Merge branch 'log' f2621a0
@msimerson msimerson enable plugin syntax checks for developers 38f2f5e
@msimerson msimerson refactored Qpsmtpd::Auth::SASL
unit tests for new methods are in t/auth.t

added PLAIN and LOGIN tests in auth_flat_file

Most tests are disabled unless an interactive terminal is detected and $ENV{QPSMTPD_DEVELOPER} is set.
c44ab8b
@msimerson msimerson Merge branch 'auth' f1aec3b
@msimerson msimerson Merge branch 'core' 8a063c2
@msimerson msimerson Altered SASL method to include the mechanism in log entries.
removed auth method from return calls in all auth plugins. The caller knows the mechanism already. In the code, the difference looks like this:

before:
        or return (DENY, "authcvm/$method");
after:
        or return (DENY, "authcvm");

Added debug level log entries in auth_vpopmaild
ffe85f2
@msimerson msimerson Merge branch 'auth' f221316
@msimerson msimerson Command.pm, promoted strictures to 1st line of code 6ccab56
@msimerson msimerson Merge branch 'core' 69024a3
@msimerson msimerson confine duplicate Auth log entry to LOGDEBUG 71b88a0
@msimerson msimerson in log entries, print hook name first
so log entries look like this:

86553 (connect) ident::geoip: US, United States
86553 (connect) ident::p0f: Windows 7 or 8
86553 (connect) check_earlytalker: remote host said nothing spontaneous, proceeding

instead of this:

86553 ident::geoip: (connect): US, United States
86553 ident::p0f: (connect) Windows 7 or 8
86553 check_earlytalker: (connect): remote host said nothing spontaneous, proceeding
a8e81b2
@msimerson msimerson Merge branch 'log' 0f0ae34
@msimerson msimerson added vpopmail_sql db connect error handling. c1673aa
@msimerson msimerson Merge branch 'auth' 9100a64
@msimerson msimerson only test POD for developers 5165169
@msimerson msimerson Merge branch 'POD' f5f2123
@msimerson msimerson instead of skipping test errors, handle them 5ec4531
@msimerson msimerson closed this
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on May 4, 2012
  1. @msimerson

    added FAQ with 3 answers.

    msimerson committed
  2. @msimerson

    moved POD to top of file

    msimerson committed
    all but 3 plugins have their POD at the top of the file. Bring these little lost sheep into the barn.
  3. @msimerson
  4. @msimerson

    Merge branch 'logging'

    msimerson committed
  5. @msimerson
  6. @msimerson
  7. @msimerson

    removed extra ) char

    msimerson committed
  8. @msimerson

    Merge branch 'logging'

    msimerson committed
  9. @msimerson
  10. @msimerson

    Merge branch 'auth'

    msimerson committed
  11. @msimerson
  12. @msimerson

    Merge branch 'log'

    msimerson committed
  13. @msimerson
  14. @msimerson

    refactored Qpsmtpd::Auth::SASL

    msimerson committed
    unit tests for new methods are in t/auth.t
    
    added PLAIN and LOGIN tests in auth_flat_file
    
    Most tests are disabled unless an interactive terminal is detected and $ENV{QPSMTPD_DEVELOPER} is set.
  15. @msimerson

    Merge branch 'auth'

    msimerson committed
  16. @msimerson

    Merge branch 'core'

    msimerson committed
  17. @msimerson

    Altered SASL method to include the mechanism in log entries.

    msimerson committed
    removed auth method from return calls in all auth plugins. The caller knows the mechanism already. In the code, the difference looks like this:
    
    before:
            or return (DENY, "authcvm/$method");
    after:
            or return (DENY, "authcvm");
    
    Added debug level log entries in auth_vpopmaild
  18. @msimerson

    Merge branch 'auth'

    msimerson committed
  19. @msimerson
  20. @msimerson

    Merge branch 'core'

    msimerson committed
  21. @msimerson
  22. @msimerson

    in log entries, print hook name first

    msimerson committed
    so log entries look like this:
    
    86553 (connect) ident::geoip: US, United States
    86553 (connect) ident::p0f: Windows 7 or 8
    86553 (connect) check_earlytalker: remote host said nothing spontaneous, proceeding
    
    instead of this:
    
    86553 ident::geoip: (connect): US, United States
    86553 ident::p0f: (connect) Windows 7 or 8
    86553 check_earlytalker: (connect): remote host said nothing spontaneous, proceeding
  23. @msimerson

    Merge branch 'log'

    msimerson committed
  24. @msimerson
  25. @msimerson

    Merge branch 'auth'

    msimerson committed
  26. @msimerson

    only test POD for developers

    msimerson committed
  27. @msimerson

    Merge branch 'POD'

    msimerson committed
  28. @msimerson
View
47 FAQ.pod
@@ -0,0 +1,47 @@
+# best read with perldoc: perldoc FAQ.pod
+
+=head1 FAQ
+
+=head2 Q: Do I need to enable a logging plugin?
+
+=head2 A: No.
+
+When zero logging plugins are configured, logs are directed to STDERR. This
+is the 'default' logging and logs are piped to multilog and stored in
+log/main/current.
+
+When more than zero logging plugins are enabled, builtin logging is disabled
+and logs are sent to every logging plugin configured in config/plugins.
+
+
+=head2 Q: How do I watch the logs?
+
+=head2 A: Here's a few examples:
+
+The default log files can be watched in real time lik this:
+
+ tail -F ~smtpd/log/main/current
+
+To convert the tai timestamps to human readable date time:
+
+ tail -F ~smtpd/log/main/current | tai64nlocal
+
+To exclude the dates entirely, use this command:
+
+ tail -F ~smtpd/smtpd/log/main/current | cut -d' ' -f2-3
+
+
+=head2 Q: How do I get alerts when qpsmtpd has a problem?
+
+=head2 A: Send logs with levels below LOGERROR to syslog.
+
+This can be done by adding the following lines to config/plugins:
+
+ logging/syslog loglevel LOGERROR
+ logging/warn LOGINFO
+
+The warn logging plugin replicates the builtin logging, directing log messages to STDERR. The syslog plugin directs errors to syslog where standard monitoring tools can pick them up and act on them.
+
+With these settings, errors will still get sent to STDERR as well.
+
+=cut
View
4 docs/authentication.pod
@@ -211,7 +211,7 @@ vpopmail.
=item auth_vpopmaild
If you aren't sure which one to use, then use auth_vpopmaild. It
-has full support for all 3 authentication methods (PLAIN,LOGIN,CRAM-MD5),
+supports the PLAIN and LOGIN authentication methods,
doesn't require the qpsmtpd process to run with special permissions, and
can authenticate against vpopmail running on another host. It does require
the vpopmaild server to be running.
@@ -228,7 +228,7 @@ CRAM-MD5 patch has been added to the developers repo:
=item auth_vpopmail_sql
If you are using the MySQL backend for vpopmail, then this module can be
-used for smtp-auth. It has support for all three auth methods. However, it
+used for smtp-auth. It supports LOGIN, PLAIN, and CRAM-MD5. However, it
does not work with some vpopmail features such as alias domains, service
restrictions, nor does it update vpopmail's last_auth information.
View
30 lib/Qpsmtpd.pm
@@ -125,17 +125,18 @@ sub varlog {
$self->load_logging; # in case we don't have this loaded yet
- my ($rc) = $self->run_hooks_no_respond("logging", $trace, $hook, $plugin, @log);
-
- unless ( $rc and $rc == DECLINED or $rc == OK ) {
- # no logging plugins registered so fall back to STDERR
- warn join(" ", $$ .
- (defined $plugin && defined $hook ? " $plugin plugin ($hook):" :
- defined $plugin ? " $plugin plugin:" :
- defined $hook ? " running plugin ($hook):" : ""),
- @log), "\n"
- if $trace <= $TraceLevel;
- }
+ my ($rc) = $self->run_hooks_no_respond("logging", $trace, $hook, $plugin, @log)
+ or return;
+
+ return if $rc == DECLINED || $rc == OK; # plugin success
+ return if $trace > $TraceLevel;
+
+ # no logging plugins registered, fall back to STDERR
+ my $prefix = defined $plugin && defined $hook ? " ($hook) $plugin:" :
+ defined $plugin ? " $plugin:" :
+ defined $hook ? " ($hook) running plugin:" : '';
+
+ warn join(' ', $$ . $prefix, @log), "\n";
}
sub clear_config_cache {
@@ -415,6 +416,9 @@ sub transaction { return {}; } # base class implements empty transaction
sub run_hooks {
my ($self, $hook) = (shift, shift);
+#if ( $hook =~ /^auth/i ) {
+#warn sprintf( "run_hooks called by %s, %s, %s\n", (caller) );
+#};
if ($hooks->{$hook}) {
my @r;
my @local_hooks = @{$hooks->{$hook}};
@@ -515,7 +519,9 @@ sub hook_responder {
my ($self, $hook, $msg, $args) = @_;
#my $t1 = $SAMPLER->("hook_responder", undef, 1);
-
+#if ( $hook =~ /^auth/i ) {
+#warn sprintf( "hook_responder called by %s, %s, %s\n", (caller) );
+#};
my $code = shift @$msg;
my $responder = $hook . '_respond';
View
177 lib/Qpsmtpd/Auth.pm
@@ -1,11 +1,13 @@
+package Qpsmtpd::Auth;
# See the documentation in 'perldoc README.authentication'
-package Qpsmtpd::Auth;
-use Qpsmtpd::Constants;
+use strict;
+use warnings;
+
use MIME::Base64;
+use Qpsmtpd::Constants;
-sub e64
-{
+sub e64 {
my ($arg) = @_;
my $res = encode_base64($arg);
chomp($res);
@@ -18,61 +20,17 @@ sub SASL {
my ( $session, $mechanism, $prekey ) = @_;
my ( $user, $passClear, $passHash, $ticket, $loginas );
- if ( $mechanism eq "plain" ) {
- if (!$prekey) {
- $session->respond( 334, " " );
- $prekey= <STDIN>;
- }
- ( $loginas, $user, $passClear ) = split /\x0/,
- decode_base64($prekey);
-
- # Authorization ID must not be different from
- # Authentication ID
- if ( $loginas ne '' && $loginas ne $user ) {
- $session->respond(535, "Authentication invalid");
- return DECLINED;
- }
+ if ( $mechanism eq 'plain' ) {
+ ($loginas, $user, $passClear) = get_auth_details_plain($session,$prekey);
+ return DECLINED if ! $user || ! $passClear;
}
- elsif ($mechanism eq "login") {
-
- if ( $prekey ) {
- $user = decode_base64($prekey);
- }
- else {
- $session->respond(334, e64("Username:"));
- $user = decode_base64(<STDIN>);
- if ($user eq '*') {
- $session->respond(501, "Authentication canceled");
- return DECLINED;
- }
- }
-
- $session->respond(334, e64("Password:"));
- $passClear = <STDIN>;
- $passClear = decode_base64($passClear);
- if ($passClear eq '*') {
- $session->respond(501, "Authentication canceled");
- return DECLINED;
- }
+ elsif ( $mechanism eq 'login' ) {
+ ($user, $passClear) = get_auth_details_login($session,$prekey);
+ return DECLINED if ! $user || ! $passClear;
}
- elsif ( $mechanism eq "cram-md5" ) {
-
- # rand() is not cryptographic, but we only need to generate a globally
- # unique number. The rand() is there in case the user logs in more than
- # once in the same second, of if the clock is skewed.
- $ticket = sprintf( '<%x.%x@%s>',
- rand(1000000), time(), $session->config("me") );
-
- # We send the ticket encoded in Base64
- $session->respond( 334, encode_base64( $ticket, "" ) );
- my $line = <STDIN>;
-
- if ( $line eq '*' ) {
- $session->respond( 501, "Authentication canceled" );
- return DECLINED;
- }
-
- ( $user, $passHash ) = split( ' ', decode_base64($line) );
+ elsif ( $mechanism eq 'cram-md5' ) {
+ ( $ticket, $user, $passHash ) = get_auth_details_cram_md5($session);
+ return DECLINED if ! $user || ! $passHash;
}
else {
#this error is now caught in SMTP.pm's sub auth
@@ -80,12 +38,6 @@ sub SASL {
return DECLINED;
}
- # Make sure that we have enough information to proceed
- unless ( $user && ($passClear || $passHash) ) {
- $session->respond(504, "Invalid authentication string");
- return DECLINED;
- }
-
# try running the specific hooks first
my ( $rc, $msg ) =
$session->run_hooks( "auth-$mechanism", $mechanism, $user, $passClear,
@@ -99,11 +51,11 @@ sub SASL {
}
if ( $rc == OK ) {
- $msg = "Authentication successful for $user" .
- ( defined $msg ? " - " . $msg : "" );
+ $msg = uc($mechanism) . " authentication successful for $user" .
+ ( $msg ? " - $msg" : '');
$session->respond( 235, $msg );
$session->connection->relay_client(1);
- $session->log( LOGINFO, $msg );
+ $session->log( LOGDEBUG, $msg ); # already logged by $session->respond
$session->{_auth_user} = $user;
$session->{_auth_mechanism} = $mechanism;
@@ -112,14 +64,101 @@ sub SASL {
return OK;
}
else {
- $msg = "Authentication failed for $user" .
- ( defined $msg ? " - " . $msg : "" );
+ $msg = uc($mechanism) . " authentication failed for $user" .
+ ( $msg ? " - $msg" : '');
$session->respond( 535, $msg );
- $session->log( LOGERROR, $msg );
+ $session->log( LOGDEBUG, $msg ); # already logged by $session->respond
return DENY;
}
}
+sub get_auth_details_plain {
+ my ( $session, $prekey ) = @_;
+
+ if ( ! $prekey) {
+ $session->respond( 334, ' ' );
+ $prekey= <STDIN>;
+ }
+
+ my ( $loginas, $user, $passClear ) = split /\x0/, decode_base64($prekey);
+
+ if ( ! $user ) {
+ if ( $loginas ) {
+ $session->respond(535, "Authentication invalid ($loginas)");
+ }
+ else {
+ $session->respond(535, "Authentication invalid");
+ }
+ return;
+ };
+
+ # Authorization ID must not be different from Authentication ID
+ if ( $loginas ne '' && $loginas ne $user ) {
+ $session->respond(535, "Authentication invalid for $user");
+ return;
+ }
+
+ return ($loginas, $user, $passClear);
+};
+
+sub get_auth_details_login {
+ my ( $session, $prekey ) = @_;
+
+ my $user;
+
+ if ( $prekey ) {
+ $user = decode_base64($prekey);
+ }
+ else {
+ $user = get_base64_response($session,'Username:') or return;
+ }
+
+ my $passClear = get_base64_response($session,'Password:') or return;
+
+ return ($user, $passClear);
+};
+
+sub get_auth_details_cram_md5 {
+ my ( $session, $ticket ) = @_;
+
+ if ( ! $ticket ) { # ticket is only passed in during testing
+ # rand() is not cryptographic, but we only need to generate a globally
+ # unique number. The rand() is there in case the user logs in more than
+ # once in the same second, or if the clock is skewed.
+ $ticket = sprintf( '<%x.%x@%s>',
+ rand(1000000), time(), $session->config('me') );
+ };
+
+ # send the base64 encoded ticket
+ $session->respond( 334, encode_base64( $ticket, '' ) );
+ my $line = <STDIN>;
+
+ if ( $line eq '*' ) {
+ $session->respond( 501, "Authentication canceled" );
+ return;
+ };
+
+ my ( $user, $passHash ) = split( ' ', decode_base64($line) );
+ unless ( $user && $passHash ) {
+ $session->respond(504, "Invalid authentication string");
+ return;
+ }
+
+ return ($ticket, $user, $passHash);
+};
+
+sub get_base64_response {
+ my ($session, $question) = @_;
+
+ $session->respond(334, e64($question));
+ my $answer = decode_base64( <STDIN> );
+ if ($answer eq '*') {
+ $session->respond(501, "Authentication canceled");
+ return;
+ }
+ return $answer;
+};
+
# tag: qpsmtpd plugin that sets RELAYCLIENT when the user authentifies
1;
View
3 lib/Qpsmtpd/Command.pm
@@ -53,10 +53,11 @@ Inside a plugin
=cut
+use strict;
+
use Qpsmtpd::Constants;
use vars qw(@ISA);
@ISA = qw(Qpsmtpd::SMTP);
-use strict;
sub parse {
my ($me,$cmd,$line,$sub) = @_;
View
27 lib/Qpsmtpd/SMTP.pm
@@ -54,18 +54,14 @@ sub dispatch {
if ($cmd !~ /^(\w{1,12})$/ or !exists $self->{_commands}->{$1}) {
$self->run_hooks("unrecognized_command", $cmd, @_);
- return 1
+ return 1;
}
$cmd = $1;
- if (1 or $self->{_commands}->{$cmd} and $self->can($cmd)) {
my ($result) = eval { $self->$cmd(@_) };
$self->log(LOGERROR, "XX: $@") if $@;
return $result if defined $result;
return $self->fault("command '$cmd' failed unexpectedly");
- }
-
- return;
}
sub unrecognized_command_respond {
@@ -265,26 +261,25 @@ sub auth_parse_respond {
unless ($ok == OK);
$mechanism = lc($mechanism);
-
#they AUTH'd once already
return $self->respond( 503, "but you already said AUTH ..." )
- if ( defined $self->{_auth}
- and $self->{_auth} == OK );
+ if ( defined $self->{_auth} && $self->{_auth} == OK );
+
return $self->respond( 503, "AUTH not defined for HELO" )
if ( $self->connection->hello eq "helo" );
+
return $self->respond( 503, "SSL/TLS required before AUTH" )
if ( ($self->config('tls_before_auth'))[0]
- and $self->transaction->notes('tls_enabled') );
+ && $self->transaction->notes('tls_enabled') );
- # if we don't have a plugin implementing this auth mechanism, 504
+ # we don't have a plugin implementing this auth mechanism, 504
if( exists $auth_mechanisms{uc($mechanism)} ) {
return $self->{_auth} = Qpsmtpd::Auth::SASL( $self, $mechanism, @stuff );
- } else {
- $self->respond( 504, "Unimplemented authentification mechanism: $mechanism" );
- return DENY;
- }
+ };
+ $self->respond( 504, "Unimplemented authentification mechanism: $mechanism" );
+ return DENY;
}
sub mail {
@@ -313,7 +308,7 @@ sub mail {
return $self->respond(503, "please say hello first ...");
}
else {
- $self->log(LOGINFO, "full from_parameter: $line");
+ $self->log(LOGDEBUG, "full from_parameter: $line");
$self->run_hooks("mail_parse", $line);
}
}
@@ -388,7 +383,7 @@ sub mail_respond {
$self->disconnect;
}
else { # includes OK
- $self->log(LOGINFO, "getting mail from ".$from->format);
+ $self->log(LOGDEBUG, "getting mail from ".$from->format);
$self->respond(250, $from->format . ", sender OK - how exciting to get mail from you!");
$self->transaction->sender($from);
}
View
16 lib/Qpsmtpd/TcpServer.pm
@@ -25,7 +25,7 @@ sub has_ipv6 {
return $has_ipv6;
}
-my $first_0;
+my $first_0;
sub start_connection {
my $self = shift;
@@ -46,25 +46,21 @@ sub start_connection {
$local_port = $ENV{TCPLOCALPORT};
$local_host = $ENV{TCPLOCALHOST};
} else {
- # Started from inetd or similar.
+ # Started from inetd or similar.
# get info on the remote host from the socket.
# ignore ident/tap/...
- my $hersockaddr = getpeername(STDIN)
+ my $hersockaddr = getpeername(STDIN)
or die "getpeername failed: $0 must be called from tcpserver, (x)inetd or a similar program which passes a socket to stdin";
my ($port, $iaddr) = sockaddr_in($hersockaddr);
$remote_ip = inet_ntoa($iaddr);
$remote_host = gethostbyaddr($iaddr, AF_INET) || "[$remote_ip]";
$remote_info = $remote_host;
-### TODO
-# set $remote_port, $local_ip, and $local_port. Those values are
-# required for the p0f plugin to function.
-### /TODO
}
$self->log(LOGNOTICE, "Connection from $remote_info [$remote_ip]");
# if the local dns resolver doesn't filter it out we might get
# ansi escape characters that could make a ps axw do "funny"
- # things. So to be safe, cut them out.
+ # things. So to be safe, cut them out.
$remote_host =~ tr/a-zA-Z\.\-0-9\[\]//cd;
$first_0 = $0 unless $first_0;
@@ -169,7 +165,7 @@ sub tcpenv {
my $TCPLOCALIP = $nto_laddr;
my $TCPREMOTEIP = $nto_iaddr;
-
+
if ($no_rdns) {
return ($TCPLOCALIP, $TCPREMOTEIP, $TCPREMOTEIP ? "[$ENV{TCPREMOTEIP}]" : "[noip!]");
}
@@ -191,7 +187,7 @@ sub check_socket() {
my $self = shift;
return 1 if ( $self->{__client_socket}->connected );
-
+
return 0;
}
View
2 plugins/auth/auth_checkpassword
@@ -142,7 +142,7 @@ sub get_sudo {
my $sudo = `which sudo` || '/usr/local/bin/sudo';
return '' if !-x $sudo;
- $sudo .= ' -C4'; # prevent sudo from clobber file descriptor 3
+ $sudo .= ' -C4'; # prevent sudo from clobbering file descriptor 3
return "$sudo -u vpopmail" if $binary =~ /vchkpw/;
return $sudo;
View
25 plugins/auth/auth_cvm_unix_local
@@ -47,8 +47,7 @@ use constant SSMTP_PORT => getservbyname("ssmtp", "tcp") || 465;
sub register {
my ( $self, $qp, %arg ) = @_;
- unless ($arg{cvm_socket})
- {
+ unless ($arg{cvm_socket}) {
$self->log(LOGERROR, "authcvm - requires cvm_socket argument");
return 0;
}
@@ -61,15 +60,13 @@ sub register {
return 0 if ($port == SMTP_PORT and $self->{_enable_smtp} ne 'yes');
return 0 if ($port == SSMTP_PORT and $self->{_enable_ssmtp} ne 'yes');
- if ($arg{cvm_socket} =~ /^([\w\/.-]+)$/)
- {
+ if ($arg{cvm_socket} =~ /^([\w\/.-]+)$/) {
$self->{_cvm_socket} = $1;
}
- unless (-S $self->{_cvm_socket})
- {
- $self->log(LOGERROR, "authcvm - cvm_socket missing or not usable");
- return 0;
+ unless (-S $self->{_cvm_socket}) {
+ $self->log(LOGERROR, "authcvm - cvm_socket missing or not usable");
+ return 0;
}
$self->register_hook("auth-plain", "authcvm_plain");
@@ -81,13 +78,12 @@ sub authcvm_plain {
my ( $self, $transaction, $method, $user, $passClear, $passHash, $ticket ) =
@_;
- $self->log(LOGINFO, "authcvm/$method authentication attempt for: $user");
+ $self->log(LOGINFO, "authcvm authentication attempt for: $user");
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0)
- or return (DENY, "authcvm/$method");
+ socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or return (DENY, "authcvm");
connect(SOCK, sockaddr_un($self->{_cvm_socket}))
- or return (DENY, "authcvm/$method");
+ or return (DENY, "authcvm");
my $o = select(SOCK); $| = 1; select($o);
@@ -100,8 +96,5 @@ sub authcvm_plain {
my $ret = <SOCK>;
my ($s) = unpack ("C", $ret);
- return (
- ($s ? $s == 100 ? DENY : DECLINED
- : OK),
- "authcvm/$method");
+ return ( ($s ? $s == 100 ? DENY : DECLINED : OK), 'authcvm');
}
View
38 plugins/auth/auth_flat_file
@@ -35,41 +35,45 @@ use Digest::HMAC_MD5 qw(hmac_md5_hex);
sub register {
my ( $self, $qp ) = @_;
- $self->register_hook("auth-cram-md5", "auth_flat_file");
+ $self->register_hook('auth-plain', 'auth_flat_file');
+ $self->register_hook('auth-login', 'auth_flat_file');
+ $self->register_hook('auth-cram-md5', 'auth_flat_file');
}
sub auth_flat_file {
my ( $self, $transaction, $method, $user, $passClear, $passHash, $ticket ) =
@_;
- my ( $pw_name, $pw_domain ) = split "@", lc($user);
+ if ( ! defined $passClear && ! defined $passHash ) {
+ return ( DENY, "authflat - missing password" );
+ }
+
+ my ( $pw_name, $pw_domain ) = split '@', lc($user);
unless ( defined $pw_domain ) {
return DECLINED;
}
- $self->log(LOGINFO, "Authentication for: $pw_name\@$pw_domain");
-
my ($auth_line) = grep {/^$pw_name\@$pw_domain:/} $self->qp->config('flat_auth_pw');
- unless (defined $auth_line) {
+ if ( ! defined $auth_line) {
+ $self->log(LOGINFO, "User not found: $pw_name\@$pw_domain");
return DECLINED;
}
+ $self->log(LOGINFO, "Authentication for: $pw_name\@$pw_domain");
+
my ($auth_user, $auth_pass) = split(/:/, $auth_line, 2);
# at this point we can assume the user name matched
- if (
- ( defined $passClear
- and $auth_pass eq $passClear ) or
- ( defined $passHash
- and $passHash eq hmac_md5_hex($ticket, $auth_pass) )
- )
- {
- return ( OK, "authflat/$method" );
- }
- else {
- return ( DENY, "authflat/$method - wrong password" );
- }
+ if ( defined $passClear && $auth_pass eq $passClear ) {
+ return ( OK, "authflat" );
+ };
+
+ if ( defined $passHash && $passHash eq hmac_md5_hex($ticket, $auth_pass) ) {
+ return ( OK, "authflat" );
+ };
+
+ return ( DENY, "authflat - wrong password" );
}
View
162 plugins/auth/auth_ldap_bind
@@ -1,5 +1,84 @@
#!perl -w
-
+
+=head1 NAME
+
+auth_ldap_bind - Authenticate user via an LDAP bind
+
+=head1 DESCRIPTION
+
+This plugin authenticates users against an LDAP Directory. The plugin
+first performs a lookup for an entry matching the connecting user. This
+lookup uses the 'ldap_auth_filter_attr' attribute to match the connecting
+user to their LDAP DN. Once the plugin has found the user's DN, the plugin
+will attempt to bind to the Directory as that DN with the password that has
+been supplied.
+
+=head1 CONFIGURATION
+
+Configuration items can be held in either the 'ldap' configuration file, or as
+arguments to the plugin.
+
+Configuration items in the 'ldap' configuration file
+are set one per line, starting the line with the configuration item key,
+followed by a space, then the values associated with the configuration item.
+
+Configuration items given as arguments to the plugin are keys and values
+separated by spaces. Be sure to quote any values that have spaces in them.
+
+The only configuration item which is required is 'ldap_base'. This tells the
+plugin what your base DN is. The plugin will not work until it has been
+configured.
+
+The configuration items 'ldap_host' and 'ldap_port' specify the host and port
+at which your Directory server may be contacted. If these are not specified,
+the plugin will use port '389' on 'localhost'.
+
+The configuration item 'ldap_timeout' specifies how long the plugin should
+wait for a response from your Directory server. By default, the value is 5
+seconds.
+
+The configuration item 'ldap_auth_filter_attr' specifies how the plugin should
+find the user in your Directory. By default, the plugin will look up the user
+based on the 'uid' attribute.
+
+=head1 NOTES
+
+Each auth requires an initial lookup to find the user's DN. Ideally, the
+plugin would simply bind as the user without the need for this lookup (see
+FUTURE DIRECTION below).
+
+This plugin requires that the Directory allow anonymous bind (see FUTURE
+DIRECTION below).
+
+=head1 FUTURE DIRECTION
+
+A configurable LDAP filter should be made available, to account for users
+who are over quota, have had their accounts disabled, or whatever other
+arbitrary requirements.
+
+A configurable DN template (uid=$USER,ou=$DOMAIN,$BASE). This would prevent
+the need of the initial user lookup, as the DN is created from the template.
+
+A configurable bind DN, for Directories that do not allow anonymous bind.
+
+Another plugin ('ldap_auth_cleartext'?), to allow retrieval of plain-text
+passwords from the Directory, permitting CRAM-MD5 or other hash algorithm
+authentication.
+
+=head1 AUTHOR
+
+Elliot Foster <elliotf@gratuitous.net>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2005 Elliot Foster
+
+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, @args ) = @_;
$self->register_hook( "auth-plain", "authldap" );
@@ -110,83 +189,4 @@ sub authldap {
$ldh->disconnect;
}
-
-=head1 NAME
-
-auth_ldap_bind - Authenticate user via an LDAP bind
-
-=head1 DESCRIPTION
-
-This plugin authenticates users against an LDAP Directory. The plugin
-first performs a lookup for an entry matching the connecting user. This
-lookup uses the 'ldap_auth_filter_attr' attribute to match the connecting
-user to their LDAP DN. Once the plugin has found the user's DN, the plugin
-will attempt to bind to the Directory as that DN with the password that has
-been supplied.
-
-=head1 CONFIGURATION
-
-Configuration items can be held in either the 'ldap' configuration file, or as
-arguments to the plugin.
-
-Configuration items in the 'ldap' configuration file
-are set one per line, starting the line with the configuration item key,
-followed by a space, then the values associated with the configuration item.
-
-Configuration items given as arguments to the plugin are keys and values
-separated by spaces. Be sure to quote any values that have spaces in them.
-
-The only configuration item which is required is 'ldap_base'. This tells the
-plugin what your base DN is. The plugin will not work until it has been
-configured.
-
-The configuration items 'ldap_host' and 'ldap_port' specify the host and port
-at which your Directory server may be contacted. If these are not specified,
-the plugin will use port '389' on 'localhost'.
-
-The configuration item 'ldap_timeout' specifies how long the plugin should
-wait for a response from your Directory server. By default, the value is 5
-seconds.
-
-The configuration item 'ldap_auth_filter_attr' specifies how the plugin should
-find the user in your Directory. By default, the plugin will look up the user
-based on the 'uid' attribute.
-
-=head1 NOTES
-
-Each auth requires an initial lookup to find the user's DN. Ideally, the
-plugin would simply bind as the user without the need for this lookup(see
-FUTURE DIRECTION below).
-
-This plugin requires that the Directory allow anonymous bind (see FUTURE
-DIRECTION below).
-
-=head1 FUTURE DIRECTION
-
-A configurable LDAP filter should be made available, to account for users
-who are over quota, have had their accounts disabled, or whatever other
-arbitrary requirements.
-
-A configurable DN template (uid=$USER,ou=$DOMAIN,$BASE). This would prevent
-the need of the initial user lookup, as the DN is created from the template.
-
-A configurable bind DN, for Directories that do not allow anonymous bind.
-
-Another plugin ('ldap_auth_cleartext'?), to allow retrieval of plain-text
-passwords from the Directory, permitting CRAM-MD5 or other hash algorithm
-authentication.
-
-=head1 AUTHOR
-
-Elliot Foster <elliotf@gratuitous.net>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2005 Elliot Foster
-
-This plugin is licensed under the same terms as the qpsmtpd package itself.
-Please see the LICENSE file included with qpsmtpd for details.
-
-
-=cut
-
+
View
24 plugins/auth/auth_vpopmail
@@ -1,5 +1,4 @@
#!perl -w
-use strict;
=head1 NAME
@@ -41,9 +40,13 @@ Please see the LICENSE file included with qpsmtpd for details.
=cut
use strict;
+use warnings;
use Qpsmtpd::Constants;
+use Digest::HMAC_MD5 qw(hmac_md5_hex);
+use vpopmail;
+
sub register {
my ($self, $qp) = @_;
@@ -53,16 +56,13 @@ sub register {
}
sub auth_vpopmail {
- use vpopmail;
- 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")
+ return (DECLINED, "auth_vpopmail - plugin not configured correctly")
if !test_vpopmail();
my $pw = vauth_getpw($pw_name, $pw_domain);
@@ -71,25 +71,25 @@ sub auth_vpopmail {
# make sure the user exists
if (!$pw || (!$pw_clear_passwd && !$pw_passwd)) {
- return (DENY, "authvpopmail/$method - invalid user");
+ return (DENY, "auth_vpopmail - invalid user");
# change DENY to DECLINED to support multiple auth plugins
}
- return (OK, "authvpopmail/$method")
+ return (OK, "auth_vpopmail")
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")
+ return (DENY, "auth_vpopmail - incorrect password")
if $passClear ne $pw_clear_passwd;
- return (OK, "authvpopmail/$method");
+ return (OK, "auth_vpopmail");
}
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;
+ return (DECLINED, "auth_vpopmail") if !defined $pw_clear_passwd;
if (defined $passHash
and $passHash eq hmac_md5_hex($ticket, $pw_clear_passwd))
@@ -97,11 +97,11 @@ sub auth_vpopmail {
}
}
- return (OK, "authvpopmail/$method")
+ return (OK, "auth_vpopmail")
if (defined $passHash
&& $passHash eq hmac_md5_hex($ticket, $pw_clear_passwd));
- return (DENY, "authvpopmail/$method - unknown error");
+ return (DENY, "auth_vpopmail - unknown error");
}
sub test_vpopmail {
View
28 plugins/auth/auth_vpopmail_sql
@@ -63,36 +63,38 @@ Please see the LICENSE file included with qpsmtpd for details.
=cut
+use DBI;
+use Qpsmtpd::Constants;
+use Digest::HMAC_MD5 qw(hmac_md5_hex);
+
sub register {
my ( $self, $qp ) = @_;
- $self->register_hook("auth-plain", "auth_vmysql" );
- $self->register_hook("auth-login", "auth_vmysql" );
- $self->register_hook("auth-cram-md5", "auth_vmysql");
+ $self->register_hook('auth-plain', 'auth_vmysql');
+ $self->register_hook('auth-login', 'auth_vmysql');
+ $self->register_hook('auth-cram-md5', 'auth_vmysql');
}
sub auth_vmysql {
my ( $self, $transaction, $method, $user, $passClear, $passHash, $ticket ) = @_;
- use DBI;
- use Qpsmtpd::Constants;
- use Digest::HMAC_MD5 qw(hmac_md5_hex);
-
# $DB::single = 1;
my $dsn = $self->qp->config("vpopmail_mysql_dsn") || "dbi:mysql:dbname=vpopmail;host=127.0.0.1";
my $dbuser = $self->qp->config("vpopmail_mysql_user") || "vpopmailuser";
my $dbpass = $self->qp->config("vpopmail_mysql_pass") || "vpoppasswd";
- my $dbh = DBI->connect( $dsn, $dbuser, $dbpass );
+ my $dbh = DBI->connect( $dsn, $dbuser, $dbpass ) or do {
+ $self->log(LOGERROR, "auth_vpopmail_sql: db connection failed");
+ return DECLINED;
+ };
$dbh->{ShowErrorStatement} = 1;
my ( $pw_name, $pw_domain ) = split '@', lc($user);
return DECLINED if ! defined $pw_domain;
- $self->log(LOGINFO,
- "Authentication to vpopmail via mysql: $pw_name\@$pw_domain");
+ $self->log(LOGDEBUG, "auth_vpopmail_sql: $pw_name\@$pw_domain");
my $sth = $dbh->prepare(<<SQL);
SELECT *
@@ -120,7 +122,7 @@ SQL
# user doesn't exist in this domain
( not defined $pw_passwd )
) {
- return ( DECLINED, "auth_vmysql/$method" );
+ return ( DECLINED, "auth_vmysql" );
}
# at this point we can assume the user name matched
@@ -136,10 +138,10 @@ SQL
)
{
- return ( OK, "auth_vmysql/$method" );
+ return ( OK, "auth_vmysql" );
}
else {
- return ( DENY, "auth_vmysql/$method - wrong password" );
+ return ( DENY, "auth_vmysql - wrong password" );
}
}
View
41 plugins/auth/auth_vpopmaild
@@ -2,9 +2,11 @@
use strict;
use warnings;
+
+use Qpsmtpd::Constants;
use IO::Socket;
use version;
-my $VERSION = qv('1.0.1');
+my $VERSION = qv('1.0.2');
sub register {
my ($self, $qp, %args) = @_;
@@ -14,13 +16,16 @@ sub register {
$self->register_hook('auth-plain', 'auth_vpopmaild');
$self->register_hook('auth-login', 'auth_vpopmaild');
- $self->register_hook('auth-cram-md5', 'auth_vpopmaild');
+ #$self->register_hook('auth-cram-md5', 'auth_vpopmaild'); # not supported
}
sub auth_vpopmaild {
my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) = @_;
- use Qpsmtpd::Constants;
+ if ( ! $passClear ) {
+ $self->log(LOGINFO, "vpopmaild does not support cram-md5");
+ return DECLINED;
+ }
# create socket
my $vpopmaild_socket =
@@ -31,28 +36,38 @@ sub auth_vpopmaild {
Type => SOCK_STREAM
) or return DECLINED;
- #$self->log(LOGINFO, "Attempting $method auth via vpopmaild");
+ $self->log(LOGDEBUG, "attempting $method");
# Get server greeting (+OK)
my $connect_response = <$vpopmaild_socket>;
- if ( $connect_response !~ /^\+OK/ ) {
- $self->log(LOGINFO, "Failed to receive vpopmaild connection response: $connect_response");
+ if ( ! $connect_response ) {
+ $self->log(LOGERROR, "no connection response");
close($vpopmaild_socket);
return DECLINED;
};
- # send login details
- print $vpopmaild_socket "login $user $passClear\n\r";
-
- # get response from server
- my $login_response = <$vpopmaild_socket>;
+ if ( $connect_response !~ /^\+OK/ ) {
+ $self->log(LOGERROR, "bad connection response: $connect_response");
+ close($vpopmaild_socket);
+ return DECLINED;
+ };
+ print $vpopmaild_socket "login $user $passClear\n\r"; # send login details
+ my $login_response = <$vpopmaild_socket>; # get response from server
close($vpopmaild_socket);
+ if ( ! $login_response ) {
+ $self->log(LOGERROR, "no login response");
+ return DECLINED;
+ };
+
# check for successful login (single line (+OK) or multiline (+OK+))
- return (OK, 'auth_vpopmaild') if $login_response =~ /^\+OK/;
+ if ( $login_response =~ /^\+OK/ ) {
+ $self->log(LOGDEBUG, "auth success");
+ return (OK, 'auth_vpopmaild');
+ };
- $self->log(LOGINFO, "Failed vpopmaild authentication response: $login_response");
+ $self->log(LOGNOTICE, "failed authentication response: $login_response");
return DECLINED;
}
View
57 plugins/domainkeys
@@ -1,9 +1,37 @@
#!perl -w
+
+=head1 NAME
+
+domainkeys: validate a DomainKeys signature on an incoming mail
+
+=head1 SYNOPSIS
+
+ domainkeys [warn_only 1]
+
+Performs a DomainKeys validation on the message. Takes a single
+configuration
+
+ warn_only 1
+
+which means that messages which are not correctly signed (i.e. signed but
+modified or deliberately forged) will not be DENY'd, but an error will still
+be issued to the logfile.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005-2006 John Peacock.
+
+Portions Copyright (C) 2004 Anthony D. Urso. All rights reserved. This
+program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
sub init {
my ($self, $qp, %args) = @_;
foreach my $key ( %args ) {
- $self->{$key} = $args{$key};
+ $self->{$key} = $args{$key};
}
}
@@ -89,30 +117,3 @@ sub hook_data_post {
}
}
-
-=head1 NAME
-
-domainkeys: validate a DomainKeys signature on an incoming mail
-
-=head1 SYNOPSIS
-
- domainkeys [warn_only 1]
-
-Performs a DomainKeys validation on the message. Takes a single
-configuration
-
- warn_only 1
-
-which means that messages which are not correctly signed (i.e. signed but
-modified or deliberately forged) will not be DENY'd, but an error will still
-be issued to the logfile.
-
-=head1 COPYRIGHT
-
-Copyright (C) 2005-2006 John Peacock.
-
-Portions Copyright (C) 2004 Anthony D. Urso. All rights reserved. This
-program is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=cut
View
17 plugins/logging/warn
@@ -28,16 +28,17 @@ sub hook_logging {
# Don't log your own log entries! If this is the only logging plugin
# then these lines will not be logged at all. You can safely comment
# out this line and it will not cause an infinite loop.
- return DECLINED if defined $plugin and $plugin eq $self->plugin_name;
+ return DECLINED if defined $plugin && $plugin eq $self->plugin_name;
- warn
- join(" ", $$ .
- (defined $plugin ? " $plugin plugin:" :
- defined $hook ? " running plugin ($hook):" : ""),
- @log), "\n"
- if ($trace <= $self->{_level});
+ return DECLINED if $trace > $self->{_level};
- return DECLINED;
+ my $prefix = defined $plugin && defined $hook ? " ($hook) $plugin:" :
+ defined $plugin ? " $plugin:" :
+ defined $hook ? " ($hook) running plugin:" : '';
+
+ warn join(' ', $$ . $prefix, @log), "\n";
+
+ return DECLINED;
}
=head1 NAME
View
51 plugins/rhsbl
@@ -1,5 +1,31 @@
#!perl -w
+=head1 NAME
+
+rhsbl - handle RHSBL lookups
+
+=head1 DESCRIPTION
+
+Pluging that checks the host part of the sender's address against a
+configurable set of RBL services.
+
+=head1 CONFIGURATION
+
+This plugin reads the lists to use from the rhsbl_zones configuration
+file. Normal domain based dns blocking lists ("RBLs") which contain TXT
+records are specified simply as:
+
+ dsn.rfc-ignorant.org
+
+To configure RBL services which do not contain TXT records in the DNS,
+but only A records, specify, after a whitespace, your own error message
+to return in the SMTP conversation e.g.
+
+ abuse.rfc-ignorant.org does not support abuse@domain
+
+=cut
+
+
sub register {
my ($self, $qp, $denial ) = @_;
if ( defined $denial and $denial =~ /^disconnect$/i ) {
@@ -133,28 +159,3 @@ sub hook_disconnect {
return DECLINED;
}
-
-=head1 NAME
-
-rhsbl - handle RHSBL lookups
-
-=head1 DESCRIPTION
-
-Pluging that checks the host part of the sender's address against a
-configurable set of RBL services.
-
-=head1 CONFIGURATION
-
-This plugin reads the lists to use from the rhsbl_zones configuration
-file. Normal domain based dns blocking lists ("RBLs") which contain TXT
-records are specified simply as:
-
- dsn.rfc-ignorant.org
-
-To configure RBL services which do not contain TXT records in the DNS,
-but only A records, specify, after a whitespace, your own error message
-to return in the SMTP conversation e.g.
-
- abuse.rfc-ignorant.org does not support abuse@domain
-
-=cut
View
62 t/01-syntax.t
@@ -2,47 +2,43 @@ use Config qw/ myconfig /;
use Data::Dumper;
use English qw/ -no_match_vars /;
use File::Find;
-use Test::More 'no_plan';
+use Test::More;
+
+if ( $ENV{'QPSMTPD_DEVELOPER'} ) {
+ 'no_plan';
+}
+else {
+ plan skip_all => "not a developer, skipping POD tests";
+};
use lib 'lib';
my $this_perl = $Config{'perlpath'} || $EXECUTABLE_NAME;
-#ok( $Config{'perlpath'}, "config: $Config{'perlpath'}" );
-#ok( $EXECUTABLE_NAME, "var: $EXECUTABLE_NAME" );
-#ok( $this_perl, "this_perl: $this_perl" );
-
-my @skip_syntax = qw(
- plugins/milter
- plugins/auth/auth_ldap_bind
- plugins/ident/geoip
- plugins/logging/apache
- plugins/auth/auth_vpopmail
- plugins/virus/clamdscan
- plugins/sender_permitted_from
- plugins/domainkeys
- lib/Apache/Qpsmtpd.pm
- lib/Danga/Client.pm
- lib/Danga/TimeoutSocket.pm
- lib/Qpsmtpd/ConfigServer.pm
- lib/Qpsmtpd/PollServer.pm
- lib/Qpsmtpd/Plugin/Async/DNSBLBase.pm
-);
-my %skip_syntax = map { $_ => 1 } @skip_syntax;
-#print Dumper(\@skip_syntax);
my @files = find( {wanted=>\&test_syntax, no_chdir=>1}, 'plugins', 'lib' );
sub test_syntax {
- my $f = $File::Find::name;
- chomp $f;
- return if $f =~ m{^plugins/};
- return if ! -f $f;
- return if $skip_syntax{$f};
- return if $f =~ m/(~|\.(bak|orig|rej))/;
- return if $f =~ /async/; # requires ParaDNS
- my $r = `$this_perl -Ilib -MQpsmtpd::Constants -c $f 2>&1`;
- my $exit_code = sprintf ("%d", $CHILD_ERROR >> 8);
- ok( $exit_code == 0, "syntax $f");
+ my $f = $File::Find::name;
+ chomp $f;
+ return if ! -f $f;
+ return if $f =~ m/(~|\.(bak|orig|rej))/;
+ my $r;
+ eval { $r = `$this_perl -Ilib -MQpsmtpd::Constants -c $f 2>&1`; };
+ my $exit_code = sprintf ("%d", $CHILD_ERROR >> 8);
+ if ( $exit_code == 0 ) {
+ ok( $exit_code == 0, "syntax $f");
+ return;
+ };
+ if ( $r =~ /^Can't locate (.*?) in / ) {
+ ok( 0 == 0, "skipping $f, I couldn't load w/o $1");
+ return;
+ }
+ if ( $r =~ /^Base class package "Danga::Socket" is empty/ ) {
+ ok( 0 == 0, "skipping $f, Danga::Socket not available.");
+ return;
+ }
+ print "ec: $exit_code, r: $r\n";
};
+done_testing();
View
12 t/02-pod.t
@@ -1,8 +1,18 @@
#!perl
use Test::More;
+
+if ( ! $ENV{'QPSMTPD_DEVELOPER'} ) {
+ plan skip_all => "not a developer, skipping POD tests";
+ exit;
+}
+
eval "use Test::Pod 1.14";
-plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+if ( $@ ) {
+ plan skip_all => "Test::Pod 1.14 required for testing POD";
+ exit;
+};
my @poddirs = qw( lib plugins );
all_pod_files_ok( all_pod_files( @poddirs ) );
+done_testing();
View
143 t/auth.t
@@ -0,0 +1,143 @@
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+
+use lib 't';
+use lib 'lib';
+
+use Data::Dumper;
+use Digest::HMAC_MD5 qw(hmac_md5_hex);
+use English qw/ -no_match_vars /;
+use File::Path;
+
+use Qpsmtpd::Constants;
+use Scalar::Util qw( openhandle );
+use Test::More qw(no_plan);
+
+use_ok('Test::Qpsmtpd');
+use_ok('Qpsmtpd::Auth');
+
+my ($smtpd, $conn) = Test::Qpsmtpd->new_conn();
+
+ok( $smtpd, "get new connection ($smtpd)");
+isa_ok( $conn, 'Qpsmtpd::Connection', "get new connection");
+
+#warn Dumper($smtpd) and exit;
+#my $hooks = $smtpd->hooks;
+#warn Dumper($hooks) and exit;
+
+my $r;
+my $user = 'good@example.com';
+my $pass = 'good_pass';
+my $enc_plain= Qpsmtpd::Auth::e64( join("\0", '', $user, $pass ) );
+
+# get_auth_details_plain: plain auth method handles credentials properly
+my ($loginas,$ruser,$passClear) = Qpsmtpd::Auth::get_auth_details_plain($smtpd, $enc_plain);
+cmp_ok( $user, 'eq', $user, "get_auth_details_plain, user");
+cmp_ok( $passClear, 'eq', $pass, "get_auth_details_plain, password");
+
+my $bad_auth = Qpsmtpd::Auth::e64( join("\0", 'loginas', 'user@foo', 'passer') );
+($loginas,$ruser,$passClear) = Qpsmtpd::Auth::get_auth_details_plain($smtpd, $bad_auth );
+ok( ! $loginas, "get_auth_details_plain, loginas -");
+ok( !$ruser, "get_auth_details_plain, user -");
+ok( !$passClear, "get_auth_details_plain, pass -");
+
+# these plugins test against whicever loaded plugin provides their selected
+# auth type. Right now, they end up testing against auth_flat_file.
+
+# PLAIN
+$r = Qpsmtpd::Auth::SASL($smtpd, 'plain', $enc_plain);
+cmp_ok( OK, '==', $r, "plain auth");
+
+if ( $ENV{QPSMTPD_DEVELOPER} && is_interactive() ) {
+# same thing, but must be entered interactively
+ print "answer: $enc_plain\n";
+ $r = Qpsmtpd::Auth::SASL($smtpd, 'plain', '');
+ cmp_ok( OK, '==', $r, "SASL, plain");
+};
+
+
+# LOGIN
+
+if ( $ENV{QPSMTPD_DEVELOPER} && is_interactive() ) {
+
+ my $enc_user = Qpsmtpd::Auth::e64( $user );
+ my $enc_pass = Qpsmtpd::Auth::e64( $pass );
+
+# get_base64_response
+ print "answer: $enc_user\n";
+ $r = Qpsmtpd::Auth::get_base64_response( $smtpd, 'Username' );
+ cmp_ok( $r, 'eq', $user, "get_base64_response +");
+
+# get_auth_details_login
+ print "answer: $enc_pass\n";
+ ($ruser,$passClear) = Qpsmtpd::Auth::get_auth_details_login( $smtpd, $enc_user );
+ cmp_ok( $ruser, 'eq', $user, "get_auth_details_login, user +");
+ cmp_ok( $passClear, 'eq', $pass, "get_auth_details_login, pass +");
+
+ print "encoded pass: $enc_pass\n";
+ $r = Qpsmtpd::Auth::SASL($smtpd, 'login', $enc_user);
+ cmp_ok( OK, '==', $r, "SASL, login");
+};
+
+
+# CRAM-MD5
+
+if ( $ENV{QPSMTPD_DEVELOPER} && is_interactive() ) {
+ print "starting SASL\n";
+
+# since we don't have bidirection communication here, we pre-generate a ticket
+ my $ticket = sprintf( '<%x.%x@%s>', rand(1000000), time(), $smtpd->config('me') );
+ my $hash_pass = hmac_md5_hex( $ticket, $pass );
+ my $enc_answer = Qpsmtpd::Auth::e64( join(' ', $user, $hash_pass ) );
+ print "answer: $enc_answer\n";
+ my (@r) = Qpsmtpd::Auth::get_auth_details_cram_md5( $smtpd, $ticket );
+ cmp_ok( $r[0], 'eq', $ticket, "get_auth_details_cram_md5, ticket" );
+ cmp_ok( $r[1], 'eq', $user, "get_auth_details_cram_md5, user" );
+ cmp_ok( $r[2], 'eq', $hash_pass, "get_auth_details_cram_md5, passHash" );
+#warn Data::Dumper::Dumper(\@r);
+
+# this isn't going to work without bidirection communication to get the ticket
+ #$r = Qpsmtpd::Auth::SASL($smtpd, 'cram-md5' );
+ #cmp_ok( OK, '==', $r, "login auth");
+};
+
+
+sub is_interactive {
+
+## no critic
+# borrowed from IO::Interactive
+ my ($out_handle) = ( @_, select ); # Default to default output handle
+
+# Not interactive if output is not to terminal...
+ return if not -t $out_handle;
+
+# If *ARGV is opened, we're interactive if...
+ if ( openhandle * ARGV ) {
+
+# ...it's currently opened to the magic '-' file
+ return -t *STDIN if defined $ARGV && $ARGV eq '-';
+
+# ...it's at end-of-file and the next file is the magic '-' file
+ return @ARGV > 0 && $ARGV[0] eq '-' && -t *STDIN if eof *ARGV;
+
+# ...it's directly attached to the terminal
+ return -t *ARGV;
+ };
+
+# If *ARGV isn't opened, it will be interactive if *STDIN is attached
+# to a terminal and either there are no files specified on the command line
+# or if there are files and the first is the magic '-' file
+ return -t *STDIN && ( @ARGV == 0 || $ARGV[0] eq '-' );
+}
+
+
+__END__
+
+if ( ref $r ) {
+} else {
+ warn $r;
+}
+#print Data::Dumper::Dumper($conn);
+#print Data::Dumper::Dumper($smtpd);
+
Something went wrong with that request. Please try again.