Thursday, 09 September 2010
SMTP Mail with Jim
I recently had the need to send email from my Jim-enabled embedded web application. There are many ways to achieve this, including via a command line application, but I chose to use the networking capabilities of Jim to send email directly via SMTP. It turned out to be remarkably easy.
First the test code:
# Test the smtp package package require smtp # Subclass smtp to provide a custom log method class smtp_log smtp {} smtp_log method log {msg} { puts $msg } # Create an instance to send our message set s [smtp_log new {server mail.workware.net.au}] # And send it set result [$s send { to steveb@workware.net.au from steveb@workware.net.au subject "Test message" body "hello from steve" }] if {$result ne ""} { puts "Result is $result" }
And the result of running it:
<<< 220 mail.workware.net.au ESMTP Postfix
>>> HELO stevebmac.internal.workware.net.au
<<< 250 mail.workware.net.au
>>> MAIL FROM: jim@workware.net.au
<<< 250 2.1.0 Ok
>>> RCPT TO: steveb@workware.net.au
<<< 250 2.1.5 Ok
>>> DATA
<<< 354 End data with <CR><LF>.<CR><LF>
>>> To: steveb@workware.net.au
>>> From: "Jim Tcl" <jim@workware.net.au>
>>> Date: Fri, 10 Sep 09 2010 14:07:49 +1000
>>> Subject: This is a test email
>>>
=== sending body
>>> .
<<< 250 2.0.0 Ok: queued as 1DB491E69538A
>>> QUIT
<<< 221 2.0.0 Bye
::: ok
And here is the smtp package (smtp.tcl
). Note the use of
alarm/signal/catch -signal
to implement the timeout.
This package is built as an OO class.
# Package supporting sending email via direct SMTP package require oo # class to send emails via SMTP # # The following class variables are supported # # server - The hostname or IP address of the target SMTP server # # And optionally: # port - The port to sent to (defaults to 25) # timeout - Protocol timeout in seconds (defaults to 10) class smtp {server {} port 25 timeout 10 sock {}} # This log method can be overridden either by # creating a subclass, or just overwriting this method smtp method log {msg} {} # Send an email # # $info is a dictionary containing the following (required) elements # # subject - The email subject # to - Either a simple email address, or a list of {emailaddr name} # from - Either a simple email address, or a list of {emailaddr name} # body - The newline-separated email body # smtp method send {info} { if {$server eq ""} { return "smtp send: no server specified" } foreach req {subject to from body} { if {![exists info($req)]} { return "smtp send: missing $req" } } local proc smtp.format_addr {addr {name {}}} { if {$name eq ""} { return $addr } return "\"$name\" <$addr>" } signal handle SIGALRM # Run the protocol set rc [catch -signal { alarm $timeout set sock [socket stream $server:$port] $self whenok 220 { $self puts "HELO [info hostname]" } $self whenok 250 { $self puts "MAIL FROM: [lindex $info(from) 0]" } $self whenok 250 { $self puts "RCPT TO: [lindex $info(to) 0]" } $self whenok 250 { $self puts "DATA" } $self whenok 354 { $self puts "To: [smtp.format_addr {*}$info(to)]" $self puts "From: [smtp.format_addr {*}$info(from)]" set RFC822 {%a, %d %b %m %Y %H:%M:%S %z} $self puts "Date: [clock format [clock seconds] -format $RFC822]" $self puts "Subject: $info(subject)" $self puts "" $self log "=== sending body" foreach line [split $info(body) \n] { if {[string index $line 0] eq "."} { $sock puts -nonewline "." } $sock puts $line\r } $self puts "." } $self whenok 250 { $self puts "QUIT" } $self whenok 221 { $self log "::: ok" } } error opts] alarm 0 catch { $sock close } if {$rc} { $self log "!!! $error" return $error } } # Write to the socket and also log smtp method puts {msg} { $self log ">>> $msg" $sock puts $msg\r $sock flush } # Internal method # # When the socket is readable, # reads the response and checks the code, and if OK, execute the $script # If not OK, returns with a 'break' return code and a message smtp method whenok {code script} { alarm $timeout if {[$sock gets buf] < 0} { return -code break "Expected $code but got EOF" } $self log "<<< $buf" lassign $buf recv if {[string range $recv 0 2] ne $code} { return -code break "Expected $code but got: $buf" } # Invoke the script in the original callframe uplevel 2 $script }
Steve Bennett (steveb@workware.net.au)
comments powered by Disqus