;; @module smtp.lsp ;; @description Send mail using SMTP protocol ;; @version 2.0 - March 2008, Cormullion added AUTH PLAIN authentication ;; @version 2.1 - changes for 10.0 ;; @version 2.2 - doc changes ;; @version 2.3 - fix in mail-send-body, thanks to Alessandro ;; @version 2.31 - removed spurious apostrophe ;; @author Lutz Mueller 2001-2010, Cormullion 2008 ;;

Routines for sending mail

;; This module implements routines to communicate with a SMTP mail server ;; for sending email. To use this module include the following 'load' statement ;; at the beginning of the program file: ;;
 
;; (load "/usr/share/newlisp/modules/smtp.lsp") 
;; ; or shorter
;; (module "smtp.lsp")
;; 
;; To see debugging information:

;; (set 'debug-flag true) (context 'SMTP) (set 'debug-flag nil) ;; @syntax (SMTP:send-mail i [ str-pass>]]) ;; @param The email address of the sender. ;; @param The email address of the recipient. ;; @param The subject line of the email. ;; @param The message part of the email. ;; @param The address of the SMTP server. ;; @param Optional user name for authentication. ;; @param Optional password for authentication. ;; @return On success 'true', on failure 'nil'. ;; In case the function fails returning 'nil', the function ;; 'SMTP:get-error-text' can be used to receive the error text. ;; ;; @example ;;(SMTP:send-mail "jdoe@asite.com" "somebody@isp.com" "Greetings" ;; "How are you today? - john doe -" "smtp.asite.com" "jdoe" "secret") ;; This logs in to the server, tries to authenticate using the username 'jdoe' and password 'secret' (if supplied), ;; and sends an email with the format: ;;
 
;;  From:    jdoe@asite.com 
;;  To:      somebody@isp.com 
;;  Subject: Greetings 
;;  Message: How are you today? - John Doe - 
;; 
(context 'SMTP) (set 'debug-flag nil) (define (send-mail mail-from mail-to mail-subject mail-body SMTP-server (user-name "") (password "")) (and (set 'from-hostname (nth 1 (parse mail-from "@"))) (set 'socket (net-connect SMTP-server 25)) (confirm-request "2") (net-send-get-result (append "HELO " from-hostname) "2") (unless (and (empty? user-name) (empty? password)) (mail-authorize user-name password) true) (net-send-get-result (append "MAIL FROM: <" mail-from ">") "2") (net-send-get-result (append "RCPT TO: <" mail-to ">") "2") (net-send-get-result "DATA" "3") (mail-send-header) (mail-send-body) (confirm-request "2") (net-send-get-result "QUIT" "2") (or (net-close socket) true))) (define (confirm-request conf) (net-receive socket recvbuff 256 "\r\n") (if debug-flag (println recvbuff) true) ; Empty out pipe. According to SMTP spec, last line has valid code. ; added for 1.8 for newLISP 9.2.0 (while (< 0 (net-peek socket)) (net-receive socket recvbuff 256 "\r\n") (if debug-flag (println recvbuff))) (starts-with recvbuff conf)) (define (net-send-get-result str conf) (set 'send-str (append str "\r\n")) (if debug-flag (println "sent: " send-str)) (net-send socket send-str) (if conf (confirm-request conf) true)) (define (mail-authorize user-name password) (net-send-get-result (append "AUTH PLAIN " (base64-enc (append "\000" user-name "\000" password))) "235")) (define (mail-send-header) (net-send-get-result (append "TO: " mail-to)) (net-send-get-result (append "FROM: " mail-from)) (net-send-get-result (append "SUBJECT: " mail-subject)) (net-send-get-result (append "X-Mailer: newLISP v." (string (nth -2 (sys-info)))))) (define (mail-send-body ) (net-send-get-result "") (dolist (lne (parse mail-body "\r\n")) (if (starts-with lne ".") (net-send-get-result (append "." lne)) (net-send-get-result lne))) (net-send-get-result ".")) (define (get-error-text) recvbuff) (context 'MAIN) ; test ; (set 'SMTP:debug-flag true) ; (SMTP:send-mail ; "from@example.com" ; "to@example.com" ; "title" ; "body" ; "smtp.example.com" ; "user.name" ; "password")) ; eof