POP3 v 1.5: an updated example

Q&A's, tips, howto's

POP3 v 1.5: an updated example

Postby CaveGuy » Thu Oct 24, 2002 10:08 pm

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 .....

<pre>
;; 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 "\r\n"))
(net-send socket 'sndbuff)
(if debug-flag (println "sent: " sndbuff) true)
(net-confirm-request)
(net-flush)

(set 'sndbuff (append "PASS " password "\r\n"))
(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 "STAT\r\n")
(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 "LAST\r\n")
(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 "\r\n.\r\n" 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) "\r\n"))
(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) "\r\n"))
(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 "QUIT\r\n")
(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
</pre>
Last edited by CaveGuy on Sat Oct 26, 2002 5:17 pm, edited 5 times in total.
Bob the Caveguy aka Lord High Fixer.
CaveGuy
 
Posts: 112
Joined: Sun Oct 13, 2002 3:00 pm
Location: Columbus Ohio

Postby Lutz » Fri Oct 25, 2002 12:35 am

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
 
Posts: 5279
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California

Postby Lutz » Sat Oct 26, 2002 6:33 pm

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


Lutz
Lutz
 
Posts: 5279
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California


Return to newLISP in the real world

Who is online

Users browsing this forum: No registered users and 1 guest

cron