blob: 56fe98b0251012c270cc8dfc921153d3064c3fd5 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
#!/usr/bin/env tclsh
## -*- tcl -*-
# 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.3 2010/11/25 17:19:45 andreas_kupries 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
#
proc policy {demoarg code diagnostic} {
if {$code > 299} {
puts stderr "TLS error: $code $diagnostic"
}
#return secure; # fail if no TLS
return insecure;
}
# Setup default sender and target
set DEFUSER tcllib-demo@[info host]
set USERNAME $tcl_platform(user)
set PASSWORD ""
# Try and lift authentication details from the environment.
if {[info exists env(USERNAME)]} {
set USERNAME $env(USERNAME)
}
# We can get the password from http_proxy_pass - maybe.
if {[info exists env(http_proxy_pass)]} {
set PASSWORD $env(http_proxy_pass)
}
set defmsg "This is a default tcllib demo mail message."
# Compose and send a message. Command parameters can override the settings
# discovered above.
#
proc Send [list \
[list server localhost] \
[list port 25] \
[list from $DEFUSER] \
[list to $DEFUSER] \
[list msg $defmsg]] {
set tok [mime::initialize -canonical text/plain -string $msg]
set args [list \
-debug 1 \
-servers [list $server] \
-ports [list $port] \
-usetls 1 \
-tlspolicy [list policy $tok] \
-header [list From "$from"] \
-header [list To "$to"] \
-header [list Subject "RFC 2554 test"] \
-header [list Date "[clock format [clock seconds]]"]]
if {[info exists ::USERNAME] && [string length $::USERNAME] > 0} {
lappend args \
-username $::USERNAME \
-password $::PASSWORD
}
eval [linsert $args 0 smtp::sendmessage $tok]
mime::finalize $tok
}
if {!$tcl_interactive} {
eval [linsert $argv 0 Send]
}
|
