cgit.sxemacs.org Git - gnus/blob - lisp/pop3.el

   1 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface
   2
   3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
   4 ;;   2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
   7 ;; Maintainer: FSF
   8 ;; Keywords: mail
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands
  28 ;; are implemented.  The LIST command has not been implemented due to lack
  29 ;; of actual usefulness.
  30 ;; The optional POP3 command TOP has not been implemented.
  31
  32 ;; This program was inspired by Kyle E. Jones's vm-pop program.
  33
  34 ;;; Code:
  35
  36 (eval-when-compile (require 'cl))
  37 (require 'mail-utils)
  38 (defvar parse-time-months)
  39
  40 (defgroup pop3 nil
  41   "Post Office Protocol."
  42   :group 'mail
  43   :group 'mail-source)
  44
  45 (defcustom pop3-maildrop (or (user-login-name)
  46                              (getenv "LOGNAME")
  47                              (getenv "USER"))
  48   "*POP3 maildrop."
  49   :version "22.1" ;; Oort Gnus
  50   :type 'string
  51   :group 'pop3)
  52
  53 (defcustom pop3-mailhost (or (getenv "MAILHOST") ;; nil -> mismatch
  54                              "pop3")
  55   "*POP3 mailhost."
  56   :version "22.1" ;; Oort Gnus
  57   :type 'string
  58   :group 'pop3)
  59
  60 (defcustom pop3-port 110
  61   "*POP3 port."
  62   :version "22.1" ;; Oort Gnus
  63   :type 'number
  64   :group 'pop3)
  65
  66 (defcustom pop3-password-required t
  67   "*Non-nil if a password is required when connecting to POP server."
  68   :version "22.1" ;; Oort Gnus
  69   :type 'boolean
  70   :group 'pop3)
  71
  72 ;; Should this be customizable?
  73 (defvar pop3-password nil
  74   "*Password to use when connecting to POP server.")
  75
  76 (defcustom pop3-authentication-scheme 'pass
  77   "*POP3 authentication scheme.
  78 Defaults to `pass', for the standard USER/PASS authentication.  The other
  79 valid value is 'apop'."
  80   :type '(choice (const :tag "Normal user/password" pass)
  81                  (const :tag "APOP" apop))
  82   :version "22.1" ;; Oort Gnus
  83   :group 'pop3)
  84
  85 (defcustom pop3-leave-mail-on-server nil
  86   "*Non-nil if the mail is to be left on the POP server after fetching.
  87
  88 If `pop3-leave-mail-on-server' is non-nil the mail is to be left
  89 on the POP server after fetching.  Note that POP servers maintain
  90 no state information between sessions, so what the client
  91 believes is there and what is actually there may not match up.
  92 If they do not, then you may get duplicate mails or the whole
  93 thing can fall apart and leave you with a corrupt mailbox."
  94   ;; We can't use the UILD support from XEmacs mail-lib or cvs.m17n.org:
  95   ;; http://thread.gmane.org/v9lld8fml4.fsf@marauder.physik.uni-ulm.de
  96   ;; http://thread.gmane.org/b9yy8hzy9ej.fsf@jpl.org
  97   ;; Any volunteer to re-implement this?
  98   :version "22.1" ;; Oort Gnus
  99   :type 'boolean
 100   :group 'pop3)
 101
 102 (defvar pop3-timestamp nil
 103   "Timestamp returned when initially connected to the POP server.
 104 Used for APOP authentication.")
 105
 106 (defvar pop3-read-point nil)
 107 (defvar pop3-debug nil)
 108
 109 ;; Borrowed from nnheader-accept-process-output in nnheader.el.  See the
 110 ;; comments there for explanations about the values.
 111
 112 (eval-and-compile
 113   (if (and (fboundp 'nnheader-accept-process-output)
 114            (boundp 'nnheader-read-timeout))
 115       (defalias 'pop3-accept-process-output 'nnheader-accept-process-output)
 116     ;; Borrowed from `nnheader.el':
 117     (defvar pop3-read-timeout
 118       (if (string-match "windows-nt\\|os/2\\|cygwin"
 119                         (symbol-name system-type))
 120           1.0
 121         0.01)
 122       "How long pop3 should wait between checking for the end of output.
 123 Shorter values mean quicker response, but are more CPU intensive.")
 124     (defun pop3-accept-process-output (process)
 125       (accept-process-output
 126        process
 127        (truncate pop3-read-timeout)
 128        (truncate (* (- pop3-read-timeout
 129                        (truncate pop3-read-timeout))
 130                     1000))))))
 131
 132 (defun pop3-streaming-movemail (file)
 133   "Transfer contents of a maildrop to the specified FILE.
 134 Use streaming commands."
 135   (let* ((process (pop3-open-server pop3-mailhost pop3-port))
 136          message-count message-total-size)
 137     (pop3-logon process)
 138     (with-current-buffer (process-buffer process)
 139       (let ((size (pop3-stat process)))
 140         (setq message-count (car size)
 141               message-total-size (cadr size)))
 142       (when (plusp message-count)
 143         (pop3-send-streaming-command
 144          process "RETR" message-count message-total-size)
 145         (pop3-write-to-file file)
 146         (unless pop3-leave-mail-on-server
 147           (pop3-send-streaming-command
 148            process "DELE" message-count nil))))
 149     (pop3-quit process)
 150     t))
 151
 152 (defun pop3-send-streaming-command (process command count total-size)
 153   (erase-buffer)
 154   (let ((i 1))
 155     (while (>= count i)
 156       (process-send-string process (format "%s %d\r\n" command i))
 157       ;; Only do 100 messages at a time to avoid pipe stalls.
 158       (when (zerop (% i 100))
 159         (pop3-wait-for-messages process i total-size))
 160       (incf i)))
 161   (pop3-wait-for-messages process count total-size))
 162
 163 (defun pop3-wait-for-messages (process count total-size)
 164   (while (< (pop3-number-of-responses total-size) count)
 165     (when total-size
 166       (message "pop3 retrieved %dKB (%d%%)"
 167                (truncate (/ (buffer-size) 1000))
 168                (truncate (* (/ (* (buffer-size) 1.0)
 169                                total-size) 100))))
 170     (nnheader-accept-process-output process)))
 171
 172 (defun pop3-write-to-file (file)
 173   (let ((pop-buffer (current-buffer))
 174         (start (point-min))
 175         beg end
 176         temp-buffer)
 177     (with-temp-buffer
 178       (setq temp-buffer (current-buffer))
 179       (with-current-buffer pop-buffer
 180         (goto-char (point-min))
 181         (while (re-search-forward "^\\+OK" nil t)
 182           (forward-line 1)
 183           (setq beg (point))
 184           (when (re-search-forward "^\\.\r?\n" nil t)
 185             (setq start (point))
 186             (forward-line -1)
 187             (setq end (point)))
 188           (with-current-buffer temp-buffer
 189             (goto-char (point-max))
 190             (let ((hstart (point)))
 191               (insert-buffer-substring pop-buffer beg end)
 192               (pop3-clean-region hstart (point))
 193               (goto-char (point-max))
 194               (pop3-munge-message-separator hstart (point))
 195               (goto-char (point-max))))))
 196       (let ((coding-system-for-write 'binary))
 197         (goto-char (point-min))
 198         ;; Check whether something inserted a newline at the start and
 199         ;; delete it.
 200         (when (eolp)
 201           (delete-char 1))
 202         (write-region (point-min) (point-max) file nil 'nomesg)))))
 203
 204 (defun pop3-number-of-responses (endp)
 205   (let ((responses 0))
 206     (save-excursion
 207       (goto-char (point-min))
 208       (while (or (and (re-search-forward "^\\+OK" nil t)
 209                       (or (not endp)
 210                           (re-search-forward "^\\.\r?\n" nil t)))
 211                  (re-search-forward "^-ERR " nil t))
 212         (incf responses)))
 213     responses))
 214
 215 (defun pop3-logon (process)
 216   (let ((pop3-password pop3-password))
 217     ;; for debugging only
 218     (if pop3-debug (switch-to-buffer (process-buffer process)))
 219     ;; query for password
 220     (if (and pop3-password-required (not pop3-password))
 221         (setq pop3-password
 222               (read-passwd (format "Password for %s: " pop3-maildrop))))
 223     (cond ((equal 'apop pop3-authentication-scheme)
 224            (pop3-apop process pop3-maildrop))
 225           ((equal 'pass pop3-authentication-scheme)
 226            (pop3-user process pop3-maildrop)
 227            (pop3-pass process))
 228           (t (error "Invalid POP3 authentication scheme")))))
 229
 230 (defun pop3-movemail (&optional crashbox)
 231   "Transfer contents of a maildrop to the specified CRASHBOX."
 232   (or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
 233   (let* ((process (pop3-open-server pop3-mailhost pop3-port))
 234          (crashbuf (get-buffer-create " *pop3-retr*"))
 235          (n 1)
 236          message-count
 237          message-sizes)
 238     (pop3-logon process)
 239     (setq message-count (car (pop3-stat process)))
 240     (when (> message-count 0)
 241       (setq message-sizes (pop3-list process)))
 242     (unwind-protect
 243         (while (<= n message-count)
 244           (message "Retrieving message %d of %d from %s... (%.1fk)"
 245                    n message-count pop3-mailhost
 246                    (/ (cdr (assoc n message-sizes))
 247                       1024.0))
 248           (pop3-retr process n crashbuf)
 249           (save-excursion
 250             (set-buffer crashbuf)
 251             (let ((coding-system-for-write 'binary))
 252               (write-region (point-min) (point-max) crashbox t 'nomesg))
 253             (set-buffer (process-buffer process))
 254             (erase-buffer))
 255           (unless pop3-leave-mail-on-server
 256             (pop3-dele process n))
 257           (setq n (+ 1 n))
 258           (pop3-accept-process-output process))
 259       (when (and pop3-leave-mail-on-server
 260                  (> n 1))
 261         (message "pop3.el doesn't support UIDL.  Setting `pop3-leave-mail-on-server'
 262 to %s might not give the result you'd expect." pop3-leave-mail-on-server)
 263         (sit-for 1))
 264       (pop3-quit process))
 265     (kill-buffer crashbuf))
 266   t)
 267
 268 (defun pop3-get-message-count ()
 269   "Return the number of messages in the maildrop."
 270   (let* ((process (pop3-open-server pop3-mailhost pop3-port))
 271          message-count
 272          (pop3-password pop3-password))
 273     ;; for debugging only
 274     (if pop3-debug (switch-to-buffer (process-buffer process)))
 275     ;; query for password
 276     (if (and pop3-password-required (not pop3-password))
 277         (setq pop3-password
 278               (read-passwd (format "Password for %s: " pop3-maildrop))))
 279     (cond ((equal 'apop pop3-authentication-scheme)
 280            (pop3-apop process pop3-maildrop))
 281           ((equal 'pass pop3-authentication-scheme)
 282            (pop3-user process pop3-maildrop)
 283            (pop3-pass process))
 284           (t (error "Invalid POP3 authentication scheme")))
 285     (setq message-count (car (pop3-stat process)))
 286     (pop3-quit process)
 287     message-count))
 288
 289 (autoload 'open-tls-stream "tls")
 290 (autoload 'starttls-open-stream "starttls")
 291 (autoload 'starttls-negotiate "starttls") ; avoid warning
 292
 293 (defcustom pop3-stream-type nil
 294   "*Transport security type for POP3 connexions.
 295 This may be either nil (plain connexion), `ssl' (use an
 296 SSL/TSL-secured stream) or `starttls' (use the starttls mechanism
 297 to turn on TLS security after opening the stream).  However, if
 298 this is nil, `ssl' is assumed for connexions to port
 299 995 (pop3s)."
 300   :version "23.1" ;; No Gnus
 301   :group 'pop3
 302   :type '(choice (const :tag "Plain" nil)
 303                  (const :tag "SSL/TLS" ssl)
 304                  (const starttls)))
 305
 306 (eval-and-compile
 307   (if (fboundp 'set-process-query-on-exit-flag)
 308       (defalias 'pop3-set-process-query-on-exit-flag
 309         'set-process-query-on-exit-flag)
 310     (defalias 'pop3-set-process-query-on-exit-flag
 311       'process-kill-without-query)))
 312
 313 (defun pop3-open-server (mailhost port)
 314   "Open TCP connection to MAILHOST on PORT.
 315 Returns the process associated with the connection."
 316   (let ((coding-system-for-read 'binary)
 317         (coding-system-for-write 'binary)
 318         process)
 319     (save-excursion
 320       (set-buffer (get-buffer-create (concat " trace of POP session to "
 321                                              mailhost)))
 322       (erase-buffer)
 323       (setq pop3-read-point (point-min))
 324       (setq process
 325             (cond
 326              ((or (eq pop3-stream-type 'ssl)
 327                   (and (not pop3-stream-type) (member port '(995 "pop3s"))))
 328               ;; gnutls-cli, openssl don't accept service names
 329               (if (or (equal port "pop3s")
 330                       (null port))
 331                   (setq port 995))
 332               (let ((process (open-tls-stream "POP" (current-buffer)
 333                                               mailhost port)))
 334                 (when process
 335                   ;; There's a load of info printed that needs deleting.
 336                   (let ((again 't))
 337                     ;; repeat until
 338                     ;; - either we received the +OK line
 339                     ;; - or accept-process-output timed out without getting
 340                     ;;   anything
 341                     (while (and again
 342                                 (setq again (memq (process-status process)
 343                                                   '(open run))))
 344                       (setq again (pop3-accept-process-output process))
 345                       (goto-char (point-max))
 346                       (forward-line -1)
 347                       (cond ((looking-at "\\+OK")
 348                              (setq again nil)
 349                              (delete-region (point-min) (point)))
 350                             ((not again)
 351                              (pop3-quit process)
 352                              (error "POP SSL connexion failed")))))
 353                   process)))
 354              ((eq pop3-stream-type 'starttls)
 355               ;; gnutls-cli, openssl don't accept service names
 356               (if (equal port "pop3")
 357                   (setq port 110))
 358               (let ((process (starttls-open-stream "POP" (current-buffer)
 359                                                    mailhost (or port 110))))
 360                 (pop3-send-command process "STLS")
 361                 (let ((response (pop3-read-response process t)))
 362                   (if (and response (string-match "+OK" response))
 363                       (starttls-negotiate process)
 364                     (pop3-quit process)
 365                     (error "POP server doesn't support starttls")))
 366                 process))
 367              (t
 368               (open-network-stream "POP" (current-buffer) mailhost port))))
 369       (let ((response (pop3-read-response process t)))
 370         (setq pop3-timestamp
 371               (substring response (or (string-match "<" response) 0)
 372                          (+ 1 (or (string-match ">" response) -1)))))
 373       (pop3-set-process-query-on-exit-flag process nil)
 374       process)))
 375
 376 ;; Support functions
 377
 378 (defun pop3-send-command (process command)
 379   (set-buffer (process-buffer process))
 380   (goto-char (point-max))
 381   ;; (if (= (aref command 0) ?P)
 382   ;;     (insert "PASS <omitted>\r\n")
 383   ;;   (insert command "\r\n"))
 384   (setq pop3-read-point (point))
 385   (goto-char (point-max))
 386   (process-send-string process (concat command "\r\n")))
 387
 388 (defun pop3-read-response (process &optional return)
 389   "Read the response from the server.
 390 Return the response string if optional second argument is non-nil."
 391   (let ((case-fold-search nil)
 392         match-end)
 393     (save-excursion
 394       (set-buffer (process-buffer process))
 395       (goto-char pop3-read-point)
 396       (while (and (memq (process-status process) '(open run))
 397                   (not (search-forward "\r\n" nil t)))
 398         (pop3-accept-process-output process)
 399         (goto-char pop3-read-point))
 400       (setq match-end (point))
 401       (goto-char pop3-read-point)
 402       (if (looking-at "-ERR")
 403           (error "%s" (buffer-substring (point) (- match-end 2)))
 404         (if (not (looking-at "+OK"))
 405             (progn (setq pop3-read-point match-end) nil)
 406           (setq pop3-read-point match-end)
 407           (if return
 408               (buffer-substring (point) match-end)
 409             t)
 410           )))))
 411
 412 (defun pop3-clean-region (start end)
 413   (setq end (set-marker (make-marker) end))
 414   (save-excursion
 415     (goto-char start)
 416     (while (and (< (point) end) (search-forward "\r\n" end t))
 417       (replace-match "\n" t t))
 418     (goto-char start)
 419     (while (and (< (point) end) (re-search-forward "^\\." end t))
 420       (replace-match "" t t)
 421       (forward-char)))
 422   (set-marker end nil))
 423
 424 ;; Copied from message-make-date.
 425 (defun pop3-make-date (&optional now)
 426   "Make a valid date header.
 427 If NOW, use that time instead."
 428   (require 'parse-time)
 429   (let* ((now (or now (current-time)))
 430          (zone (nth 8 (decode-time now)))
 431          (sign "+"))
 432     (when (< zone 0)
 433       (setq sign "-")
 434       (setq zone (- zone)))
 435     (concat
 436      (format-time-string "%d" now)
 437      ;; The month name of the %b spec is locale-specific.  Pfff.
 438      (format " %s "
 439              (capitalize (car (rassoc (nth 4 (decode-time now))
 440                                       parse-time-months))))
 441      (format-time-string "%Y %H:%M:%S " now)
 442      ;; We do all of this because XEmacs doesn't have the %z spec.
 443      (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60)))))
 444
 445 (defun pop3-munge-message-separator (start end)
 446   "Check to see if a message separator exists.  If not, generate one."
 447   (save-excursion
 448     (save-restriction
 449       (narrow-to-region start end)
 450       (goto-char (point-min))
 451       (if (not (or (looking-at "From .?") ; Unix mail
 452                    (looking-at "\001\001\001\001\n") ; MMDF
 453                    (looking-at "BABYL OPTIONS:") ; Babyl
 454                    ))
 455           (let* ((from (mail-strip-quoted-names (mail-fetch-field "From")))
 456                  (tdate (mail-fetch-field "Date"))
 457                  (date (split-string (or (and tdate
 458                                               (not (string= "" tdate))
 459                                               tdate)
 460                                          (pop3-make-date))
 461                                      " "))
 462                  (From_))
 463             ;; sample date formats I have seen
 464             ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT)
 465             ;; Date: 08 Jul 1996 23:22:24 -0400
 466             ;; should be
 467             ;; Tue Jul 9 09:04:21 1996
 468
 469             ;; Fixme: This should use timezone on the date field contents.
 470             (setq date
 471                   (cond ((not date)
 472                          "Tue Jan 1 00:00:0 1900")
 473                         ((string-match "[A-Z]" (nth 0 date))
 474                          (format "%s %s %s %s %s"
 475                                  (nth 0 date) (nth 2 date) (nth 1 date)
 476                                  (nth 4 date) (nth 3 date)))
 477                         (t
 478                          ;; this really needs to be better but I don't feel
 479                          ;; like writing a date to day converter.
 480                          (format "Sun %s %s %s %s"
 481                                  (nth 1 date) (nth 0 date)
 482                                  (nth 3 date) (nth 2 date)))
 483                         ))
 484             (setq From_ (format "\nFrom %s  %s\n" from date))
 485             (while (string-match "," From_)
 486               (setq From_ (concat (substring From_ 0 (match-beginning 0))
 487                                   (substring From_ (match-end 0)))))
 488             (goto-char (point-min))
 489             (insert From_)
 490             (if (search-forward "\n\n" nil t)
 491                 nil
 492               (goto-char (point-max))
 493               (insert "\n"))
 494             (let ((size (- (point-max) (point))))
 495               (forward-line -1)
 496               (insert (format "Content-Length: %s\n" size)))
 497             )))))
 498
 499 ;; The Command Set
 500
 501 ;; AUTHORIZATION STATE
 502
 503 (defun pop3-user (process user)
 504   "Send USER information to POP3 server."
 505   (pop3-send-command process (format "USER %s" user))
 506   (let ((response (pop3-read-response process t)))
 507     (if (not (and response (string-match "+OK" response)))
 508         (error "USER %s not valid" user))))
 509
 510 (defun pop3-pass (process)
 511   "Send authentication information to the server."
 512   (pop3-send-command process (format "PASS %s" pop3-password))
 513   (let ((response (pop3-read-response process t)))
 514     (if (not (and response (string-match "+OK" response)))
 515         (pop3-quit process))))
 516
 517 (defun pop3-apop (process user)
 518   "Send alternate authentication information to the server."
 519   (let ((pass pop3-password))
 520     (if (and pop3-password-required (not pass))
 521         (setq pass
 522               (read-passwd (format "Password for %s: " pop3-maildrop))))
 523     (if pass
 524         (let ((hash (md5 (concat pop3-timestamp pass) nil nil 'binary)))
 525           (pop3-send-command process (format "APOP %s %s" user hash))
 526           (let ((response (pop3-read-response process t)))
 527             (if (not (and response (string-match "+OK" response)))
 528                 (pop3-quit process)))))
 529     ))
 530
 531 ;; TRANSACTION STATE
 532
 533 (defun pop3-stat (process)
 534   "Return the number of messages in the maildrop and the maildrop's size."
 535   (pop3-send-command process "STAT")
 536   (let ((response (pop3-read-response process t)))
 537     (list (string-to-number (nth 1 (split-string response " ")))
 538           (string-to-number (nth 2 (split-string response " "))))
 539     ))
 540
 541 (defun pop3-list (process &optional msg)
 542   "If MSG is nil, return an alist of (MESSAGE-ID . SIZE) pairs.
 543 Otherwise, return the size of the message-id MSG"
 544   (pop3-send-command process (if msg
 545                                  (format "LIST %d" msg)
 546                                "LIST"))
 547   (let ((response (pop3-read-response process t)))
 548     (if msg
 549         (string-to-number (nth 2 (split-string response " ")))
 550       (let ((start pop3-read-point) end)
 551         (save-excursion
 552           (set-buffer (process-buffer process))
 553           (while (not (re-search-forward "^\\.\r\n" nil t))
 554             (pop3-accept-process-output process)
 555             (goto-char start))
 556           (setq pop3-read-point (point-marker))
 557           (goto-char (match-beginning 0))
 558           (setq end (point-marker))
 559           (mapcar #'(lambda (s) (let ((split (split-string s " ")))
 560                                   (cons (string-to-number (nth 0 split))
 561                                         (string-to-number (nth 1 split)))))
 562                   (delete "" (split-string (buffer-substring start end)
 563                                            "\r\n"))))))))
 564
 565 (defun pop3-retr (process msg crashbuf)
 566   "Retrieve message-id MSG to buffer CRASHBUF."
 567   (pop3-send-command process (format "RETR %s" msg))
 568   (pop3-read-response process)
 569   (let ((start pop3-read-point) end)
 570     (save-excursion
 571       (set-buffer (process-buffer process))
 572       (while (not (re-search-forward "^\\.\r\n" nil t))
 573         (pop3-accept-process-output process)
 574         (goto-char start))
 575       (setq pop3-read-point (point-marker))
 576       ;; this code does not seem to work for some POP servers...
 577       ;; and I cannot figure out why not.
 578       ;;      (goto-char (match-beginning 0))
 579       ;;      (backward-char 2)
 580       ;;      (if (not (looking-at "\r\n"))
 581       ;;          (insert "\r\n"))
 582       ;;      (re-search-forward "\\.\r\n")
 583       (goto-char (match-beginning 0))
 584       (setq end (point-marker))
 585       (pop3-clean-region start end)
 586       (pop3-munge-message-separator start end)
 587       (save-excursion
 588         (set-buffer crashbuf)
 589         (erase-buffer))
 590       (copy-to-buffer crashbuf start end)
 591       (delete-region start end)
 592       )))
 593
 594 (defun pop3-dele (process msg)
 595   "Mark message-id MSG as deleted."
 596   (pop3-send-command process (format "DELE %s" msg))
 597   (pop3-read-response process))
 598
 599 (defun pop3-noop (process msg)
 600   "No-operation."
 601   (pop3-send-command process "NOOP")
 602   (pop3-read-response process))
 603
 604 (defun pop3-last (process)
 605   "Return highest accessed message-id number for the session."
 606   (pop3-send-command process "LAST")
 607   (let ((response (pop3-read-response process t)))
 608     (string-to-number (nth 1 (split-string response " ")))
 609     ))
 610
 611 (defun pop3-rset (process)
 612   "Remove all delete marks from current maildrop."
 613   (pop3-send-command process "RSET")
 614   (pop3-read-response process))
 615
 616 ;; UPDATE
 617
 618 (defun pop3-quit (process)
 619   "Close connection to POP3 server.
 620 Tell server to remove all messages marked as deleted, unlock the maildrop,
 621 and close the connection."
 622   (pop3-send-command process "QUIT")
 623   (pop3-read-response process t)
 624   (if process
 625       (save-excursion
 626         (set-buffer (process-buffer process))
 627         (goto-char (point-max))
 628         (delete-process process))))
 629 \f
 630 ;; Summary of POP3 (Post Office Protocol version 3) commands and responses
 631
 632 ;;; AUTHORIZATION STATE
 633
 634 ;; Initial TCP connection
 635 ;; Arguments: none
 636 ;; Restrictions: none
 637 ;; Possible responses:
 638 ;;  +OK [POP3 server ready]
 639
 640 ;; USER name
 641 ;; Arguments: a server specific user-id (required)
 642 ;; Restrictions: authorization state [after unsuccessful USER or PASS
 643 ;; Possible responses:
 644 ;;  +OK [valid user-id]
 645 ;;  -ERR [invalid user-id]
 646
 647 ;; PASS string
 648 ;; Arguments: a server/user-id specific password (required)
 649 ;; Restrictions: authorization state, after successful USER
 650 ;; Possible responses:
 651 ;;  +OK [maildrop locked and ready]
 652 ;;  -ERR [invalid password]
 653 ;;  -ERR [unable to lock maildrop]
 654
 655 ;; STLS      (RFC 2595)
 656 ;; Arguments: none
 657 ;; Restrictions: Only permitted in AUTHORIZATION state.
 658 ;; Possible responses:
 659 ;;  +OK
 660 ;;  -ERR
 661
 662 ;;; TRANSACTION STATE
 663
 664 ;; STAT
 665 ;; Arguments: none
 666 ;; Restrictions: transaction state
 667 ;; Possible responses:
 668 ;;  +OK nn mm [# of messages, size of maildrop]
 669
 670 ;; LIST [msg]
 671 ;; Arguments: a message-id (optional)
 672 ;; Restrictions: transaction state; msg must not be deleted
 673 ;; Possible responses:
 674 ;;  +OK [scan listing follows]
 675 ;;  -ERR [no such message]
 676
 677 ;; RETR msg
 678 ;; Arguments: a message-id (required)
 679 ;; Restrictions: transaction state; msg must not be deleted
 680 ;; Possible responses:
 681 ;;  +OK [message contents follow]
 682 ;;  -ERR [no such message]
 683
 684 ;; DELE msg
 685 ;; Arguments: a message-id (required)
 686 ;; Restrictions: transaction state; msg must not be deleted
 687 ;; Possible responses:
 688 ;;  +OK [message deleted]
 689 ;;  -ERR [no such message]
 690
 691 ;; NOOP
 692 ;; Arguments: none
 693 ;; Restrictions: transaction state
 694 ;; Possible responses:
 695 ;;  +OK
 696
 697 ;; LAST
 698 ;; Arguments: none
 699 ;; Restrictions: transaction state
 700 ;; Possible responses:
 701 ;;  +OK nn [highest numbered message accessed]
 702
 703 ;; RSET
 704 ;; Arguments: none
 705 ;; Restrictions: transaction state
 706 ;; Possible responses:
 707 ;;  +OK [all delete marks removed]
 708
 709 ;;; UPDATE STATE
 710
 711 ;; QUIT
 712 ;; Arguments: none
 713 ;; Restrictions: none
 714 ;; Possible responses:
 715 ;;  +OK [TCP connection closed]
 716
 717 (provide 'pop3)
 718
 719 ;;; pop3.el ends here