Documentation can be found at http://tcllib.sourceforge.net/doc/smtpd.html
Here's a simple example (found in the tcllib examples tree):
#! /bin/sh # # tk_smtpd - Copyright (C) 2001 Pat Thoyts <[email protected]> # # Simple test of the mail server. All incoming messages are displayed in a # message dialog. # # This example works nicely under Windows or within tkcon. # # Usage tk_smtpd 0.0.0.0 8025 # or tk_smtpd 127.0.0.1 2525 # or tk_smtpd # to listen to the default port 25 on all tcp/ip interfaces. # # ------------------------------------------------------------------------- # This software 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 file 'license.terms' for # more details. # ------------------------------------------------------------------------- # \ exec wish8.3 "$0" ${1+"$@"} package require smtpd package require Tk wm withdraw . # Handle new mail by raising a message dialog for each recipient. proc deliver {sender recipients data} { if {[catch {eval array set saddr [mime::parseaddress $sender]}]} { error "invalid sender address \"$sender\"" } set mail "From $saddr(address) [clock format [clock seconds]]" append mail "\n" [join $data "\n"] foreach rcpt $recipients { if {! [catch {eval array set addr [mime::parseaddress $rcpt]}]} { tk_messageBox -title "To: $addr(address)" -message $mail } } } # Accept everyone except those spammers on 192.168.1.* :) proc validate_host {ipnum} { if {[string match "192.168.1.*" $ipnum]} { error "your domain is not allowed to post, Spammers!" } } # Accept mail from anyone except user 'denied' proc validate_sender {address} { eval array set addr [mime::parseaddress $address] if {[string match "denied" $addr(local)]} { error "mailbox $addr(local) denied" } return } # Only reject mail for recipients beginning with 'bogus' proc validate_recipient {address} { eval array set addr [mime::parseaddress $address] if {[string match "bogus*" $addr(local)]} { error "mailbox $addr(local) denied" } return } # Setup the mail server smtpd::configure \ -deliver ::deliver \ -validate_host ::validate_host \ -validate_recipient ::validate_recipient \ -validate_sender ::validate_sender # Run the server on the default port 25. For unix change to # a high numbered port eg: 2525 or 8025 etc with # smtpd::start 127.0.0.1 8025 or smtpd::start 0.0.0.0 2525 set iface 0.0.0.0 set port 25 if {$argc > 0} { set iface [lindex $argv 0] } if {$argc > 1} { set port [lindex $argv 1] } smtpd::start $iface $port # # Local variables: # mode: tcl # indent-tabs-mode: nil # End:
The following will take and only send the message to unique destinations. It uses both the smtpd and smtp packages.
## ## Program to ensure that duplicate messages are not sent from ClearQuest ## to a given recipient ##
## ## Require any packages that will be used ## package require Tcl package require mime package require smtpd package require smtp package require log package require msgcat
## ## Set global variables ## set allowedUserPatternList {*} set allowedHostIPList {127.0.0.1} set mailForwardingHost {smtphost.somewhere.net} set mailForwardingPort 25
## ## Uncomment the following lines after the "##+" up to the "##-" to turn ## off messages, comment them out to turn messages on ## ##+ ::log::lvSuppress debug ::log::lvSuppress notice ##-
Hmm - fakemail is stinky perl - the tcllib smtpd package is also maintained and is beautiful tcl :) ## ## validateHost - Checks to see if a host is legal ## ## Arguments: ## ipnum - IP address of sender ## proc validateHost {ipnum} {
global allowedHostIPList
##
## Loop through the patterns and check for a match
##
foreach allowedIP $allowedHostIPList {
if {[string equal $allowedIP $ipnum]} then {
::log::log debug [::msgcat::mc ip.granted $ipnum]
return;
}
}
##
## No matches, so we throw an error to deny access
##
::log::log debug [::msgcat::mc ip.denied $ipnum]
return -code error deny
return}
Hmm - fakemail is stinky perl - the tcllib smtpd package is also maintained and is beautiful tcl :) ## ## validateSender - Checks to see if a sender if legeal ## ## Arguments: ## address - sender's e-mail address ## proc validateSender {address} {
global allowedUserPatternList
##
## Loop through the patterns and check for a match
##
foreach allowedPattern $allowedUserPatternList {
if {[string match $allowedPattern $address]} then {
::log::log debug [::msgcat::mc sender.granted $address]
return;
}
}
##
## No matches, so we throw an error to deny access
##
::log::log debug [::msgcat::mc sender.denied $address]
return -code error deny}
Hmm - fakemail is stinky perl - the tcllib smtpd package is also maintained and is beautiful tcl :) ## ## processMail - Procedure that processes a mail message ## ## Arguments: ## args - accept any arguments ## proc processMail {sender recipients data} {
global mailForwardingHost
global mailForwardingPort
global LastData
##
## Send the mail
##
::log::log debug [::msgcat::mc process.sending $data]
set LastData $data
set token [mime::initialize -string [join $data "\n"]]
set results [smtp::sendmessage $token \
-servers $mailForwardingHost \
-ports $mailForwardingPort \
-queue 0 \
-atleastone 1 \
-originator $sender \
-recipients [lsort -unique $recipients] \
]
mime::finalize $token -subordinates all
if {[llength $results]} then {
::log::log debug [::msgcat::mc process.failure $results]
}
##
## Return to caller
##
return}
Hmm - fakemail is stinky perl - the tcllib smtpd package is also maintained and is beautiful tcl :) ## ## ok - Procedure that always returns a successful validation ## ## Arguments: ## args - accept any arguments ## proc ok {args} {
return
}
Hmm - fakemail is stinky perl - the tcllib smtpd package is also maintained and is beautiful tcl :) ## ## Main code body ##
## ## Initialize Message Catalog ## set msgDir file join [file dirname [info script] msgs ::msgcat::mcload $msgDir
## ## Setup to receive mail ## ::smtpd::configure \
-validate_host validateHost \
-validate_sender validateSender \
-validate_recipient ok \
-deliver processMail ## ## Kick off the whole thing ## ::log::log debug ::msgcat::mc starting ::smtpd::start
--- Here is the associated message file:
## ## Message file ClearQuest Smtp Deamon ## ::msgcat::mcset c ip.granted {Access granted to host "%s"} ::msgcat::mcset c ip.denied {Access denied to host "%s"} ::msgcat::mcset c sender.granted {Access granted to sender "%s"} ::msgcat::mcset c sender.denied {Access denied to sender "%s"} ::msgcat::mcset c process.original {Orginal recipients "%s"} ::msgcat::mcset c process.resultant {Resultant recipients "%s"} ::msgcat::mcset c process.sending {Sending "%s"} ::msgcat::mcset c process.failure {Message failed to be sent to {%s}} ::msgcat::mcset c starting {ClearQuest SMTP Deamon Started}
Category Package, subset Tcllib