1 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
4 ;; 2004, 2005 Free Software Foundation, Inc.
6 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
7 ;; Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
8 ;; Katsumi Yamaoka <yamaoka@jpl.org>
9 ;; Maintainer: Volunteers
12 ;; This file is part of T-gnus.
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
31 ;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands
32 ;; are implemented. The LIST command has not been implemented due to lack
33 ;; of actual usefulness.
34 ;; The optional POP3 command TOP has not been implemented.
36 ;; This program was inspired by Kyle E. Jones's vm-pop program.
40 ;; Put something like the following line in your ~/.gnus.el file if
41 ;; you'd like to use this module together with Gnus, not T-gnus.
43 ;;(eval-after-load "mail-source" '(require 'pop3))
45 ;; There are two ways to install this module; one is to replace
46 ;; pop3.el of the Gnus version with this module when installing Gnus;
47 ;; the other is to replace pop3.el of the Gnus version which has been
48 ;; installed with this module and byte-compile it.
50 ;; Note: you should not modify the value for the `pop' section of the
51 ;; `mail-source-keyword-map' variable.
53 ;; This program provides the following features in addition to Gnus:
55 ;; 1. You can use SSL or STARTTLS stream to connect to mail servers.
56 ;; For example, specify the `:connection' keyword and the value pair
57 ;; in a mail-source as follows:
59 ;;(setq mail-sources '((pop :server "pop3.mail.server" :port 995
60 ;; :connection ssl :authentication apop)))
62 ;; For STARTTLS stream, use `tls' isntead of `ssl'. The default
63 ;; connection type is defined by `pop3-connection-type' which
66 ;; 2. You can fetch mails without deleting them in mail servers. To do
67 ;; that, specify the `:leave' keyword with the value t as follows:
69 ;;(setq mail-sources '((pop :server "pop3.mail.server" :leave t)))
71 ;; Already read mails are registered into the ~/.uidls-SERVER file
72 ;; (which is the default, see `pop3-uidl-file-name'), and you will
73 ;; never need to fetch them twice. The default value for the
74 ;; `:leave' keyword is specified by the `pop3-leave-mail-on-server'
75 ;; variable. You have no need to modify that value normally.
77 ;; 3. See the source code for some other miscellaneous extended features.
87 "Post Office Protocol."
91 (defcustom pop3-maildrop (or (user-login-name)
95 :version "22.1" ;; Oort Gnus
99 (defcustom pop3-mailhost (or (getenv "MAILHOST") ;; nil -> mismatch
102 :version "22.1" ;; Oort Gnus
106 (defcustom pop3-port 110
108 :version "22.1" ;; Oort Gnus
112 (defcustom pop3-connection-type nil
113 "*POP3 connection type."
114 :type '(choice (const :tag "Not specified" nil)
119 (defcustom pop3-password-required t
120 "*Non-nil if a password is required when connecting to POP server."
121 :version "22.1" ;; Oort Gnus
125 ;; Should this be customizable?
126 (defvar pop3-password nil
127 "*Password to use when connecting to POP server.")
129 (defcustom pop3-authentication-scheme 'pass
130 "*POP3 authentication scheme.
131 Defaults to `pass', for the standard USER/PASS authentication. The other
132 valid value is 'apop'."
133 :type '(choice (const :tag "Normal user/password" pass)
134 (const :tag "APOP" apop))
135 :version "22.1" ;; Oort Gnus
138 (defcustom pop3-leave-mail-on-server nil
139 "*Non-nil if the mail is to be left on the POP server after fetching.
141 If `pop3-leave-mail-on-server' is non-nil the mail is to be left
142 on the POP server after fetching. Note that POP servers maintain
143 no state information between sessions, so what the client
144 believes is there and what is actually there may not match up.
145 If they do not, then the whole thing can fall apart and leave you
146 with a corrupt mailbox."
147 :version "22.1" ;; Oort Gnus
151 (defvar pop3-timestamp nil
152 "Timestamp returned when initially connected to the POP server.
153 Used for APOP authentication.")
155 (defcustom pop3-maximum-message-size nil
156 "If non-nil only download messages smaller than this."
157 :type '(choice (const :tag "Unlimited" nil)
158 (integer :tag "Maximum size"))
161 (defcustom pop3-except-header-regexp nil
162 "If non-nil we do not retrieve messages whose headers are matching this regexp."
163 :type '(choice (const :tag "Retrieve any messages" nil)
164 (regexp :format "\n%t: %v"))
167 (defcustom pop3-uidl-file-name "~/.uidls"
168 "File in which to store the UIDL of processed messages."
172 (defvar pop3-uidl-support nil
173 "Alist of servers and flags of whether they support UIDLs.
174 Users don't have to set this value.")
176 (defvar pop3-uidl-obarray (make-vector 31 0)
179 (defvar pop3-read-point nil)
180 (defvar pop3-debug nil)
183 (autoload 'starttls-open-stream "starttls")
184 (autoload 'starttls-negotiate "starttls"))
186 (defcustom pop3-ssl-program-name
187 (if (executable-find "openssl")
190 "The program to run in a subprocess to open an SSL connection."
194 (defcustom pop3-ssl-program-arguments
195 '("s_client" "-quiet")
196 "Arguments to be passed to the program `pop3-ssl-program-name'."
197 :type '(repeat (string :format "%v"))
200 (defun pop3-progress-message (format percent &rest args)
201 (apply (function message) format args))
203 ;; Borrowed from nnheader-accept-process-output in nnheader.el.
204 (defvar pop3-read-timeout
205 (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
206 (symbol-name system-type))
207 ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de
209 ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS.
211 ;; There should probably be a runtime test to determine the timing
212 ;; resolution, or a primitive to report it. I don't know off-hand
213 ;; what's possible. Perhaps better, maybe the Windows/DOS primitive
214 ;; could round up non-zero timeouts to a minimum of 1.0?
217 "How long pop3 should wait between checking for the end of output.
218 Shorter values mean quicker response, but are more CPU intensive.")
220 ;; Borrowed from nnheader-accept-process-output in nnheader.el.
221 (defun pop3-accept-process-output (process)
222 (accept-process-output
224 (truncate pop3-read-timeout)
225 (truncate (* (- pop3-read-timeout
226 (truncate pop3-read-timeout))
229 (defun pop3-movemail (&optional crashbox)
230 "Transfer contents of a maildrop to the specified CRASHBOX."
231 (or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
232 (let* ((process (pop3-open-server pop3-mailhost pop3-port))
233 (crashbuf (get-buffer-create " *pop3-retr*"))
236 (pop3-password pop3-password)
237 (pop3-uidl-file-name (convert-standard-filename
238 (concat pop3-uidl-file-name "-"
240 retrieved-messages messages)
241 ;; for debugging only
242 (if pop3-debug (switch-to-buffer (process-buffer process)))
243 ;; query for password
244 (if (and pop3-password-required (not pop3-password))
246 (read-passwd (format "Password for %s: " pop3-maildrop))))
247 (cond ((equal 'apop pop3-authentication-scheme)
248 (pop3-apop process pop3-maildrop))
249 ((equal 'pass pop3-authentication-scheme)
250 (pop3-user process pop3-maildrop)
252 (t (error "Invalid POP3 authentication scheme")))
253 ;; get messages that are suitable for download
254 (message "Retrieving message list...")
255 (setq messages (pop3-get-message-numbers process)
256 message-count (length (cdr messages)))
257 (message "Retrieving message list...%d of %d unread"
258 message-count (pop messages))
260 (unless (not (stringp crashbox))
262 (pop3-progress-message
263 "Retrieving message %d of %d (%d octets) from %s..."
264 (floor (* (/ (float n) message-count) 100))
265 n message-count (cdar messages) pop3-mailhost)
266 (pop3-retr process (caar messages) crashbuf)
267 (push (caar messages) retrieved-messages)
268 (setq messages (cdr messages)
270 (with-current-buffer crashbuf
271 (let ((coding-system-for-write 'binary)
272 jka-compr-compression-info-list jam-zcat-filename-list)
273 (write-region (point-min) (point-max)
274 crashbox 'append 'nomesg)))
275 ;; mark messages as read
276 (when pop3-leave-mail-on-server
278 ;; now delete the messages we have retrieved
279 (unless pop3-leave-mail-on-server
280 (dolist (n retrieved-messages)
281 (message "Deleting message %d of %d from %s..."
282 n message-count pop3-mailhost)
283 (pop3-dele process n))))
285 (kill-buffer crashbuf)
288 (defun pop3-get-message-count ()
289 "Return the number of messages in the maildrop."
290 (let* ((process (pop3-open-server pop3-mailhost pop3-port))
292 (pop3-password pop3-password))
293 ;; for debugging only
294 (if pop3-debug (switch-to-buffer (process-buffer process)))
295 ;; query for password
296 (if (and pop3-password-required (not pop3-password))
298 (read-passwd (format "Password for %s: " pop3-maildrop))))
299 (cond ((equal 'apop pop3-authentication-scheme)
300 (pop3-apop process pop3-maildrop))
301 ((equal 'pass pop3-authentication-scheme)
302 (pop3-user process pop3-maildrop)
304 (t (error "Invalid POP3 authentication scheme")))
305 (setq message-count (car (pop3-stat process)))
309 (defcustom pop3-stream-type nil
310 "*Transport security type for POP3 connexions.
311 This may be either nil (plain connexion), `ssl' (use an
312 SSL/TSL-secured stream) or `starttls' (use the starttls mechanism
313 to turn on TLS security after opening the stream). However, if
314 this is nil, `ssl' is assumed for connexions to port
316 :version "23.0" ;; No Gnus
318 :type '(choice (const :tag "Plain" nil)
319 (const :tag "SSL/TLS" ssl)
322 (defun pop3-open-server (mailhost port)
323 "Open TCP connection to MAILHOST on PORT.
324 Returns the process associated with the connection.
325 Argument PORT specifies connecting port."
328 (set-buffer (get-buffer-create (concat " trace of POP session to "
331 (setq pop3-read-point (point-min))
335 ((or (eq pop3-connection-type 'ssl)
336 (eq pop3-stream-type 'ssl)
337 (and (not pop3-stream-type) (member port '(995 "pop3s"))))
338 ;; gnutls-cli, openssl don't accept service names
339 (if (or (equal port "pop3s")
342 (pop3-open-ssl-stream "POP" (current-buffer) mailhost port))
343 ((or (memq pop3-connection-type '(tls starttls))
344 (memq pop3-stream-type '(tls starttls)))
345 ;; gnutls-cli, openssl don't accept service names
346 (if (equal port "pop3")
348 (pop3-open-tls-stream "POP" (current-buffer)
349 mailhost (or port 110)))
351 (let ((coding-system-for-read 'binary)
352 (coding-system-for-write 'binary))
353 (open-network-stream "POP" (current-buffer) mailhost port)))))
354 (let ((response (pop3-read-response process t)))
356 (substring response (or (string-match "<" response) 0)
357 (+ 1 (or (string-match ">" response) -1)))))
361 (autoload 'open-ssl-stream "ssl"))
363 (defun pop3-open-ssl-stream-1 (name buffer host service extra-arg)
365 (let* ((ssl-program-name
366 pop3-ssl-program-name)
367 (ssl-program-arguments
368 `(,@pop3-ssl-program-arguments
370 "-connect" ,(format "%s:%d" host service)))
371 (process (open-ssl-stream name buffer host service)))
373 ;; There's a load of info printed that needs deleting.
374 (with-current-buffer buffer
375 (goto-char (point-min))
376 (while (and (memq (process-status process) '(open run))
377 (goto-char (point-max))
379 (not (looking-at "+OK")))
380 (pop3-accept-process-output process)
382 (delete-region (point-min) (point)))
383 (and process (memq (process-status process) '(open run))
386 (defun pop3-open-ssl-stream (name buffer host service)
387 "Open a SSL connection for a service to a host.
388 Returns a subprocess-object to represent the connection.
389 Args are NAME BUFFER HOST SERVICE."
390 (let (selective-display ;; Disable ^M to nl translation.
391 (coding-system-for-read 'binary)
392 (coding-system-for-write 'binary))
393 (or (pop3-open-ssl-stream-1 name buffer host service "-ssl3")
394 (pop3-open-ssl-stream-1 name buffer host service "-ssl2"))))
396 (defun pop3-open-tls-stream (name buffer host service)
397 "Open a TLSv1 connection for a service to a host.
398 Returns a subprocess-object to represent the connection.
399 Args are NAME BUFFER HOST SERVICE."
400 (let* (selective-display ;; Disable ^M to nl translation.
401 (coding-system-for-read 'binary)
402 (coding-system-for-write 'binary)
403 (process (starttls-open-stream name buffer host service)))
405 (starttls-negotiate process)
410 (defun pop3-process-filter (process output)
412 (set-buffer (process-buffer process))
413 (goto-char (point-max))
416 (defun pop3-send-command (process command)
417 (set-buffer (process-buffer process))
418 (goto-char (point-max))
419 ;; (if (= (aref command 0) ?P)
420 ;; (insert "PASS <omitted>\r\n")
421 ;; (insert command "\r\n"))
422 (setq pop3-read-point (point))
423 (goto-char (point-max))
424 (process-send-string process (concat command "\r\n")))
426 (defun pop3-read-response (process &optional return)
427 "Read the response from the server PROCESS.
428 Return the response string if optional second argument RETURN is non-nil."
429 (let ((case-fold-search nil)
432 (set-buffer (process-buffer process))
433 (goto-char pop3-read-point)
434 (while (and (memq (process-status process) '(open run))
435 (not (search-forward "\r\n" nil t)))
436 (pop3-accept-process-output process)
437 (goto-char pop3-read-point))
438 (setq match-end (point))
439 (goto-char pop3-read-point)
440 (if (looking-at "-ERR")
441 (error (buffer-substring (point) (- match-end 2)))
442 (if (not (looking-at "+OK"))
443 (progn (setq pop3-read-point match-end) nil)
444 (setq pop3-read-point match-end)
446 (buffer-substring (point) match-end)
449 (defun pop3-clean-region (start end)
450 (setq end (set-marker (make-marker) end))
453 (while (and (< (point) end) (search-forward "\r\n" end t))
454 (replace-match "\n" t t))
456 (while (re-search-forward "\n\n\\(From \\)" end t)
457 (replace-match "\n\n>\\1" t nil))
459 (while (and (< (point) end) (re-search-forward "^\\." end t))
460 (replace-match "" t t)
462 (set-marker end nil))
464 (eval-when-compile (defvar parse-time-months))
466 ;; Copied from message-make-date.
467 (defun pop3-make-date (&optional now)
468 "Make a valid date header.
469 If NOW, use that time instead."
470 (require 'parse-time)
471 (let* ((now (or now (current-time)))
472 (zone (nth 8 (decode-time now)))
476 (setq zone (- zone)))
478 (format-time-string "%d" now)
479 ;; The month name of the %b spec is locale-specific. Pfff.
481 (capitalize (car (rassoc (nth 4 (decode-time now))
482 parse-time-months))))
483 (format-time-string "%Y %H:%M:%S " now)
484 ;; We do all of this because XEmacs doesn't have the %z spec.
485 (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60)))))
487 (defun pop3-munge-message-separator (start end)
488 "Check to see if a message separator exists. If not, generate one."
491 (narrow-to-region start end)
492 (goto-char (point-min))
493 (if (not (or (looking-at "From .?") ; Unix mail
494 (looking-at "\001\001\001\001\n") ; MMDF
495 (looking-at "BABYL OPTIONS:"))) ; Babyl
496 (let* ((from (mail-strip-quoted-names (mail-fetch-field "From")))
497 (tdate (mail-fetch-field "Date"))
498 (date (split-string (or (and tdate
499 (not (string= "" tdate))
504 ;; sample date formats I have seen
505 ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT)
506 ;; Date: 08 Jul 1996 23:22:24 -0400
508 ;; Tue Jul 9 09:04:21 1996
510 ;; Fixme: This should use timezone on the date field contents.
513 "Tue Jan 1 00:00:0 1900")
514 ((string-match "[A-Z]" (nth 0 date))
515 (format "%s %s %s %s %s"
516 (nth 0 date) (nth 2 date) (nth 1 date)
517 (nth 4 date) (nth 3 date)))
519 ;; this really needs to be better but I don't feel
520 ;; like writing a date to day converter.
521 (format "Sun %s %s %s %s"
522 (nth 1 date) (nth 0 date)
523 (nth 3 date) (nth 2 date)))))
524 (setq From_ (format "\nFrom %s %s\n" from date))
525 (while (string-match "," From_)
526 (setq From_ (concat (substring From_ 0 (match-beginning 0))
527 (substring From_ (match-end 0)))))
528 (goto-char (point-min))
530 (if (search-forward "\n\n" nil t)
532 (goto-char (point-max))
534 (narrow-to-region (point) (point-max))
535 (let ((size (- (point-max) (point-min))))
536 (goto-char (point-min))
539 (insert (format "Content-Length: %s\n" size))))))))
543 (defun pop3-get-message-numbers (process)
544 "Get the list of message numbers and lengths to retrieve via PROCESS."
545 ;; we use the LIST comand first anyway to get the message lengths.
546 ;; then if we're leaving mail on the server, see if the UIDL command
547 ;; is implemented. if so, we use it to get the message number list.
548 (let* ((messages (pop3-list process))
549 (total (or (pop messages) 0))
550 (uidl (if pop3-leave-mail-on-server
551 (pop3-get-uidl process)))
554 ;; only retrieve messages matching our regexp or in the uidl list
556 ;; remove elements not in the uidl, this assumes the uidl is short
557 (or (not (and pop3-leave-mail-on-server
558 (cdr (assoc pop3-mailhost pop3-uidl-support))))
559 (memq (caar messages) uidl))
561 ;; don't download messages that are too large
562 (not (and pop3-maximum-message-size
563 (> (cdar messages) pop3-maximum-message-size)))
564 (not (and pop3-except-header-regexp
565 (string-match pop3-except-header-regexp
566 (pop3-top process (caar messages) 0)))))
567 (push (car messages) out))
568 (setq messages (cdr messages)))
569 (cons total (nreverse out))))
571 (defun pop3-get-uidl (process)
572 "Use PROCESS to get a list of unread message numbers."
573 (let ((messages (pop3-uidl process))
574 (support (assoc pop3-mailhost pop3-uidl-support))
577 (setcdr support (and messages t))
578 (push (cons pop3-mailhost (and messages t))
583 (when (file-readable-p pop3-uidl-file-name)
584 (insert-file-contents pop3-uidl-file-name))
585 (goto-char (point-min))
586 (while (looking-at "\\([^ \n\t]+\\)")
587 (set (intern (match-string 1) pop3-uidl-obarray)
590 (dolist (message (cdr messages))
591 (if (setq uidl (intern-soft (cdr message) pop3-uidl-obarray))
592 (setcar (symbol-value uidl) (car message))
593 (set (intern (cdr message) pop3-uidl-obarray)
594 (cons (car message) nil))))
595 (pop3-get-unread-message-numbers))))
597 (defun pop3-get-unread-message-numbers ()
598 "Return a sorted list of unread msg numbers to retrieve."
600 (mapatoms (lambda (atom)
601 (if (not (cdr (symbol-value atom)))
602 (push (car (symbol-value atom)) nums)))
606 (defun pop3-save-uidls ()
607 "Save the updated UIDLs to disk for use next time."
608 (when (and pop3-leave-mail-on-server
609 ;; UIDL hash table is non-empty
610 (let ((len (length pop3-uidl-obarray)))
612 (setq len (if (symbolp (aref pop3-uidl-obarray (1- len)))
615 (when (file-readable-p pop3-uidl-file-name)
616 (copy-file pop3-uidl-file-name
617 (concat pop3-uidl-file-name ".old")
618 'overwrite 'keeptime))
620 (with-temp-file pop3-uidl-file-name
623 (when (car (symbol-value atom))
624 (insert (format "%s\n" atom))))
626 (fillarray pop3-uidl-obarray 0)))
631 ;; AUTHORIZATION STATE
633 (defun pop3-user (process user)
634 "Send USER information to POP3 server."
635 (pop3-send-command process (format "USER %s" user))
636 (let ((response (pop3-read-response process t)))
637 (if (not (and response (string-match "+OK" response)))
638 (error "USER %s not valid" user))))
640 (defun pop3-pass (process)
641 "Send authentication information to the server."
642 (pop3-send-command process (format "PASS %s" pop3-password))
643 (let ((response (pop3-read-response process t)))
644 (if (not (and response (string-match "+OK" response)))
645 (pop3-quit process))))
647 (defun pop3-apop (process user)
648 "Send alternate authentication information to the server."
649 (let ((pass pop3-password))
650 (if (and pop3-password-required (not pass))
652 (read-passwd (format "Password for %s: " pop3-maildrop))))
654 ;; Note that `md5' should never encode a given string to use for
655 ;; the apop authentication, so we should specify `binary'.
656 (let ((hash (md5 (concat pop3-timestamp pass) nil nil 'binary)))
657 (pop3-send-command process (format "APOP %s %s" user hash))
658 (let ((response (pop3-read-response process t)))
659 (if (not (and response (string-match "+OK" response)))
660 (pop3-quit process)))))))
662 (defun pop3-stls (process)
663 "Query whether TLS extension is supported"
664 (pop3-send-command process "STLS")
665 (let ((response (pop3-read-response process t)))
666 (if (not (and response (string-match "+OK" response)))
667 (pop3-quit process))))
671 (defun pop3-stat (process)
672 "Return the number of messages in the maildrop and the maildrop's size."
673 (pop3-send-command process "STAT")
674 (let ((response (pop3-read-response process t)))
675 (list (string-to-number (nth 1 (split-string response " ")))
676 (string-to-number (nth 2 (split-string response " "))))))
678 (defun pop3-retr (process msg crashbuf)
679 "Retrieve message-id MSG to buffer CRASHBUF."
680 (pop3-send-command process (format "RETR %s" msg))
681 (pop3-read-response process)
683 (let ((region (pop3-get-extended-response process)))
684 (pop3-munge-message-separator (car region) (cadr region))
685 (append-to-buffer crashbuf (car region) (cadr region))
686 (delete-region (car region) (cadr region)))))
688 (defun pop3-dele (process msg)
689 "Mark message-id MSG as deleted."
690 (pop3-send-command process (format "DELE %s" msg))
691 (pop3-read-response process))
693 (defun pop3-noop (process msg)
695 (pop3-send-command process "NOOP")
696 (pop3-read-response process))
698 (defun pop3-last (process)
699 "Return highest accessed message-id number for the session."
700 (pop3-send-command process "LAST")
701 (let ((response (pop3-read-response process t)))
702 (string-to-number (nth 1 (split-string response " ")))))
704 (defun pop3-rset (process)
705 "Remove all delete marks from current maildrop."
706 (pop3-send-command process "RSET")
707 (pop3-read-response process))
711 (defun pop3-quit (process)
712 "Close connection to POP3 server.
713 Tell server to remove all messages marked as deleted, unlock the maildrop,
714 and close the connection."
715 (pop3-send-command process "QUIT")
716 (pop3-read-response process t)
719 (set-buffer (process-buffer process))
720 (goto-char (point-max))
721 (delete-process process))))
723 (defun pop3-uidl (process &optional msgno)
724 "Return the results of a UIDL command in PROCESS for optional MSGNO.
725 If UIDL is unsupported on this mail server or if msgno is invalid, return nil.
726 Otherwise, return a list in the form
728 (N (1 UIDL-1) (2 UIDL-2) ... (N UIDL-N))
732 N is an integer for the number of UIDLs returned (could be 0)
736 (pop3-send-command process (format "UIDL %d" msgno))
737 (pop3-send-command process "UIDL"))
739 (if (null (pop3-read-response process t))
740 nil ;; UIDL is not supported on this server
744 (apply 'narrow-to-region (pop3-get-extended-response process))
745 (goto-char (point-min))
746 (while (looking-at "\\([^ \n\t]*\\) \\([^ \n\t]*\\)")
747 (setq msgno (string-to-number (match-string 1))
748 uidl (match-string 2))
749 (push (cons msgno uidl) pairs)
750 (beginning-of-line 2))
751 (cons (length pairs) (nreverse pairs)))))))
753 (defun pop3-list (process &optional msgno)
754 "Return the results of a LIST command for PROCESS and optional MSGNO.
755 If (optional) msgno is invalid, return nil. Otherwise, return a list
758 (N (1 LEN-1) (2 LEN-2) ... (N LEN-N))
762 N is an integer for the number of msg/len pairs (could be 0)
763 LEN-n is an integer."
765 (pop3-send-command process (format "LIST %d" msgno))
766 (pop3-send-command process "LIST"))
768 (if (null (pop3-read-response process t))
769 nil ;; MSGNO is not valid number
773 (apply 'narrow-to-region (pop3-get-extended-response process))
774 (goto-char (point-min))
775 (while (looking-at "\\([^ \n\t]*\\) \\([^ \n\t]*\\)")
776 (setq msgno (string-to-number (match-string 1))
777 len (string-to-number (match-string 2)))
778 (push (cons msgno len) pairs)
779 (beginning-of-line 2))
780 (cons (length pairs) (nreverse pairs)))))))
782 (defun pop3-top (process msgno &optional lines)
783 "Return the top LINES of messages for PROCESS and MSGNO.
784 If msgno is invalid, return nil. Otherwise, return a string."
785 (pop3-send-command process (format "TOP %d %d" msgno (or lines 1)))
786 (if (pop3-read-response process t)
787 nil ;; MSGNO is not valid number
789 (apply 'buffer-substring (pop3-get-extended-response process)))))
793 (defun pop3-get-extended-response (process)
794 "Get the extended pop3 response in the PROCESS buffer."
795 (let ((start pop3-read-point) end)
796 (set-buffer (process-buffer process))
798 (while (not (re-search-forward "^\\.\r\n" nil t))
799 (pop3-accept-process-output process)
801 (setq pop3-read-point (point-marker))
802 (goto-char (match-beginning 0))
803 (setq end (point-marker))
804 (pop3-clean-region start end)
807 ;;; Advise the mail-source function in order to use this module in Gnus.
809 (eval-after-load "mail-source"
810 '(if (member '(:connection)
811 (assq 'pop (symbol-value 'mail-source-keyword-map)))
812 nil ;; T-gnus is running.
813 (defadvice mail-source-fetch-pop (around bind-t-gnus-keywords activate)
814 "Bind `pop3-connection-type' and `pop3-leave-mail-on-server' according
815 to `mail-sources' while fetching mails with Gnus."
816 (let ((pop3-connection-type (or (plist-get (cdr (ad-get-arg 0))
818 pop3-connection-type))
819 (pop3-leave-mail-on-server (or (plist-get (cdr (ad-get-arg 0))
821 pop3-leave-mail-on-server)))
825 ;; Summary of POP3 (Post Office Protocol version 3) commands and responses
827 ;;; AUTHORIZATION STATE
829 ;; Initial TCP connection
831 ;; Restrictions: none
832 ;; Possible responses:
833 ;; +OK [POP3 server ready]
836 ;; Arguments: a server specific user-id (required)
837 ;; Restrictions: authorization state [after unsuccessful USER or PASS
838 ;; Possible responses:
839 ;; +OK [valid user-id]
840 ;; -ERR [invalid user-id]
843 ;; Arguments: a server/user-id specific password (required)
844 ;; Restrictions: authorization state, after successful USER
845 ;; Possible responses:
846 ;; +OK [maildrop locked and ready]
847 ;; -ERR [invalid password]
848 ;; -ERR [unable to lock maildrop]
852 ;; Restrictions: authorization state
853 ;; Possible responses:
854 ;; +OK [negotiation is ready]
855 ;; -ERR [security layer is already active]
859 ;; Restrictions: Only permitted in AUTHORIZATION state.
860 ;; Possible responses:
864 ;;; TRANSACTION STATE
868 ;; Restrictions: transaction state
869 ;; Possible responses:
870 ;; +OK nn mm [# of messages, size of maildrop]
873 ;; Arguments: a message-id (optional)
874 ;; Restrictions: transaction state; msg must not be deleted
875 ;; Possible responses:
876 ;; +OK [scan listing follows]
877 ;; -ERR [no such message]
880 ;; Arguments: a message-id (required), number of lines (optional)
881 ;; Restrictions: transaction state; msg must not be deleted
882 ;; Possible responses:
883 ;; +OK [partial message listing follows]
884 ;; -ERR [no such message]
887 ;; Arguments: a message-id (optional)
888 ;; Restrictions: transaction state; msg must not be deleted
889 ;; Possible responses:
890 ;; +OK [uidl listing follows]
891 ;; -ERR [no such message]
894 ;; Arguments: a message-id (required)
895 ;; Restrictions: transaction state; msg must not be deleted
896 ;; Possible responses:
897 ;; +OK [message contents follow]
898 ;; -ERR [no such message]
901 ;; Arguments: a message-id (required)
902 ;; Restrictions: transaction state; msg must not be deleted
903 ;; Possible responses:
904 ;; +OK [message deleted]
905 ;; -ERR [no such message]
909 ;; Restrictions: transaction state
910 ;; Possible responses:
915 ;; Restrictions: transaction state
916 ;; Possible responses:
917 ;; +OK nn [highest numbered message accessed]
921 ;; Restrictions: transaction state
922 ;; Possible responses:
923 ;; +OK [all delete marks removed]
929 ;; Restrictions: none
930 ;; Possible responses:
931 ;; +OK [TCP connection closed]
935 ;;; pop3.el ends here