FEAT: smtp scheme: recipient's address validation and possibility to have more than one; Better error handling.

Author: Oldes

src/mezz/prot-smtp.reb

@@ -4,8 +4,8 @@ Rebol [
 	type:    module
 	author:  ["Graham" "Oldes"]
 	rights:  BSD
-	version: 1.0.1
-	date:    13-Jul-2022
+	version: 1.1.0
+	date:    14-Jul-2022
 	file:    %prot-smtp.reb
 	notes: {
 		0.0.1 original tested in 2010
@@ -16,20 +16,17 @@ Rebol [
 		0.0.6 Fixed some bugs in transferring email greater than the buffer size.
         1.0.0 Oldes: Updated to work with my Rebol3 fork; including TLS.
         1.0.1 Oldes: Using extenal IP in the EHLO message, when domain-name is not available
+        1.1.0 Oldes: Recipient's address validation and possibility to have more than one
 
         Note that if your password does not work for gmail then you need to 
         generate an app password.  See https://support.google.com/accounts/answer/185833
 		
 		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
@@ -53,7 +50,7 @@ where's my kibble?}]
             ehlo: "local.domain.name" ; optional, if not available, external IP will be used
 		] compose [
 			from: me@somewhere.com
-			to: recipient@other.com
+			to:   recipient@other.com
 			message: (message)
 		]
 		
@@ -74,8 +71,6 @@ bufsize: 16384 ;-- use a write buffer of 16KiB (maximum TLS record size!) for se
 mail-obj: make object! [ 
 	from: 
 	to:
-	name: 
-	subject:
 	message: none
 ]
 
@@ -177,8 +172,8 @@ sync-smtp-handler: function [event][
 								return false
 							)
 							|
-							thru "AUTH" [#" " | #"="] copy auth-methods: to CRLF to end (
-								auth-methods: split auth-methods #" "
+							thru "AUTH" [SP | #"="] copy auth-methods: to CRLF to end (
+								auth-methods: split auth-methods SP
 								foreach auth auth-methods [
 									try [auth: to word! auth]
 									switch auth [
@@ -252,7 +247,7 @@ sync-smtp-handler: function [event][
 						; compute challenge response
 						auth-key: checksum/with auth-key 'md5 spec/pass
 						sys/log/more 'SMTP "Client: ***auth-key***"
-						write client to binary! ajoin [enbase/flat ajoin [spec/user #" " lowercase enbase auth-key 16] 64 CRLF]
+						write client to binary! ajoin [enbase/flat ajoin [spec/user SP lowercase enbase auth-key 16] 64 CRLF]
 						smtp-port/state: 'PASSWORD
 						false
 					][
@@ -262,30 +257,44 @@ sync-smtp-handler: function [event][
 				PLAIN
 				PASSWORD [
 					either code = 235 [
+						write client to binary! net-log/C ajoin ["MAIL FROM: " mold as tag! smtp-ctx/mail/from CRLF]
 						smtp-port/state: 'FROM
-						write client to binary! net-log/C ajoin ["MAIL FROM: <" smtp-ctx/mail/from ">" CRLF	]
+						smtp-ctx/recipients: 0
 						false
 					][
 						throw-smtp-error smtp-port "Failed authentication"
 					]
 				]
-				FROM [
-					either code = 250 [
-						write client to binary! net-log/C ajoin ["RCPT TO: <" smtp-ctx/mail/to ">" crlf]
-						smtp-port/state: 'TO
-						false
-					] [
-						throw-smtp-error smtp-port "Rejected by server"
+				FROM
+				RCPT [
+					if code <> 250 [
+						either state == 'FROM [
+							throw-smtp-error smtp-port "FROM address rejected by server"
+							return true ; awake.. no more job to do.
+						][
+							sys/log/error 'SMTP ["Server rejects TO address:" as-red smtp-ctx/rcpt]
+							smtp-ctx/rcpt: none
+							smtp-ctx/recipients: smtp-ctx/recipients - 1
+						]
 					]
-				]
-				TO [
-					either code = 250 [
-						smtp-port/state: 'DATA
+					either empty? smtp-ctx/mail/to [
+						;; no more recipients, check if at least one was accepted...
+						;sys/log/debug 'SMTP ["Number of accepted recipients:" smtp-ctx/recipients]
+						if smtp-ctx/recipients == 0 [
+							throw-smtp-error smtp-port "There were no accepted recipients!"
+							return true
+						]
+						;; if so, request the DATA start...
 						write client to binary! net-log/C join "DATA" CRLF
-						false
-					] [
-						throw-smtp-error smtp-port "Server rejects TO address"
+						smtp-port/state: 'DATA
+					][
+						;; register another recipient...
+						smtp-ctx/rcpt: take smtp-ctx/mail/to
+						smtp-ctx/recipients: smtp-ctx/recipients + 1
+						write client to binary! net-log/C ajoin ["RCPT TO: " mold as tag! smtp-ctx/rcpt crlf]
+						smtp-port/state: 'RCPT
 					]
+					false
 				]
 				DATA [
 					either code = 354 [
@@ -347,16 +356,36 @@ sync-smtp-handler: function [event][
 sync-write: func [
 	port [port!]
 	body [block!]
-	/local ctx result
+	/local ctx result rcpt error
 ][
 	sys/log/debug 'SMTP ["sync-write state:" port/state]
+
+	;; there may be multiple recipients...
+	;; do validation before actually opening the connection.
+	rcpt: select body 'to
+	case/all [
+		block? :rcpt [
+			;; only emails are valid here, so remove everything else...
+			rcpt: copy rcpt
+			remove-each m rcpt [not email? m]
+		]
+		email? :rcpt [
+			rcpt: to block! rcpt
+		]
+		any [not block? :rcpt empty? :rcpt] [
+			throw-smtp-error port "There must be at least one recipient!"
+			return true
+		]
+	]
+
 	unless ctx: port/extra [
 		open port
 		ctx: port/extra
 		port/state: 'READY
 	]
 	; construct the email object from the specs 
 	ctx/mail: construct/with body mail-obj
+	ctx/mail/to: :rcpt
 
 	ctx/connection/awake: :sync-smtp-handler
 
@@ -375,6 +404,10 @@ sync-write: func [
 	if port/state = 'CLOSE [
 		close port
 	]
+	;print "sync-write DONE"
+	if all [port port/extra error? port/extra/error][
+		do port/extra/error
+	]
 	true
 ]
 
@@ -402,6 +435,8 @@ sys/make-scheme [
 				connection:
 				mail:
 				error:
+				rcpt:       ;= used to store the last requested RCPT address
+				recipients: ;= number of accepted recipients (must be at least one to proceed data sending)
 			]
 			spec: port/spec
 			; create the tcp port and set it to port/state/connection
@@ -468,17 +503,14 @@ sys/make-scheme [
 			sync-write port body
 		]
 	]
-	awake: func[event /local port type error][
+	awake: func[event /local port type][
 		port: event/port
 		type: event/type
 		sys/log/debug 'SMTP ["SMTP-Awake event:" type]
 		switch/default type [
 			error [
-				error: all [port/extra port/extra/error]
-				close port
-				wait [port 0.1]
-				do error
 				port/state: 'ERROR
+				try [ close port/extra/connection ]
 				true
 			]
 			close [