view release on metacpan or  search on metacpan

lib/Mail/Toaster/Setup/Test.pm  view on Meta::CPAN

    $self->imap_auth_ssl;
};

sub imap_auth_nossl {
    my $self = shift;

    my $r = $self->util->install_module("Mail::IMAPClient", verbose => 0);
    $self->pretty("checking Mail::IMAPClient", $r );
    if ( ! $r ) {
        print "skipping imap test authentications\n";
        return;
    };

    eval "use Mail::IMAPClient";  ## no critic ( ProhibitStringyEval )
    if ( $EVAL_ERROR ) {
        $self->audit("unable to load Mail::IMAPClient");
        return;
    };

    # an authentication that should succeed
    my $imap = Mail::IMAPClient->new(
        User     => $self->conf->{'toaster_test_email'} || 'test2@example.com',
        Password => $self->conf->{'toaster_test_email_pass'} || 'cHanGeMe',
        Server   => 'localhost',
    );
    if ( !defined $imap ) {
        $self->pretty( "imap connection", $imap );
        return;
    };

    $self->pretty( "authenticate IMAP user with plain passwords",
        $imap->IsAuthenticated );

    my @features = $imap->capability
        or warn "Couldn't determine capability: $@\n";
    $self->audit( "Your IMAP server supports: " . join( ',', @features ) );
    $imap->logout;

    print "an authentication that should fail\n";
    $imap = Mail::IMAPClient->new(
        Server => 'localhost',
        User   => 'no_such_user',
        Pass   => 'hi_there_log_watcher'
    )
    or do {
        $self->pretty( "imap connection that should fail", 0);
        return 1;
    };
    $self->pretty( "  imap connection", $imap->IsConnected );
    $self->pretty( "  test auth that should fail", !$imap->IsAuthenticated );
    $imap->logout;
    return;
};

sub imap_auth_ssl {
    my $self = shift;

    my $user = $self->conf->{'toaster_test_email'}      || 'test2@example.com';
    my $pass = $self->conf->{'toaster_test_email_pass'} || 'cHanGeMe';

    my $r = $self->util->install_module( "IO::Socket::SSL", verbose => 0,);
    $self->pretty( "checking IO::Socket::SSL ", $r);
    if ( ! $r ) {
        print "skipping IMAP SSL tests due to missing SSL support\n";
        return;
    };

    require IO::Socket::SSL;
    my $socket = IO::Socket::SSL->new(
        PeerAddr => 'localhost',
        PeerPort => 993,
        Proto    => 'tcp',
        SSL_verify_mode => 'SSL_VERIFY_NONE',
    );
    $self->pretty( "  imap SSL connection", $socket);
    return if ! $socket;

    print "  connected with " . $socket->get_cipher . "\n";
    print $socket ". login $user $pass\n";
    ($r) = $socket->peek =~ /OK/i;
    $self->pretty( "  auth IMAP SSL with plain password", $r ? 0 : 1);
    print $socket ". logout\n";
    close $socket;

#  no idea why this doesn't work, so I just forge an authentication by printing directly to the socket
#   my $imapssl = Mail::IMAPClient->new( Socket=>$socket, User=>$user, Password=>$pass) or warn "new IMAP failed: ($@)\n";
#   $imapssl->IsAuthenticated ? print "ok\n" : print "FAILED.\n";

# doesn't work yet because courier doesn't support CRAM-MD5 via the vchkpw auth module
#   print "authenticating IMAP user with CRAM-MD5...";
#   $imap->connect;
#   $imap->authenticate;
#   $imap->IsAuthenticated ? print "ok\n" : print "FAILED.\n";
#
#   print "logging out...";
#   $imap->logout;
#   $imap->IsAuthenticated ? print "FAILED.\n" : print "ok.\n";
#   $imap->IsConnected ? print "connection open.\n" : print "connection closed.\n";

}

