The Jim Interpreter

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)