#!/usr/bin/env perl
use strict;
use warnings;
use IO::Socket::SSL;
use File::Spec;
die unless @ARGV == 3;
my $server_port = shift @ARGV;
my ($username, $password) = map { quotemeta $_ } @ARGV;
my $server = IO::Socket::SSL->new(
LocalAddr => '127.0.0.1',
LocalPort => $server_port,
Proto => 'tcp',
ReuseAddr => 1,
Listen => 2,
SSL_key_file => File::Spec->catfile(qw/t certs server-key.pem/),
SSL_cert_file => File::Spec->catfile(qw/t certs server-cert.pem/),
) or die "Couldn't listen: " . IO::Socket::SSL::errstr() . "\n";
while ( my $client = $server->accept() ) {
local $/ = "\r\n";
print {$client} "* OK IMAP4rev1 server ready\r\n";
chomp( my $response = <$client> );
$response =~ s{^(\S+)\s+}{}xms;
my $cid = $1 || q{*};
if ( $response =~ m{^LOGIN \s+ "?$username"? \s+ "?$password"?}xms ) {
print {$client} "$cid OK LOGIN Completed\r\n";
}
else {
print {$client} "$cid NO LOGIN Incorrect username or password\r\n";
}
close($client);
}
close($server);