File: smtp_server.tcl

package info (click to toggle)
tkrat 1%3A2.2cvs20100105-true-dfsg-6.1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 10,340 kB
  • ctags: 9,259
  • sloc: ansic: 96,057; tcl: 25,667; makefile: 1,638; sh: 282
file content (178 lines) | stat: -rw-r--r-- 3,774 bytes parent folder | download | duplicates (4)
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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
# Implements a smtp-server

namespace eval smtp_server {
    # Port to use for SMTP
    variable port 42301

    # The latest message we received
    variable message {}

    # smtp state
    variable state disconnected

    # Numer of connections to SMTP-server
    variable opens 0

    # Channel between server and client. Used to forcibly close the conn
    variable channel

    # List of recipients of the last message
    variable recipients {}

    # "ok" if the server should accept the message
    variable action ok

    # Server socket
    variable server
}

# Start the smtp-server
proc smtp_server::start {} {
    variable port
    variable server

    while {[catch "socket -server smtp_server::open $port" server]} {
	incr port
    }
}

# Get port number
proc smtp_server::get_port {} {
    variable port

    return $port
}

# Prepare server for new incoming message
proc smtp_server::prepare_incoming {{new_action {ok}}} {
    variable message {}
    variable action $new_action
}

# Get current state
proc smtp_server::get_state {} {
    variable state

    return $state
}

# Get open count
proc smtp_server::get_opens {} {
    variable opens

    return $opens
}

# Get received message
proc smtp_server::get_received {} {
    variable message
    variable recipients

    return [list $recipients $message]
}

# Close the current session
proc smtp_server::close_session {} {
    variable channel

    close $channel
}

# Close the server
proc smtp_server::stop {} {
    variable server

    close $server
}

proc smtp_server::open {c host port} {
    variable message
    variable state
    variable channel $c
    variable opens
    variable recipients
    global debug

    if {$debug} {
	puts "SMTP connection from $host:$port"
    }
    incr opens
    fconfigure $c -buffering line
    puts $c "220 SMTP simulator"
    set state initial
    set message {}
    set recipients {}
    fileevent $c readable "smtp_server::handle_data $c"
}

proc smtp_server::handle_data {c} {
    variable message
    variable state
    variable recipients
    variable action
    global debug

    if {-1 == [gets $c line]} {
	# Sender closed the connection
	if {$debug} {
	    puts "SMTP connection closed by client"
	}
	set state disconnected
	close $c
	return
    }
    if {$debug} {
	puts "IN:  $line"
    }
    regsub -all "\r" $line {} line
    set cmd [string toupper [lindex $line 0]];
    if {"initial" == $state && "EHLO" == $cmd} {
	set resp "250-Hello on yourself"
	set resp "$resp\n250-EXPN"
	set resp "$resp\n250-VERB"
	set resp "$resp\n250-8BITMIME"
	set resp "$resp\n250-SIZE"
	set resp "$resp\n250-DSN"
	set resp "$resp\n250-ONEX"
	set resp "$resp\n250-ETRN"
	set resp "$resp\n250-XUSR"
	set resp "$resp\n250 HELP"
	set state command
    } elseif {"command" == $state && "MAIL" == $cmd} {
	if {"ok" != $action} {
	    set resp "550 I have been instructed to deny you"
	    set state command
	} else {
	    set resp "250 sender ok"
	    set state get_rcpt
	    set message {}
	    set recipients {}
	}
    } elseif {"command" == $state && "QUIT" == $cmd} {
	set resp "221 closing connection"
	set state quit
    } elseif  {"get_rcpt" == $state && "RCPT" == $cmd} {
	lappend recipients [lindex [split $line "<>"] 1]
	set resp "250 rcpt ok"
    } elseif  {"get_rcpt" == $state && "DATA" == $cmd} {
	set resp "354 Enter mail"
	set state data
    } elseif {"data" == $state && "." != $line} {
	lappend message $line
	return
    } elseif {"data" == $state && "." == $line} {
	set resp "250 Message accepted"
	set state command
    } elseif {"RSET" == $line} {
	set resp "250 reset"
	set state command
    } else {
	set resp "500 Command unrecognized"
    }
    if {$debug} {
	foreach o [split $resp "\n"] {
	    puts "OUT: $o"
	}
    }
    puts $c $resp
}