;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation ;;; Prepared by Mark Evenson ;;; ;;; This library is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU Library General Public License as ;;; published by the Free Software Foundation; either version 2 of the ;;; License, or (at your option) any later version. This library 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 Library General Public ;;; License for more details. You should have received a copy of the GNU ;;; Library General Public License along with this library; if not, write ;;; to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, ;;; USA. ;;; ;;; This is bbdb-export-whitelist.el ;;; ;;; $Id: bbdb-export-whitelist.el 250 2006-03-30 11:31:28Z evenson $ (defvar bbdb-export-whitelist-spamassassin-filename (concat (getenv "HOME") "/.spamassassin/user_prefs") "*Location of the SpammAssassin user_prefs file") (defvar bbdb-export-whitelist-buffer-name "*BBDB Spamassassin whitelist export*" "Default buffer name for exporting the contents of the *BBDB* buffer.") (defvar bbdb-export-whitelist-header-start "#======= Start of BBDB Records (AUTOGENERATED: DO NOT REMOVE) =======\n" "Marker for beginning of autogenerated whitelist entries") (defvar bbdb-export-whitelist-header-end "#======= End of BBDB Records (AUTOGENERATED: DO NOT REMOVE) =======\n" "Marker for the end of autogenerated bwhitelist entries") (defun bbdb-export-whitelist-to-spamassassin () "Export all BBDB records as whitelist entries to the Spamassassin user-prefs file" (interactive) (save-window-excursion (let ((user-prefs-buffer (find-file bbdb-export-whitelist-spamassassin-filename)) (bbdb-records-buffer (bbdb-export-whitelist))) (switch-to-buffer user-prefs-buffer) (goto-char (point-min)) (goto-char (let* ((begin (search-forward bbdb-export-whitelist-header-start nil t)) (end (search-forward bbdb-export-whitelist-header-end nil t ))) (cond ((and (eq begin nil) (eq end nil)) (goto-char (point-max)) (if (not (looking-at "\n")) (insert "\n")) (insert-before-markers bbdb-export-whitelist-header-start) (setq insert-point (point)) (insert bbdb-export-whitelist-header-end) insert-point) ((eq begin nil) (goto-char end) (search-backward bbdb-export-whitelist-header-end) (insert-before-markers bbdb-export-whitelist-header-start) (point)) ((eq end nil) (goto-char begin) (insert-before-markers bbdb-export-whitelist-header-end) begin) (t (delete-region begin end) (goto-char begin) (insert bbdb-export-whitelist-header-end) begin)))) (insert-buffer-substring bbdb-records-buffer) (save-buffer))) (message "Successfully exported all BBDB records to '%s'" bbdb-export-whitelist-spamassassin-filename)) (defun bbdb-export-whitelist () "Output the selected BBDB entries in a format suitable for a SpamAssassin whitelist." (save-excursion (let ((to-buffer (get-buffer-create bbdb-export-whitelist-buffer-name)) (records (progn ; ensure that BBDB contains all entries (bbdb "" nil) (set-buffer bbdb-buffer-name) bbdb-records)) (current-letter "")) (switch-to-buffer to-buffer) (delete-region (point-min) (point-max)) (while records (setq current-letter (bbdb-export-whitelist-do-record (car (car records)) current-letter)) (setq records (cdr records))))) (message "BBDB export buffer %s generated." bbdb-export-whitelist-buffer-name) bbdb-export-whitelist-buffer-name) (defun bbdb-export-whitelist-do-record (record current-letter) "Insert the bbdb RECORD in export format." (let ((name (bbdb-record-name record)) (net (bbdb-record-net record)) (company (bbdb-record-company record)) (first-letter (upcase (substring (concat (bbdb-record-sortkey record) "?") 0 1)))) (if (not (string-equal first-letter current-letter)) (progn (message "Now processing \"%s\" entries..." first-letter))) ;; Don't export entries without email addresses (if net (if name (bbdb-export-whitelist-buffer-insert-record name net) (if company (bbdb-export-whitelist-buffer-insert-record company net) (bbdb-export-whitelist-buffer-insert-record " " net)))) first-letter)) (defun bbdb-export-whitelist-buffer-insert-record (name net) (let ((addresses "") (begin (point)) end) (message "Exporting %s" name) (insert (format "# %s\n" name)) (dolist (address net) (setq addresses (format "%s %s" addresses address))) (insert (format "whitelist_from\t%s\n" addresses)) (setq end (point)))) (provide 'bbdb-export-whitelist)