email.rkt (2950B)
1 #lang racket/base 2 (require racket/format 3 net/head 4 net/smtp 5 net/sendmail 6 openssl 7 racket/tcp) 8 9 (provide send-email) 10 11 (define (send-email to-email get-opt 12 stamp 13 start-seconds end-seconds 14 failures) 15 (let ([server (get-opt '#:smtp-server #f)] 16 [from-email (or (get-opt '#:email-from #f) 17 (car to-email))] 18 [subject (~a "[build] " 19 (if (null? failures) 20 "success" 21 "FAILURE") 22 " " stamp)] 23 [message (append 24 (if (null? failures) 25 '("All builds succeeded.") 26 (cons 27 "The following builds failed:" 28 (for/list ([i (in-list failures)]) 29 (~a " " i)))) 30 (list 31 "" 32 (let ([e (- end-seconds start-seconds)] 33 [~d (lambda (n) 34 (~a n #:width 2 #:pad-string "0" #:align 'right))]) 35 (~a "Elapsed time: " 36 (~d (quotient e (* 60 60))) 37 ":" 38 (~d (modulo (quotient e (* 60)) 60)) 39 ":" 40 (~d (modulo e (* 60 60))))) 41 "" 42 (~a "Stamp: " stamp)))]) 43 (cond 44 [server 45 (let* ([smtp-connect (get-opt '#:smtp-connect 'plain)] 46 [port-no (get-opt '#:smtp-port 47 (case smtp-connect 48 [(plain) 25] 49 [(ssl) 465] 50 [(tls) 587]))]) 51 (smtp-send-message server 52 #:port-no port-no 53 #:tcp-connect (if (eq? 'ssl smtp-connect) 54 ssl-connect 55 tcp-connect) 56 #:tls-encode (and (eq? 'tls smtp-connect) 57 ports->ssl-ports) 58 #:auth-user (get-opt '#:smtp-user #f) 59 #:auth-passwd (get-opt '#:smtp-password #f) 60 from-email 61 to-email 62 (standard-message-header from-email 63 to-email 64 null 65 null 66 subject) 67 message))] 68 [else 69 (send-mail-message from-email 70 subject 71 to-email 72 null 73 null 74 message)])))