Download raw body.
initial smtpd regress suite
Hello,
This is some manual cleanup of a PR that we got on OpenSMTPD-portable:
https://github.com/OpenSMTPD/OpenSMTPD/pull/1306
I've simplified a bit the code, got rid of Lmtp.pm which was a
copy-paste of Server.pm, got rid of IO::Socket::INET6, etc...
I've also removed for now the sqlite table test.
My perl-fu (unfortunately) it's not very strong, but it reassures me
that the bulk of the code is a dumb copy-paste from relayd regress. At
least Client.pm, Proc.pm and Server.pm are copy-pasted files, with very
minor tweaking (dropped some SSL bits for now.)
I've kept the author' copyright in addition to bluhm@'s.
I'd like to plug it, and then hopefully add more tests on top.
opinions?
diffstat refs/remotes/origin/master refs/heads/master
A regress/usr.sbin/smtpd/Client.pm | 110+ 0-
A regress/usr.sbin/smtpd/Makefile | 64+ 0-
A regress/usr.sbin/smtpd/Proc.pm | 205+ 0-
A regress/usr.sbin/smtpd/Server.pm | 108+ 0-
A regress/usr.sbin/smtpd/Smtpd.pm | 142+ 0-
A regress/usr.sbin/smtpd/args-filter-junk.pl | 35+ 0-
A regress/usr.sbin/smtpd/args-filter-reject.pl | 32+ 0-
A regress/usr.sbin/smtpd/args-table-aliases.pl | 34+ 0-
A regress/usr.sbin/smtpd/args-table-db.pl | 40+ 0-
A regress/usr.sbin/smtpd/args-table-file.pl | 34+ 0-
A regress/usr.sbin/smtpd/args-table-static.pl | 34+ 0-
A regress/usr.sbin/smtpd/filter-stub.pl | 75+ 0-
A regress/usr.sbin/smtpd/funcs.pl | 261+ 0-
A regress/usr.sbin/smtpd/smtpd.pl | 102+ 0-
14 files changed, 1276 insertions(+), 0 deletions(-)
diff refs/remotes/origin/master refs/heads/master
commit - 3d7071fd2e449c2c8e77a4f35765f97a4f5c2311
commit + 34314b7dda64dc357bbd6a0cd35322339072a6f9
blob - /dev/null
blob + fc1fc3eeb3711f1575eaa06250e60c669ca806b5 (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/Client.pm
@@ -0,0 +1,110 @@
+# $OpenBSD $
+
+# Copyright (c) 2010-2021 Alexander Bluhm <bluhm@openbsd.org>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+use strict;
+use warnings;
+
+package Client;
+use parent 'Proc';
+use Carp;
+use Socket qw(:DEFAULT IPPROTO_TCP TCP_NODELAY);
+use Socket6;
+use IO::Socket::IP;
+use IO::Socket::SSL;
+
+sub new {
+ my $class = shift;
+ my %args = @_;
+ $args{logfile} ||= "client.log";
+ $args{up} ||= "Connected";
+ $args{timefile} //= "time.log";
+ my $self = Proc::new($class, %args);
+ $self->{connectdomain}
+ or croak "$class connect domain not given";
+ $self->{connectaddr}
+ or croak "$class connect addr not given";
+ $self->{connectport}
+ or croak "$class connect port not given";
+ return $self;
+}
+
+sub child {
+ my $self = shift;
+
+ # in case we redo the connect, shutdown the old one
+ shutdown(\*STDOUT, SHUT_WR);
+ delete $self->{cs};
+
+ $SSL_ERROR = "";
+ my $iosocket = $self->{ssl} ? "IO::Socket::SSL" : "IO::Socket::IP";
+ my $cs = $iosocket->new(
+ Proto => "tcp",
+ Domain => $self->{connectdomain},
+ # IO::Socket::IP calls the domain family
+ Family => $self->{connectdomain},
+ PeerAddr => $self->{connectaddr},
+ PeerPort => $self->{connectport},
+ SSL_verify_mode => SSL_VERIFY_NONE,
+ SSL_use_cert => $self->{offertlscert} ? 1 : 0,
+ SSL_cert_file => $self->{offertlscert} ?
+ "client.crt" : "",
+ SSL_key_file => $self->{offertlscert} ?
+ "client.key" : "",
+ ) or die ref($self), " $iosocket socket connect failed: $!,$SSL_ERROR";
+ if ($self->{sndbuf}) {
+ setsockopt($cs, SOL_SOCKET, SO_SNDBUF,
+ pack('i', $self->{sndbuf}))
+ or die ref($self), " set SO_SNDBUF failed: $!";
+ }
+ if ($self->{rcvbuf}) {
+ setsockopt($cs, SOL_SOCKET, SO_RCVBUF,
+ pack('i', $self->{rcvbuf}))
+ or die ref($self), " set SO_SNDBUF failed: $!";
+ }
+ if ($self->{sndtimeo}) {
+ setsockopt($cs, SOL_SOCKET, SO_SNDTIMEO,
+ pack('l!l!', $self->{sndtimeo}, 0))
+ or die ref($self), " set SO_SNDTIMEO failed: $!";
+ }
+ if ($self->{rcvtimeo}) {
+ setsockopt($cs, SOL_SOCKET, SO_RCVTIMEO,
+ pack('l!l!', $self->{rcvtimeo}, 0))
+ or die ref($self), " set SO_RCVTIMEO failed: $!";
+ }
+ setsockopt($cs, IPPROTO_TCP, TCP_NODELAY, pack('i', 1))
+ or die ref($self), " set TCP_NODELAY failed: $!";
+
+ print STDERR "connect sock: ",$cs->sockhost()," ",$cs->sockport(),"\n";
+ print STDERR "connect peer: ",$cs->peerhost()," ",$cs->peerport(),"\n";
+ if ($self->{ssl}) {
+ print STDERR "ssl version: ",$cs->get_sslversion(),"\n";
+ print STDERR "ssl cipher: ",$cs->get_cipher(),"\n";
+ print STDERR "ssl peer certificate:\n",
+ $cs->dump_peer_certificate();
+
+ if ($self->{offertlscert}) {
+ print STDERR "ssl client certificate:\n";
+ print STDERR "Subject Name: ",
+ "${\$cs->sock_certificate('subject')}\n";
+ print STDERR "Issuer Name: ",
+ "${\$cs->sock_certificate('issuer')}\n";
+ }
+ }
+
+ *STDIN = *STDOUT = $self->{cs} = $cs;
+}
+
+1;
blob - /dev/null
blob + 61dfe7294ae131be18f8cfa6aadd3ad8727a5b30 (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/Makefile
@@ -0,0 +1,64 @@
+# $OpenBSD$
+
+# The following ports must be installed for the regression tests:
+# p5-Socket6 Perl defines relating to AF_INET6 sockets
+# p5-IO-Socket-SSL Perl interface to SSL sockets
+#
+# Check wether all required perl packages are installed. If some
+# are missing print a warning and skip the tests, but do not fail.
+
+PERL_REQUIRE != perl -Mstrict -Mwarnings -e ' \
+ eval { require Socket6 } or print $@; \
+ eval { require IO::Socket::SSL } or print $@; \
+'
+.if ! empty (PERL_REQUIRE)
+regress:
+ @echo "${PERL_REQUIRE}"
+ @echo 'run "pkg_add p5-Socket6 p5-IO-Socket-SSL"'
+ @echo SKIPPED
+.endif
+
+REGRESS_SETUP_ONCE += setup
+setup:
+ ${SUDO} true
+
+# Automatically generate regress targets from test cases in directory.
+
+ARGS != cd ${.CURDIR} && ls args-*.pl
+CLEANFILES += *.log smtpd.conf aliases-test.txt vusers-db vusers-file.txt
+CLEANFILES += ktrace.out stamp-*
+
+# Set variables so that make runs with and without obj directory.
+# Only do that if necessary to keep visible output short.
+
+.if ${.CURDIR} == ${.OBJDIR}
+PERLINC = -I.
+PERLPATH =
+.else
+PERLINC = -I${.CURDIR}
+PERLPATH = ${.CURDIR}/
+.endif
+
+# The arg tests take a perl hash with arguments controlling the
+# test parameters. Generally they consist of client, relayd, server.
+
+.for test in ${ARGS}
+REGRESS_TARGETS += run-${test}
+run-${test}: ${test}
+ time SUDO="${SUDO}" KTRACE=${KTRACE} SMTPD=${SMTPD} CURDIR=${.CURDIR} \
+ perl ${PERLINC} ${PERLPATH}smtpd.pl ${PERLPATH}${test}
+.endfor
+
+# make perl syntax check for all args files
+
+.PHONY: syntax
+
+syntax: stamp-syntax
+
+stamp-syntax: ${ARGS}
+.for test in ${ARGS}
+ @perl -c ${PERLPATH}${test}
+.endfor
+ @date >$@
+
+.include <bsd.regress.mk>
blob - /dev/null
blob + aed0ad025283f8242abd4a1f3fef44573fb30040 (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/Proc.pm
@@ -0,0 +1,205 @@
+# $OpenBSD $
+
+# Copyright (c) 2010-2016 Alexander Bluhm <bluhm@openbsd.org>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+use strict;
+use warnings;
+
+package Proc;
+use Carp;
+use Errno;
+use File::Basename;
+use IO::File;
+use POSIX;
+use Time::HiRes qw(time alarm sleep);
+
+my %CHILDREN;
+
+sub kill_children {
+ my @pids = @_ ? @_ : keys %CHILDREN
+ or return;
+ my @perms;
+ foreach my $pid (@pids) {
+ if (kill(TERM => $pid) != 1 and $!{EPERM}) {
+ push @perms, $pid;
+ }
+ }
+ if (my @sudo = split(' ', $ENV{SUDO}) and @perms) {
+ local $?; # do not modify during END block
+ my @cmd = (@sudo, '/bin/kill', '-TERM', @perms);
+ system(@cmd);
+ }
+ delete @CHILDREN{@pids};
+}
+
+BEGIN {
+ $SIG{TERM} = $SIG{INT} = sub {
+ my $sig = shift;
+ kill_children();
+ $SIG{TERM} = $SIG{INT} = 'DEFAULT';
+ POSIX::raise($sig);
+ };
+}
+
+END {
+ kill_children();
+ $SIG{TERM} = $SIG{INT} = 'DEFAULT';
+}
+
+sub new {
+ my $class = shift;
+ my $self = { @_ };
+ $self->{down} ||= "Shutdown";
+ $self->{func} && ref($self->{func}) eq 'CODE'
+ or croak "$class func not given";
+ $self->{logfile}
+ or croak "$class log file not given";
+ open(my $fh, '>', $self->{logfile})
+ or die "$class log file $self->{logfile} create failed: $!";
+ $fh->autoflush;
+ $self->{log} = $fh;
+ $self->{ppid} = $$;
+ return bless $self, $class;
+}
+
+sub run {
+ my $self = shift;
+
+ pipe(my $reader, my $writer)
+ or die ref($self), " pipe to child failed: $!";
+ defined(my $pid = fork())
+ or die ref($self), " fork child failed: $!";
+ if ($pid) {
+ $CHILDREN{$pid} = 1;
+ $self->{pid} = $pid;
+ close($reader);
+ $self->{pipe} = $writer;
+ return $self;
+ }
+ %CHILDREN = ();
+ $SIG{TERM} = $SIG{INT} = 'DEFAULT';
+ $SIG{__DIE__} = sub {
+ die @_ if $^S;
+ warn @_;
+ IO::Handle::flush(\*STDERR);
+ POSIX::_exit(255);
+ };
+ open(STDERR, '>&', $self->{log})
+ or die ref($self), " dup STDERR failed: $!";
+ close($writer);
+ open(STDIN, '<&', $reader)
+ or die ref($self), " dup STDIN failed: $!";
+ close($reader);
+
+ do {
+ $self->child();
+ print STDERR $self->{up}, "\n";
+ $self->{begin} = time();
+ $self->{func}->($self);
+ } while ($self->{redo});
+ $self->{end} = time();
+ print STDERR "Shutdown", "\n";
+ if ($self->{timefile}) {
+ open(my $fh, '>>', $self->{timefile})
+ or die ref($self), " open $self->{timefile} failed: $!";
+ printf $fh "time='%s' duration='%.10g' ".
+ "forward='%s' test='%s'\n",
+ scalar(localtime(time())), $self->{end} - $self->{begin},
+ $self->{forward}, basename($self->{testfile});
+ }
+
+ IO::Handle::flush(\*STDOUT);
+ IO::Handle::flush(\*STDERR);
+ POSIX::_exit(0);
+}
+
+sub wait {
+ my $self = shift;
+ my $flags = shift;
+
+ # if we a not the parent process, assume the child is still running
+ return 0 unless $self->{ppid} == $$;
+
+ my $pid = $self->{pid}
+ or croak ref($self), " no child pid";
+ my $kid = waitpid($pid, $flags);
+ if ($kid > 0) {
+ my $status = $?;
+ my $code;
+ $code = "exit: ". WEXITSTATUS($?) if WIFEXITED($?);
+ $code = "signal: ". WTERMSIG($?) if WIFSIGNALED($?);
+ $code = "stop: ". WSTOPSIG($?) if WIFSTOPPED($?);
+ delete $CHILDREN{$pid} if WIFEXITED($?) || WIFSIGNALED($?);
+ return wantarray ? ($kid, $status, $code) : $kid;
+ }
+ return $kid;
+}
+
+sub loggrep {
+ my $self = shift;
+ my($regex, $timeout) = @_;
+
+ my $end;
+ $end = time() + $timeout if $timeout;
+
+ do {
+ my($kid, $status, $code) = $self->wait(WNOHANG);
+ if ($kid > 0 && $status != 0 && !$self->{dryrun}) {
+ # child terminated with failure
+ die ref($self), " child status: $status $code";
+ }
+ open(my $fh, '<', $self->{logfile})
+ or die ref($self), " log file open failed: $!";
+ my @match = grep { /$regex/ } <$fh>;
+ return wantarray ? @match : $match[0] if @match;
+ close($fh);
+ # pattern not found
+ if ($kid == 0) {
+ # child still running, wait for log data
+ sleep .1;
+ } else {
+ # child terminated, no new log data possible
+ return;
+ }
+ } while ($timeout and time() < $end);
+
+ return;
+}
+
+sub up {
+ my $self = shift;
+ my $timeout = shift || 10;
+ $self->loggrep(qr/$self->{up}/, $timeout)
+ or croak ref($self), " no '$self->{up}' in $self->{logfile} ".
+ "after $timeout seconds";
+ return $self;
+}
+
+sub down {
+ my $self = shift;
+ my $timeout = shift || 30;
+ $self->loggrep(qr/$self->{down}/, $timeout)
+ or croak ref($self), " no '$self->{down}' in $self->{logfile} ".
+ "after $timeout seconds";
+ return $self;
+}
+
+sub kill_child {
+ my $self = shift;
+ kill_children($self->{pid});
+ return $self;
+}
+
+1;
blob - /dev/null
blob + 48e034a229f33a24c0c4010e279e18de266b778f (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/Server.pm
@@ -0,0 +1,108 @@
+# $OpenBSD $
+
+# Copyright (c) 2010-2021 Alexander Bluhm <bluhm@openbsd.org>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+use strict;
+use warnings;
+
+package Server;
+use parent 'Proc';
+use Carp;
+use Config;
+use Socket qw(:DEFAULT IPPROTO_TCP TCP_NODELAY);
+use Socket6;
+use IO::Socket::IP;
+use IO::Socket::SSL;
+
+sub new {
+ my $class = shift;
+ my %args = @_;
+ $args{logfile} ||= "server.log";
+ $args{up} ||= "Accepted";
+ my $self = Proc::new($class, %args);
+ $self->{listendomain}
+ or croak "$class listen domain not given";
+ $SSL_ERROR = "";
+ my $iosocket = $self->{ssl} ? "IO::Socket::SSL" : "IO::Socket::IP";
+ my $ls = $iosocket->new(
+ Proto => "tcp",
+ ReuseAddr => 1,
+ Domain => $self->{listendomain},
+ # IO::Socket::IP calls the domain family
+ Family => $self->{listendomain},
+ $self->{listenaddr} ? (LocalAddr => $self->{listenaddr}) : (),
+ $self->{listenport} ? (LocalPort => $self->{listenport}) : (),
+ SSL_server => 1,
+ SSL_key_file => "server.key",
+ SSL_cert_file => "server.crt",
+ SSL_verify_mode => SSL_VERIFY_NONE,
+ ) or die ref($self), " $iosocket socket failed: $!,$SSL_ERROR";
+ if ($self->{sndbuf}) {
+ setsockopt($ls, SOL_SOCKET, SO_SNDBUF,
+ pack('i', $self->{sndbuf}))
+ or die ref($self), " set SO_SNDBUF failed: $!";
+ }
+ if ($self->{rcvbuf}) {
+ setsockopt($ls, SOL_SOCKET, SO_RCVBUF,
+ pack('i', $self->{rcvbuf}))
+ or die ref($self), " set SO_RCVBUF failed: $!";
+ }
+ my $packstr = $Config{longsize} == 8 ? 'ql!' :
+ $Config{byteorder} == 1234 ? 'lxxxxl!xxxx' : 'xxxxll!';
+ if ($self->{sndtimeo}) {
+ setsockopt($ls, SOL_SOCKET, SO_SNDTIMEO,
+ pack($packstr, $self->{sndtimeo}, 0))
+ or die ref($self), " set SO_SNDTIMEO failed: $!";
+ }
+ if ($self->{rcvtimeo}) {
+ setsockopt($ls, SOL_SOCKET, SO_RCVTIMEO,
+ pack($packstr, $self->{rcvtimeo}, 0))
+ or die ref($self), " set SO_RCVTIMEO failed: $!";
+ }
+ setsockopt($ls, IPPROTO_TCP, TCP_NODELAY, pack('i', 1))
+ or die ref($self), " set TCP_NODELAY failed: $!";
+ listen($ls, 1)
+ or die ref($self), " socket listen failed: $!";
+ my $log = $self->{log};
+ print $log "listen sock: ",$ls->sockhost()," ",$ls->sockport(),"\n";
+ $self->{listenaddr} = $ls->sockhost() unless $self->{listenaddr};
+ $self->{listenport} = $ls->sockport() unless $self->{listenport};
+ $self->{ls} = $ls;
+ return $self;
+}
+
+sub child {
+ my $self = shift;
+
+ # in case we redo the accept, shutdown the old one
+ shutdown(\*STDOUT, SHUT_WR);
+ delete $self->{as};
+
+ my $as = $self->{ls}->accept()
+ or die ref($self)," ",ref($self->{ls}),
+ " socket accept failed: $!,$SSL_ERROR";
+ print STDERR "accept sock: ",$as->sockhost()," ",$as->sockport(),"\n";
+ print STDERR "accept peer: ",$as->peerhost()," ",$as->peerport(),"\n";
+ if ($self->{ssl}) {
+ print STDERR "ssl version: ",$as->get_sslversion(),"\n";
+ print STDERR "ssl cipher: ",$as->get_cipher(),"\n";
+ print STDERR "ssl peer certificate:\n",
+ $as->dump_peer_certificate();
+ }
+
+ *STDIN = *STDOUT = $self->{as} = $as;
+}
+
+1;
blob - /dev/null
blob + 914e36c03b39229af2907fa6cbfc4a8a2b1e60cb (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/Smtpd.pm
@@ -0,0 +1,142 @@
+# $OpenBSD $
+
+# Copyright (c) 2026 doom <doom@tagram.loom>
+# Copyright (c) 2010-2015 Alexander Bluhm <bluhm@openbsd.org>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+use strict;
+use warnings;
+
+package Smtpd;
+use parent 'Proc';
+use Carp;
+use Cwd;
+use File::Basename;
+use File::Copy;
+use File::Temp qw/tempdir/;
+
+sub new {
+ my $class = shift;
+ my %args = @_;
+ $args{logfile} ||= "smtpd.log";
+ $args{up} ||= "starting"; # matches "OpenSMTPD x.y.z starting"
+ $args{down} ||= "Exiting";
+ $args{func} = sub { Carp::confess "$class func may not be called" };
+ $args{conffile} ||= "smtpd.conf";
+ $args{listenaddr}
+ or croak "$class listen addr not given";
+ $args{listenport}
+ or croak "$class listen port not given";
+ $args{connectaddr}
+ or croak "$class connect addr not given";
+ $args{connectport}
+ or croak "$class connect port not given";
+
+ my $self = Proc::new($class, %args);
+ ref($self->{config}) eq 'ARRAY'
+ or $self->{config} = [ split("\n", $self->{config} || "") ];
+
+ # Variables available for substitution in config lines and file content.
+ my $listenaddr = $self->{listenaddr};
+ my $listenport = $self->{listenport};
+ my $connectaddr = $self->{connectaddr};
+ my $connectport = $self->{connectport};
+ my $objdir = getcwd();
+ my $curdir = $ENV{'CURDIR'};
+
+ # Some files (tables, filters) need to be readable / executables
+ # by the _smtpd user, which may not traverse /usr/obj/.
+ # Setup a temp directory for this stuff.
+ my $tempdir = tempdir('smtpd-regress-XXXXXXXXXX', TMPDIR => 1,
+ CLEANUP => 1);
+ chmod(0755, $tempdir)
+ or die ref($self), "chmod $tempdir failed: $!";
+
+ # copy filters to $tempdir
+ if (ref($self->{filter_scripts}) eq 'ARRAY'
+ && @{$self->{filter_scripts}}) {
+ for my $src (@{$self->{filter_scripts}}) {
+ my $dst = "$tempdir/" . basename($src);
+ copy($curdir .'/'. $src, $dst)
+ or die ref($self), " copy $src -> $dst failed: $!";
+ chmod(0755, $dst)
+ or die ref($self), " chmod $dst failed: $!";
+ }
+ }
+
+ # Write any ancillary data files the test needs (e.g. table backends).
+ # Keys are filenames relative to objdir; values are file content.
+ if (ref($self->{files}) eq 'HASH') {
+ while (my ($name, $content) = each %{$self->{files}}) {
+ (my $c = $content) =~ s/(\$[a-z]+)/$1/eeg;
+ open(my $fh, '>', "$objdir/$name")
+ or die ref($self), " file $name create failed: $!";
+ print $fh $c;
+ close $fh;
+ }
+ }
+
+ # Setup makemaps
+ if (ref($self->{makemap}) eq 'ARRAY') {
+ for my $map (@{$self->{makemap}}) {
+ my $dst = "$tempdir/" . basename($map) . ".db";
+ system 'makemap', '-o', $dst, "$objdir/$map"
+ }
+ }
+
+ # Run setup commands (e.g. makemap to build .db files) after writing
+ # data files but before generating smtpd.conf.
+ if (ref($self->{commands}) eq 'ARRAY') {
+ for my $cmd (@{$self->{commands}}) {
+ my @c = map { (my $a = $_) =~ s/(\$[a-z]+)/$1/eeg; $a } @$cmd;
+ system(@c) == 0
+ or die ref($self), " command '@c' failed: $?";
+ }
+ }
+
+ open(my $fh, '>', $self->{conffile})
+ or die ref($self), " conf file $self->{conffile} create failed: $!";
+
+ # Config lines come BEFORE the listen directive.
+ #
+ # Substituted variables: $listenaddr $listenport $connectaddr
+ # $connectport $objdir $tempdir
+ foreach my $line (@{$self->{config}}) {
+ (my $l = $line) =~ s/(\$[a-z]+)/$1/eeg;
+ print $fh "$l\n";
+ }
+
+ # Listen directive optionally attaching a named filter chain.
+ print $fh "listen on $listenaddr port $listenport";
+ if ($self->{listen_filter}) {
+ print $fh " filter \"$self->{listen_filter}\"";
+ }
+ print $fh "\n";
+
+ close $fh;
+ return $self;
+}
+
+sub child {
+ my $self = shift;
+ my @sudo = $ENV{SUDO} ? ($ENV{SUDO}) : ();
+ my @ktrace = $ENV{KTRACE} ? ($ENV{KTRACE}, "-i") : ();
+ my $smtpd = $ENV{SMTPD} || "smtpd";
+ my @cmd = (@sudo, @ktrace, $smtpd, "-dv", "-f", $self->{conffile});
+ print STDERR "execute: @cmd\n";
+ exec @cmd;
+ die ref($self), " exec '@cmd' failed: $!";
+}
+
+1;
blob - /dev/null
blob + e4f242c57af9b7120b2c31ee1ecc9bbc9d2b3291 (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/args-filter-junk.pl
@@ -0,0 +1,35 @@
+# args-filter-junk.pl -- filter marks message as junk at mail-from phase
+#
+# Tests the "junk" filter action. Unlike reject, junk accepts the message
+# but sets the X-Spam flag so smtpd can route it differently. The message
+# still reaches the LMTP sink; we verify both delivery and the junk decision
+# in smtpd's log.
+
+use strict;
+use warnings;
+use Cwd qw(getcwd);
+
+our %args = (
+ client => {
+ func => \&smtp_client,
+ to => 'doom@localhost',
+ loggrep => qr/250 .* Message accepted for delivery/,
+ },
+ smtpd => {
+ listen_filter => "junk",
+ filter_scripts => [ "filter-stub.pl" ],
+ config => [
+ 'filter "junk" proc-exec "$tempdir/filter-stub.pl mail-from junk"',
+ 'table vusers { doom@localhost = build }',
+ 'action "local" lmtp "$connectaddr:$connectport" virtual <vusers>',
+ 'match from local for local action "local"',
+ ],
+ loggrep => qr/stat=Delivered/,
+ },
+ server => {
+ func => \&lmtp_server,
+ loggrep => qr/RCPT: RCPT TO:<build>/,
+ },
+);
+
+1;
blob - /dev/null
blob + b83b390123084d261fb6333eb23080c1e809bbcd (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/args-filter-reject.pl
@@ -0,0 +1,32 @@
+# args-filter-reject.pl -- filter rejects at mail-from phase
+#
+# Tests the proc-exec filter mechanism. filter-stub.pl registers for the
+# mail-from phase and responds with a 550 reject. Verifies that smtpd
+# propagates the rejection to the SMTP client and logs the disconnect.
+
+use strict;
+use warnings;
+use Cwd qw(getcwd);
+
+our %args = (
+ client => {
+ func => \&smtp_client,
+ to => 'doom@localhost',
+ loggrep => qr/MAIL FROM rejected/,
+ },
+ smtpd => {
+ listen_filter => "reject",
+ filter_scripts => [ "filter-stub.pl" ],
+ config => [
+ 'filter "reject" proc-exec "$tempdir/filter-stub.pl mail-from reject"',
+ 'action "local" lmtp "$connectaddr:$connectport"',
+ 'match from local for local action "local"',
+ ],
+ loggrep => qr/smtp disconnected/,
+ },
+ server => {
+ noserver => 1,
+ },
+);
+
+1;
blob - /dev/null
blob + c7b879ca36970f77c416ae13a56a5b3604f5165f (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/args-table-aliases.pl
@@ -0,0 +1,34 @@
+# args-table-aliases.pl -- file-backed table for local alias expansion (K_ALIAS)
+#
+# Tests K_ALIAS lookup via the file backend. smtpd resolves the local part
+# of the recipient address ("alias-test") against the aliases table and
+# delivers to the mapped user via LMTP. Exercises the alias expansion path
+# distinct from virtual domain mapping.
+
+use strict;
+use warnings;
+
+our %args = (
+ client => {
+ func => \&smtp_client,
+ to => 'alias-test@localhost',
+ loggrep => qr/250 .* Message accepted for delivery/,
+ },
+ smtpd => {
+ files => {
+ 'aliases-test.txt' => "alias-test\tbuild\n",
+ },
+ config => [
+ 'table aliases file:$objdir/aliases-test.txt',
+ 'action "local" lmtp "$connectaddr:$connectport" alias <aliases>',
+ 'match from local for local action "local"',
+ ],
+ loggrep => qr/stat=Delivered/,
+ },
+ server => {
+ func => \&lmtp_server,
+ loggrep => qr/RCPT: RCPT TO:<build>/,
+ },
+);
+
+1;
blob - /dev/null
blob + e9be212c79989dcc18eee6a4258134e5845873f9 (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/args-table-db.pl
@@ -0,0 +1,40 @@
+# args-table-db.pl -- Berkeley DB-backed table for virtual address mapping
+#
+# Tests the db table backend (table_db.c). Uses makemap(8) to compile a
+# text virtual-map file into a .db file before smtpd starts. Verifies that
+# smtpd opens the .db file, performs a K_VIRTUAL lookup, and delivers via LMTP.
+#
+# Requires: makemap(8) in PATH (standard on OpenBSD; set MAKEMAP env if needed).
+
+use strict;
+use warnings;
+
+my $makemap = $ENV{MAKEMAP} || "makemap";
+
+our %args = (
+ client => {
+ func => \&smtp_client,
+ to => 'dbtest@localhost',
+ loggrep => qr/250 .* Message accepted for delivery/,
+ },
+ smtpd => {
+ # No .txt extension: makemap appends .db to the whole name,
+ # so "vusers-db" -> "vusers-db.db" as expected by the config.
+ files => {
+ 'vusers-db' => "dbtest\@localhost\tbuild\n",
+ },
+ makemap => [ 'vusers-db' ],
+ config => [
+ 'table vusers db:$tempdir/vusers-db.db',
+ 'action "local" lmtp "$connectaddr:$connectport" virtual <vusers>',
+ 'match from local for local action "local"',
+ ],
+ loggrep => qr/stat=Delivered/,
+ },
+ server => {
+ func => \&lmtp_server,
+ loggrep => qr/RCPT: RCPT TO:<build>/,
+ },
+);
+
+1;
blob - /dev/null
blob + cf18b1a689dc763e124977d0c90336069e077e5c (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/args-table-file.pl
@@ -0,0 +1,34 @@
+# args-table-file.pl -- file-backed table for virtual address mapping
+#
+# Tests the file table backend (table_static.c reading from disk) with
+# K_VIRTUAL service. The file is written by Smtpd.pm before smtpd starts.
+# Verifies that smtpd correctly loads and queries the file at startup and
+# delivers the resolved address via LMTP.
+
+use strict;
+use warnings;
+
+our %args = (
+ client => {
+ func => \&smtp_client,
+ to => 'filetest@localhost',
+ loggrep => qr/250 .* Message accepted for delivery/,
+ },
+ smtpd => {
+ files => {
+ 'vusers-file.txt' => "filetest\@localhost\tbuild\n",
+ },
+ config => [
+ 'table vusers file:$objdir/vusers-file.txt',
+ 'action "local" lmtp "$connectaddr:$connectport" virtual <vusers>',
+ 'match from local for local action "local"',
+ ],
+ loggrep => qr/stat=Delivered/,
+ },
+ server => {
+ func => \&lmtp_server,
+ loggrep => qr/RCPT: RCPT TO:<build>/,
+ },
+);
+
+1;
blob - /dev/null
blob + b5147272d92c51d7397e4141eb407b1039730e75 (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/args-table-static.pl
@@ -0,0 +1,34 @@
+# args-table-static.pl -- static inline table for virtual address mapping
+#
+# Tests that smtpd resolves a recipient through a static virtual table
+# and delivers the message via LMTP. This exercises table_static.c and
+# the alias/virtual expansion path introduced in Gilles' table engine
+# refactor.
+
+use strict;
+use warnings;
+
+our %args = (
+ client => {
+ func => \&smtp_client,
+ to => 'test@localhost',
+ loggrep => qr/250 .* Message accepted for delivery/,
+ },
+ smtpd => {
+ # $connectaddr and $connectport are substituted by Smtpd.pm
+ # with the loopback address and port of the LMTP sink.
+ # Map directly to a local user to avoid system aliases expansion.
+ config => [
+ 'table vusers { test@localhost = build }',
+ 'action "local" lmtp "$connectaddr:$connectport" virtual <vusers>',
+ 'match from local for local action "local"',
+ ],
+ loggrep => qr/stat=Delivered/,
+ },
+ server => {
+ func => \&lmtp_server,
+ loggrep => qr/RCPT: RCPT TO:<build>/,
+ },
+);
+
+1;
blob - /dev/null
blob + 0b4873e8775a7331bb2d47c234d7e13df22f2f83 (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/filter-stub.pl
@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+# filter-stub.pl -- minimal OpenSMTPD filter for regression testing
+#
+# Implements the OpenSMTPD filter protocol v0.7. Registers for the phase
+# named on the command line and responds with the action that follows:
+#
+# filter-stub.pl <phase> <action> [<message>]
+#
+# Examples:
+# filter-stub.pl mail-from reject "550 5.7.0 Sender rejected"
+# filter-stub.pl rcpt-to junk
+# filter-stub.pl ehlo proceed
+#
+# stdin/stdout are the socket pair with smtpd (set up by fork_filter_process).
+# stderr goes to smtpd's error fd and is logged.
+
+use strict;
+use warnings;
+
+$| = 1; # autoflush stdout
+
+my $phase = shift or die "usage: filter-stub.pl <phase> <action> [msg]\n";
+my $action = shift or die "usage: filter-stub.pl <phase> <action> [msg]\n";
+my $message = shift // ""; # optional rejection/disconnect message
+
+print STDERR "filter-stub: phase=$phase action=$action\n";
+
+# -----------------------------------------------------------------------
+# Handshake: consume config lines until "config|ready", then register.
+# -----------------------------------------------------------------------
+while (my $line = <STDIN>) {
+ chomp $line;
+ print STDERR "filter-stub <<< $line\n";
+ last if $line eq 'config|ready';
+}
+
+print STDOUT "register|filter|smtp-in|$phase\n";
+print STDOUT "register|ready\n";
+print STDERR "filter-stub: registered for smtp-in|$phase, action=$action\n";
+
+# -----------------------------------------------------------------------
+# Main loop: handle filter events for the registered phase.
+# -----------------------------------------------------------------------
+while (my $line = <STDIN>) {
+ chomp $line;
+ print STDERR "filter-stub <<< $line\n";
+
+ # Event format:
+ # filter|version|timestamp|smtp-in|phase|reqid|token|params...
+ # Response format:
+ # filter-result|reqid|token|action[|parameter]
+ # Both reqid (f[5]) and token (f[6]) must be echoed back.
+ my @f = split(/\|/, $line, -1);
+ next unless @f >= 7 && $f[0] eq 'filter' && $f[4] eq $phase;
+
+ my $reqid = $f[5];
+ my $token = $f[6];
+
+ if ($action eq 'proceed') {
+ print STDOUT "filter-result|$reqid|$token|proceed\n";
+ } elsif ($action eq 'junk') {
+ print STDOUT "filter-result|$reqid|$token|junk\n";
+ } elsif ($action eq 'reject') {
+ my $msg = $message || "550 5.7.0 Rejected by filter";
+ print STDOUT "filter-result|$reqid|$token|reject|$msg\n";
+ } elsif ($action eq 'disconnect') {
+ my $msg = $message || "421 4.3.0 Service temporarily unavailable";
+ print STDOUT "filter-result|$reqid|$token|disconnect|$msg\n";
+ } else {
+ die "filter-stub: unknown action '$action'\n";
+ }
+ print STDERR "filter-stub: responded $action to reqid=$reqid token=$token\n";
+}
+
+print STDERR "filter-stub: stdin closed, exiting\n";
blob - /dev/null
blob + 7e9e40b3a72eb56f0ca64f856bdcf096b3b11b87 (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/funcs.pl
@@ -0,0 +1,261 @@
+# $OpenBSD $
+
+# Copyright (c) 2026 doom <doom@tagram.loom>
+# Copyright (c) 2010-2021 Alexander Bluhm <bluhm@openbsd.org>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+use strict;
+use warnings;
+use IO::Socket;
+use IO::Socket::IP;
+use Socket6;
+use Sys::Hostname;
+
+sub find_ports {
+ my %args = @_;
+ my $num = delete $args{num} // 1;
+ my $domain = delete $args{domain} // AF_INET;
+ my $addr = delete $args{addr} // "127.0.0.1";
+
+ my @sockets = (1..$num);
+ foreach my $s (@sockets) {
+ $s = IO::Socket::IP->new(
+ Proto => "tcp",
+ Family => $domain,
+ $addr ? (LocalAddr => $addr) : (),
+ ) or die "find_ports: create and bind socket failed: $!";
+ }
+ my @ports = map { $_->sockport() } @sockets;
+
+ return @ports;
+}
+
+########################################################################
+# Script funcs
+########################################################################
+
+sub check_logs {
+ my ($c, $d, $s, %args) = @_;
+
+ return if $args{nocheck};
+
+ check_loggrep($c, $d, $s, %args);
+}
+
+sub check_loggrep {
+ my ($c, $d, $s, %args) = @_;
+
+ my %name2proc = (client => $c, smtpd => $d, server => $s);
+ foreach my $name (qw(client smtpd server)) {
+ my $p = $name2proc{$name} or next;
+ my $pattern = $args{$name}{loggrep} or next;
+ $pattern = [ $pattern ] unless ref($pattern) eq 'ARRAY';
+ foreach my $pat (@$pattern) {
+ if (ref($pat) eq 'HASH') {
+ while (my($re, $num) = each %$pat) {
+ my @matches = $p->loggrep($re);
+ @matches == $num
+ or die "$name matches '@matches': ",
+ "'$re' => $num";
+ }
+ } else {
+ $p->loggrep($pat)
+ or die "$name log missing pattern: '$pat'";
+ }
+ }
+ }
+}
+
+########################################################################
+# SMTP low-level I/O; used by both smtp_client and lmtp_server
+########################################################################
+
+sub _smtp_readline {
+ # Read one CRLF-terminated line from STDIN; log and return without CRLF.
+ local $/ = "\r\n";
+ my $line = <STDIN>;
+ return undef unless defined $line;
+ $line =~ s/\r\n$//;
+ print STDERR "<<< $line\n";
+ return $line;
+}
+
+sub _smtp_send {
+ # Write one SMTP line (appends CRLF) to STDOUT and log it.
+ my $line = shift;
+ print STDERR ">>> $line\n";
+ print STDOUT "$line\r\n"
+ or die "_smtp_send: print failed: $!";
+ IO::Handle::flush(\*STDOUT);
+}
+
+sub _smtp_read_response {
+ # Read a complete SMTP response (possibly multi-line).
+ # Returns (numeric-code, arrayref-of-lines).
+ # Dies on EOF.
+ my @lines;
+ while (1) {
+ my $line = _smtp_readline();
+ defined($line) or die "_smtp_read_response: unexpected EOF";
+ push @lines, $line;
+ # Multi-line replies use "NNN-text"; final line uses "NNN text".
+ last unless $line =~ /^\d{3}-/;
+ }
+ my $code = substr($lines[-1], 0, 3);
+ return ($code, \@lines);
+}
+
+########################################################################
+# Client funcs
+########################################################################
+
+sub smtp_client {
+ my $self = shift;
+ my $from = $self->{from} || 'sender@example.com';
+ my $to = $self->{to} || 'user@localhost';
+ my $subj = $self->{subject} || 'smtpd-regress test';
+ my $body = $self->{body} || "This is a test message from smtpd-regress.\r\n";
+
+ # Greeting
+ my ($code, $lines) = _smtp_read_response();
+ $code eq '220'
+ or die ref($self), " expected 220 greeting, got: $lines->[-1]";
+
+ # EHLO
+ my $hostname = hostname();
+ _smtp_send("EHLO $hostname");
+ ($code, $lines) = _smtp_read_response();
+ $code eq '250'
+ or die ref($self), " EHLO failed: $lines->[-1]";
+
+ # MAIL FROM; a 4xx/5xx here means the server (or a filter) rejected
+ # the sender. Log it and return cleanly so loggrep can assert on it.
+ _smtp_send("MAIL FROM:<$from>");
+ ($code, $lines) = _smtp_read_response();
+ unless ($code eq '250') {
+ print STDERR "smtp_client: MAIL FROM rejected: $lines->[-1]\n";
+ _smtp_send("QUIT");
+ _smtp_read_response();
+ return;
+ }
+
+ # RCPT TO; same: rejection is a valid test outcome.
+ _smtp_send("RCPT TO:<$to>");
+ ($code, $lines) = _smtp_read_response();
+ unless ($code eq '250') {
+ print STDERR "smtp_client: RCPT TO rejected: $lines->[-1]\n";
+ _smtp_send("QUIT");
+ _smtp_read_response();
+ return;
+ }
+
+ # DATA
+ _smtp_send("DATA");
+ ($code, $lines) = _smtp_read_response();
+ $code eq '354'
+ or die ref($self), " DATA failed: $lines->[-1]";
+
+ # Headers + body. Dot-stuff any body lines starting with '.'.
+ print STDOUT "From: $from\r\n";
+ print STDOUT "To: $to\r\n";
+ print STDOUT "Subject: $subj\r\n";
+ print STDOUT "\r\n";
+ foreach my $line (split(/\r?\n/, $body)) {
+ $line = ".$line" if $line =~ /^\./;
+ print STDOUT "$line\r\n";
+ }
+ _smtp_send(".");
+ ($code, $lines) = _smtp_read_response();
+ unless ($code eq '250') {
+ print STDERR "smtp_client: message rejected after DATA: $lines->[-1]\n";
+ _smtp_send("QUIT");
+ _smtp_read_response();
+ return;
+ }
+
+ # QUIT
+ _smtp_send("QUIT");
+ ($code, $lines) = _smtp_read_response();
+ $code eq '221'
+ or die ref($self), " QUIT failed: $lines->[-1]";
+}
+
+########################################################################
+# Server funcs
+########################################################################
+
+sub lmtp_server {
+ my $self = shift;
+ my $hostname = hostname();
+
+ # Greeting
+ _smtp_send("220 $hostname LMTP $hostname ready");
+
+ # LHLO
+ my $cmd = _smtp_readline();
+ defined($cmd) or die ref($self), " unexpected EOF waiting for LHLO";
+ $cmd =~ /^LHLO\s/i
+ or die ref($self), " expected LHLO, got: $cmd";
+ _smtp_send("250-$hostname");
+ _smtp_send("250-8BITMIME");
+ _smtp_send("250-ENHANCEDSTATUSCODES");
+ _smtp_send("250 Ok");
+
+ # MAIL FROM
+ $cmd = _smtp_readline();
+ defined($cmd) or die ref($self), " unexpected EOF waiting for MAIL FROM";
+ $cmd =~ /^MAIL FROM:/i
+ or die ref($self), " expected MAIL FROM, got: $cmd";
+ my ($from) = $cmd =~ /^MAIL FROM:<([^>]*)>/i;
+ print STDERR "MAIL: $cmd\n";
+ _smtp_send("250 2.1.0 Ok");
+
+ # One or more RCPT TO
+ my @rcpts;
+ while (1) {
+ $cmd = _smtp_readline();
+ defined($cmd) or die ref($self), " unexpected EOF waiting for RCPT/DATA";
+ last unless $cmd =~ /^RCPT TO:/i;
+ my ($rcpt) = $cmd =~ /^RCPT TO:<([^>]*)>/i;
+ push @rcpts, $rcpt;
+ print STDERR "RCPT: $cmd\n";
+ _smtp_send("250 2.1.5 Ok");
+ }
+
+ # DATA
+ $cmd =~ /^DATA$/i
+ or die ref($self), " expected DATA, got: $cmd";
+ _smtp_send("354 End data with <CR><LF>.<CR><LF>");
+
+ # Receive message body until lone '.'
+ my @body;
+ while (1) {
+ my $line = _smtp_readline();
+ defined($line) or die ref($self), " unexpected EOF in message body";
+ last if $line eq '.';
+ $line =~ s/^\.(.)/.$1/ if $line =~ /^\.\./; # dot-unstuff
+ push @body, $line;
+ }
+ print STDERR "DATA: ", scalar(@body), " lines received\n";
+ _smtp_send("250 2.0.0 Ok: message delivered");
+
+ # QUIT
+ $cmd = _smtp_readline();
+ defined($cmd) or die ref($self), " unexpected EOF waiting for QUIT";
+ $cmd =~ /^QUIT$/i
+ or die ref($self), " expected QUIT, got: $cmd";
+ _smtp_send("221 2.0.0 Bye");
+}
+
+1;
blob - /dev/null
blob + ec89e7655b07337b5436b8e4f322d6a6e0f200b4 (mode 644)
--- /dev/null
+++ regress/usr.sbin/smtpd/smtpd.pl
@@ -0,0 +1,102 @@
+#!/usr/bin/perl
+# $OpenBSD $
+
+# Copyright (c) 2026 doom <doom@tagram.loom>
+# Copyright (c) 2010-2014 Alexander Bluhm <bluhm@openbsd.org>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+use strict;
+use warnings;
+use Socket;
+
+use Client;
+use Smtpd;
+use Server;
+require 'funcs.pl';
+
+sub usage {
+ die "usage: smtpd.pl [test-args.pl]\n";
+}
+
+my $testfile;
+our %args;
+if (@ARGV and -f $ARGV[-1]) {
+ $testfile = pop;
+ do $testfile
+ or die "Do test file $testfile failed: ", $@ || $!;
+}
+@ARGV == 0 or usage();
+
+# Allocate two ports up front: one for smtpd to listen on (SMTP client
+# connects here), one for the LMTP sink to listen on (smtpd delivers here).
+my ($smtp_port, $lmtp_port) = find_ports(num => 2);
+
+my ($c, $d, $s);
+
+# LMTP sink must be bound before smtpd reads its config.
+$s = Server->new(
+ forward => "smtp",
+ func => \&lmtp_server,
+ listendomain => AF_INET,
+ listenaddr => "127.0.0.1",
+ listenport => $lmtp_port,
+ %{$args{server} || {}},
+ testfile => $testfile,
+) unless ($args{server} || {})->{noserver};
+
+# smtpd under test; the config is generated by Smtpd.pm from args{smtpd}{config}.
+$d = Smtpd->new(
+ listenaddr => "127.0.0.1",
+ listenport => $smtp_port,
+ connectaddr => "127.0.0.1",
+ connectport => $lmtp_port,
+ %{$args{smtpd} || {}},
+ testfile => $testfile,
+);
+
+# SMTP client that connects to smtpd's listen port.
+$c = Client->new(
+ forward => "smtp",
+ func => \&smtp_client,
+ connectdomain => AF_INET,
+ connectaddr => "127.0.0.1",
+ connectport => $smtp_port,
+ %{$args{client} || {}},
+ testfile => $testfile,
+ server => \$s,
+) unless ($args{client} || {})->{noclient};
+
+# Start LMTP sink first so smtpd can connect at delivery time.
+$s->run unless ($args{server} || {})->{noserver};
+
+# Start smtpd and wait for it to announce itself ready.
+$d->run;
+$d->up;
+
+# Start SMTP client and wait for it to report "Connected".
+$c->run->up unless ($args{client} || {})->{noclient};
+
+# Wait for LMTP sink to accept a connection (delivery).
+$s->up unless ($args{server} || {})->{noserver};
+
+# Wait for client and LMTP sink to finish their conversations.
+$c->down unless ($args{client} || {})->{noclient};
+$s->down unless ($args{server} || {})->{noserver};
+
+
+# Shut smtpd down cleanly.
+$d->kill_child;
+$d->down;
+
+check_logs($c, $d, $s, %args);
initial smtpd regress suite