maildemo.tcl

Go to the documentation of this file.

/*  maildemo.tcl - Copyright (C) 2005 Pat Thoyts <patthoyts@users.sf.net>*/
/*  */
/*  This program illustrates the steps required to compose a MIME message and */
/*  mail it to a recipient using the tcllib mime and smtp packages.*/
/* */
/*  If we can find suitable environment variables we will authenticate with a*/
/*  server (if it presents this option) and we will use SSL communications*/
/*  if available.*/
/* */
/*  $Id: maildemo.tcl,v 1.2 2005/10/07 00:30:13 patthoyts Exp $*/

package require mime
package require smtp

/*  The use of SSL by our client can be controlled by a policy procedure. Using*/
/*  this we can specify that we REQUIRE SSL or we can make SSL optional.*/
/*  This procedure should return 'secure' to require SSL*/
/* */
ret  policy (type demoarg , type code , type diagnostic) {
    if {$code > 299} {
        puts stderr "TLS error: $code $diagnostic"
    }
    #return secure;                      # fail if no TLS
    return insecure;
}

/*  Setup default sender and target*/
 DEFUSER =  tcllib-demo@[info host]
 USERNAME =  $tcl_platform(user)
 PASSWORD =  ""

/*  Try and lift authentication details from the environment.*/
if {[info exists env(USERNAME)]} {
     USERNAME =  $env(USERNAME)
}

/*  We can get the password from http_proxy_pass - maybe.*/
if {[info exists env(http_proxy_pass)]} {
     PASSWORD =  $env(http_proxy_pass)
}

 defmsg =  "This is a default tcllib demo mail message."

/*  Compose and send a message. Command parameters can override the settings */
/*  discovered above.*/
/* */
ret  Send [list \
               [list server localhost] \
               [list port 25] \
               [list from $DEFUSER] \
               [list to   $DEFUSER] \
               [list msg  $defmsg]] (
    type set , type tok [, type mime::, type initialize -, type canonical , type text/, type plain -, type string $, type msg]
    , type set , type args [, type list \
                  -, type debug 1 \
                  -, type servers   [, type list $, type server] \
                  -, type ports     [, type list $, type port] \
                  -, type usetls    1 \
                  -, type tlspolicy [, type list , type policy $, type tok] \
                  -, type header    [, type list , type From "$, type from"] \
                  -, type header    [, type list , type To "$, type to"] \
                  -, type header    [, type list , type Subject ", type RFC 2554 , type test"] \
                  -, type header    [, type list , type Date "[, type clock , type format [, type clock , type seconds]]"]]
    , type if , optional [info =exists ::USERNAME] =&& [string =length $::USERNAME] => 0 , optional 
        lappend =args \
            =-username  $::USERNAME =\
            -password  =$::PASSWORD
    

    , type eval [, type linsert $, type args 0 , type smtp::, type sendmessage $, type tok]    
    , type mime::, type finalize $, type tok
)

if {!$tcl_interactive} {
    eval [linsert $argv 0 Send]
}