;;; pop3.el --- Post Office Protocol (RFC 1460) interface
-;; Copyright (C) 1996, Free Software Foundation, Inc.
+;; Copyright (C) 1996,1997 Free Software Foundation, Inc.
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
;; Keywords: mail, pop3
-;; Version: 1.3
+;; Version: 1.3g
;; This file is part of GNU Emacs.
(require 'mail-utils)
(provide 'pop3)
-(eval-and-compile
- (if (not (fboundp 'md5)) (autoload 'md5 "md5")))
+(defconst pop3-version "1.3g")
(defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil)
"*POP3 maildrop.")
"*Password to use when connecting to POP server.")
(defvar pop3-authentication-scheme 'pass
- "*POP3 authentication scheme. Defaults to 'pass, for the standard
-USER/PASS authentication. Other valid values are 'apop.")
+ "*POP3 authentication scheme.
+Defaults to 'pass, for the standard USER/PASS authentication. Other valid
+values are 'apop.")
(defvar pop3-timestamp nil
"Timestamp returned when initially connected to the POP server.
Used for APOP authentication.")
+(defvar pop3-movemail-file-coding-system nil
+ "Crashbox made by pop3-movemail with this coding system.")
+
(defvar pop3-read-point nil)
(defvar pop3-debug nil)
(pop3-retr process n crashbuf)
(save-excursion
(set-buffer crashbuf)
- (append-to-file (point-min) (point-max) crashbox))
+ (let ((coding-system-for-write pop3-movemail-file-coding-system))
+ (append-to-file (point-min) (point-max) crashbox))
+ (set-buffer (process-buffer process))
+ (while (> (buffer-size) 5000)
+ (goto-char (point-min))
+ (forward-line 50)
+ (delete-region (point-min) (point))))
(pop3-dele process n)
- (setq n (+ 1 n)))
+ (setq n (+ 1 n))
+ (if pop3-debug (sit-for 1) (sit-for 0.1))
+ )
(pop3-quit process)
(kill-buffer crashbuf)
)
(set-buffer (process-buffer process))
(goto-char pop3-read-point)
(while (not (search-forward "\r\n" nil t))
- (accept-process-output process)
+ (accept-process-output process 3)
(goto-char pop3-read-point))
(setq match-end (point))
(goto-char pop3-read-point)
(defun pop3-munge-message-separator (start end)
"Check to see if a message separator exists. If not, generate one."
+ (if (not (fboundp 'message-make-date)) (autoload 'message-make-date "message"))
(save-excursion
(save-restriction
(narrow-to-region start end)
(looking-at "BABYL OPTIONS:") ; Babyl
))
(let ((from (mail-strip-quoted-names (mail-fetch-field "From")))
- (date (pop3-string-to-list (mail-fetch-field "Date")))
+ (date (pop3-string-to-list (or (mail-fetch-field "Date")
+ (message-make-date))))
(From_))
;; sample date formats I have seen
;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT)
(nth 1 date) (nth 0 date)
(nth 3 date) (nth 2 date)))
))
- (setq From_ (format "From %s %s\n" from date))
+ (setq From_ (format "\nFrom %s %s\n" from date))
(while (string-match "," From_)
(setq From_ (concat (substring From_ 0 (match-beginning 0))
(substring From_ (match-end 0)))))
(pop3-quit process)))))
))
+(defvar pop3-md5-program "md5"
+ "*Program to encode its input in MD5.")
+
+(defun pop3-md5 (string)
+ (with-temp-buffer
+ (insert string)
+ (call-process-region (point-min) (point-max)
+ (or shell-file-name "/bin/sh")
+ t (current-buffer) nil
+ "-c" pop3-md5-program)
+ ;; The meaningful output is the first 32 characters.
+ ;; Don't return the newline that follows them!
+ (buffer-substring (point-min) (+ (point-min) 32))))
+
(defun pop3-apop (process user)
"Send alternate authentication information to the server."
- (if (not (fboundp 'md5)) (autoload 'md5 "md5"))
(let ((pass pop3-password))
(if (and pop3-password-required (not pass))
(setq pass
(pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
(if pass
- (let ((hash (md5 (concat pop3-timestamp pass))))
+ (let ((hash (pop3-md5 (concat pop3-timestamp pass))))
(pop3-send-command process (format "APOP %s %s" user hash))
(let ((response (pop3-read-response process t)))
(if (not (and response (string-match "+OK" response)))
;; TRANSACTION STATE
(defun pop3-stat (process)
- "Return a list of the number of messages in the maildrop and the size
-of the maildrop."
+ "Return the number of messages in the maildrop and the maildrop's size."
(pop3-send-command process "STAT")
(let ((response (pop3-read-response process t)))
(list (string-to-int (nth 1 (pop3-string-to-list response)))
This function currently does nothing.")
(defun pop3-retr (process msg crashbuf)
- "Retrieve message-id MSG from the server and place the contents in
-buffer CRASHBUF."
+ "Retrieve message-id MSG to buffer CRASHBUF."
(pop3-send-command process (format "RETR %s" msg))
(pop3-read-response process)
(let ((start pop3-read-point) end)
(save-excursion
(set-buffer (process-buffer process))
(while (not (re-search-forward "^\\.\r\n" nil t))
- (accept-process-output process)
+ (accept-process-output process 3)
;; bill@att.com ... to save wear and tear on the heap
(if (> (buffer-size) 20000) (sleep-for 1))
(if (> (buffer-size) 50000) (sleep-for 1))
;; bill@att.com
(goto-char start))
(setq pop3-read-point (point-marker))
+;; this code does not seem to work for some POP servers...
+;; and I cannot figure out why not.
+; (goto-char (match-beginning 0))
+; (backward-char 2)
+; (if (not (looking-at "\r\n"))
+; (insert "\r\n"))
+; (re-search-forward "\\.\r\n")
(goto-char (match-beginning 0))
(setq end (point-marker))
(pop3-clean-region start end)
;; UPDATE
(defun pop3-quit (process)
- "Tell server to remove all messages marked as deleted, unlock the
-maildrop, and close the connection."
+ "Close connection to POP3 server.
+Tell server to remove all messages marked as deleted, unlock the maildrop,
+and close the connection."
(pop3-send-command process "QUIT")
(pop3-read-response process t)
(if process
projects / gnus / blobdiff