1# maildemo.tcl - Copyright (C) 2005 Pat Thoyts <patthoyts@users.sf.net> 2# 3# This program illustrates the steps required to compose a MIME message and 4# mail it to a recipient using the tcllib mime and smtp packages. 5# 6# If we can find suitable environment variables we will authenticate with a 7# server (if it presents this option) and we will use SSL communications 8# if available. 9# 10# $Id: maildemo.tcl,v 1.2 2005/10/07 00:30:13 patthoyts Exp $ 11 12package require mime 13package require smtp 14 15# The use of SSL by our client can be controlled by a policy procedure. Using 16# this we can specify that we REQUIRE SSL or we can make SSL optional. 17# This procedure should return 'secure' to require SSL 18# 19proc policy {demoarg code diagnostic} { 20 if {$code > 299} { 21 puts stderr "TLS error: $code $diagnostic" 22 } 23 #return secure; # fail if no TLS 24 return insecure; 25} 26 27# Setup default sender and target 28set DEFUSER tcllib-demo@[info host] 29set USERNAME $tcl_platform(user) 30set PASSWORD "" 31 32# Try and lift authentication details from the environment. 33if {[info exists env(USERNAME)]} { 34 set USERNAME $env(USERNAME) 35} 36 37# We can get the password from http_proxy_pass - maybe. 38if {[info exists env(http_proxy_pass)]} { 39 set PASSWORD $env(http_proxy_pass) 40} 41 42set defmsg "This is a default tcllib demo mail message." 43 44# Compose and send a message. Command parameters can override the settings 45# discovered above. 46# 47proc Send [list \ 48 [list server localhost] \ 49 [list port 25] \ 50 [list from $DEFUSER] \ 51 [list to $DEFUSER] \ 52 [list msg $defmsg]] { 53 set tok [mime::initialize -canonical text/plain -string $msg] 54 set args [list \ 55 -debug 1 \ 56 -servers [list $server] \ 57 -ports [list $port] \ 58 -usetls 1 \ 59 -tlspolicy [list policy $tok] \ 60 -header [list From "$from"] \ 61 -header [list To "$to"] \ 62 -header [list Subject "RFC 2554 test"] \ 63 -header [list Date "[clock format [clock seconds]]"]] 64 if {[info exists ::USERNAME] && [string length $::USERNAME] > 0} { 65 lappend args \ 66 -username $::USERNAME \ 67 -password $::PASSWORD 68 } 69 70 eval [linsert $args 0 smtp::sendmessage $tok] 71 mime::finalize $tok 72} 73 74if {!$tcl_interactive} { 75 eval [linsert $argv 0 Send] 76}