POP3 v 1.5: an updated example

[CaveGuy]

v 1.5: Fixes a missing  'mail-dir reference in both the (get-all-mail and (get-new-mail functions.



The (get-messagesfunction  now attempts to make 'mail-dir, if not found.



Changeing the message file type to ".pop3" now reflects the context it was created by. (CaveGuy).



Previously, I modified the filename generator to use the first SMTP or ESMTP ID to be found in the message header. and changed the prefix from "new" to "ME-"  ME stands for the Mail Editor, the application context that will use/process these files.



I like this ability to edit and update forum based examples.



How do I keep the code format intact ?

as you can see pre causes double spaceing :(



Are the interested parties notified every time I make

an edit, or only when I post a reply ?



Well here it is .....

;; pop3.lsp - subsrotuines for mail retrieval

;;

;;  USAGE:

;;

;;  ;; include the pop3 module

;;  (load "/usr/share/newlisp/pop3.lsp")

;;

;;  (POP3:get-all-mail "user" "password" "pop.my-isp.com" "messages/")

;;

;;  loads down all messages and puts them in a directory "messages/"

;;  

;;

;;  (POP3:get-new-mail "user" "" "pop.my-isp.com" "messages/")

;;

;;  loads down only new messages

;;

;;

;;  (POP3:get-mail-status "user" "password" "pop.my-isp.com")

;;

;;  gets a list of status numbers (totalMessages, totalBytes, lastRead)

;;

;;

;;  (POP3:get-error-text)

;;

;;  gets error message for failed all/new/status function

;;

;;

;; v 1.1: replaced all 'concat' with 'append', 'debug' renamed to 'debug-flag'

;; v 1.2: replaces # with ;; for comments

;; v 1.3: better error reporting when (set 'debug-flag true)

;; v 1.4: Modified message file name generation to assure uniqueness in 

;;        (get-all-messages [CaveGuy].

;; v 1.5: Fixed 'mail-dir reference in (get-all-mail and (get-new-mail functions

;;        (get-messages now attempts to makes 'mail-dir, if not found.

;;        also changed the message file type to ".pop3" to reflect the context

;;        it was created by. (CaveGuy).

;;



(context 'POP3)



(set 'debug-flag nil)



(define (get-all-mail userName password pop3server mail-dir)

    (and 

        (connect pop3server)

        (logon userName password)

        (set 'status (get-status))

        (set 'no-msgs (nth 2 status))

        (if (> no-msgs 0)

          (get-messages 1 no-msgs mail-dir)

          true)

        (log-off)))



(define (get-new-mail userName password pop3server mail-dir)

    (and 

        (connect pop3server)

        (logon userName password)

        (set 'status (get-status))

        (if (not (= (first status) (nth 2 status)))

          (get-messages (+ (first status) 1) (nth 2 status) mail-dir)

          true)

        (log-off)))



(define (get-mail-status userName password pop3server)

    (and 

        (connect pop3server)

        (logon userName password)

        (set 'status (get-status))

        (log-off)

        status))



(define (delete-old-mail userName password pop3server)

    (and

        (connect pop3server)

        (logon userName password)

        (set 'status (get-status))

        (if (> (first status) 0)

            (for (msg 1 (first status)) (delete-message msg))

            true)

        (log-off)

        (first status)))



;; receive request answer and verify

;;

(define (net-confirm-request)

    (if (net-receive socket 'rcvbuff 512 "+OK")

        (begin

       (if debug-flag (println rcvbuff))

            (if (find "-ERR" rcvbuff) 

                (finish rcvbuff)

                true))

        nil))



(define (net-flush)

   (if socket

      (while (> (net-peek socket) 0) 

         (net-receive socket 'junk 256)

         (if debug-flag (println junk) )))

   true)



;; connect to server

;;

(define (connect server)

    (set 'socket (net-connect pop3server 110))

    (if (and debug-flag socket) (println "connected on: " socket) )

    (if (and socket (net-confirm-request))

        (net-flush)

        (finish "could not connect")))



;;

(define (logon userName password)

    (and

        (set 'sndbuff (append "USER " userName "rn"))

        (net-send socket 'sndbuff)

   (if debug-flag (println "sent: " sndbuff) true)

        (net-confirm-request)

        (net-flush)



        (set 'sndbuff (append "PASS " password "rn"))

        (net-send socket 'sndbuff)

   (if debug-flag (println "sent: " sndbuff) true)

        (net-confirm-request)

        (net-flush)

        (if debug-flag (println "logon sucessful") true)))





;; get status and last read

;;

(define (get-status)

    (and

        (set 'sndbuff "STATrn")

        (net-send socket 'sndbuff)

   (if debug-flag (println "sent: " sndbuff) true)

        (net-confirm-request)

        (net-receive socket 'status 256)

   (if debug-flag (println "status: " status) true)

        (net-flush)

        (set 'sndbuff "LASTrn")

        (net-send socket 'sndbuff)

   (if debug-flag (println "sent: " sndbuff) true)

        (net-confirm-request)

        (net-receive socket 'last-read 256)

   (if debug-flag (println "last read: " last-read) true)

        (net-flush)

        (set 'result (list (integer (first (parse status)))))

   (if debug-flag (println "parsed status: " result) true)

        (push (integer (nth 1 (parse status))) result)

        (push (integer (first (parse last-read))) result)

        result))





;; get a message

;;

(define (retrieve-message , message)

   (set 'finished nil)

   (set 'message "")

   (while (not finished)

      (net-receive socket 'rcvbuff 16384)

      (set 'message (append message rcvbuff))

      (if (find "rn.rn" message) (set 'finished true)))

   (if debug-flag (println "received message") true)

   message)





;; get all messages

;;

;; v 1.4: modified file name generation to improve uniqueness. (CaveGuy)

;;        file name now created using last SMTP or ESMTP ID from header.

;; v 1.5: changed file type to ".pop3" to reflect the context that created it.

;;        (get-messages now forces the directory, if it does not exsist.

;; 

(define (get-messages from to mail-dir)

   (if (if (not (directory? mail-dir)) (make-dir mail-dir) true)

       (begin

          (if (not (ends-with mail-dir "/")) (set 'mail-dir (append mail-dir "/")))

          (for (msg from to)

               (if debug-flag (println "getting message " msg) true)

          (set 'sndbuff (append "RETR " (string msg) "rn"))

          (net-send socket 'sndbuff)

          (if debug-flag (println "sent: " sndbuff) true)

          (set 'message (retrieve-message))

               (if debug-flag (println (slice message 1 200)) true)

               (set 'istr (get-message-id message))

          (set 'istr (append mail-dir "ME-" istr))         

               (if debug-flag (println "saving " istr) true)

               (write-file istr message)

               (if (not (rename-file istr (append istr ".pop3")))

              (delete-file istr))))) )



;; delete messages

;;

(define (delete-message msg)

    (and

        (set 'sndbuff (append "DELE " (string msg) "rn"))

        (net-send socket 'sndbuff)

   (if debug-flag (println "sent: " sndbuff) true)

        (net-confirm-request)))



;; get-message-date was

;; changed to get-message-id

;; v 1.4: CaveGuy



(define (get-message-id message)

    (set 'ipos (+ (find "id <| id |tid " message 1) 5)

    'iend (find "@|;|n|r| |t" (slice message ipos) 1))

    (if debug-flag 

   (print "Message ID: " (slice message ipos iend) "n"))

    (set 'istr (slice message ipos iend)) )





;; log off

;;

(define (log-off)

    (set 'sndbuff "QUITrn")

    (net-send socket 'sndbuff)

    (if debug-flag (println "sent: " sndbuff) true)

    (net-receive socket 'rcvbuff 256)

    (if debug-flag (println rcvbuff) true)

    true)



;; report error and finish

;;

(define (finish message)

    (if (ends-with message "+OK")

      (set 'message (chop message 3)))

    ;(print "<h3>" message "</h3>")

    (set 'mail-error-text message)

    (if debug-flag (println "ERROR: " message) true)

    (if socket (net-flush))

    (if socket (log-off))

    nil)



(define (get-error-text) mail-error-text)



(context 'MAIN)





;; testing

;; make sure the directory 'mail/' or wherever you want your mail

;; does exist.

;;

;(if (not(POP3:get-all-mail "myid" "mypass" "mail.myisp.com" "mail/"))

;    (print (POP3:get-error-text)) true)



;(POP3:get-new-mail "myid" "mypass" "mail.myisp.com" "mail/")

;(print (POP3:get-mail-status "myid" "mypass" "mail.myisp.com"))

;(exit)



;; eof

[Lutz]

I posted earlier newLISP 7.0.0 in the development directory, which also contains changes to pop3.lsp, but I will merge your changes probably tomorrow into  a 7.0.1. Thanks a lot for this contribution!



Lutz

[Lutz]

Thanks for the pop3.lsp update, I will merge changes/addtions in the next  development version.





Lutz