distro-build/distro-build-server/email.rkt
2014-11-29 14:21:41 -05:00

75 lines
2.9 KiB
Racket

#lang racket/base
(require racket/format
net/head
net/smtp
net/sendmail
openssl
racket/tcp)
(provide send-email)
(define (send-email to-email get-opt
stamp
start-seconds end-seconds
failures)
(let ([server (get-opt '#:smtp-server #f)]
[from-email (or (get-opt '#:email-from #f)
(car to-email))]
[subject (~a "[build] "
(if (null? failures)
"success"
"FAILURE")
" " stamp)]
[message (append
(if (null? failures)
'("All builds succeeded.")
(cons
"The following builds failed:"
(for/list ([i (in-list failures)])
(~a " " i))))
(list
""
(let ([e (- end-seconds start-seconds)]
[~d (lambda (n)
(~a n #:width 2 #:pad-string "0" #:align 'right))])
(~a "Elapsed time: "
(~d (quotient e (* 60 60)))
":"
(~d (modulo (quotient e (* 60)) 60))
":"
(~d (modulo e (* 60 60)))))
""
(~a "Stamp: " stamp)))])
(cond
[server
(let* ([smtp-connect (get-opt '#:smtp-connect 'plain)]
[port-no (get-opt '#:smtp-port
(case smtp-connect
[(plain) 25]
[(ssl) 465]
[(tls) 587]))])
(smtp-send-message server
#:port-no port-no
#:tcp-connect (if (eq? 'ssl smtp-connect)
ssl-connect
tcp-connect)
#:tls-encode (and (eq? 'tls smtp-connect)
ports->ssl-ports)
#:auth-user (get-opt '#:smtp-user #f)
#:auth-passwd (get-opt '#:smtp-password #f)
from-email
to-email
(standard-message-header from-email
to-email
null
null
subject)
message))]
[else
(send-mail-message from-email
subject
to-email
null
null
message)])))