Documentation can be found at http://tcllib.sourceforge.net/doc/smtpd.html ---- '''Note''': The [tcllib] [smtpd] [package] is a framework for writing Mail Transfer Agents (MTA). It does not handle delivery but provides hooks to program against. Its function is to provide a correct interface to SMTP network clients; "correct" here means, in conformance with RFCs 821 and 2821 [http://www.normos.org/ietf/rfc/rfc2821.txt]. ---- Here's a simple example (found in the tcllib examples tree): ====== #! /bin/sh # # tk_smtpd - Copyright (C) 2001 Pat Thoyts # # 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 {houmailgwi1.hou.aspentech.com} 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 ##- ## ## 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 } ## ## 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 } ## ## 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 } ## ## ok - Procedure that always returns a successful validation ## ## Arguments: ## args - accept any arguments ## proc ok {args} { return } ## ## 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} ====== ---- Fakemail [http://www.lastcraft.com/fakemail.php] is a maintained project for a small dummy SMTP [daemon] for [testing]. Hmm - fakemail is stinky [perl] - the [tcllib] smtpd package is also maintained and is beautiful tcl :) 'Anyone motivated enough to determine whether there's any functionality smtpd can learn from fakemail? ---- [SMTPD Example] <> Package | Tcllib | Internet