From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/12394 Path: main.gmane.org!not-for-mail From: Mansuriatus Shahrir Amir Newsgroups: gmane.emacs.gnus.general Subject: Keep Mail on pop3 server Date: 29 Sep 1997 20:13:02 -0700 Message-ID: NNTP-Posting-Host: coloc-standby.netfonds.no X-Trace: main.gmane.org 1035151939 3579 80.91.224.250 (20 Oct 2002 22:12:19 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Sun, 20 Oct 2002 22:12:19 +0000 (UTC) Return-Path: Original-Received: from xemacs.org (xemacs.cs.uiuc.edu [128.174.252.16]) by altair.xemacs.org (8.8.7/8.8.7) with ESMTP id GAA16188 for ; Mon, 29 Sep 1997 06:36:01 -0700 Original-Received: from ifi.uio.no (0@ifi.uio.no [129.240.64.2]) by xemacs.org (8.8.5/8.8.5) with SMTP id IAA27861 for ; Mon, 29 Sep 1997 08:29:34 -0500 (CDT) Original-Received: from claymore.vcinet.com (claymore.vcinet.com [208.205.12.23]) by ifi.uio.no with SMTP (8.6.11/ifi2.4) id for ; Mon, 29 Sep 1997 14:09:38 +0200 Original-Received: (qmail 10726 invoked by uid 504); 29 Sep 1997 12:09:33 -0000 Original-Received: (qmail 10723 invoked from network); 29 Sep 1997 12:09:15 -0000 Original-Received: from weblock.tm.net.my (202.188.0.180) by claymore.vcinet.com with SMTP; 29 Sep 1997 12:09:14 -0000 Original-Received: from MANSUR ([202.188.7.90]) by weblock.tm.net.my (Post.Office MTA v3.1 release PO203a ID# 581-40942U100000L100000S0) with SMTP id AAA16428 for ; Mon, 29 Sep 1997 20:09:55 +0800 Original-To: ding@gnus.org Original-Lines: 286 X-Mailer: Quassia Gnus v0.10/Emacs 19.34 Xref: main.gmane.org gmane.emacs.gnus.general:12394 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:12394 First of all I would like to thanks Lars and Rotinox for helping me configure nnagent. I should have known to put (gnus-agentize) in .gnus as in the manual, rather than in .emacs. Thanks for pointing out to me. BTW I still unable to download Quasia 0.11 as I'm unable to access www.gnus.org at all. The ftp server doesn't have the file. One more thing I would like to do, if ne1 knows the answer. As per the subject, does ne1 already has the setup that leave mail on pop3 server. I have the solution for Vm whereby I would use "UIDL" feature on some pop3 server and caches that information in a file. Then the next time I visit the server those messages already downloaded would not be downloaded the second time. The code is given to me by someone and has been in use by me satisfactorily. If the server doesn't support UIDL, it will behave similar as before but the mail is still kept on server, and the same msgs will be downloaded again the next time. The code is given below. I'm not that familiar with Elisp hence adapting it to Gnus is beyond me. But if ne1's willing I'll be appreciated. The code is below. ; -*-Emacs-Lisp-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; File: vm-pop-extra.el ; RCS: $Header: n:/src/vm/vm-hacks/RCS/vm-pop-extra.el,v 1.3 1997-09-17 18:47:29-04 mjchan Exp mjchan $ ; Abstract: uidl support for vm-pop ; Author: Ming-Jen Chan (mjchan@cs.cmu.edu) ; Created: Mon Feb 10 15:43:34 1997 ; Modified: Ming-Jen Chan (mjchan@cs.cmu.edu) ; Language: Emacs-Lisp ; Package: N/A ; Status: Experimental ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Verbatim copies of this file may be freely redistributed. ;;; ;;; Modified versions of this file may be redistributed provided that this ;;; notice remains unchanged, the file contains prominent notice of ;;; author and time of modifications, and redistribution of the file ;;; is not further restricted in any way. ;;; ;;; This file is distributed `as is', without warranties of any kind. ;;; See the GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Emacs; see the file COPYING. If not, write to ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; What is in this file: ; The code in this file provides the support of ; leaving mail on pop3 server after it is retrieved. This is ; controlled by adding the keyword "keep" in vm-spool-files' spool name ; specification, something like: popserver:110:pass:user:*:keep ; However, this feature won't work with pop server that does not ; support UIDL. For such server, message can still be kept on server, ; but will be downloaded every time retrieving is performed. ; this code is based on vm-pop.el written by Kyle Jones, the author of VM. (provide 'vm-pop-extra) (require 'vm-pop) ;;; internal variables (defvar vm-pop-keep-mail-for-size nil "internal variable that indicates the mail that was not downloaded should be kept on server.") (defvar vm-pop-uidl-list-filename ".vm-pop-uidl-list" "UIDL list last seen on pop server. This is the template, the real name is the template appended with the pop3 host name in the folder directory.") ;;; code (defun vm-pop-save-uidl-list (host list) "Write LIST to the file named by \"vm-pop-uidl-list-filename\"." (save-window-excursion (let* ((file (concat (expand-file-name vm-pop-uidl-list-filename vm-folder-directory) "-" host)) (buf (set-buffer (create-file-buffer file)))) (set-visited-file-name file) (erase-buffer) (prin1 list buf) (princ "\n" buf) (save-buffer 0) (kill-buffer buf)))) (defun vm-pop-read-retrieved-uidl-list (host) "Read the current uidl list from the file named by \"vm-pop-uidl-list-filename\". The list is the return value." (let ((list nil) (file (concat (expand-file-name vm-pop-uidl-list-filename vm-folder-directory) "-" host))) (save-window-excursion (if (not (file-readable-p file)) (message "server %s doesn't have a list of UIDLs yet in %s." host file) (find-file-read-only file) (setq list (read (current-buffer))) (kill-buffer (current-buffer)))) list)) (defun vm-pop-server-speak-uidl (process) "verify if pop server supports UIDL and return the uidl list if it does." (vm-pop-send-command process "UIDL") (if (not (vm-pop-read-response process)) nil (let ((start vm-pop-read-point) end response (ulist nil)) (goto-char start) (while (not (re-search-forward "^\\.\r\n" nil t)) (accept-process-output process) (goto-char start)) (setq vm-pop-read-point (point-marker)) (goto-char start) (while (re-search-forward "^[^\\.].*\r\n" nil t) (setq response (buffer-substring (match-beginning 0) (match-end 0))) (setq response (vm-parse response "\\([^ \r]+\\) *")) (setq ulist (append ulist (list (cons (nth 0 response) (nth 1 response)))))) (goto-char vm-pop-read-point) ulist))) (defun vm-pop-read-uidl-response (process) (let ((response (vm-pop-read-response process t))) (nth 2 (vm-parse response "\\([^ \r]+\\) *")))) (defun vm-pop-read-list-response (process) (let ((response (vm-pop-read-response process t))) (string-to-int (nth 2 (vm-parse response "\\([^ \r]+\\) *"))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; modified version of vm-pop-move-mail ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun vm-pop-move-mail (source destination) (let ((process nil) (folder-type vm-folder-type) (saved-password t) (m-per-session vm-pop-messages-per-session) (b-per-session vm-pop-bytes-per-session) (handler (and (fboundp 'find-file-name-handler) (condition-case () (find-file-name-handler source 'vm-pop-move-mail) (wrong-number-of-arguments (find-file-name-handler source))))) (popdrop (vm-safe-popdrop-string source)) (statblob nil) (host (nth 0 (vm-parse source "\\([^:]+\\):?"))) uidl mn mlist keep-mail-on-server server-speak-uidl latest-uidl-list retrieved-uidl-list mailbox-count mailbox-size message-size response n retrieved retrieved-bytes process-buffer) (unwind-protect (catch 'done (if handler (throw 'done (funcall handler 'vm-pop-move-mail source destination))) ;; check if this pop mailbox should keep those emails that are ;; retrieved. (if (equal (nth 5 (vm-parse source "\\([^:]+\\):?")) "keep") (setq keep-mail-on-server t) (setq keep-mail-on-server nil)) (setq process (vm-pop-make-session source)) (or process (throw 'done nil)) (setq process-buffer (process-buffer process)) (save-excursion (set-buffer process-buffer) (setq vm-folder-type (or folder-type vm-default-folder-type)) ;; find out how many messages are in the box. (vm-pop-send-command process "STAT") (setq response (vm-pop-read-stat-response process) mailbox-count (nth 0 response) mailbox-size (nth 1 response)) ;; forget it if the command fails ;; or if there are no messages present. (if (or (null mailbox-count) (< mailbox-count 1)) (throw 'done nil)) ;; check if the server speaks UIDL ;; server-speak-uidl: the list maintained by the server ;; retrieved-uidl-list: the list of mails that have been retrieved ;; latest-uidle-list: copy of server-speak-uidl ;; mlist: a list of mails that will be retrieved in this connection. (setq latest-uidl-list nil mlist nil n 1) (setq server-speak-uidl (vm-pop-server-speak-uidl process)) (if server-speak-uidl ;; server does speak UIDL (progn (setq retrieved-uidl-list (vm-pop-read-retrieved-uidl-list host)) (while (<= n mailbox-count) (setq uidl (cdr (nth (1- n) server-speak-uidl))) (setq latest-uidl-list (append latest-uidl-list (list uidl))) (if (not (member uidl retrieved-uidl-list)) (setq mlist (append mlist (list (cons n uidl))))) (vm-increment n)) (if (null mlist) (throw 'done nil) (setq mailbox-count (length mlist)))) ;; the server does not speak UIDL, all mails will be retrieved. (while (<= n mailbox-count) (setq mlist (append mlist (list (cons n nil)))) (vm-increment n))) ;; loop through the maildrop retrieving and deleting ;; messages as we go. (setq mn 1 retrieved 0 retrieved-bytes 0) (setq statblob (vm-pop-start-status-timer)) (vm-set-pop-stat-x-box statblob popdrop) (vm-set-pop-stat-x-maxmsg statblob mailbox-count) (while (and (<= mn mailbox-count) (or (not (natnump m-per-session)) (< retrieved m-per-session)) (or (not (natnump b-per-session)) (< retrieved-bytes b-per-session))) ;; uidl stuff (setq n (car (car mlist))) ; message number (setq uidl (cdr (car mlist))) ; message UIDL (setq mlist (cdr mlist)) ; the rest of the UIDL list (vm-set-pop-stat-x-currmsg statblob n) (vm-pop-send-command process (format "LIST %d" n)) (setq message-size (vm-pop-read-list-response process)) (vm-set-pop-stat-x-need statblob message-size) (if (and (integerp vm-pop-max-message-size) (> message-size vm-pop-max-message-size) (progn (setq response (if vm-pop-ok-to-ask (vm-pop-ask-about-large-message process message-size n) 'skip)) (not (eq response 'retrieve)))) (if (eq response 'delete) (progn (message "Deleting message %d..." n) (vm-pop-send-command process (format "DELE %d" n)) (if server-speak-uidl ;; delete the uidl from the list (delete uidl latest-uidl-list)) (and (null (vm-pop-read-response process)) (throw 'done (not (equal retrieved 0))))) (if server-speak-uidl ;; delete the uidl from the list (delete uidl latest-uidl-list)) (if vm-pop-ok-to-ask (message "Skipping message %d..." n) (message "Skipping message %d in %s, too large (%d > %d)..." n popdrop message-size vm-pop-max-message-size))) (message "Retrieving message %d (%d of %d) from %s..." n mn mailbox-count popdrop) (vm-pop-send-command process (format "RETR %d" n)) (and (null (vm-pop-read-response process)) (throw 'done (not (equal retrieved 0)))) (and (null (vm-pop-retrieve-to-crashbox process destination statblob)) (throw 'done (not (equal retrieved 0)))) (vm-increment retrieved) (and b-per-session (setq retrieved-bytes (+ retrieved-bytes message-size))) (if (not keep-mail-on-server) (progn (vm-pop-send-command process (format "DELE %d" n)) (if server-speak-uidl ;; delete the uidl from the list (delete uidl latest-uidl-list)) ;; DELE can't fail but Emacs or this code might ;; blow a gasket and spew filth down the ;; connection, so... (and (null (vm-pop-read-response process)) (throw 'done (not (equal retrieved 0)))))) (vm-increment mn))) (if server-speak-uidl (progn (setq retrieved-uidl-list latest-uidl-list) (vm-pop-save-uidl-list host retrieved-uidl-list))) (not (equal retrieved 0)))) (and statblob (vm-pop-stop-status-timer statblob)) (if process (vm-pop-end-session process))))) --------------------------------------------------------------------- Mansuriatus Shahrir Amir mansur@tm.net.my