SMTP authorization
Posted: Fri Aug 11, 2006 5:17 pm
The current newLISP SMTP module doesn't support any authorization - I tried to use it today, and I haven't got any accounts that work OK with it. Is it easy to add the necessary stuff?
Friends and Fans of newLISP
http://www.newlispfanclub.alh.net/forum/
http://www.newlispfanclub.alh.net/forum/viewtopic.php?f=5&t=1286
Code: Select all
220 anchor-post-30.mail.med.net ESMTP Fri, 11 Aug 2006 20:31:42 +0000
sent: HELO frangipane.med.com
250 anchor-post-30.mail.med.net Hello dyn-26-45-23-135.dslaccess.com [26.45.23.135]
sent: MAIL FROM: <postmaster@frangipane.med.com>
250 OK
sent: RCPT TO: <postmaster@frangipane.med.com>
550 SMTP AUTH required from 26.45.23.135
Code: Select all
;; @module smtp.lsp
;; @version 1.7 - comments redone for automatic documentation
;; @version 1.8 - 2006-10-08 cormullion: first attempt at implementing AUTH PLAIN authentication
;; @author Lutz Mueller 2001
;;
;; <h2>Routines for sending mail</h2>
;; 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:
;; <pre>
;; (load "/usr/share/newlisp/smtp.lsp")
;; </pre>
;; To see debugging information:
;; <pre>(set 'debug-flag true)</pre>
(context 'SMTP)
(set 'debug-flag nil)
;; @syntax (SMTP:send-mail <str> <str> <str> <str> <str> <str> <str>)
;; @param <str> the email address of the sender
;; @param <str> the email address of the recipient
;; @param <str> the subject line of the email
;; @param <str> the message part of the email
;; @param <str> the address of the SMTP server
;; @param <user> (optional) the user name for authentication
;; @param <password> (optional unless user-name supplied) the 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:
;; <pre>
;; From: jdoe@asite.com
;; To: somebody@isp.com
;; Subject: Greetings
;; Message: How are you today? - John Doe -
;; </pre>
(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")
(if (and user-name password)
(mail-authorize user-name password))
(net-send-get-result (append "HELO " from-hostname) "2")
(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)
(and
(net-receive socket 'recvbuff 256 "\r\n")
(if debug-flag (println recvbuff) true)
; remember responses
(push recvbuff responses -1)
(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)
; find out what server does
(and
(net-send-get-result (append "EHLO " from-hostname) "2")
(while (net-select socket "read" 500)
(confirm-request "250"))
(find "250-AUTH PLAIN" (join responses ))
(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 (= lne ".")
(net-send-get-result "..")
(net-send-get-result lne)))
(net-send-get-result "."))
;; @syntax (SMTP:get-error-text)
;; @return The text of the last error occurred.
(define (get-error-text)
recvbuff)
(context 'MAIN)
; eof