From: "Omar Polo" Subject: initial smtpd regress suite To: tech@openbsd.org Date: Wed, 04 Nov 2026 16:18:41 +0100 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 +# +# 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 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 +# +# 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 +# +# 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 +# Copyright (c) 2010-2015 Alexander Bluhm +# +# 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 ', + 'match from local for local action "local"', + ], + loggrep => qr/stat=Delivered/, + }, + server => { + func => \&lmtp_server, + loggrep => qr/RCPT: RCPT TO:/, + }, +); + +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 ', + 'match from local for local action "local"', + ], + loggrep => qr/stat=Delivered/, + }, + server => { + func => \&lmtp_server, + loggrep => qr/RCPT: RCPT TO:/, + }, +); + +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 ', + 'match from local for local action "local"', + ], + loggrep => qr/stat=Delivered/, + }, + server => { + func => \&lmtp_server, + loggrep => qr/RCPT: RCPT TO:/, + }, +); + +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 ', + 'match from local for local action "local"', + ], + loggrep => qr/stat=Delivered/, + }, + server => { + func => \&lmtp_server, + loggrep => qr/RCPT: RCPT TO:/, + }, +); + +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 ', + 'match from local for local action "local"', + ], + loggrep => qr/stat=Delivered/, + }, + server => { + func => \&lmtp_server, + loggrep => qr/RCPT: RCPT TO:/, + }, +); + +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 [] +# +# 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 [msg]\n"; +my $action = shift or die "usage: filter-stub.pl [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 = ) { + 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 = ) { + 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 +# Copyright (c) 2010-2021 Alexander Bluhm +# +# 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 = ; + 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 ."); + + # 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 +# Copyright (c) 2010-2014 Alexander Bluhm +# +# 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);