modules/pop3.lsp

   1 ;; @module pop3.lsp
   2 ;; @description POP3 mail retrieval routines
   3 ;; @version 1.9 - comments redone for automatic documentation
   4 ;; @author Lutz Mueller et al., 2001, 2002
   5 ;;
   6 ;; <h2>POP3 mail retrieval routines</h2>
   7 ;;
   8 ;; Only the module 'pop3.lsp' is required, not other libraries need to be
   9 ;; present. Not all mailservers support all functions.
  10 ;;
  11 ;; To use the module put a 'load' statement at the top of your file:
  12 ;; <pre>
  13 ;; (load "/usr/share/newlisp/modules/pop3.lsp")
  14 ;; </pre>
  15 ;;
  16 ;; <h2>Function overview</h2>
  17 ;; Load down all messages and put them in a directory 'messages/':
  18 ;; <pre>
  19 ;; (POP3:get-all-mail "user" "password" "pop.my-isp.com" "messages/")
  20 ;; </pre>
  21 ;;
  22 ;; Load down only new messages:
  23 ;; <pre>
  24 ;; (POP3:get-new-mail "user" "password" "pop.my-isp.com" "messages/")
  25 ;; </pre>
  26 ;;
  27 ;; Delete messages, which have not been read:
  28 ;; <pre>
  29 ;; (POP3:delete-old-mail "user" "password" "pop.my-isp.com")
  30 ;; </pre>
  31 ;;
  32 ;; Delete all messages:
  33 ;; <pre>
  34 ;; (POP3:delete-all-mail "user" "password" "pop.my-isp.com")
  35 ;; </pre>
  36 ;;
  37 ;; Get a list of status numbers '(<totalMessages>, <totalBytes>, <lastRead>)':
  38 ;; <pre>
  39 ;; (POP3:get-mail-status "user" "password" "pop.my-isp.com")
  40 ;; </pre>
  41 ;;
  42 ;; Get error message for failed all/new/status function:
  43 ;; <pre>
  44 ;; (POP3:get-error-text)
  45 ;; </pre>
  46 ;; All functions return 'nil' on error and 'POP3:get-error-text' can be used to
  47 ;; retrieve the error text.
  48 ;;
  49 ;; The variable 'POP3:debug-flag' can be set to 'true' to display all of the
  50 ;; dialog with the pop2 mail server.
  51
  52 (context 'POP3)
  53
  54 (set 'debug-flag nil)
  55
  56 ;; @syntax (POP3:get-all-mail <str-user> <str-password> <str-server> <str-dir>)
  57 ;; @param <str-user> The user ID.
  58 ;; @param <str-password> The password for the user ID.
  59 ;; @param <str-dir> The local directory for the retrieved mail.
  60 ;; @return On success 'true' else 'nil'.
  61
  62 (define (get-all-mail userName password pop3server mail-dir)
  63     (and
  64         (connect pop3server)
  65         (logon userName password)
  66         (set 'status (get-status))
  67         (set 'no-msgs (nth 2 status))
  68         (if (> no-msgs 0)
  69           (get-messages 1 no-msgs mail-dir)
  70           true)
  71         (log-off)))
  72
  73 ;; @syntax (POP3:get-new-mail <str-user> <str-password> <str-server> <str-dir>)
  74 ;; @param <str-user> The user ID.
  75 ;; @param <str-password> The password for the user ID.
  76 ;; @param <str-dir> The local directory for the retrieved mail.
  77 ;; @return On success returns 'true' else 'nil'.
  78 ;; On failure use 'POP3:get-error-text' to retrieve the text of
  79 ;; the last error which occured.
  80
  81 (define (get-new-mail userName password pop3server mail-dir)
  82     (and
  83         (connect pop3server)
  84         (logon userName password)
  85         (set 'status (get-status true))
  86         (if (<= (first status) (nth 2 status))
  87           (get-messages (first status) (nth 2 status) mail-dir)
  88           true)
  89         (log-off)))
  90
  91 ;; @syntax (POP3:get-mail-status <str-user> <str-password> <str-server>)
  92 ;; @param <str-user> The user ID.
  93 ;; @param <str-password> The password for the user ID.
  94 ;; @return A list of status information.
  95 ;; The list of status information returned contains the following items:
  96 ;; (<totalMessages>, <totalBytes>, <lastRead>)
  97
  98 (define (get-mail-status userName password pop3server)
  99     (and
 100         (connect pop3server)
 101         (logon userName password)
 102         (set 'status (get-status true))
 103         (log-off)
 104         status))
 105
 106 ;; @syntax (POP3:delete-old-mail <str-user> <str-password> <str-server>)
 107 ;; @param <str-user> The user ID.
 108 ;; @param <str-password> The password for the user ID.
 109 ;; @return The number of messages left on the server.
 110
 111 (define (delete-old-mail userName password pop3server)
 112     (and
 113         (connect pop3server)
 114         (logon userName password)
 115         (set 'status (get-status true))
 116         (if (> (first status) 1)
 117             (for (msg 1 (- (first status) 1) ) (delete-message msg))
 118             true)
 119         (log-off)
 120         (first status)))
 121
 122 ;; @syntax (POP3:delete-all-mail <str-user> <str-password> <str-server>)
 123 ;; @param <str-user> The user ID.
 124 ;; @param <str-password> The password for the user ID.
 125 ;; @return The number of the message last read.
 126 (define (delete-all-mail userName password pop3server)
 127     (and
 128         (connect pop3server)
 129         (logon userName password)
 130         (set 'status (get-status))
 131         (if (> (last status) 0)
 132             (for (msg 1 (last status) ) (delete-message msg))
 133             true)
 134         (log-off)
 135         (last status)))
 136
 137 ; receive request answer and verify
 138 ;
 139 (define (net-confirm-request)
 140     (if (net-receive socket 'rcvbuff 512 "+OK")
 141         (begin
 142             (if debug-flag (println rcvbuff))
 143             (if (find "-ERR" rcvbuff)
 144                 (finish rcvbuff)
 145                 true))
 146         nil))
 147
 148 (define (net-flush)
 149         (if socket
 150                 (while (> (net-peek socket) 0)
 151                         (net-receive socket 'junk 256)
 152                         (if debug-flag (println junk) )))
 153         true)
 154
 155 ; connect to server
 156 ;
 157 (define (connect server)
 158     (set 'socket (net-connect pop3server 110))
 159     (if (and debug-flag socket) (println "connected on: " socket) )
 160     (if (and socket (net-confirm-request))
 161         (net-flush)
 162         (finish "could not connect")))
 163
 164 ;
 165 (define (logon userName password)
 166     (and
 167         (set 'sndbuff (append "USER " userName "\r\n"))
 168         (net-send socket 'sndbuff)
 169         (if debug-flag (println "sent: " sndbuff) true)
 170         (net-confirm-request)
 171         (net-flush)
 172         (set 'sndbuff (append "PASS " password "\r\n"))
 173         (net-send socket 'sndbuff)
 174         (if debug-flag (println "sent: " sndbuff) true)
 175         (net-confirm-request)
 176         (net-flush)
 177         (if debug-flag (println "logon successful") true)))
 178
 179
 180 ; get status and last read
 181 ;
 182 (define (get-status last-flag)
 183     (and
 184         (set 'sndbuff "STAT\r\n")
 185         (net-send socket 'sndbuff)
 186         (if debug-flag (println "sent: " sndbuff) true)
 187         (net-confirm-request)
 188         (net-receive socket 'status 256)
 189         (if debug-flag (println "status: " status) true)
 190         (net-flush)
 191         (if last-flag
 192             (begin
 193                 (set 'sndbuff "LAST\r\n")
 194                 (net-send socket 'sndbuff)
 195                 (if debug-flag (println "sent: " sndbuff) true)
 196                 (net-confirm-request)
 197                 (net-receive socket 'last-read 256)
 198                 (if debug-flag (println "last read: " last-read) true)
 199                 (net-flush))
 200             (set 'last-read "0"))
 201         (set 'result (list (int (first (parse status)))))
 202         (if debug-flag (println "parsed status: " result) true)
 203         (push (int (nth 1 (parse status))) result)
 204         (push (int (first (parse last-read))) result)
 205         result))
 206
 207
 208 ; get a message
 209 ;
 210 (define (retrieve-message , message)
 211         (set 'finished nil)
 212         (set 'message "")
 213         (while (not finished)
 214                 (net-receive socket 'rcvbuff 16384)
 215                 (set 'message (append message rcvbuff))
 216                 (if (find "\r\n.\r\n" message) (set 'finished true)))
 217         (if debug-flag (println "received message") true)
 218         message)
 219
 220
 221 ; get all messages
 222 ;
 223 ; v 1.4: modified file name generation to improve uniqueness. (CaveGuy)
 224 ;        file name now created using last SMTP or ESMTP ID from header.
 225 ; v 1.5: changed file type to ".pop3" to reflect the context that created it.
 226 ;        (get-messages now forces the directory, if it does not exsist.
 227 ;
 228 ; v 1.6: make sure directory? doesn't have trailing slash in arg
 229 ;
 230 (define (get-messages from to mail-dir)
 231    (if (ends-with mail-dir "/") (set 'mail-dir (chop mail-dir)))
 232    (if (if (not (directory? mail-dir)) (make-dir mail-dir) true)
 233        (begin
 234           (set 'mail-dir (append mail-dir "/"))
 235           (for (msg from to)
 236                (if debug-flag (println "getting message " msg) true)
 237                (set 'sndbuff (append "RETR " (string msg) "\r\n"))
 238                (net-send socket 'sndbuff)
 239                (if debug-flag (println "sent: " sndbuff) true)
 240                (set 'message (retrieve-message))
 241                (if debug-flag (println (slice message 1 200)) true)
 242                (set 'istr (get-message-id message))
 243                (set 'istr (append mail-dir "ME-" istr))
 244                (if debug-flag (println "saving " istr) true)
 245                (write-file istr message)
 246                (if (not (rename-file istr (append istr ".pop3")))
 247                    (delete-file istr)))))
 248     true) ; other parts of pop3 rely on 'true' return
 249
 250 ; delete messages
 251 ;
 252 (define (delete-message msg)
 253     (and
 254         (set 'sndbuff (append "DELE " (string msg) "\r\n"))
 255         (net-send socket 'sndbuff)
 256         (if debug-flag (println "sent: " sndbuff) true)
 257         (net-confirm-request)))
 258
 259 ; get-message-date was
 260 ; changed to get-message-id
 261 ; v 1.4: CaveGuy
 262
 263 (define (get-message-id message)
 264     (set 'ipos (+ (find "id <| id |\tid " message 1) 5)
 265          'iend (find "@|;|\n|\r| |\t" (slice message ipos) 1))
 266     (if debug-flag
 267         (print "Message ID: " (slice message ipos iend) "\n"))
 268     (set 'istr (slice message ipos iend)) )
 269
 270
 271 ; log off
 272 ;
 273 (define (log-off)
 274     (set 'sndbuff "QUIT\r\n")
 275     (net-send socket 'sndbuff)
 276     (if debug-flag (println "sent: " sndbuff) true)
 277     (net-receive socket 'rcvbuff 256)
 278     (if debug-flag (println rcvbuff) true)
 279     true)
 280
 281 ; report error and finish
 282 ;
 283 (define (finish message)
 284     (if (ends-with message "+OK")
 285       (set 'message (chop message 3)))
 286     ;(print "<h3>" message "</h3>")
 287     (set 'mail-error-text message)
 288     (if debug-flag (println "ERROR: " message) true)
 289     (if socket (net-flush))
 290     (if socket (log-off))
 291     nil)
 292
 293 ;; @syntax (POP3:get-error-text)
 294 ;; @return The text of the last error occurred.
 295
 296 (define (get-error-text) mail-error-text)
 297
 298 (context 'MAIN)
 299
 300
 301 ;(if (not(POP3:get-all-mail "user" "password" "my-isp.com" "mail"))
 302 ;    (print (POP3:get-error-text)) true)
 303
 304
 305 ;(POP3:get-new-mail "user" "password" "my-isp.com" "mail")
 306 ;(print (POP3:get-mail-status ""user" "password" "my-isp.com"))
 307 ;(exit)