--- /dev/null
+#!/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 <http://www.gnu.org/licenses/>.
+
+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 <output file>] -s <socket>\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__
--- /dev/null
+#!/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 <http://www.gnu.org/licenses/>.
+
+# 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 <CRLF>.<CRLF>"
+ } 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
projects / gatekeeper.git / commitdiff