#!/usr/bin/perl
# bad-relay - bad SMTP client example
use 5.38.0;
use IO::Socket::IP;
use Time::Piece;

my ( $host, $port ) = @ARGV;
die "Usage: rly host [port]\n" unless defined $host;
$port //= 25;

my $helo = 'client.example.org';
my $from = 'fixme@example.org';
my $to   = 'fixme@example.org';

my $s = IO::Socket::IP->new(
    PeerHost => $host,
    PeerPort => $port,
    Proto    => 'tcp',
) or die "bad-relay: connect error '$host:$port': $!\n";

sub tx ( $s, $command ) {
    print $s->getline;
    print " -> ", $command;
    $s->print($command);
}

tx $s, "HELO $helo\r\n";
# Bad! We send two commands at once. Also this client is bad in that it
# is not checking the responses for errors and continues on blindly
# assuming that all is well.
tx $s, "MAIL FROM:<$from>\r\nRCPT TO:<$to>\r\n";
# The RCPT TO must instead be sent as a distinct command.
#tx $s, "RCPT TO:<$to>\r\n";
tx $s, "DATA\r\n";
$s->print("From: <$from>\r\n");
$s->print("Subject: test\r\n");
my $now = localtime;
$s->print( $now->strftime("Date: %a, %d %b %Y %H:%M:%S %z\r\n") );
$s->print( "Message-ID: <", $now->epoch, ">\r\n" );
$s->print("\r\n");
$s->print("asdf\r\n");
$s->print(".\r\n");
tx $s, "QUIT\r\n";
print $s->getline;
$s->close;