From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/50354 Path: main.gmane.org!not-for-mail From: Reiner Steib <4.uce.03.r.s@nurfuerspam.de> Newsgroups: gmane.emacs.gnus.general Subject: Re: Limiting number of Incomingxxxx mails Date: Mon, 24 Feb 2003 21:25:42 +0100 Sender: owner-ding@hpc.uh.edu Message-ID: References: Reply-To: reiner.steib@gmx.de NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: main.gmane.org 1046118432 684 80.91.224.249 (24 Feb 2003 20:27:12 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 24 Feb 2003 20:27:12 +0000 (UTC) Return-path: Original-Received: from malifon.math.uh.edu ([129.7.128.13]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 18nPBu-0000As-00 for ; Mon, 24 Feb 2003 21:27:10 +0100 Original-Received: from sina.hpc.uh.edu ([129.7.128.10] ident=lists) by malifon.math.uh.edu with esmtp (Exim 3.20 #1) id 18nPAs-0005K9-00; Mon, 24 Feb 2003 14:26:06 -0600 Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Mon, 24 Feb 2003 14:27:05 -0600 (CST) Original-Received: from sclp3.sclp.com (sclp3.sclp.com [66.230.238.2]) by sina.hpc.uh.edu (8.9.3/8.9.3) with SMTP id OAA07081 for ; Mon, 24 Feb 2003 14:26:50 -0600 (CST) Original-Received: (qmail 16066 invoked by alias); 24 Feb 2003 20:25:45 -0000 Original-Received: (qmail 16060 invoked from network); 24 Feb 2003 20:25:45 -0000 Original-Received: from theotp5.physik.uni-ulm.de (134.60.10.145) by 66.230.238.6 with SMTP; 24 Feb 2003 20:25:45 -0000 Original-Received: (from ste@localhost) by theotp5.physik.uni-ulm.de (8.11.2/8.11.2) id h1OKPgo22296; Mon, 24 Feb 2003 21:25:42 +0100 X-Authentication-Warning: theotp5.physik.uni-ulm.de: ste set sender to 4.uce.03.r.s@nurfuerspam.de using -f Original-To: ding@gnus.org X-Face: P05mdcZT&lL[-s2=mw~RsllZ0zZAb?vdE}.s (Lars Magne Ingebrigtsen's message of "Sat, 22 Feb 2003 23:05:59 +0100") User-Agent: Gnus/5.090016 (Oort Gnus v0.16) Emacs/21.2.95 (i686-pc-linux-gnu) Precedence: list X-Majordomo: 1.94.jlt7 Xref: main.gmane.org gmane.emacs.gnus.general:50354 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:50354 --=-=-= On Sat, Feb 22 2003, Lars Magne Ingebrigtsen wrote: [ `mail-source-delete-old-incoming' ] > I'm not quite sure that such a function is a good idea. The > Incoming* files are created only by pretest Gnusae, so they should > only be produced by versions of Gnus that are dangerous, mail-wise > speaking. Having mechanisms for automatically deleting stuff in > such a situation might be counterproductive. The default value of `mail-source-delete-incoming' should still be `nil' in pretest Gnusae, i.e. no automatically deleting, no change to the current behavior. I don't see any harm if Gnus would offer an option to delete old files. Note that additionally there's a `confirm' argument in `mail-source-delete-old-incoming' and a variable `mail-source-delete-old-incoming-confirm'. I.e. the user has to change `mail-source-delete-incoming' to a positive integer (default is nil) *and* change `mail-source-delete-old-incoming-confirm' to nil (default is t) in order to get automatic deleting without confirmation for every single incoming file. I suppose this should be enough protection. :-) I'll add proper documentation, if this patch will be accepted. --8<---------------cut here---------------start------------->8--- 2003-02-24 Reiner Steib * mail-source.el (mail-source-delete-incoming): Allow integer value. (mail-source-delete-old-incoming-confirm): New variable. (mail-source-delete-old-incoming): Use it. New function. (mail-source-callback): Call `mail-source-delete-old-incoming' if `mail-source-delete-incoming' is a nonnegative integer. --8<---------------cut here---------------end--------------->8--- Here's a revised version[1] of the patch: --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=mail-source.delete-old-incoming.02.patch Content-Description: mail-source.delete-old-incoming.02.patch --- mail-source.el.~6.29.~ Mon Feb 17 11:37:23 2003 +++ mail-source.el Mon Feb 24 21:07:41 2003 @@ -263,7 +263,21 @@ :type 'integer) (defcustom mail-source-delete-incoming nil - "*If non-nil, delete incoming files after handling." + "*If non-nil, delete incoming files after handling. +If t, delete immediately, if nil, never delete. If a positive number, delete +files older than number of days." + ;; Note: The removing happens in `mail-source-callback', i.e. no old + ;; incoming files will be deleted, unless you receive new mail. + ;; + ;; You may also set this to `nil' and call `mail-source-delete-old-incoming' + ;; from a hook or interactively. + :group 'mail-source + :type '(choice (const :tag "immediately" t) + (const :tag "never" nil) + (integer :tag "days"))) + +(defcustom mail-source-delete-old-incoming-confirm t + "*If non-nil, ask for for confirmation before deleting old incoming files." :group 'mail-source :type 'boolean) @@ -506,6 +520,34 @@ (setq newname (make-temp-name newprefix))) newname)))) +(defun mail-source-delete-old-incoming (&optional age confirm) + "Remove incoming files older than AGE days. +If CONFIRM is non-nil, ask for confirmation before removing a file." + (interactive "P") + (let* ((high2days (/ 65536.0 60 60 24));; convert high bits to days + (low2days (/ 1.0 65536.0)) ;; convert low bits to days + (diff (if (natnump age) age 30));; fallback, if no valid AGE given + currday files) + (setq files (directory-files + mail-source-directory t + (concat mail-source-incoming-file-prefix "*")) + currday (* (car (current-time)) high2days) + currday (+ currday (* low2days (nth 1 (current-time))))) + (while files + (let* ((ffile (car files)) + (bfile (gnus-replace-in-string + ffile "\\`.*/\\([^/]+\\)\\'" "\\1")) + (filetime (nth 5 (file-attributes ffile))) + (fileday (* (car filetime) high2days)) + (fileday (+ fileday (* low2days (nth 1 filetime))))) + (setq files (cdr files)) + (when (and (> (- currday fileday) diff) + (gnus-message 8 "File `%s' is older than %s day(s)" + bfile diff) + (or (not confirm) + (y-or-n-p (concat "Remove file `" bfile "'? ")))) + (delete-file ffile)))))) + (defun mail-source-callback (callback info) "Call CALLBACK on the mail file, and then remove the mail file. Pass INFO on to CALLBACK." @@ -519,7 +561,7 @@ (funcall callback mail-source-crash-box info) (when (file-exists-p mail-source-crash-box) ;; Delete or move the incoming mail out of the way. - (if mail-source-delete-incoming + (if (eq mail-source-delete-incoming t) (delete-file mail-source-crash-box) (let ((incoming (mail-source-make-complex-temp-name @@ -528,8 +570,13 @@ mail-source-directory)))) (unless (file-exists-p (file-name-directory incoming)) (make-directory (file-name-directory incoming) t)) - (rename-file mail-source-crash-box incoming t))))))) - + (rename-file mail-source-crash-box incoming t) + ;; remove old incoming files? + (when (natnump mail-source-delete-incoming) + (mail-source-delete-old-incoming + mail-source-delete-incoming + mail-source-delete-old-incoming-confirm)))))))) + (defun mail-source-movemail (from to) "Move FROM to TO using movemail." (if (not (file-writable-p to)) --=-=-= Bye, Reiner. [1] Simplified the code (thanks to JPW): Use natnump, set most variables in a let* form instead of using setq. -- ,,, (o o) ---ooO-(_)-Ooo--- PGP key available via WWW http://rsteib.home.pages.de/ --=-=-=--