forked from slope-lang/slope
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
Plaintext
69 lines
2.3 KiB
Plaintext
#! /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)
|
|
(cond
|
|
((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
|
|
val
|
|
(if (~bool val)
|
|
val
|
|
(begin
|
|
(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 ".")
|
|
#f
|
|
(EMAIL-build-message))))
|
|
|
|
(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")
|
|
(EMAIL-build-message)
|
|
(EMAIL-send)))
|
|
|
|
(EMAIL-main)
|