forked from rebolsource/r3
-
-
Notifications
You must be signed in to change notification settings - Fork 7
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
FEAT:
smtp
scheme: recipient's address validation and possibility t…
…o have more than one; Better error handling.
- Loading branch information
Showing
1 changed file
with
65 additions
and
33 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -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:[email protected] [ | ||
from: | ||
name: | ||
to: | ||
subject: | ||
message: | ||
] | ||
name, and subject are not currently used and may be removed | ||
eg: write smtp://user:[email protected] compose [ | ||
from: [email protected] | ||
|
@@ -53,7 +50,7 @@ where's my kibble?}] | |
ehlo: "local.domain.name" ; optional, if not available, external IP will be used | ||
] compose [ | ||
from: [email protected] | ||
to: [email protected] | ||
to: [email protected] | ||
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 [ | ||
|