* Keep Mail on pop3 server
@ 1997-09-30 3:13 Mansuriatus Shahrir Amir
0 siblings, 0 replies; only message in thread
From: Mansuriatus Shahrir Amir @ 1997-09-30 3:13 UTC (permalink / raw)
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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~1997-09-30 3:13 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
1997-09-30 3:13 Keep Mail on pop3 server Mansuriatus Shahrir Amir
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).