Rename smtp:send to smtp:send-email, simplify insomniac config
Slava Pestov
parent
9565a04e74
commit
2c1e1d9a94
|
|
@ -2,12 +2,6 @@ USING: help.markup help.syntax assocs strings logging
|
|||
logging.analysis smtp ;
|
||||
IN: logging.insomniac
|
||||
|
||||
HELP: insomniac-smtp-host
|
||||
{ $var-description "An SMTP server to use for e-mailing log reports. If not set, the value of " { $link smtp-host } " is used." } ;
|
||||
|
||||
HELP: insomniac-smtp-port
|
||||
{ $var-description "An SMTP server port to use for e-mailing log reports. If not set, the value of " { $link smtp-port } " is used." } ;
|
||||
|
||||
HELP: insomniac-sender
|
||||
{ $var-description "The originating e-mail address for mailing log reports. Must be set before " { $vocab-link "logging.insomniac" } " is used." } ;
|
||||
|
||||
|
|
@ -21,7 +15,7 @@ HELP: ?analyze-log
|
|||
|
||||
HELP: email-log-report
|
||||
{ $values { "service" "a log service name" } { "word-names" "a sequence of strings" } }
|
||||
{ $description "E-mails a log report for the given log service. The " { $link insomniac-smtp-host } ", " { $link insomniac-sender } " and " { $link insomniac-recipients } " parameters must be set up first. The " { $snippet "word-names" } " parameter is documented in " { $link analyze-entries } "." } ;
|
||||
{ $description "E-mails a log report for the given log service. The " { $link insomniac-sender } " and " { $link insomniac-recipients } " parameters must be set up first. The " { $snippet "word-names" } " parameter is documented in " { $link analyze-entries } "." } ;
|
||||
|
||||
HELP: schedule-insomniac
|
||||
{ $values { "alist" "a sequence of pairs of shape " { $snippet "{ service word-names }" } } }
|
||||
|
|
@ -33,9 +27,6 @@ $nl
|
|||
"Required configuration parameters:"
|
||||
{ $subsection insomniac-sender }
|
||||
{ $subsection insomniac-recipients }
|
||||
"Optional configuration parameters:"
|
||||
{ $subsection insomniac-smtp-host }
|
||||
{ $subsection insomniac-smtp-port }
|
||||
"E-mailing a one-off report:"
|
||||
{ $subsection email-log-report }
|
||||
"E-mailing reports and rotating logs on a daily basis:"
|
||||
|
|
|
|||
|
|
@ -6,8 +6,6 @@ io.encodings.utf8 accessors calendar qualified ;
|
|||
QUALIFIED: io.sockets
|
||||
IN: logging.insomniac
|
||||
|
||||
SYMBOL: insomniac-smtp-host
|
||||
SYMBOL: insomniac-smtp-port
|
||||
SYMBOL: insomniac-sender
|
||||
SYMBOL: insomniac-recipients
|
||||
|
||||
|
|
@ -18,29 +16,20 @@ SYMBOL: insomniac-recipients
|
|||
r> 2drop f
|
||||
] if ;
|
||||
|
||||
: with-insomniac-smtp ( quot -- )
|
||||
[
|
||||
insomniac-smtp-host get [ smtp-host set ] when*
|
||||
insomniac-smtp-port get [ smtp-port set ] when*
|
||||
call
|
||||
] with-scope ; inline
|
||||
|
||||
: email-subject ( service -- string )
|
||||
[
|
||||
"[INSOMNIAC] " % % " on " % io.sockets:host-name %
|
||||
] "" make ;
|
||||
|
||||
: (email-log-report) ( service word-names -- )
|
||||
[
|
||||
dupd ?analyze-log dup [
|
||||
<email>
|
||||
swap >>body
|
||||
insomniac-recipients get >>to
|
||||
insomniac-sender get >>from
|
||||
swap email-subject >>subject
|
||||
send
|
||||
] [ 2drop ] if
|
||||
] with-insomniac-smtp ;
|
||||
dupd ?analyze-log dup [
|
||||
<email>
|
||||
swap >>body
|
||||
insomniac-recipients get >>to
|
||||
insomniac-sender get >>from
|
||||
swap email-subject >>subject
|
||||
send-email
|
||||
] [ 2drop ] if ;
|
||||
|
||||
\ (email-log-report) NOTICE add-error-logging
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ IN: smtp.server
|
|||
|
||||
! Mock SMTP server for testing purposes.
|
||||
|
||||
! Usage: 4321 smtp-server
|
||||
! Usage: 4321 mock-smtp-server
|
||||
! $ telnet 127.0.0.1 4321
|
||||
! Trying 127.0.0.1...
|
||||
! Connected to localhost.
|
||||
|
|
@ -61,7 +61,7 @@ SYMBOL: data-mode
|
|||
] }
|
||||
} cond nip [ process ] when ;
|
||||
|
||||
: smtp-server ( port -- )
|
||||
: mock-smtp-server ( port -- )
|
||||
"Starting SMTP server on port " write dup . flush
|
||||
"127.0.0.1" swap <inet4> ascii <server> [
|
||||
accept [
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: smtp tools.test io.streams.string threads
|
||||
USING: smtp tools.test io.streams.string io.sockets threads
|
||||
smtp.server kernel sequences namespaces logging accessors
|
||||
assocs sorting ;
|
||||
IN: smtp.tests
|
||||
|
|
@ -62,12 +62,11 @@ IN: smtp.tests
|
|||
rot from>>
|
||||
] unit-test
|
||||
|
||||
[ ] [ [ 4321 smtp-server ] in-thread ] unit-test
|
||||
[ ] [ [ 4321 mock-smtp-server ] in-thread ] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
"localhost" smtp-host set
|
||||
4321 smtp-port set
|
||||
"localhost" 4321 <inet> smtp-server set
|
||||
|
||||
<email>
|
||||
"Hi guys\nBye guys" >>body
|
||||
|
|
@ -77,6 +76,6 @@ IN: smtp.tests
|
|||
"Ed <dharmatech@factorcode.org>"
|
||||
} >>to
|
||||
"Doug <erg@factorcode.org>" >>from
|
||||
send
|
||||
send-email
|
||||
] with-scope
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -8,19 +8,16 @@ calendar.format new-slots accessors ;
|
|||
IN: smtp
|
||||
|
||||
SYMBOL: smtp-domain
|
||||
SYMBOL: smtp-host "localhost" smtp-host set-global
|
||||
SYMBOL: smtp-port 25 smtp-port set-global
|
||||
SYMBOL: smtp-server "localhost" 25 <inet> smtp-server set-global
|
||||
SYMBOL: read-timeout 1 minutes read-timeout set-global
|
||||
SYMBOL: esmtp t esmtp set-global
|
||||
|
||||
: log-smtp-connection ( host port -- ) 2drop ;
|
||||
|
||||
\ log-smtp-connection NOTICE add-input-logging
|
||||
LOG: log-smtp-connection NOTICE ( addrspec -- )
|
||||
|
||||
: with-smtp-connection ( quot -- )
|
||||
smtp-host get smtp-port get
|
||||
2dup log-smtp-connection
|
||||
<inet> ascii <client> [
|
||||
smtp-server get
|
||||
dup log-smtp-connection
|
||||
ascii <client> [
|
||||
smtp-domain [ host-name or ] change
|
||||
read-timeout get stdio get set-timeout
|
||||
call
|
||||
|
|
@ -33,8 +30,8 @@ SYMBOL: esmtp t esmtp set-global
|
|||
|
||||
: validate-address ( string -- string' )
|
||||
#! Make sure we send funky stuff to the server by accident.
|
||||
dup [ "\r\n>" member? ] contains?
|
||||
[ "Bad e-mail address: " swap append throw ] when ;
|
||||
dup "\r\n>" seq-intersect empty?
|
||||
[ "Bad e-mail address: " swap append throw ] unless ;
|
||||
|
||||
: mail-from ( fromaddr -- )
|
||||
"MAIL FROM:<" write validate-address write ">" write crlf ;
|
||||
|
|
@ -91,8 +88,8 @@ LOG: smtp-response DEBUG
|
|||
: get-ok ( -- ) flush receive-response check-response ;
|
||||
|
||||
: validate-header ( string -- string' )
|
||||
dup [ "\r\n" member? ] contains?
|
||||
[ "Invalid header string: " swap append throw ] when ;
|
||||
dup "\r\n" seq-intersect empty?
|
||||
[ "Invalid header string: " swap append throw ] unless ;
|
||||
|
||||
: write-header ( key value -- )
|
||||
swap
|
||||
|
|
@ -153,7 +150,7 @@ M: email clone
|
|||
email construct-empty
|
||||
H{ } clone >>headers ;
|
||||
|
||||
: send ( email -- )
|
||||
: send-email ( email -- )
|
||||
prepare (send) ;
|
||||
|
||||
! Dirk's old AUTH CRAM-MD5 code. I don't know anything about
|
||||
|
|
|
|||
Loading…
Reference in New Issue