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}