gchiu/prot-smtp.r

## prot-smtp.r
Rebol [
  system: "Rebol [R3] Language interpreter"
	title: "Rebol 3 SMTP scheme"
	author: "Graham"
	date: [9-Jan-2010 20-Jan-2013 29-Mar-2013]
	rights: 'BSD
	name: 'smtp
	type: 'module
	version: 0.0.8
	file: %prot-smtp.r
	notes: {
		0.0.1 original tested in 2010
		0.0.2 updated for the open source versions
		0.0.3 Changed to use a synchronous mode rather than async.  Authentication not yet supported
		0.0.4 Added LOGIN, PLAIN and CRAM-MD5 authentication.  Tested against CommunigatePro
		0.0.5 Changed to move credentials to the url or port specification
		0.0.6 22-Jan-2013 Fixed some bugs in transferring email greater than the buffer size.
		0.0.7 23-Jan-2013 Added a callback to the write block to be used for updating a GUI.
		0.0.8 29-Mar-2013 switched to using numeric codes

		synchronous mode
		write smtp://user:password@smtp.clear.net.nz [
			from:
			name:
			to:
			subject:
			message:
		]

		name, and subject are not currently used and may be removed

		eg: write smtp://user:password@smtp.yourisp.com compose [
			from: me@somewhere.com
			to: recipient@other.com
			message: (message)
		]

		message: rejoin [ {To: } compkarori@gmail.com {
From: } "R3 User" { <} gchiu@compkarori.co.nz {>
Date: Mon, 21 Jan 2013 17:45:07 +1300
Subject: testing from r3
X-REBOL: REBOL3 Alpha

where's my kibble?}]

		write [
			scheme: 'smtp
			host: "smtp.yourisp.com"
			user: "joe"
			pass: "password"
			ehlo: "FQDN"
		] compose [
			from: me@somewhere.com
			to: recipient@other.com
			message: (message)
		]

		Where message is an email with all the appropriate headers.
		In Rebol2, this was constructed by the 'send function

		If both user and pass are none, then it assumes no authentication is required

		If you need to use smtp asynchronously, you supply your own awake handler

		p: open smtp://smtp.provider.com
		p/state/connection/awake: :my-async-handler
		wait p/state/connection
	}
]

bufsize: 32000 ;-- use a write buffer of 32k for sending large attachments

mail-obj: make object! [
	from:
	to:
	name:
	subject:
	message: none
	callback: none ; used to update any gui.
]

make-smtp-error: func [
	message
] [
	do make error! [
		type: 'Access
		id: 'Protocol
		arg1: message
	]
]

