Mercurial > hg > xemacs-beta

comparison lisp/gnus/pop3.el @ 38:1a767b41a199 r19-15b102

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b102
author cvs
date Mon, 13 Aug 2007 08:54:01 +0200
parents 0293115a14e9
children cca96a509cfe
comparison
equal deleted inserted replaced
37:ad40ac360d14 38:1a767b41a199
2 2
3 ;; Copyright (C) 1996, Free Software Foundation, Inc. 3 ;; Copyright (C) 1996, Free Software Foundation, Inc.
4 4
5 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net> 5 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
6 ;; Keywords: mail, pop3 6 ;; Keywords: mail, pop3
7 ;; Version: 1.3 7 ;; Version: 1.3c
8 8
9 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
10 10
11 ;; GNU Emacs is free software; you can redistribute it and/or modify 11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by 12 ;; it under the terms of the GNU General Public License as published by
35 ;;; Code: 35 ;;; Code:
36 36
37 (require 'mail-utils) 37 (require 'mail-utils)
38 (provide 'pop3) 38 (provide 'pop3)
39 39
40 (eval-and-compile 40 (defconst pop3-version "1.3c")
41 (if (not (fboundp 'md5)) (autoload 'md5 "md5")))
42 41
43 (defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil) 42 (defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil)
44 "*POP3 maildrop.") 43 "*POP3 maildrop.")
45 (defvar pop3-mailhost (or (getenv "MAILHOST") nil) 44 (defvar pop3-mailhost (or (getenv "MAILHOST") nil)
46 "*POP3 mailhost.") 45 "*POP3 mailhost.")
51 "*Non-nil if a password is required when connecting to POP server.") 50 "*Non-nil if a password is required when connecting to POP server.")
52 (defvar pop3-password nil 51 (defvar pop3-password nil
53 "*Password to use when connecting to POP server.") 52 "*Password to use when connecting to POP server.")
54 53
55 (defvar pop3-authentication-scheme 'pass 54 (defvar pop3-authentication-scheme 'pass
56 "*POP3 authentication scheme. Defaults to 'pass, for the standard 55 "*POP3 authentication scheme.
57 USER/PASS authentication. Other valid values are 'apop.") 56 Defaults to 'pass, for the standard USER/PASS authentication. Other valid
57 values are 'apop.")
58 58
59 (defvar pop3-timestamp nil 59 (defvar pop3-timestamp nil
60 "Timestamp returned when initially connected to the POP server. 60 "Timestamp returned when initially connected to the POP server.
61 Used for APOP authentication.") 61 Used for APOP authentication.")
62 62
83 (message (format "Retrieving message %d of %d from %s..." 83 (message (format "Retrieving message %d of %d from %s..."
84 n message-count pop3-mailhost)) 84 n message-count pop3-mailhost))
85 (pop3-retr process n crashbuf) 85 (pop3-retr process n crashbuf)
86 (save-excursion 86 (save-excursion
87 (set-buffer crashbuf) 87 (set-buffer crashbuf)
88 (append-to-file (point-min) (point-max) crashbox)) 88 (append-to-file (point-min) (point-max) crashbox)
89 (set-buffer (process-buffer process))
90 (while (> (buffer-size) 5000)
91 (goto-char (point-min))
92 (forward-line 50)
93 (delete-region (point-min) (point))))
89 (pop3-dele process n) 94 (pop3-dele process n)
90 (setq n (+ 1 n))) 95 (setq n (+ 1 n))
96 (if pop3-debug (sit-for 1) (sit-for 0.1))
97 )
91 (pop3-quit process) 98 (pop3-quit process)
92 (kill-buffer crashbuf) 99 (kill-buffer crashbuf)
93 ) 100 )
94 ) 101 )
95 102
270 )) 277 ))
271 278
272 ;; TRANSACTION STATE 279 ;; TRANSACTION STATE
273 280
274 (defun pop3-stat (process) 281 (defun pop3-stat (process)
275 "Return a list of the number of messages in the maildrop and the size 282 "Return the number of messages in the maildrop and the maildrop's size."
276 of the maildrop."
277 (pop3-send-command process "STAT") 283 (pop3-send-command process "STAT")
278 (let ((response (pop3-read-response process t))) 284 (let ((response (pop3-read-response process t)))
279 (list (string-to-int (nth 1 (pop3-string-to-list response))) 285 (list (string-to-int (nth 1 (pop3-string-to-list response)))
280 (string-to-int (nth 2 (pop3-string-to-list response)))) 286 (string-to-int (nth 2 (pop3-string-to-list response))))
281 )) 287 ))
283 (defun pop3-list (process &optional msg) 289 (defun pop3-list (process &optional msg)
284 "Scan listing of available messages. 290 "Scan listing of available messages.
285 This function currently does nothing.") 291 This function currently does nothing.")
286 292
287 (defun pop3-retr (process msg crashbuf) 293 (defun pop3-retr (process msg crashbuf)
288 "Retrieve message-id MSG from the server and place the contents in 294 "Retrieve message-id MSG to buffer CRASHBUF."
289 buffer CRASHBUF."
290 (pop3-send-command process (format "RETR %s" msg)) 295 (pop3-send-command process (format "RETR %s" msg))
291 (pop3-read-response process) 296 (pop3-read-response process)
292 (let ((start pop3-read-point) end) 297 (let ((start pop3-read-point) end)
293 (save-excursion 298 (save-excursion
294 (set-buffer (process-buffer process)) 299 (set-buffer (process-buffer process))
302 (if (> (buffer-size) 500000) (sleep-for 1)) 307 (if (> (buffer-size) 500000) (sleep-for 1))
303 ;; bill@att.com 308 ;; bill@att.com
304 (goto-char start)) 309 (goto-char start))
305 (setq pop3-read-point (point-marker)) 310 (setq pop3-read-point (point-marker))
306 (goto-char (match-beginning 0)) 311 (goto-char (match-beginning 0))
312 (backward-char 2)
313 (if (not (looking-at "\r\n"))
314 (insert "\r\n"))
315 (re-search-forward "\\.\r\n")
316 (goto-char (match-beginning 0))
307 (setq end (point-marker)) 317 (setq end (point-marker))
308 (pop3-clean-region start end) 318 (pop3-clean-region start end)
309 (pop3-munge-message-separator start end) 319 (pop3-munge-message-separator start end)
310 (save-excursion 320 (save-excursion
311 (set-buffer crashbuf) 321 (set-buffer crashbuf)
337 (pop3-read-response process)) 347 (pop3-read-response process))
338 348
339 ;; UPDATE 349 ;; UPDATE
340 350
341 (defun pop3-quit (process) 351 (defun pop3-quit (process)
342 "Tell server to remove all messages marked as deleted, unlock the 352 "Close connection to POP3 server.
343 maildrop, and close the connection." 353 Tell server to remove all messages marked as deleted, unlock the maildrop,
354 and close the connection."
344 (pop3-send-command process "QUIT") 355 (pop3-send-command process "QUIT")
345 (pop3-read-response process t) 356 (pop3-read-response process t)
346 (if process 357 (if process
347 (save-excursion 358 (save-excursion
348 (set-buffer (process-buffer process)) 359 (set-buffer (process-buffer process))