diff --git a/extra/logging/insomniac/insomniac-docs.factor b/extra/logging/insomniac/insomniac-docs.factor index 93485e4c7c..7529c3ba63 100755 --- a/extra/logging/insomniac/insomniac-docs.factor +++ b/extra/logging/insomniac/insomniac-docs.factor @@ -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:" diff --git a/extra/logging/insomniac/insomniac.factor b/extra/logging/insomniac/insomniac.factor index dfd7f430d2..c7d1faf42e 100755 --- a/extra/logging/insomniac/insomniac.factor +++ b/extra/logging/insomniac/insomniac.factor @@ -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 [ - - swap >>body - insomniac-recipients get >>to - insomniac-sender get >>from - swap email-subject >>subject - send - ] [ 2drop ] if - ] with-insomniac-smtp ; + dupd ?analyze-log dup [ + + 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 diff --git a/extra/smtp/server/server.factor b/extra/smtp/server/server.factor index 92b605e91c..14957ceca2 100755 --- a/extra/smtp/server/server.factor +++ b/extra/smtp/server/server.factor @@ -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 ascii [ accept [ diff --git a/extra/smtp/smtp-tests.factor b/extra/smtp/smtp-tests.factor index 76ceaceea4..a705a9609e 100755 --- a/extra/smtp/smtp-tests.factor +++ b/extra/smtp/smtp-tests.factor @@ -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 smtp-server set "Hi guys\nBye guys" >>body @@ -77,6 +76,6 @@ IN: smtp.tests "Ed " } >>to "Doug " >>from - send + send-email ] with-scope ] unit-test diff --git a/extra/smtp/smtp.factor b/extra/smtp/smtp.factor index b23d5e3798..a941b14a47 100755 --- a/extra/smtp/smtp.factor +++ b/extra/smtp/smtp.factor @@ -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 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 - ascii [ + smtp-server get + dup log-smtp-connection + ascii [ 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