; auth-methods: copy []
alpha: charset [#"a" - #"z" #"A" - #"Z"]
digit: charset [#"0" - #"9"]
code-rule: [3 digit]

net-log: func [txt
	/C
	/S
] [
	if C [prin "C: "]
	if S [prin "S: "]
	print txt
	txt
]

sync-smtp-handler: func [event
	/local client response state code code-group line-response auth-key auth-methods ptr tls-capa tls-avail mailsize mailchunk
] [
	line-response: tls-capa: none
	auth-methods: copy []
	print ["=== Client event:" event/type]
	; client is the real port ie. port/state/connection
	client: event/port
	print ["client state: " client/spec/state]
	switch event/type [
		error [
			net-log "Network error"
			close client
			return true
		]
		lookup [
			; print "DNS lookup"
			open client
		]
		connect [
			net-log "connected"
			client/spec/state: 'EHLO
			read client
		]

		read [
			; can receive a multiline response, we're just going to process the code from the first
			; line, since all codes should be the same for each line
			net-log/S response: enline to-string client/data
			code: code-group: none
			parse response [copy code code-rule
				(code-group: to integer! copy/part code 1 code: to integer! code)
			]
			?? code
			?? code-group
			if code = 501 [
				make-smtp-error join "Unknown server error " response
			]
			switch/default client/spec/state [
				INIT [
					print "in init state"
					if code = 220 [
						; wants me to send EHLO
						write client to-binary net-log/C rejoin ["EHLO " any [client/spec/ehlo "Rebol-PC"] CRLF]
						client/spec/state: 'AUTH
					]
				]
				EHLO [
					if code = 220 [
						; wants me to send EHLO
						write client to-binary net-log/C rejoin ["EHLO " any [client/spec/ehlo "Rebol-PC"] CRLF]
						client/spec/state: 'AUTH
					]
					if code-group >= 4 [
						net-log join "Server error code: " response
						client/spec/state: 'END
						return true
					]
				]
				LOGIN [
					case [
						find/part response "334 VXNlcm5hbWU6" 16 [
							; username being requested
							write client to-binary net-log/C join enbase client/spec/user CRLF
						]
						find/part response "334 UGFzc3dvcmQ6" 16 [
							; pass being requested
							write client to-binary net-log/C join enbase client/spec/pass CRLF
							client/spec/state: 'PASSWORD
						]
						true [
							make-smtp-error join "Unknown response in AUTH LOGIN " response
						]
					]

				]

				CRAM-MD5 [
					case [
						code = 334 [
							auth-key: debase skip response 4
							; compute challenge response
							auth-key: checksum/method/key auth-key 'md5 client/spec/pass
							write client to-binary net-log/C join
							enbase reform [client/spec/user lowercase enbase/base auth-key 16] CRLF
							client/spec/state: 'PASSWORD
						]
						true [
							make-smtp-error join "Unknown response in AUTH CRAM-MD5 " response
						]
					]
				]

				PASSWORD [
					either code = 235 [
						client/spec/state: 'FROM
						write client to-binary net-log/C rejoin ["MAIL FROM: <" client/spec/email/from ">" CRLF]
					] [
						;-- failed authentication so close
						make-smtp-error "Failed authentication"
					]
				]

				AUTH [
					if code = 220 [
						; wants me to send EHLO
						write client to-binary net-log/C rejoin ["EHLO " any [client/spec/ehlo "Rebol-PC"] CRLF]
					]
					; should get a long string with all the options including authentication methods.
					if code = 250 [
						net-log "determining authentication methods"
						clear head auth-methods
						parse/all response [
							some [
								copy line-response to CRLF (
									parse/all line-response [
										"250"
										["-" | " "]
										["AUTH" [" " | "="]
											any
											[
												"CRAM-MD5" (append auth-methods 'cram) |
												"PLAIN" (append auth-methods 'plain) |
												"LOGIN" (append auth-methods 'login) |
												space |
												some alpha
											] |
											["STARTTLS" to end (print "supports TLS" tls-avail: true)]
											some alpha thru CRLF]
									]) crlf
							]
						]
						if find auth-methods 'plain [client/spec/state: 'PLAIN]
						if find auth-methods 'login [client/spec/state: 'LOGIN]
						if find auth-methods 'cram [client/spec/state: 'CRAM-MD5]
					]
					; use a separate protocol smtps for secure smtp
					;if all [
					;	tls-avail
					;	empty? auth-methods
					;][
					;	write client to-binary net-log/C join "STARTTLS" CRLF
					;]
					; should now have switched from AUTH to a type of authentication
					if client/spec/state != 'AUTH [
						; some servers will let you send without authentication if you're hosted on their network
						either all [
							none? client/spec/user
							none? client/spec/pass
						] [
							client/spec/state: 'FROM
							write client to-binary net-log/C rejoin ["MAIL FROM: <" client/spec/email/from ">" CRLF]] [
							switch/default client/spec/state [
								PLAIN [
									write client to-binary net-log/C rejoin ["AUTH PLAIN " enbase rejoin [client/spec/user #"^@" client/spec/user #"^@" client/spec/pass] CRLF]
									client/spec/state: 'PASSWORD
								]
								LOGIN [
									; tell the server we are going to use AUTH LOGIN
									write client to-binary net-log/C join "AUTH LOGIN" CRLF
									client/spec/state: 'LOGIN
								]
								CRAM-MD5 [
									; tell server we are using CRAM-MD5
									write client to-binary net-log/C join "AUTH CRAM-MD5" CRLF
									client/spec/state: 'CRAM-MD5
								]
							] [
								make-smtp-error "No supported authentication method"
							]
							; authentication is now handled by the main state loop except for Plain
						]
					]
				]
				FROM [
					either code = 250 [
						write client to-binary net-log/C rejoin ["RCPT TO: <" client/spec/email/to ">" crlf]
						client/spec/state: 'TO
					] [
						make-smtp-error "rejected by server"
						;return true
					]
				]
				TO [
					either code = 250 [
						client/spec/state: 'DATA
						write client to-binary net-log/C join "DATA" CRLF
					] [
						make-smtp-error "server rejects TO address"
						;return true
					]
				]
				DATA [
					either code = 354 [
						replace/all client/spec/email/message "^/." "^/.."
						client/spec/email/message: ptr: rejoin [enline client/spec/email/message]
						net-log/C "sending 32K"
						if any-function? client/spec/email/callback [
							mailsize: max mailsize length? ptr
							mailchunk: min bufsize length? ptr
							callback mailsize mainchunk
						]
						write client copy/part ptr bufsize
						remove/part ptr bufsize
						client/spec/state: 'SENDING
					] [
						make-smtp-error "Not allowing us to send ... quitting"
					]
				]

				END [
					either code = 250 [
						net-log "message successfully sent."
						client/spec/state: 'QUIT
						write client to-binary net-log/C join "QUIT" crlf
						return true
					] [
						make-smtp-error "some error occurred on sending."
						; return true
					]
				]
				QUIT [
					make-smtp-error "Should never get here"
				]
			] [net-log join "Unknown state " client/spec/state]
		]
		wrote [
			either client/spec/state = 'SENDING [
				either not empty? ptr: client/spec/email/message [
					net-log/C ["sending " min bufsize length? ptr " bytes of " length? ptr]
					if any-function? client/spec/email/callback [
						mailsize: max mailsize length? ptr
						mailchunk: min bufsize length? ptr
						callback mailsize mainchunk
					]
					write client to-binary copy/part ptr bufsize
					remove/part ptr bufsize
				] [
					write client to-binary net-log/C rejoin [crlf "." crlf]
					client/spec/state: 'END
				]
			] [
				read client
			]
		]
		close [net-log "Port closed on me"]
	]
	false
]

sync-write: func [port [port!] body
	/local state result
] [
	unless port/state [open port port/state/close?: yes]
	state: port/state
	; construct the email from the specs
	port/state/connection/spec/email: construct/with body mail-obj

	port/state/connection/awake: :sync-smtp-handler
	; doesn't support multiple email sending yet
	;if state/state = 'ready [
	; the read gets the data from the smtp server and triggers the events that follow that is handled by our state engine in the sync-smtp-handler
	;	read port
	;]
	unless port? wait [state/connection port/spec/timeout] [make error! "SMTP timeout"]
	if state/close? [close port]
	true
]

sys/make-scheme [
	name: 'smtp
	title: "SMTP Protocol"
	spec: make system/standard/port-spec-net [
		port-id: 25
		timeout: 60
		email: ;-- object constructed from argument
		ehlo:
		user:
		pass: none
	]
	actor: [
		open: func [
			port [port!]
			/local conn
		] [
			if port/state [return port]
			if none? port/spec/host [
				make-smtp-error "Missing host address when opening smtp server"
			]
			; set the port state to hold the tcp port
			port/state: context [
				state:
				connection:
				error: none
				awake: none ;-- so port/state/awake will hold the awake handler :port/awake
				close?: none ;-- flag for us to decide whether to close the port eg in syn mode
			]
			; create the tcp port and set it to port/state/connection
			port/state/connection: conn: make port! [
				scheme: 'tcp
				host: port/spec/host
				port-id: port/spec/port-id
				state: 'INIT
				ref: rejoin [tcp:// host ":" port-id]
				email: port/spec/email
				user: port/spec/user
				pass: port/spec/pass
				ehlo: any [port/spec/ehlo "Rebol3-User-PC"]
			]
			open conn ;-- open the actual tcp port

			print "port opened ..."
			; return the newly created and open port
			port
		]
		open?: func [
			port [port!]
		] [
			all [port/state]
		]

		close: func [
			port [port!]
		] [
			if open? port [
				close port/state/connection
				port/state/connection/awake: none
				port/state: none
			]
			port
		]

		read: func [
			port [port!]
		] [
			either any-function? :port/awake [
				either not open? port [
					; print "opening & waiting on port"
					unless port? wait [open port/state/connection port/spec/timeout] [make-smtp-error "Timeout"]
					; wait open port/state/connection
				] [
					; print "waiting on port"
					unless port? wait [port/state/connection port/spec/timeout] [make-smtp-error "Timeout"]
				]
				port
			] [
				make-smtp-error "No handler for the port exists yet"
				; should this be used at all for smtp?
			]
		]

		write: func [
			port [port!] body [block!]
			/local conn email
		] [
			sync-write port body
		]
	]
]
	Rebol [
	system: "Rebol [R3] Language interpreter"
	title: "Rebol 3 SMTP scheme"
	author: "Graham"
	date: [9-Jan-2010 20-Jan-2013 29-Mar-2013]
	rights: 'BSD
	name: 'smtp
	type: 'module
	version: 0.0.8
	file: %prot-smtp.r
	notes: {
	0.0.1 original tested in 2010
	0.0.2 updated for the open source versions
	0.0.3 Changed to use a synchronous mode rather than async. Authentication not yet supported
	0.0.4 Added LOGIN, PLAIN and CRAM-MD5 authentication. Tested against CommunigatePro
	0.0.5 Changed to move credentials to the url or port specification
	0.0.6 22-Jan-2013 Fixed some bugs in transferring email greater than the buffer size.
	0.0.7 23-Jan-2013 Added a callback to the write block to be used for updating a GUI.
	0.0.8 29-Mar-2013 switched to using numeric codes

	synchronous mode
	write smtp://user:password@smtp.clear.net.nz [
	from:
	name:
	to:
	subject:
	message:
	]

	name, and subject are not currently used and may be removed

	eg: write smtp://user:password@smtp.yourisp.com compose [
	from: me@somewhere.com
	to: recipient@other.com
	message: (message)
	]

	message: rejoin [ {To: } compkarori@gmail.com {
	From: } "R3 User" { <} gchiu@compkarori.co.nz {>
	Date: Mon, 21 Jan 2013 17:45:07 +1300
	Subject: testing from r3
	X-REBOL: REBOL3 Alpha

	where's my kibble?}]

	write [
	scheme: 'smtp
	host: "smtp.yourisp.com"
	user: "joe"
	pass: "password"
	ehlo: "FQDN"
	] compose [
	from: me@somewhere.com
	to: recipient@other.com
	message: (message)
	]

	Where message is an email with all the appropriate headers.
	In Rebol2, this was constructed by the 'send function

	If both user and pass are none, then it assumes no authentication is required

	If you need to use smtp asynchronously, you supply your own awake handler

	p: open smtp://smtp.provider.com
	p/state/connection/awake: :my-async-handler
	wait p/state/connection
	}
	]

	bufsize: 32000 ;-- use a write buffer of 32k for sending large attachments

	mail-obj: make object! [
	from:
	to:
	name:
	subject:
	message: none
	callback: none ; used to update any gui.
	]

	make-smtp-error: func [
	message
	] [
	do make error! [
	type: 'Access
	id: 'Protocol
	arg1: message
	]
	]

	; auth-methods: copy []
	alpha: charset [#"a" - #"z" #"A" - #"Z"]
	digit: charset [#"0" - #"9"]
	code-rule: [3 digit]

	net-log: func [txt
	/C
	/S
	] [
	if C [prin "C: "]
	if S [prin "S: "]
	print txt
	txt
	]

	sync-smtp-handler: func [event
	/local client response state code code-group line-response auth-key auth-methods ptr tls-capa tls-avail mailsize mailchunk
	] [
	line-response: tls-capa: none
	auth-methods: copy []
	print ["=== Client event:" event/type]
	; client is the real port ie. port/state/connection
	client: event/port
	print ["client state: " client/spec/state]
	switch event/type [
	error [
	net-log "Network error"
	close client
	return true
	]
	lookup [
	; print "DNS lookup"
	open client
	]
	connect [
	net-log "connected"
	client/spec/state: 'EHLO
	read client
	]

	read [
	; can receive a multiline response, we're just going to process the code from the first
	; line, since all codes should be the same for each line
	net-log/S response: enline to-string client/data
	code: code-group: none
	parse response [copy code code-rule
	(code-group: to integer! copy/part code 1 code: to integer! code)
	]
	?? code
	?? code-group
	if code = 501 [
	make-smtp-error join "Unknown server error " response
	]
	switch/default client/spec/state [
	INIT [
	print "in init state"
	if code = 220 [
	; wants me to send EHLO
	write client to-binary net-log/C rejoin ["EHLO " any [client/spec/ehlo "Rebol-PC"] CRLF]
	client/spec/state: 'AUTH
	]
	]
	EHLO [
	if code = 220 [
	; wants me to send EHLO
	write client to-binary net-log/C rejoin ["EHLO " any [client/spec/ehlo "Rebol-PC"] CRLF]
	client/spec/state: 'AUTH
	]
	if code-group >= 4 [
	net-log join "Server error code: " response
	client/spec/state: 'END
	return true
	]
	]
	LOGIN [
	case [
	find/part response "334 VXNlcm5hbWU6" 16 [
	; username being requested
	write client to-binary net-log/C join enbase client/spec/user CRLF
	]
	find/part response "334 UGFzc3dvcmQ6" 16 [
	; pass being requested
	write client to-binary net-log/C join enbase client/spec/pass CRLF
	client/spec/state: 'PASSWORD
	]
	true [
	make-smtp-error join "Unknown response in AUTH LOGIN " response
	]
	]

	]

	CRAM-MD5 [
	case [
	code = 334 [
	auth-key: debase skip response 4
	; compute challenge response
	auth-key: checksum/method/key auth-key 'md5 client/spec/pass
	write client to-binary net-log/C join
	enbase reform [client/spec/user lowercase enbase/base auth-key 16] CRLF
	client/spec/state: 'PASSWORD
	]
	true [
	make-smtp-error join "Unknown response in AUTH CRAM-MD5 " response
	]
	]
	]

	PASSWORD [
	either code = 235 [
	client/spec/state: 'FROM
	write client to-binary net-log/C rejoin ["MAIL FROM: <" client/spec/email/from ">" CRLF]
	] [
	;-- failed authentication so close
	make-smtp-error "Failed authentication"
	]
	]

	AUTH [
	if code = 220 [
	; wants me to send EHLO
	write client to-binary net-log/C rejoin ["EHLO " any [client/spec/ehlo "Rebol-PC"] CRLF]
	]
	; should get a long string with all the options including authentication methods.
	if code = 250 [
	net-log "determining authentication methods"
	clear head auth-methods
	parse/all response [
	some [
	copy line-response to CRLF (
	parse/all line-response [
	"250"
	["-" \| " "]
	["AUTH" [" " \| "="]
	any
	[
	"CRAM-MD5" (append auth-methods 'cram) \|
	"PLAIN" (append auth-methods 'plain) \|
	"LOGIN" (append auth-methods 'login) \|
	space \|
	some alpha
	] \|
	["STARTTLS" to end (print "supports TLS" tls-avail: true)]
	some alpha thru CRLF]
	]) crlf
	]
	]
	if find auth-methods 'plain [client/spec/state: 'PLAIN]
	if find auth-methods 'login [client/spec/state: 'LOGIN]
	if find auth-methods 'cram [client/spec/state: 'CRAM-MD5]
	]
	; use a separate protocol smtps for secure smtp
	;if all [
	; tls-avail
	; empty? auth-methods
	;][
	; write client to-binary net-log/C join "STARTTLS" CRLF
	;]
	; should now have switched from AUTH to a type of authentication
	if client/spec/state != 'AUTH [
	; some servers will let you send without authentication if you're hosted on their network
	either all [
	none? client/spec/user
	none? client/spec/pass
	] [
	client/spec/state: 'FROM
	write client to-binary net-log/C rejoin ["MAIL FROM: <" client/spec/email/from ">" CRLF]] [
	switch/default client/spec/state [
	PLAIN [
	write client to-binary net-log/C rejoin ["AUTH PLAIN " enbase rejoin [client/spec/user #"^@" client/spec/user #"^@" client/spec/pass] CRLF]
	client/spec/state: 'PASSWORD
	]
	LOGIN [
	; tell the server we are going to use AUTH LOGIN
	write client to-binary net-log/C join "AUTH LOGIN" CRLF
	client/spec/state: 'LOGIN
	]
	CRAM-MD5 [
	; tell server we are using CRAM-MD5
	write client to-binary net-log/C join "AUTH CRAM-MD5" CRLF
	client/spec/state: 'CRAM-MD5
	]
	] [
	make-smtp-error "No supported authentication method"
	]
	; authentication is now handled by the main state loop except for Plain
	]
	]
	]
	FROM [
	either code = 250 [
	write client to-binary net-log/C rejoin ["RCPT TO: <" client/spec/email/to ">" crlf]
	client/spec/state: 'TO
	] [
	make-smtp-error "rejected by server"
	;return true
	]
	]
	TO [
	either code = 250 [
	client/spec/state: 'DATA
	write client to-binary net-log/C join "DATA" CRLF
	] [
	make-smtp-error "server rejects TO address"
	;return true
	]
	]
	DATA [
	either code = 354 [
	replace/all client/spec/email/message "^/." "^/.."
	client/spec/email/message: ptr: rejoin [enline client/spec/email/message]
	net-log/C "sending 32K"
	if any-function? client/spec/email/callback [
	mailsize: max mailsize length? ptr
	mailchunk: min bufsize length? ptr
	callback mailsize mainchunk
	]
	write client copy/part ptr bufsize
	remove/part ptr bufsize
	client/spec/state: 'SENDING
	] [
	make-smtp-error "Not allowing us to send ... quitting"
	]
	]

	END [
	either code = 250 [
	net-log "message successfully sent."
	client/spec/state: 'QUIT
	write client to-binary net-log/C join "QUIT" crlf
	return true
	] [
	make-smtp-error "some error occurred on sending."
	; return true
	]
	]
	QUIT [
	make-smtp-error "Should never get here"
	]
	] [net-log join "Unknown state " client/spec/state]
	]
	wrote [
	either client/spec/state = 'SENDING [
	either not empty? ptr: client/spec/email/message [
	net-log/C ["sending " min bufsize length? ptr " bytes of " length? ptr]
	if any-function? client/spec/email/callback [
	mailsize: max mailsize length? ptr
	mailchunk: min bufsize length? ptr
	callback mailsize mainchunk
	]
	write client to-binary copy/part ptr bufsize
	remove/part ptr bufsize
	] [
	write client to-binary net-log/C rejoin [crlf "." crlf]
	client/spec/state: 'END
	]
	] [
	read client
	]
	]
	close [net-log "Port closed on me"]
	]
	false
	]

	sync-write: func [port [port!] body
	/local state result
	] [
	unless port/state [open port port/state/close?: yes]
	state: port/state
	; construct the email from the specs
	port/state/connection/spec/email: construct/with body mail-obj

	port/state/connection/awake: :sync-smtp-handler
	; doesn't support multiple email sending yet
	;if state/state = 'ready [
	; the read gets the data from the smtp server and triggers the events that follow that is handled by our state engine in the sync-smtp-handler
	; read port
	;]
	unless port? wait [state/connection port/spec/timeout] [make error! "SMTP timeout"]
	if state/close? [close port]
	true
	]

	sys/make-scheme [
	name: 'smtp
	title: "SMTP Protocol"
	spec: make system/standard/port-spec-net [
	port-id: 25
	timeout: 60
	email: ;-- object constructed from argument
	ehlo:
	user:
	pass: none
	]
	actor: [
	open: func [
	port [port!]
	/local conn
	] [
	if port/state [return port]
	if none? port/spec/host [
	make-smtp-error "Missing host address when opening smtp server"
	]
	; set the port state to hold the tcp port
	port/state: context [
	state:
	connection:
	error: none
	awake: none ;-- so port/state/awake will hold the awake handler :port/awake
	close?: none ;-- flag for us to decide whether to close the port eg in syn mode
	]
	; create the tcp port and set it to port/state/connection
	port/state/connection: conn: make port! [
	scheme: 'tcp
	host: port/spec/host
	port-id: port/spec/port-id
	state: 'INIT
	ref: rejoin [tcp:// host ":" port-id]
	email: port/spec/email
	user: port/spec/user
	pass: port/spec/pass
	ehlo: any [port/spec/ehlo "Rebol3-User-PC"]
	]
	open conn ;-- open the actual tcp port

	print "port opened ..."
	; return the newly created and open port
	port
	]
	open?: func [
	port [port!]
	] [
	all [port/state]
	]

	close: func [
	port [port!]
	] [
	if open? port [
	close port/state/connection
	port/state/connection/awake: none
	port/state: none
	]
	port
	]

	read: func [
	port [port!]
	] [
	either any-function? :port/awake [
	either not open? port [
	; print "opening & waiting on port"
	unless port? wait [open port/state/connection port/spec/timeout] [make-smtp-error "Timeout"]
	; wait open port/state/connection
	] [
	; print "waiting on port"
	unless port? wait [port/state/connection port/spec/timeout] [make-smtp-error "Timeout"]
	]
	port
	] [
	make-smtp-error "No handler for the port exists yet"
	; should this be used at all for smtp?
	]
	]

	write: func [
	port [port!] body [block!]
	/local conn email
	] [
	sync-write port body
	]
	]
	]