Mercurial > emacs
comparison lisp/gnus/pop3.el @ 26108:08a36c7a0a52
Merge changes from version `1.3s' which we weren't sent.
author | Dave Love <fx@gnu.org> |
---|---|
date | Tue, 19 Oct 1999 18:27:39 +0000 |
parents | 04a29f9f6a22 |
children | 64597461b498 |
comparison
equal
deleted
inserted
replaced
26107:5bdae485eb03 | 26108:08a36c7a0a52 |
---|---|
1 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface | 1 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface |
2 | 2 |
3 ;; Copyright (C) 1996,1997,1998 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1996-1999 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 ;; Maintainer: FSF |
7 ;; Version: 1.3m | 7 ;; Keywords: mail |
8 ;; Version: 1.3s | |
8 | 9 |
9 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
10 | 11 |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;; 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 | 13 ;; it under the terms of the GNU General Public License as published by |
33 ;; This program was inspired by Kyle E. Jones's vm-pop program. | 34 ;; This program was inspired by Kyle E. Jones's vm-pop program. |
34 | 35 |
35 ;;; Code: | 36 ;;; Code: |
36 | 37 |
37 (require 'mail-utils) | 38 (require 'mail-utils) |
38 (provide 'pop3) | 39 |
39 | 40 (defconst pop3-version "1.3s") |
40 (defconst pop3-version "1.3m") | |
41 | 41 |
42 (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) |
43 "*POP3 maildrop.") | 43 "*POP3 maildrop.") |
44 (defvar pop3-mailhost (or (getenv "MAILHOST") nil) | 44 (defvar pop3-mailhost (or (getenv "MAILHOST") nil) |
45 "*POP3 mailhost.") | 45 "*POP3 mailhost.") |
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 |
63 (defvar pop3-movemail-file-coding-system nil | 63 (defvar pop3-movemail-file-coding-system nil |
64 "Crashbox made by pop3-movemail with this coding system.") | 64 "Crashbox made by `pop3-movemail' with this coding system.") |
65 | 65 |
66 (defvar pop3-read-point nil) | 66 (defvar pop3-read-point nil) |
67 (defvar pop3-debug nil) | 67 (defvar pop3-debug nil) |
68 | 68 |
69 (defun pop3-movemail (&optional crashbox) | 69 (defun pop3-movemail (&optional crashbox) |
84 (cond ((equal 'apop pop3-authentication-scheme) | 84 (cond ((equal 'apop pop3-authentication-scheme) |
85 (pop3-apop process pop3-maildrop)) | 85 (pop3-apop process pop3-maildrop)) |
86 ((equal 'pass pop3-authentication-scheme) | 86 ((equal 'pass pop3-authentication-scheme) |
87 (pop3-user process pop3-maildrop) | 87 (pop3-user process pop3-maildrop) |
88 (pop3-pass process)) | 88 (pop3-pass process)) |
89 (t (error "Invalid POP3 authentication scheme."))) | 89 (t (error "Invalid POP3 authentication scheme"))) |
90 (setq message-count (car (pop3-stat process))) | 90 (setq message-count (car (pop3-stat process))) |
91 (while (<= n message-count) | 91 (unwind-protect |
92 (message (format "Retrieving message %d of %d from %s..." | 92 (while (<= n message-count) |
93 n message-count pop3-mailhost)) | 93 (message (format "Retrieving message %d of %d from %s..." |
94 (pop3-retr process n crashbuf) | 94 n message-count pop3-mailhost)) |
95 (save-excursion | 95 (pop3-retr process n crashbuf) |
96 (set-buffer crashbuf) | 96 (save-excursion |
97 (let ((coding-system-for-write pop3-movemail-file-coding-system)) | 97 (set-buffer crashbuf) |
98 (append-to-file (point-min) (point-max) crashbox)) | 98 (write-region (point-min) (point-max) crashbox t 'nomesg) |
99 (set-buffer (process-buffer process)) | 99 (set-buffer (process-buffer process)) |
100 (while (> (buffer-size) 5000) | 100 (while (> (buffer-size) 5000) |
101 (goto-char (point-min)) | 101 (goto-char (point-min)) |
102 (forward-line 50) | 102 (forward-line 50) |
103 (delete-region (point-min) (point)))) | 103 (delete-region (point-min) (point)))) |
104 (pop3-dele process n) | 104 (pop3-dele process n) |
105 (setq n (+ 1 n)) | 105 (setq n (+ 1 n)) |
106 (if pop3-debug (sit-for 1) (sit-for 0.1)) | 106 (if pop3-debug (sit-for 1) (sit-for 0.1)) |
107 ) | 107 ) |
108 (pop3-quit process) | 108 (pop3-quit process)) |
109 (kill-buffer crashbuf) | 109 (kill-buffer crashbuf) |
110 ) | 110 ) |
111 ) | 111 t) |
112 | 112 |
113 (defun pop3-open-server (mailhost port) | 113 (defun pop3-open-server (mailhost port) |
114 "Open TCP connection to MAILHOST. | 114 "Open TCP connection to MAILHOST on PORT. |
115 Returns the process associated with the connection." | 115 Returns the process associated with the connection." |
116 (let ((process-buffer | 116 (let ((process-buffer |
117 (get-buffer-create (format "trace of POP session to %s" mailhost))) | 117 (get-buffer-create (format "trace of POP session to %s" mailhost))) |
118 (process) | 118 (process) |
119 (coding-system-for-read 'binary) | 119 (coding-system-for-read 'binary) |
147 ;; (if (= (aref command 0) ?P) | 147 ;; (if (= (aref command 0) ?P) |
148 ;; (insert "PASS <omitted>\r\n") | 148 ;; (insert "PASS <omitted>\r\n") |
149 ;; (insert command "\r\n")) | 149 ;; (insert command "\r\n")) |
150 (setq pop3-read-point (point)) | 150 (setq pop3-read-point (point)) |
151 (goto-char (point-max)) | 151 (goto-char (point-max)) |
152 (process-send-string process command) | 152 (process-send-string process (concat command "\r\n")) |
153 (process-send-string process "\r\n") | |
154 ) | 153 ) |
155 | 154 |
156 (defun pop3-read-response (process &optional return) | 155 (defun pop3-read-response (process &optional return) |
157 "Read the response from the server. | 156 "Read the response from the server. |
158 Return the response string if optional second argument is non-nil." | 157 Return the response string if optional second argument is non-nil." |
250 (setq From_ (format "\nFrom %s %s\n" from date)) | 249 (setq From_ (format "\nFrom %s %s\n" from date)) |
251 (while (string-match "," From_) | 250 (while (string-match "," From_) |
252 (setq From_ (concat (substring From_ 0 (match-beginning 0)) | 251 (setq From_ (concat (substring From_ 0 (match-beginning 0)) |
253 (substring From_ (match-end 0))))) | 252 (substring From_ (match-end 0))))) |
254 (goto-char (point-min)) | 253 (goto-char (point-min)) |
255 (insert From_)))))) | 254 (insert From_) |
255 (re-search-forward "\n\n") | |
256 (narrow-to-region (point) (point-max)) | |
257 (let ((size (- (point-max) (point-min)))) | |
258 (goto-char (point-min)) | |
259 (widen) | |
260 (forward-line -1) | |
261 (insert (format "Content-Length: %s\n" size))) | |
262 ))))) | |
256 | 263 |
257 ;; The Command Set | 264 ;; The Command Set |
258 | 265 |
259 ;; AUTHORIZATION STATE | 266 ;; AUTHORIZATION STATE |
260 | 267 |
468 ;; QUIT | 475 ;; QUIT |
469 ;; Arguments: none | 476 ;; Arguments: none |
470 ;; Restrictions: none | 477 ;; Restrictions: none |
471 ;; Possible responses: | 478 ;; Possible responses: |
472 ;; +OK [TCP connection closed] | 479 ;; +OK [TCP connection closed] |
480 | |
481 (provide 'pop3) | |
482 | |
483 ;;; pop3.el ends here |