sub pop3_auth {
    my $self  = shift;
    my %p = validate( @_, { $self->get_std_opts },);

    $OUTPUT_AUTOFLUSH = 1;

    my $r = $self->util->install_module( "Mail::POP3Client", verbose => 0,);
    $self->pretty("checking Mail::POP3Client", $r );
    eval "use Mail::POP3Client";  ## no critic ( ProhibitStringyEval )
    if ( $EVAL_ERROR ) {
        print "unable to load Mail::POP3Client, skipping POP3 tests\n";
        return;
    };

    my %auths = (
        'POP3'          => { type => 'PASS',     descr => 'plain text' },
        'POP3-APOP'     => { type => 'APOP',     descr => 'APOP' },
        'POP3-CRAM-MD5' => { type => 'CRAM-MD5', descr => 'CRAM-MD5' },
        'POP3-SSL'      => { type => 'PASS', descr => 'plain text', ssl => 1 },
        'POP3-SSL-APOP' => { type => 'APOP', descr => 'APOP', ssl => 1 },
        'POP3-SSL-CRAM-MD5' => { type => 'CRAM-MD5', descr => 'CRAM-MD5', ssl => 1 },
    );

    foreach ( sort keys %auths ) {
        $self->pop3_auth_prot( $_, $auths{$_} );
    }

    return 1;
}

sub pop3_auth_prot {
    my $self = shift;
    my ( $name, $v ) = @_;

    my $type  = $v->{'type'};
    my $descr = $v->{'descr'};

    my $user = $self->conf->{'toaster_test_email'}        || 'test2@example.com';
    my $pass = $self->conf->{'toaster_test_email_pass'}   || 'cHanGeMe';
    my $host = $self->conf->{'pop3_ip_address_listen_on'} || 'localhost';
    $host = "localhost" if ( $host =~ /system|qmail|all/i );

    my $pop = Mail::POP3Client->new(
        HOST      => $host,
        AUTH_MODE => $type,
        $v->{ssl} ? ( USESSL => 1 ) : (),
    );

    if ( $v->{ssl} ) {
        my $socket = IO::Socket::SSL->new( PeerAddr => $host,
                                        PeerPort => 995,
                                        SSL_verify_mode => 'SSL_VERIFY_NONE',
                                        Proto    => 'tcp',
                                        )
            or do { warn "No socket!"; return };

         $pop->Socket($socket);
    }

    $pop->User($user);
    $pop->Pass($pass);
    $pop->Connect >= 0 || warn $pop->Message;
    $self->pretty( "  $name authentication", ($pop->State eq 'TRANSACTION'));

#   if ( my @features = $pop->Capa ) {
#       print "  POP3 server supports: " . join( ",", @features ) . "\n";
#   }
    $pop->Close;
}

sub smtp_auth {
    my $self  = shift;
    my %p = validate( @_, { $self->get_std_opts } );

    my @modules = ('IO::Socket::INET', 'IO::Socket::SSL', 'Net::SSLeay', 'Socket qw(:DEFAULT :crlf)','Net::SMTP_auth');
    foreach ( @modules ) {
        eval "use $_";   ## no critic ( ProhibitStringyEval )
        die $@ if $@;
        $self->pretty( "loading $_", 'ok' );
    };

    Net::SSLeay::load_error_strings();
    Net::SSLeay::SSLeay_add_ssl_algorithms();
    Net::SSLeay::randomize();

    my $host = $self->conf->{'smtpd_listen_on_address'} || 'localhost';
       $host = 'localhost' if ( $host =~ /system|qmail|all/i );

    my $smtp = Net::SMTP_auth->new($host);
    $self->pretty( "connect to smtp port on $host", $smtp );
    return 0 if ! defined $smtp;

    my @auths = $smtp->auth_types;
    $self->pretty( "  get list of SMTP AUTH methods", scalar @auths);
    $smtp->quit;

    $self->smtp_auth_pass($host, \@auths);
    $self->smtp_auth_fail($host, \@auths);
};

sub smtp_auth_pass {
    my $self = shift;
    my $host = shift;
    my $auths = shift or die "invalid params\n";

    my $user = $self->conf->{'toaster_test_email'}      || 'test2@example.com';
    my $pass = $self->conf->{'toaster_test_email_pass'} || 'cHanGeMe';

    # test each authentication method the server advertises
    foreach (@$auths) {

        my $smtp = Net::SMTP_auth->new($host);
        my $r = $smtp->auth( $_, $user, $pass );
        $self->pretty( "  authentication with $_", $r );
        next if ! $r;

        $smtp->mail( $self->conf->{'toaster_admin_email'} );
        $smtp->to('postmaster');
        $smtp->data;
        $smtp->datasend("To: postmaster\n");
        $smtp->datasend("\n");
        $smtp->datasend("A simple test message\n");
        $smtp->dataend;

        $smtp->quit;
        $self->pretty("  sending after auth $_", 1 );
    }
}

sub smtp_auth_fail {
    my $self = shift;
    my $host = shift;
    my $auths = shift or die "invalid params\n";

    my $user = 'non-exist@example.com';