From: Jacob Bachmeyer Date: Sat, 27 Feb 2021 02:52:25 +0000 (-0600) Subject: Add initial mock SMTP and syslog servers X-Git-Url: https://vcs.fsf.org/?a=commitdiff_plain;h=4f94291c240f56da44945e394de16b368a1e351d;p=gatekeeper.git Add initial mock SMTP and syslog servers --- diff --git a/testsuite/lib/exec/minlogd.pl b/testsuite/lib/exec/minlogd.pl new file mode 100755 index 0000000..5d7f662 --- /dev/null +++ b/testsuite/lib/exec/minlogd.pl @@ -0,0 +1,194 @@ +#!/usr/bin/perl +# -*- CPerl -*- + +# Copyright (C) 2021 Jacob Bachmeyer +# +# This file is part of a testsuite for the GNU FTP upload system. +# +# This file is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +use strict; +use warnings; + +# Minimal syslog server; listens on AF_UNIX socket, writes received +# messages to a file after performing format translation (if relevant) +# according to RFC3164 and RFC5424. + +use constant MAX_LOGPACKET => 4096; + +use Errno; +use Fcntl; +use Socket; +use Getopt::Long; +use POSIX qw(strftime); + +my $AppendFlag = 0; +my $OutputFileName = undef; +my $SocketName = undef; +GetOptions('append|a' => \$AppendFlag, + 'output|o=s' => \$OutputFileName, + 'socket|s=s' => \$SocketName, +) or die "could not parse arguments"; + +die "usage: $0 [-a] [-o ] -s \n" + unless defined $SocketName; + +unless (-S $SocketName) { + die "$SocketName exists, but is not a socket" if -e $SocketName; + unlink $SocketName; +} + +if (defined $OutputFileName) { + open LoggerOutput, ($AppendFlag ? '>>' : '>'), $OutputFileName + or die "open output file $OutputFileName: $!"; +} else { + die "minlogd: append makes no sense without an output file\n" if $AppendFlag; + open LoggerOutput, '>&', STDOUT or die "dup stdout: $!"; +} + +sub fd_nonblock { + # make a filehandle non-blocking, as described in perlfunc + my $fd = shift; + my $flags = fcntl $fd, F_GETFL, 0 or die "fcntl F_GETFL: $!"; + fcntl $fd, F_SETFL, $flags | O_NONBLOCK or die "fcntl F_SETFL: $!"; +} + +fd_nonblock \*STDIN; + +{ # create listening socket + my $saddr = pack_sockaddr_un $SocketName; + socket LoggerSocket, PF_UNIX, SOCK_DGRAM, 0 + or die "create logger socket: $!"; + bind LoggerSocket, $saddr + or die "bind logger socket: $!"; +} + +fd_nonblock \*LoggerSocket; + +my $Running = 1; + +sub cleanup { + unlink $SocketName; +} + +$SIG{INT} = $SIG{TERM} = sub { $Running = 0 }; +$SIG{__DIE__} = \&cleanup; + +print "minlogd: listening on $SocketName\n"; + +my $Rchk = ''; +vec($Rchk, (fileno STDIN), 1) = 1; +vec($Rchk, (fileno LoggerSocket), 1) = 1; + +# -- input handlers + +sub handle_command ($) { + my $command = shift; + chomp $command; + + if ($command eq 'exit') { + print "minlogd: shutting down\n"; + cleanup; exit + } +} + +my $Cmdbuf = ''; +sub accumulate_command () { + my $eof; # defined and zero at eof + # read while data is available, expecting EAGAIN or eof + 1 while $eof = sysread STDIN, $Cmdbuf, 128, length $Cmdbuf; + + my @commands = (); + # extract any complete records + while ((my $eolpos = index $Cmdbuf, $/) > -1) + { push @commands, (substr $Cmdbuf, 0, ($eolpos + length $/), '') } + + handle_command $_ for @commands; +} + +my %Months = (Jan => 1, Feb => 2, Mar => 3, Apr => 4, + May => 5, Jun => 6, Jul => 7, Aug => 8, + Sep => 9, Oct => 10, Nov => 11, Dec => 12); +sub handle_message ($) { + my $message = shift; + + local *_; $_ = $message; + my $PRI; # syslog PRI field + my $VERSION = 0; # 0 == RFC3164, 1 == RFC5424 + # [classic BSD syslog did not have a VERSION field] + my $TIMESTAMP; my $HOSTNAME; my $MSG = $_; + # APPNAME, PROCID, MSGID added in RFC5424 + my $APPNAME = '-'; my $PROCID = '-'; my $MSGID = '-'; my $SDAT = '-'; + + # determine RFC3164 format or RFC5424 format + if (m/^<[[:digit:]]+>1 /) { $VERSION = 1 } # RFC5424 + + if ($VERSION == 0) { # parse by RFC3164 + # handle unrecognizable PRI per RFC3164 + if (m/^(<[[:digit:]]+>)/g) { $PRI = $1 } + else { $PRI = '<13>' } + + if (m/\G(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\s + (\d{2})\s(\d{2}):(\d{2}):(\d{2})\s/gcx) + { $TIMESTAMP = + strftime '%Y-%m-%dT%H:%M:%S', + $5, $4, $3, $2, $Months{$1}-1, (localtime)[5..8] } + else # add timestamp + { $TIMESTAMP = + strftime '%Y-%m-%dT%H:%M:%S', localtime } + + if (m/\G(\S+) /gc) { $HOSTNAME = $1 } + else { $HOSTNAME = 'localhost' } + + $MSG = substr $_, pos $_ if pos $_; + } elsif ($VERSION == 1) { # parse by RFC5424 + ($PRI, $TIMESTAMP, $HOSTNAME, $APPNAME, $PROCID, $MSGID, $SDAT, $MSG) = + split / /, $_, 8; + # This can conflate structured data and free-form message text, but + # those two fields will simply be pasted back together, so this issue + # does not matter for this implementation. + $PRI =~ s/1$//; # trim version number from extracted PRI field + } else + { die "unrecognized syslog message format (newer version?):\n $_" } + + print LoggerOutput $PRI, + join(' ', 1, $TIMESTAMP, $HOSTNAME, $APPNAME, $PROCID, $MSGID, + $SDAT, $MSG),"\n"; +} + +sub accumulate_message () { + my $message; + my $from = recv LoggerSocket, $message, MAX_LOGPACKET, 0; + if (defined $from) { handle_message $message } + else { warn "recv: $!" } + +} + +# -- event loop + +my $Rrdy = ''; +do { + # process syslog datagram input + accumulate_message if vec($Rrdy, (fileno LoggerSocket), 1); + # handle console input + accumulate_command if vec($Rrdy, (fileno STDIN), 1); + + # wait for input + select $Rrdy=$Rchk, undef, undef, undef; +} while ($Running); + +cleanup; +exit; + +__END__ diff --git a/testsuite/lib/exec/minsmtpd.tcl b/testsuite/lib/exec/minsmtpd.tcl new file mode 100755 index 0000000..e85c4da --- /dev/null +++ b/testsuite/lib/exec/minsmtpd.tcl @@ -0,0 +1,201 @@ +#!/usr/bin/tclsh + +# Copyright (C) 2021 Jacob Bachmeyer +# +# This file is part of a testsuite for the GNU FTP upload system. +# +# This file is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# Minimal SMTP server; records received messages into mbox format + +set mbox stdout +set mboxappend no + +for {set i 0} {$i < $argc} {incr i} { + if { [lindex $argv $i] eq "-a" } { + set mboxappend yes + } + if { [lindex $argv $i] eq "-o" } { + set mboxfile [lindex $argv [incr i]] + } +} +unset i + +if { [info exists mboxfile] } { + puts "minsmptd: writing mail to $mboxfile" + if { $mboxappend } { + set mbox [open $mboxfile a] + } else { + set mbox [open $mboxfile w] + } +} else { + puts "minsmptd: writing mail to $mbox" +} + +# minimal command set from page 53 in RFC2821: +# EHLO HELO MAIL RCPT DATA RSET NOOP QUIT VRFY +# see page 49 in RFC2821 for allowed responses to commands + +# global session state array, indexed by client I/O channel (as "%") +# keys: +# % name given in HELO/EHLO command; empty at session start +# %,busy in a mail transaction? +# %,from reverse-path buffer +# %,to forward-path buffer +# %,data mail data buffer +array set session {} + +proc handle_command {client} { + global session + + gets $client line + + puts "minsmptd: client $client: $line" + if { [regexp -nocase {^(helo|ehlo) (.*)$} $line -> cmd remote] } { + set session($client) $remote + puts $client "250 Hi, ${remote}" + } elseif { [regexp -nocase {^mail from:(.*)$} $line -> addr] } { + if { [string length $session($client)] + && ! $session($client,busy) } { + set session($client,busy) yes + set session($client,from) $addr + set session($client,to) [list] + set session($client,data) {} + puts $client "250 OK" + } else { + puts $client "503 Bad sequence of commands" + } + } elseif { [regexp -nocase {^rcpt to:(.*)$} $line -> addr] } { + if { [string length $session($client)] + && $session($client,busy) } { + lappend session($client,to) $addr + puts $client "250 OK" + } else { + puts $client "503 Bad sequence of commands" + } + } elseif { [regexp -nocase {^data} $line] } { + if { [string length $session($client)] + && $session($client,busy) + && [llength $session($client,to)] } { + fileevent $client readable [list handle_data $client] + puts $client "354 Start mail input; end with ." + } else { + puts $client "503 Bad sequence of commands" + } + } elseif { [regexp -nocase {^rset} $line] } { + set session($client,busy) no + puts $client "250 OK" + } elseif { [regexp -nocase {^noop} $line] } { + puts $client "250 OK" + } elseif { [regexp -nocase {^help} $line] } { + puts $client "502 Command not implemented" + } elseif { [regexp -nocase {^expn} $line] } { + puts $client "502 Command not implemented" + } elseif { [regexp -nocase {^vrfy} $line] } { + puts $client "502 Command not implemented" + } elseif { [regexp -nocase {^quit} $line] } { + array unset session "${client}*" + puts $client "221 Bye" + close $client + return + } else { + puts $client "500 Syntax error, command unrecognized" + } + flush $client +} + +proc handle_data {client} { + global session mbox + + gets $client line + + if { [regexp {^\.$} $line] } { + # store message + set postmark "From $session($client) " + append postmark [clock format [clock seconds]] + set peer [fconfigure $client -peername] + set trace "Received: From $session($client) " + append trace [format "(%s:%s)" [lindex $peer 0] [lindex $peer 2]] + append trace " via TCP with SMTP" + append trace " for" + append trace " " [join $session($client,to)] + # The message buffer starts with a newline. This makes + # generating conformant output a bit harder. + puts -nonewline $mbox $postmark + puts -nonewline $mbox "\nReturn-Path: $session($client,from)" + puts -nonewline $mbox "\n$trace" + puts $mbox [regsub -all -line {^From } $session($client,data) ">&"] + + # end transaction + set session($client,busy) no + + # return to command mode + fileevent $client readable [list handle_command $client] + puts $client "250 OK" + flush $client + } else { + regsub {^\.} $line "" line + append session($client,data) "\n" $line + } +} + +proc client_connect {client remaddr remport} { + global session + + puts "minsmtpd: connect from $remaddr:$remport as $client" + fconfigure $client -blocking no + fileevent $client readable [list handle_command $client] + + set session($client) {} + set session($client,busy) no + puts $client "220 localhost minsmtpd testing SMTP server ready" + flush $client +} + +proc bgerror {message} { + global errorCode errorInfo + puts "minsmtpd: background error: $message" + puts "minsmtpd: background error code: $errorCode" + puts "minsmtpd: traceback follows:" + puts $errorInfo + puts "minsmtpd: aborting..." + exit +} + +set listener [socket -server client_connect -myaddr localhost 0] +set listener_port [lindex [fconfigure $listener -sockname] 2] + +puts "minsmtpd: listening on local port $listener_port" + +proc console_input {} { + global session + + gets stdin line + + if { [regexp -nocase {^exit} $line] } { + foreach chan [file channels] { + if { [info exists session($chan)] } { + puts $chan "421 Server shutting down" + } + } + puts "minsmtpd: shutting down" + exit + } +} +fconfigure stdin -blocking no +fileevent stdin readable console_input + +vwait forever + +# EOF