+2004-10-15 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-backend-article-list-property)
+ (spam-backend-get-article-todo-list)
+ (spam-backend-put-article-todo-list, )
+ (spam-summary-prepare-exit, spam-resolve-registrations-routine):
+ resolve registrations separately
+ (spam-register-routine): format comments
+ (spam-unregister-routine, spam-register-routine): always call with
+ specific-articles, no default list
+ (spam-summary-prepare-exit): use the spam-classifications function
+
+ * netrc.el (autoload, netrc-parse): use encrypt.el instead of
+ gnus-encrypt.el
+
+ * encrypt.el: copied from gnus-encrypt.el
+
+ * gnus-encrypt.el: commented that it's obsolete
+
+2004-10-15 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-score.el (gnus-adaptive-pretty-print): New variable.
+ (gnus-score-save): Use it.
+
+ * message.el (message-bury): Use `window-dedicated-p'.
+
2004-10-15 Simon Josefsson <jas@extundo.com>
* pop3.el (top-level): Don't require nnheader.
--- /dev/null
+;;; encrypt.el --- file encryption routines
+;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: Teodor Zlatanov <tzz@lifelogs.com>
+;; Created: 2003/01/24
+;; Keywords: files
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; This module addresses data encryption. Page breaks are used for
+;;; grouping declarations and documentation relating to each
+;;; particular aspect.
+
+;;; Code:
+
+;; autoload password
+(eval-and-compile
+ (autoload 'password-read "password"))
+
+(defgroup encrypt nil
+ "File encryption configuration.")
+
+(defcustom encrypt-password-cache-expiry 200
+ "Encryption password timeout.
+When set, directly sets password-cache-expiry"
+ :type 'integer
+ :group 'encrypt
+ :set (lambda (symbol value)
+ (set symbol value)
+ (setq password-cache-expiry value)))
+
+(defcustom encrypt-file-alist nil
+ "List of file names or regexes matched with encryptions.
+Format example:
+ '((\"beta\"
+ (gpg \"AES\"))
+ (\"/home/tzz/alpha\"
+ (encrypt-xor \"Semi-Secret\")))"
+
+ :type '(repeat
+ (list :tag "Encryption entry"
+ (radio :tag "What to encrypt"
+ (file :tag "Filename")
+ (regexp :tag "Regular expression match"))
+ (radio :tag "How to encrypt it"
+ (list
+ :tag "GPG Encryption"
+ (const :tag "GPG Program" gpg)
+ (radio :tag "Choose a cipher"
+ (const :tag "3DES Encryption" "3DES")
+ (const :tag "CAST5 Encryption" "CAST5")
+ (const :tag "Blowfish Encryption" "BLOWFISH")
+ (const :tag "AES Encryption" "AES")
+ (const :tag "AES192 Encryption" "AES192")
+ (const :tag "AES256 Encryption" "AES256")
+ (const :tag "Twofish Encryption" "TWOFISH")
+ (string :tag "Cipher Name")))
+ (list
+ :tag "Built-in simple XOR"
+ (const :tag "XOR Encryption" encrypt-xor)
+ (string :tag "XOR Cipher Value (seed value)")))))
+ :group 'encrypt)
+
+;; TODO: now, load gencrypt.el and if successful, modify the
+;; custom-type of encrypt-file-alist to add the gencrypt.el options
+
+;; (plist-get (symbol-plist 'encrypt-file-alist) 'custom-type)
+;; then use plist-put
+
+(defcustom encrypt-gpg-path (executable-find "gpg")
+ "Path to the GPG program."
+ :type '(radio
+ (file :tag "Location of the GPG executable")
+ (const :tag "GPG is not installed" nil))
+ :group 'encrypt)
+
+(defvar encrypt-temp-prefix "encrypt"
+ "Prefix for temporary filenames")
+
+(defun encrypt-find-model (filename)
+ "Given a filename, find a encrypt-file-alist entry"
+ (dolist (entry encrypt-file-alist)
+ (let ((match (nth 0 entry))
+ (model (nth 1 entry)))
+ (when (or (eq match filename)
+ (string-match match filename))
+ (return model)))))
+
+(defun encrypt-insert-file-contents (file &optional model)
+ "Decrypt FILE into the current buffer."
+ (interactive "fFile to insert: ")
+ (let* ((model (or model (encrypt-find-model file)))
+ (method (nth 0 model))
+ (cipher (nth 1 model))
+ (password-key (format "encrypt-password-%s-%s %s"
+ (symbol-name method) cipher file))
+ (passphrase
+ (password-read-and-add
+ (format "%s password for cipher %s? "
+ (symbol-name method) cipher)
+ password-key))
+ (buffer-file-coding-system 'binary)
+ (coding-system-for-read 'binary)
+ outdata)
+
+ ;; note we only insert-file-contents if the method is known to be valid
+ (cond
+ ((eq method 'gpg)
+ (insert-file-contents file)
+ (setq outdata (encrypt-gpg-decode-buffer passphrase cipher)))
+ ((eq method 'encrypt-xor)
+ (insert-file-contents file)
+ (setq outdata (encrypt-xor-decode-buffer passphrase cipher))))
+
+ (if outdata
+ (progn
+ (gnus-message 9 "%s was decrypted with %s (cipher %s)"
+ file (symbol-name method) cipher)
+ (delete-region (point-min) (point-max))
+ (goto-char (point-min))
+ (insert outdata))
+ ;; the decryption failed, alas
+ (password-cache-remove password-key)
+ (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)"
+ file (symbol-name method) cipher))))
+
+(defun encrypt-get-file-contents (file &optional model)
+ "Decrypt FILE and return the contents."
+ (interactive "fFile to decrypt: ")
+ (with-temp-buffer
+ (encrypt-insert-file-contents file model)
+ (buffer-string)))
+
+(defun encrypt-put-file-contents (file data &optional model)
+ "Encrypt the DATA to FILE, then continue normally."
+ (with-temp-buffer
+ (insert data)
+ (encrypt-write-file-contents file model)))
+
+(defun encrypt-write-file-contents (file &optional model)
+ "Encrypt the current buffer to FILE, then continue normally."
+ (interactive "fFile to write: ")
+ (let* ((model (or model (encrypt-find-model file)))
+ (method (nth 0 model))
+ (cipher (nth 1 model))
+ (password-key (format "encrypt-password-%s-%s %s"
+ (symbol-name method) cipher file))
+ (passphrase
+ (password-read
+ (format "%s password for cipher %s? "
+ (symbol-name method) cipher)
+ password-key))
+ outdata)
+
+ (cond
+ ((eq method 'gpg)
+ (setq outdata (encrypt-gpg-encode-buffer passphrase cipher)))
+ ((eq method 'encrypt-xor)
+ (setq outdata (encrypt-xor-encode-buffer passphrase cipher))))
+
+ (if outdata
+ (progn
+ (gnus-message 9 "%s was encrypted with %s (cipher %s)"
+ file (symbol-name method) cipher)
+ (delete-region (point-min) (point-max))
+ (goto-char (point-min))
+ (insert outdata)
+ ;; do not confirm overwrites
+ (write-file file nil))
+ ;; the decryption failed, alas
+ (password-cache-remove password-key)
+ (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)"
+ file (symbol-name method) cipher))))
+
+(defun encrypt-xor-encode-buffer (passphrase cipher)
+ (encrypt-xor-process-buffer passphrase cipher t))
+
+(defun encrypt-xor-decode-buffer (passphrase cipher)
+ (encrypt-xor-process-buffer passphrase cipher nil))
+
+(defun encrypt-xor-process-buffer (passphrase
+ cipher
+ &optional encode)
+ "Given PASSPHRASE, xor-encode or decode the contents of the current buffer."
+ (let* ((bs (buffer-substring-no-properties (point-min) (point-max)))
+ ;; passphrase-sum is a simple additive checksum of the
+ ;; passphrase and the cipher
+ (passphrase-sum
+ (when (stringp passphrase)
+ (apply '+ (append cipher passphrase nil))))
+ new-list)
+
+ (with-temp-buffer
+ (if encode
+ (progn
+ (dolist (x (append bs nil))
+ (setq new-list (cons (logxor x passphrase-sum) new-list)))
+
+ (dolist (x new-list)
+ (insert (format "%d " x))))
+ (progn
+ (setq new-list (reverse (split-string bs)))
+ (dolist (x new-list)
+ (setq x (string-to-int x))
+ (insert (format "%c" (logxor x passphrase-sum))))))
+ (buffer-substring-no-properties (point-min) (point-max)))))
+
+(defun encrypt-gpg-encode-buffer (passphrase cipher)
+ (encrypt-gpg-process-buffer passphrase cipher t))
+
+(defun encrypt-gpg-decode-buffer (passphrase cipher)
+ (encrypt-gpg-process-buffer passphrase cipher nil))
+
+(defun encrypt-gpg-process-buffer (passphrase
+ cipher
+ &optional encode)
+ "With PASSPHRASE, use GPG to encode or decode the current buffer."
+ (let* ((program encrypt-gpg-path)
+ (input (buffer-substring-no-properties (point-min) (point-max)))
+ (temp-maker (if (fboundp 'make-temp-file)
+ 'make-temp-file
+ 'make-temp-name))
+ (temp-file (funcall temp-maker encrypt-temp-prefix))
+ (default-enable-multibyte-characters nil)
+ (args `("--cipher-algo" ,cipher
+ "--status-fd" "2"
+ "--logger-fd" "2"
+ "--passphrase-fd" "0"
+ "--no-tty"))
+ exit-status exit-data)
+
+ (when encode
+ (setq args
+ (append args
+ '("--symmetric"
+ "--armor"))))
+
+ (if program
+ (with-temp-buffer
+ (when passphrase
+ (insert passphrase "\n"))
+ (insert input)
+ (setq exit-status
+ (apply #'call-process-region (point-min) (point-max) program
+ t `(t ,temp-file) nil args))
+ (if (equal exit-status 0)
+ (setq exit-data
+ (buffer-substring-no-properties (point-min) (point-max)))
+ (with-temp-buffer
+ (when (file-exists-p temp-file)
+ (insert-file-contents temp-file))
+ (gnus-error 5 (format "%s exited abnormally: '%s' [%s]"
+ program exit-status (buffer-string)))))
+ (delete-file temp-file))
+ (gnus-error 5 "GPG is not installed."))
+ exit-data))
+
+(provide 'encrypt)
+;;; encrypt.el ends here
+
+;; arch-tag: d907e4f1-71b5-42b1-a180-fc7b84ff0648
-;;; gnus-encrypt.el --- file encryption routines for Gnus
+;;; gnus-encrypt.el --- file encryption routines for Gnus, OBSOLETE (use encrypt.el instead)
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
:group 'gnus-score-files
:type 'regexp)
+(defcustom gnus-adaptive-pretty-print nil
+ "If non-nil, adaptive score files fill are pretty printed."
+ :group 'gnus-score-files
+ :group 'gnus-score-adapt
+ :version "22.0" ;; No Gnus
+ :type 'boolean)
+
(defcustom gnus-score-default-header nil
"Default header when entering new scores.
(setq score (setcdr entry (gnus-delete-alist 'touched score)))
(erase-buffer)
(let (emacs-lisp-mode-hook)
- (if (string-match
- (concat (regexp-quote gnus-adaptive-file-suffix) "$")
- file)
- ;; This is an adaptive score file, so we do not run
- ;; it through `pp'. These files can get huge, and
- ;; are not meant to be edited by human hands.
+ (if (and (not gnus-adaptive-pretty-print)
+ (string-match
+ (concat (regexp-quote gnus-adaptive-file-suffix) "$")
+ file))
+ ;; This is an adaptive score file, so we do not run it through
+ ;; `pp' unless requested. These files can get huge, and are
+ ;; not meant to be edited by human hands.
(gnus-prin1 score)
;; This is a normal score file, so we print it very
;; prettily.
"Bury this mail BUFFER."
(let ((newbuf (other-buffer buffer)))
(bury-buffer buffer)
- (if (and (fboundp 'frame-parameters)
- (cdr (assq 'dedicated (frame-parameters)))
+ (if (and (window-dedicated-p (selected-window))
(not (null (delq (selected-frame) (visible-frame-list)))))
(delete-frame (selected-frame))
(switch-to-buffer newbuf))))
;;; .netrc and .authinfo rc parsing
;;;
-;; autoload gnus-encrypt
+;; autoload encrypt
(eval-and-compile
- (autoload 'gnus-encrypt-find-model "gnus-encrypt")
- (autoload 'gnus-encrypt-insert-file-contents "gnus-encrypt"))
+ (autoload 'encrypt-find-model "encrypt")
+ (autoload 'encrypt-insert-file-contents "encrypt"))
(defgroup netrc nil
"Netrc configuration.")
(let ((tokens '("machine" "default" "login"
"password" "account" "macdef" "force"
"port"))
- (encryption-model (gnus-encrypt-find-model file))
+ (encryption-model (encrypt-find-model file))
alist elem result pair)
(if encryption-model
- (gnus-encrypt-insert-file-contents file encryption-model)
+ (encrypt-insert-file-contents file encryption-model)
(insert-file-contents file))
(goto-char (point-min))
classification
type)))
+(defun spam-backend-article-list-property (classification
+ &optional unregister)
+ "Property name of article list with CLASSIFICATION and UNREGISTER."
+ (let* ((r (if unregister "unregister" "register"))
+ (prop (format "%s-%s" classification r)))
+ prop))
+
+(defun spam-backend-get-article-todo-list (backend
+ classification
+ &optional unregister)
+ "Get the articles to be processed for BACKEND and CLASSIFICATION.
+With UNREGISTER, get articles to be unregistered.
+This is a temporary storage function - nothing here persists."
+ (get
+ backend
+ (intern (spam-backend-article-list-property classification unregister))))
+
+(defun spam-backend-put-article-todo-list (backend classification list &optional unregister)
+ "Set the LIST of articles to be processed for BACKEND and CLASSIFICATION.
+With UNREGISTER, set articles to be unregistered.
+This is a temporary storage function - nothing here persists."
+ (put
+ backend
+ (intern (spam-backend-article-list-property classification unregister))
+ list))
+
(defun spam-backend-ham-registration-function (backend)
"Get the ham registration function for BACKEND."
(get backend 'hrf))
;; call spam-register-routine with specific articles to unregister,
;; when there are articles to unregister and the check is enabled
(when (and unregister-list (symbol-value backend))
- (spam-unregister-routine
- classification
- backend
- unregister-list))))))
+ (spam-backend-put-article-todo-list backend
+ classification
+ unregister-list
+ t))))))
;; do the non-moving backends first, then the moving ones
(dolist (backend-type '(non-mover mover))
- (dolist (classification '(spam ham))
+ (dolist (classification (spam-classifications))
(dolist (backend (spam-backend-list backend-type))
(when (spam-group-processor-p
gnus-newsgroup-name
backend
classification)
- (let ((num (spam-register-routine classification backend)))
- (when (> num 0)
- (gnus-message
- 6
- "%d %s messages were processed by backend %s."
- num
- classification
- backend)))))))
+ (spam-backend-put-article-todo-list backend
+ classification
+ (spam-list-articles
+ gnus-newsgroup-articles
+ classification))))))
+
+ (spam-resolve-registrations-routine) ; do the registrations now
;; we mark all the leftover spam articles as expired at the end
(dolist (article (spam-list-articles
;;{{{ registration/unregistration functions
+(defun spam-resolve-registrations-routine ()
+ "Go through the backends and register or unregister articles as needed."
+ (dolist (backend-type '(non-mover mover))
+ (dolist (classification (spam-classifications))
+ (dolist (backend (spam-backend-list backend-type))
+ (let ((rlist (spam-backend-get-article-todo-list
+ backend classification))
+ (ulist (spam-backend-get-article-todo-list
+ backend classification t))
+ (delcount 0))
+
+ ;; clear the old lists right away
+ (spam-backend-put-article-todo-list backend
+ classification
+ nil
+ nil)
+ (spam-backend-put-article-todo-list backend
+ classification
+ nil
+ t)
+
+ ;; eliminate duplicates
+ (dolist (article ulist)
+ (when (assq article rlist)
+ (incf delcount)
+ (setq rlist (delq article rlist))))
+
+ (unless (zerop delcount)
+ (gnus-message
+ 9
+ "%d messages were saved the trouble of unregistering and then registering"
+ delcount))
+
+ ;; unregister articles
+ (unless (zerop (length ulist))
+ (let ((num (spam-unregister-routine classification backend ulist)))
+ (when (> num 0)
+ (gnus-message
+ 6
+ "%d %s messages were unregistered by backend %s."
+ num
+ classification
+ backend))))
+
+ ;; register articles
+ (unless (zerop (length rlist))
+ (let ((num (spam-register-routine classification backend rlist)))
+ (when (> num 0)
+ (gnus-message
+ 6
+ "%d %s messages were registered by backend %s."
+ num
+ classification
+ backend)))))))))
+
(defun spam-unregister-routine (classification
- backend
- &optional specific-articles)
- (spam-register-routine classification backend t specific-articles))
+ backend
+ specific-articles)
+ (spam-register-routine classification backend specific-articles t))
(defun spam-register-routine (classification
- backend
- &optional unregister
- specific-articles)
+ backend
+ specific-articles
+ &optional unregister)
(when (and (spam-classification-valid-p classification)
(spam-backend-valid-p backend))
(let* ((register-function
classification
backend)
(funcall run-function articles)
- ;; now log all the registrations (or undo them, depending on unregister)
+ ;; now log all the registrations (or undo them, depending on
+ ;; unregister)
(dolist (article articles)
(funcall log-function
(spam-fetch-field-message-id-fast article)
+2004-10-15 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus.texi (Adaptive Scoring): Added gnus-adaptive-pretty-print.
+
2004-10-15 Katsumi Yamaoka <yamaoka@jpl.org>
* message.texi (Canceling News): Add how to set a password.
\e$BE,1~@-%9%3%"EPO?9`L\$O!"%0%k!<%WL>$K\e(B @code{gnus-adaptive-file-suffix} \e$B$r\e(B
\e$BIU2C$7$?L>A0$N%U%!%$%k$KF~$l$i$l$^$9!#=i4|@_DjCM$O\e(B @file{ADAPT} \e$B$G$9!#\e(B
+@vindex gnus-adaptive-pretty-print
+\e$BE,1~@-%9%3%"%U%!%$%k$O5pBg$K$J$jF@$k$7!"?M$N<j$GJT=8$5$l$k$3$H$OA[Dj$5$l\e(B
+\e$B$F$$$^$;$s!#\e(B@code{gnus-adaptive-pretty-print} \e$B$,\e(B @code{nil} (\e$B%G%#%U%)%k\e(B
+\e$B%H\e(B) \e$B$G$"$k$H!"$=$l$i$N%U%!%$%k$O?M$KFI$a$k$h$&$J7A<0$G$O=q$+$l$^$;$s!#\e(B
+
@vindex gnus-score-exact-adapt-limit
\e$BE,1~@-%9%3%"$r9T$&$H$-$O!"ItJ,J8;zNs0lCW$d%U%!%8!<$J0lCW$r9T$C$?J}$,!"$*\e(B
\e$B$=$i$/$[$H$s$I$N>l9g$K$*$$$FNI$$7k2L$,F@$i$l$k$G$7$g$&!#$7$+$7!"%X%C%@!<\e(B
group name with @code{gnus-adaptive-file-suffix} appended. The default
is @file{ADAPT}.
+@vindex gnus-adaptive-pretty-print
+Adaptive score files can get huge and are not meant to be edited by
+human hands. If @code{gnus-adaptive-pretty-print} is @code{nil} (the
+deafult) those files will not be written in a human readable way.
+
@vindex gnus-score-exact-adapt-limit
When doing adaptive scoring, substring or fuzzy matching would probably
give you the best results in most cases. However, if the header one
projects / elisp / gnus.git- / commitdiff