modules/smtp.lsp

   1 ;; @module smtp.lsp
   2 ;; @description Routines for sending mail using SMPT protocol
   3 ;; @version 1.8 - comments redone for automatic documentation
   4 ;; @author Lutz Mueller 2001
   5 ;;
   6 ;; <h2>Routines for sending mail</h2>
   7 ;; This module implements routines to communicate with a SMTP mail server
   8 ;; for sending email. To use this module include the following 'load' statement
   9 ;; at the beginning of the program file:
  10 ;; <pre>
  11 ;; (load "/usr/share/newlisp/modules/smtp.lsp")
  12 ;; </pre>
  13
  14 ;; @syntax (SMTP:send-mail <str-from> <str-to> <str-subject> <str-message> <str-server>)
  15 ;; @param <str-from> The email address of the sender.
  16 ;; @param <str-to> The email address of the recipient.
  17 ;; @param <str-subject> The subject line of the email.
  18 ;; @param <str-message> The message part of the email.
  19 ;; @param <str-server> The address of the SMTP server.
  20 ;; @return On success 'true', on failure 'nil'.
  21 ;; In case the function fails returning 'nil', the function
  22 ;; 'SMTP:get-error-text' can be used to receive the error text.
  23 ;;
  24 ;; @example
  25 ;;
  26 ;; (SMTP:send-mail "jdoe@asite.com" "somebody@isp.com" "Greetings"
  27 ;;                   "How are you today? - john doe -" "smtp.asite.com")
  28
  29 ;; Will send mail:
  30 ;; <pre>
  31 ;;  from address: jdoe@asite.com
  32 ;;    to address: somebody@isp.com
  33 ;;  subject line: Greetings
  34 ;;  message body: Hoe are you today? - john doe-
  35 ;;     smtp host: smtp.asite.com
  36 ;; </pre>
  37
  38 ;; @syntax (SMTP:get-error-text)
  39 ;; @return The text of the last error occured.
  40
  41 (context 'SMTP)
  42
  43 (set 'debug-flag nil)
  44
  45 ; this is the main function to use
  46 ;
  47 ;  USAGE:
  48 ;
  49
  50 (define (send-mail mail-from mail-to mail-subject mail-body SMTP-server)
  51     (and
  52         (set 'from-hostname (nth 1 (parse mail-from "@")))
  53         (set 'socket (net-connect SMTP-server 25))
  54         (confirm-request "2")
  55         (net-send-get-result (append "HELO " from-hostname) "2")
  56         (net-send-get-result (append "MAIL FROM: <" mail-from ">") "2")
  57         (net-send-get-result (append "RCPT TO: <" mail-to ">") "2")
  58         (net-send-get-result "DATA" "3")
  59         (mail-send-header)
  60         (mail-send-body)
  61         (confirm-request "2")
  62         (net-send-get-result "QUIT" "2")
  63         (or (net-close socket) true)))
  64
  65 (define (confirm-request conf)
  66     (net-receive socket 'recvbuff 256 "\r\n")
  67     (if debug-flag (println recvbuff) true)
  68         ; Empty out pipe. According to SMTP spec, last line has valid code.
  69         ; added for 1.8 for newLISP 9.2.0
  70         (while (< 0 (net-peek socket))
  71                 (net-receive socket 'recvbuff 256 "\r\n")
  72                 (if debug-flag (println recvbuff)))
  73         (starts-with recvbuff conf))
  74
  75 (define (net-send-get-result str conf)
  76    (set 'send-str (append str "\r\n"))
  77    (if debug-flag (println "sent: " send-str))
  78    (net-send socket 'send-str)
  79    (if conf (confirm-request conf) true))
  80
  81 (define (mail-send-header)
  82     (net-send-get-result (append "TO: " mail-to))
  83     (net-send-get-result (append "FROM: " mail-from))
  84     (net-send-get-result (append "SUBJECT: " mail-subject))
  85     (net-send-get-result (append "X-Mailer: newLISP v." (string (nth -2 (sys-info))))))
  86
  87 (define (mail-send-body )
  88     (net-send-get-result "")
  89     (dolist (lne (parse mail-body "\r\n"))
  90         (if (= lne ".")
  91             (net-send-get-result "..")
  92             (net-send-get-result lne)))
  93     (net-send-get-result "."))
  94
  95 (define (get-error-text)
  96     recvbuff)
  97
  98 (context 'MAIN)
  99
 100 ; eof