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