You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

69 lines
2.3 KiB

#! /usr/bin/env slope
;;; Simple SMTP mail sender
(define EMAIL-host (hostname))
(define EMAIL-sender "")
(define EMAIL-Recipient "")
(define EMAIL-Message "")
(define EMAIL-Subject "")
(define EMAIL-set-recipient (lambda (name)
(if (string? name)
(set! EMAIL-Recipient (string-trim-space name))
(! "'EMAIL-set-recipient' expected a string. A non-string value was given"))))
(define EMAIL-set-sender (lambda (name)
(set! EMAIL-sender (string-append name "@" EMAIL-host))))
(define EMAIL-set-subject (lambda (sub)
(if (string? sub)
(set! EMAIL-Subject sub)
(! "'EMAIL-set-subject' expected a string. A non-string value was given"))))
(define EMAIL-set-message (lambda (message)
((string? message) (set! EMAIL-Message (string-append EMAIL-Message message "\n")))
((and (io-handle? message) (~bool message)) (set! EMAIL-Message (read-all message)))
(else (! "'EMAIL-set-message' expected a string or IOHandle. A non-valid value was given")))))
(define EMAIL-send (lambda ()
(define Smtp (net-conn EMAIL-host "25"))
(write (string-append "HELO " EMAIL-host "\r\n") Smtp)
(write (string-append "MAIL FROM: <" EMAIL-sender ">\r\n") Smtp)
(write (string-append "RCPT TO: <" EMAIL-Recipient ">\r\n") Smtp)
(write "DATA\r\n" Smtp)
(write (string-format "From: <%v>\r\n" EMAIL-sender) Smtp)
(write (string-format "To: <%v>\r\n" EMAIL-Recipient) Smtp)
(write (string-format "Subject: %v\r\n\r\n" EMAIL-Subject) Smtp)
(for-each (lambda (line) (write (string-append line "\r\n") Smtp)) (string->list EMAIL-Message "\n"))
(write "\r\n.\r\n" Smtp)
(close Smtp)))
(define EMAIL-query-user (lambda (txt allow-blanks)
(display txt)
(define val (read-line))
(if allow-blanks
(if (~bool val)
(display "This field cannot be empty\n")
(EMAIL-query-user txt allow-blanks))))))
(define EMAIL-build-message (lambda ()
(define in (EMAIL-query-user "msg> " #t))
(EMAIL-set-message in)
(if (equal? in ".")
(define EMAIL-main (lambda ()
(EMAIL-set-sender (env "USER"))
(EMAIL-set-recipient (EMAIL-query-user "To: " #f))
(EMAIL-set-subject (EMAIL-query-user "Subject: " #f))
(display "Enter message one line at a time. Enter a .\nas the only thing on its line to send. ^C to cancel.\n")