smtp: Fix issues with sending an email using Outlook's smtp server.
- Outlook requires saying HELO after upgrading to TLS. - Outlook stopped supporting plain auth in 2017. Tested on gmail and outlook.clean-linux-x86-64
parent
0ea9f8935d
commit
d26d36cc86
|
@ -11,7 +11,7 @@ HELP: smtp-config
|
||||||
{ { $slot "server" } { "An " { $link <inet> } " of the SMTP server." } }
|
{ { $slot "server" } { "An " { $link <inet> } " of the SMTP server." } }
|
||||||
{ { $slot "tls?" } { "Secure socket after connecting to server, server must support " { $snippet "STARTTLS" } } }
|
{ { $slot "tls?" } { "Secure socket after connecting to server, server must support " { $snippet "STARTTLS" } } }
|
||||||
{ { $slot "read-timeout" } { "Length of time after which we give up waiting for a response." } }
|
{ { $slot "read-timeout" } { "Length of time after which we give up waiting for a response." } }
|
||||||
{ { $slot "auth" } { "Either " { $link no-auth } " or an instance of " { $link plain-auth } } }
|
{ { $slot "auth" } { "Either " { $link no-auth } " or an instance of " { $link plain-auth } " or " { $link login-auth } } }
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
|
@ -25,12 +25,22 @@ HELP: no-auth
|
||||||
{ $class-description "If the " { $snippet "auth" } " slot is set to this value, no authentication will be performed." } ;
|
{ $class-description "If the " { $snippet "auth" } " slot is set to this value, no authentication will be performed." } ;
|
||||||
|
|
||||||
HELP: plain-auth
|
HELP: plain-auth
|
||||||
{ $class-description "If the " { $snippet "auth" } " slot is set to this value, plain authentication will be performed, with the username and password stored in the " { $slot "username" } " and " { $slot "password" } " slots of the tuple sent to the server as plain-text." } ;
|
{ $class-description "If the " { $snippet "auth" } " slot is set to this value, plain authentication will be performed, with the username and password stored in the " { $slot "username" } " and " { $slot "password" } " slots of the tuple sent to the server as plain-text." }
|
||||||
|
{ $notes "This authentication method is no longer supported by Outlook mail servers." } ;
|
||||||
|
|
||||||
HELP: <plain-auth>
|
HELP: <plain-auth>
|
||||||
{ $values { "username" string } { "password" string } { "plain-auth" plain-auth } }
|
{ $values { "username" string } { "password" string } { "plain-auth" plain-auth } }
|
||||||
{ $description "Creates a new " { $link plain-auth } " instance." } ;
|
{ $description "Creates a new " { $link plain-auth } " instance." } ;
|
||||||
|
|
||||||
|
HELP: login-auth
|
||||||
|
{ $class-description "If the " { $snippet "auth" } " slot is set to this value, LOGIN authentication will be performed, with the username and password stored in the " { $slot "username" } " and " { $slot "password" } " slots of the tuple sent to the server as plain-text." } ;
|
||||||
|
|
||||||
|
HELP: <login-auth>
|
||||||
|
{ $values { "username" string } { "password" string } { "login-auth" login-auth } }
|
||||||
|
{ $description "Creates a new " { $link login-auth } " instance." } ;
|
||||||
|
|
||||||
|
{ no-auth plain-auth login-auth } related-words
|
||||||
|
|
||||||
HELP: with-smtp-config
|
HELP: with-smtp-config
|
||||||
{ $values { "quot" quotation } }
|
{ $values { "quot" quotation } }
|
||||||
{ $description "Connects to an SMTP server using credentials and settings stored in " { $link smtp-config } " and calls the " { $link with-smtp-connection } " combinator." }
|
{ $description "Connects to an SMTP server using credentials and settings stored in " { $link smtp-config } " and calls the " { $link with-smtp-connection } " combinator." }
|
||||||
|
@ -84,7 +94,7 @@ HELP: send-email
|
||||||
|
|
||||||
ARTICLE: "smtp-gmail" "Setting up SMTP with gmail"
|
ARTICLE: "smtp-gmail" "Setting up SMTP with gmail"
|
||||||
"If you plan to send all email from the same address, then setting the config variable in the global namespace is the best option. The code example below does this approach and is meant to go in your " { $link ".factor-boot-rc" } "." $nl
|
"If you plan to send all email from the same address, then setting the config variable in the global namespace is the best option. The code example below does this approach and is meant to go in your " { $link ".factor-boot-rc" } "." $nl
|
||||||
"First, we set the login and password to a " { $link <plain-auth> } " tuple with our login. Next, we set the gmail server address with an " { $link <inet> } " object. Finally, we tell the SMTP library to use a secure connection."
|
"First, we set the login and password to a " { $link <login-auth> } " tuple with our login. Next, we set the gmail server address with an " { $link <inet> } " object. Finally, we tell the SMTP library to use a secure connection."
|
||||||
{ $notes
|
{ $notes
|
||||||
"Observed on 2016-03-02: Gmail has restrictions for what they consider \"less secure apps\" (these include the factor smtp client)."
|
"Observed on 2016-03-02: Gmail has restrictions for what they consider \"less secure apps\" (these include the factor smtp client)."
|
||||||
{ $list
|
{ $list
|
||||||
|
@ -99,7 +109,7 @@ ARTICLE: "smtp-gmail" "Setting up SMTP with gmail"
|
||||||
"default-smtp-config
|
"default-smtp-config
|
||||||
\"smtp.gmail.com\" 587 <inet> >>server
|
\"smtp.gmail.com\" 587 <inet> >>server
|
||||||
t >>tls?
|
t >>tls?
|
||||||
\"my.gmail.address@gmail.com\" \"qwertyuiasdfghjk\" <plain-auth> >>auth
|
\"my.gmail.address@gmail.com\" \"qwertyuiasdfghjk\" <login-auth> >>auth
|
||||||
\\ smtp-config set-global"
|
\\ smtp-config set-global"
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
@ -117,6 +127,7 @@ $nl
|
||||||
{ $subsections
|
{ $subsections
|
||||||
no-auth
|
no-auth
|
||||||
plain-auth
|
plain-auth
|
||||||
|
login-auth
|
||||||
}
|
}
|
||||||
"Constructing an e-mail:"
|
"Constructing an e-mail:"
|
||||||
{ $subsections
|
{ $subsections
|
||||||
|
|
|
@ -17,6 +17,9 @@ SINGLETON: no-auth
|
||||||
TUPLE: plain-auth username password ;
|
TUPLE: plain-auth username password ;
|
||||||
C: <plain-auth> plain-auth
|
C: <plain-auth> plain-auth
|
||||||
|
|
||||||
|
TUPLE: login-auth username password ;
|
||||||
|
C: <login-auth> login-auth
|
||||||
|
|
||||||
: <smtp-config> ( -- smtp-config )
|
: <smtp-config> ( -- smtp-config )
|
||||||
smtp-config new ; inline
|
smtp-config new ; inline
|
||||||
|
|
||||||
|
@ -129,7 +132,7 @@ ERROR: smtp-transaction-failed < smtp-error ;
|
||||||
|
|
||||||
: check-response ( response -- )
|
: check-response ( response -- )
|
||||||
dup code>> {
|
dup code>> {
|
||||||
{ [ dup { 220 235 250 221 354 } member? ] [ 2drop ] }
|
{ [ dup { 220 235 250 221 334 354 } member? ] [ 2drop ] }
|
||||||
{ [ dup 400 499 between? ] [ drop smtp-server-busy ] }
|
{ [ dup 400 499 between? ] [ drop smtp-server-busy ] }
|
||||||
{ [ dup 500 = ] [ drop smtp-syntax-error ] }
|
{ [ dup 500 = ] [ drop smtp-syntax-error ] }
|
||||||
{ [ dup 501 = ] [ drop smtp-command-not-implemented ] }
|
{ [ dup 501 = ] [ drop smtp-command-not-implemented ] }
|
||||||
|
@ -149,13 +152,21 @@ GENERIC: send-auth ( auth -- )
|
||||||
|
|
||||||
M: no-auth send-auth drop ;
|
M: no-auth send-auth drop ;
|
||||||
|
|
||||||
|
: >smtp-base64 ( str -- str' )
|
||||||
|
utf8 encode >base64 >string ;
|
||||||
|
|
||||||
: plain-auth-string ( username password -- string )
|
: plain-auth-string ( username password -- string )
|
||||||
[ "\0" prepend ] bi@ append utf8 encode >base64 >string ;
|
[ "\0" prepend ] bi@ append >smtp-base64 ;
|
||||||
|
|
||||||
M: plain-auth send-auth
|
M: plain-auth send-auth
|
||||||
[ username>> ] [ password>> ] bi plain-auth-string
|
[ username>> ] [ password>> ] bi plain-auth-string
|
||||||
"AUTH PLAIN " prepend command get-ok ;
|
"AUTH PLAIN " prepend command get-ok ;
|
||||||
|
|
||||||
|
M: login-auth send-auth
|
||||||
|
"AUTH LOGIN" command get-ok
|
||||||
|
[ username>> >smtp-base64 command get-ok ]
|
||||||
|
[ password>> >smtp-base64 command get-ok ] bi ;
|
||||||
|
|
||||||
: auth ( -- ) smtp-config get auth>> send-auth ;
|
: auth ( -- ) smtp-config get auth>> send-auth ;
|
||||||
|
|
||||||
: encode-header ( string -- string' )
|
: encode-header ( string -- string' )
|
||||||
|
@ -214,7 +225,10 @@ ERROR: invalid-header-string string ;
|
||||||
[
|
[
|
||||||
get-ok
|
get-ok
|
||||||
helo get-ok
|
helo get-ok
|
||||||
smtp-config get tls?>> [ start-tls get-ok send-secure-handshake ] when
|
smtp-config get tls?>> [
|
||||||
|
start-tls get-ok send-secure-handshake
|
||||||
|
helo get-ok
|
||||||
|
] when
|
||||||
auth
|
auth
|
||||||
dup from>> extract-email mail-from get-ok
|
dup from>> extract-email mail-from get-ok
|
||||||
dup to>> [ extract-email rcpt-to get-ok ] each
|
dup to>> [ extract-email rcpt-to get-ok ] each
|
||||||
|
|
Loading…
Reference in New Issue