;; @module pop3.lsp
;; @description POP3 mail retrieval routines
;; @version 1.9 - comments redone for automatic documentation
;; @author Lutz Mueller et al., 2001, 2002
;;
;; <h2>POP3 mail retrieval routines</h2>
;;
;; Only the module 'pop3.lsp' is required, not other libraries need to be
;; present. Not all mailservers support all functions.
;;
;; To use the module put a 'load' statement at the top of your file:
;; <pre>
;; (load "/usr/local/share/newlisp/pop3.lsp")
;; </pre>
;;
;; <h2>Function overview</h2>
;; Load down all messages and put them in a directory 'messages/':
;; <pre>
;; (POP3:get-all-mail "user" "password" "pop.my-isp.com" "messages/")
;; </pre>
;;  
;; Load down only new messages:
;; <pre>
;; (POP3:get-new-mail "user" "password" "pop.my-isp.com" "messages/")
;; </pre>
;;
;; Delete messages, which have not been read:
;; <pre>
;; (POP3:delete-old-mail "user" "password" "pop.my-isp.com")
;; </pre>
;;
;; Delete all messages:
;; <pre>
;; (POP3:delete-all-mail "user" "password" "pop.my-isp.com")
;; </pre>
;;
;; Get a list of status numbers '(<totalMessages>, <totalBytes>, <lastRead>)':
;; <pre>
;; (POP3:get-mail-status "user" "password" "pop.my-isp.com")
;; </pre>
;;
;; Get error message for failed all/new/status function:
;; <pre>
;; (POP3:get-error-text)
;; </pre>
;; All functions return 'nil' on error and 'POP3:get-error-text' can be used to
;; retrieve the error text. 
;;
;; The variable 'POP3:debug-flag' can be set to 'true' to display all of the
;; dialog with the pop2 mail server.

(context 'POP3)

(set 'debug-flag nil)

;; @syntax (POP3:get-all-mail <str-user> <str-password> <str-server> <str-dir>)
;; @param <str-user> The user ID.
;; @param <str-password> The password for the user ID.
;; @param <str-dir> The local directory for the retrieved mail.
;; @return On success 'true' else '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)))

;; @syntax (POP3:get-new-mail <str-user> <str-password> <str-server> <str-dir>)
;; @param <str-user> The user ID.
;; @param <str-password> The password for the user ID.
;; @param <str-dir> The local directory for the retrieved mail.
;; @return On success returns 'true' else 'nil'.
;; On failure use 'POP3:get-error-text' to retrieve the text of
;; the last error which occured.

(define (get-new-mail userName password pop3server mail-dir)
    (and 
        (connect pop3server)
        (logon userName password)
        (set 'status (get-status true))
        (if (<= (first status) (nth 2 status))
          (get-messages (first status) (nth 2 status) mail-dir)
          true)
        (log-off)))

;; @syntax (POP3:get-mail-status <str-user> <str-password> <str-server>)
;; @param <str-user> The user ID.
;; @param <str-password> The password for the user ID.
;; @return A list of status information.
;; The list of status information returned contains the following items:
;; (<totalMessages>, <totalBytes>, <lastRead>)

(define (get-mail-status userName password pop3server)
    (and 
        (connect pop3server)
        (logon userName password)
        (set 'status (get-status true))
        (log-off)
        status))

;; @syntax (POP3:delete-old-mail <str-user> <str-password> <str-server>)
;; @param <str-user> The user ID.
;; @param <str-password> The password for the user ID.
;; @return The number of messages left on the server.

(define (delete-old-mail userName password pop3server)
    (and
        (connect pop3server)
        (logon userName password)
        (set 'status (get-status true))
        (if (> (first status) 1) 
            (for (msg 1 (- (first status) 1) ) (delete-message msg))
            true)
        (log-off)
        (first status)))

;; @syntax (POP3:delete-all-mail <str-user> <str-password> <str-server>)
;; @param <str-user> The user ID.
;; @param <str-password> The password for the user ID.
;; @return The number of the message last read.
(define (delete-all-mail userName password pop3server)
    (and
        (connect pop3server)
        (logon userName password)
        (set 'status (get-status))
        (if (> (last status) 0)
            (for (msg 1 (last status) ) (delete-message msg))
            true)
        (log-off)
        (last 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 successful") true)))


; get status and last read
;
(define (get-status last-flag)
    (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)
	(if last-flag 
            (begin
                (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 'last-read "0"))
        (set 'result (list (int (first (parse status)))))
	(if debug-flag (println "parsed status: " result) true)
        (push (int (nth 1 (parse status))) result)
        (push (int (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.
; 
; v 1.6: make sure directory? doesn't have trailing slash in arg
;
(define (get-messages from to mail-dir)
   (if (ends-with mail-dir "/") (set 'mail-dir (chop mail-dir)))
   (if (if (not (directory? mail-dir)) (make-dir mail-dir) true)
       (begin
          (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)))))
    true) ; other parts of pop3 rely on 'true' return

; 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)

;; @syntax (POP3:get-error-text)
;; @return The text of the last error occurred.

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

(context 'MAIN)


;(if (not(POP3:get-all-mail "user" "password" "my-isp.com" "mail"))
;    (print (POP3:get-error-text)) true)


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