The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use lib 't/lib';
use strict;
use warnings;

use Net::IMAP::Server::Test;
my $t = "Net::IMAP::Server::Test";

$t->start_server_ok;

# SSL allows auth
$t->connect_ok;
my ($cap) = $t->cmd_like(
    "CAPABILITY",
    "* CAPABILITY",
    "tag OK",
);

like($cap, qr/\bIMAP4rev1\b/, "Advertises IMAP4rev1");
like($cap, qr/\bAUTH=PLAIN\b/, "Advertises AUTH=PLAIN over SSL");
unlike($cap, qr/\bSTARTTLS\b/, "TLS is not advertized over SSL");
unlike($cap, qr/\bLOGINDISABLED\b/, "Login is not DISABLED over SSL");

# Try over simple TCP
$t->connect_ok( "Non-SSL connection OK",
    Class => "IO::Socket::INET",
    PeerPort => $t->PORT,
);
($cap) = $t->cmd_like(
    "CAPABILITY",
    "* CAPABILITY",
    "tag OK",
);
like($cap, qr/\bIMAP4rev1\b/, "Advertises IMAP4rev1");
unlike($cap, qr/\bAUTH=PLAIN\b/, "Does not advertize AUTH=PLAIN over TCP");
like($cap, qr/\bSTARTTLS\b/, "TLS is advertized over TCP");
like($cap, qr/\bLOGINDISABLED\b/, "LOGINDISABLED over TCP");

# Start up TLS and try again
$t->cmd_like("STARTTLS" => "tag OK");
$t->start_tls_ok;
($cap) = $t->cmd_like(
    "CAPABILITY",
    "* CAPABILITY",
    "tag OK",
);
like($cap, qr/\bIMAP4rev1\b/, "Advertises IMAP4rev1");
like($cap, qr/\bAUTH=PLAIN\b/, "Advertises AUTH=PLAIN over TLS");
unlike($cap, qr/\bSTARTTLS\b/, "TLS is not advertized over TLS");
unlike($cap, qr/\bLOGINDISABLED\b/, "Login is not DISABLED over TLS");

# See what changes once we're logged in
$t->cmd_ok("LOGIN username password", "Logged in");
($cap) = $t->cmd_like(
    "CAPABILITY",
    "* CAPABILITY",
    "tag OK",
);
like($cap, qr/\bIMAP4rev1\b/, "Advertises IMAP4rev1");
unlike($cap, qr/\bAUTH=PLAIN\b/, "No longer advertises AUTH after login");
unlike($cap, qr/\bSTARTTLS\b/, "TLS is not advertized over TLS");
unlike($cap, qr/\bLOGINDISABLED\b/, "Login is not DISABLED over TLS");

done_testing;