smtpd - Tcl SMTP server implementation
SYNOPSIS
package require Tcl 8.3
package require smtpd ?1.1?
|
The smtpd package provides a simple Tcl-only server library for the Simple Mail Transfer Protocol as described in RFC 821 and RFC 2821. By default the server will bind to the default network address and the standard SMTP port (25).
This package was designed to permit testing of Mail User Agent code
from a developers workstation. It does not attempt to deliver mail to your mailbox. Instead users of this package are expected to
write a procedure that will be called when mail arrives. Once this
procedure returns, the server has nothing further to do with the mail.
In short, this code should probably not be used as a permanently
running Mail Transfer Agent on an Internet connected server, even
though we are careful not to evaluate remote user input. There are
many other well tested and security audited programs that can be used
as mail servers for internet connected hosts.
SECURITY
On Unix platforms binding to the SMTP port requires root privileges. I
would not recommend running any script-based server as root unless
there is some method for dropping root privileges immediately after
the socket is bound. Under Windows platforms, it is not necessary to
have root or administrator privileges to bind low numbered
sockets. However, security on these platforms is weak anyway.
COMMANDS
set sock [::smtpd::start [info hostname] 0]
will bind to the hosts internet interface on the first available port.
At present the package only supports a single instance of a SMTP
server. This could be changed if required at the cost of making the
package a little more complicated to read. If there is a good reason
for running multiple SMTP services then it will only be necessary to
fix the options array and the ::smtpd::stopped variable
usage.
As the server code uses fileevent(n) handlers to process the
input on sockets you will need to run the event loop. This means
either you should be running from within wish(1) or you
should vwait(n) on the ::smtpd::stopped variable which is
set when the server is stopped.
It should be noted that stopping the server does not disconnect any
currently active sessions as these are operating over an independent
channel. Only explicitly tracking and closing these sessions, or
exiting the server process will close down all the running
sessions. This is similar to the usual unix daemon practice where the
server performs a fork(2) and the client session continues on
the child process.
CALLBACKS
proc validate_host {ipnum} {
if {[string match "192.168.1.*" $ipnum]} {
error "go away!"
}
}
550 Access denied: I hate you. |
proc validate_sender {address} {
eval array set addr \\
[mime::parseaddress $address]
if {[string match "denied" $addr(local)]} {
error "mailbox $addr(local) denied"
}
return
}
|
proc deliverMIME {token} {
set sender [lindex [mime::getheader $token From] 0]
set recipients [lindex [mime::getheader $token To] 0]
set mail "From $sender [clock format [clock seconds]]"
append mail "\n" [mime::buildmessage $token]
puts $mail
}
|
proc deliver {sender recipients data} {
set mail "From $sender [clock format [clock seconds]]"
append mail "\n" [join $data "\n"]
puts "$mail"
}
|