diff options
Diffstat (limited to 'bits/bbdb-filters/bbdb-passwd.el')
| -rw-r--r-- | bits/bbdb-filters/bbdb-passwd.el | 192 |
1 files changed, 192 insertions, 0 deletions
diff --git a/bits/bbdb-filters/bbdb-passwd.el b/bits/bbdb-filters/bbdb-passwd.el new file mode 100644 index 0000000..74dc8fd --- /dev/null +++ b/bits/bbdb-filters/bbdb-passwd.el @@ -0,0 +1,192 @@ +;;; This file is part of the BBDB Filters Package. BBDB Filters Package is a +;;; collection of input and output filters for BBDB. +;;; +;;; Copyright (C) 1995 Neda Communications, Inc. +;;; Prepared by Mohsen Banan (mohsen@neda.com) +;;; +;;; 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-passwd.el + +;;; This file is a bbdb filter. It converts passwd files to the +;;; canonical bbdb input filter format (i.e., a file of +;;; bif-create-record expressions + + +(defvar bpf-default-bif-file "~/passwd-bif.el" + "*Default file name for bbdb-passwd-input.") + + +(defvar bpf-default-domain-name (if (boundp '*eoe-site-name*) *eoe-site-name*) + "*Default domain name for bbdb-passwd-input.") + + +(defvar bpf-default-org-name (if (boundp 'gnus-local-organization) gnus-local-organization + bpf-default-domain-name) + "*Default organization name for bbdb-passwd-input.") + + +(defvar bpf-omit-uid-limit 100 + "Skip UIDs below this value. Default is 100.") + +(defvar bpf-omit-user-name-regexp "\\(sl-\\\|guest\\)" + "Skip usernames that match this regular expression. +E.g., \"\\\\(sl-\\\\\\|guest\\\\)\" +") + +(defvar bpf-omit-user-name-list '("nobody" "noaccess") + "Skip usernames in this list. +E.g., '(\"noaccess\" \"nobody\") +") + +(defvar bpf-omit-pretty-name-regexp "\\(Slip \\\|Listserv\\\|PPP\\)" + "Skip pretty names that match this regular expression. +E.g., \"\\\\(Slip \\\\\\|Listserv\\\\\\|PPP\\\\)\" +") + +(defvar bpf-omit-pretty-name-list '() + "Skip pretty names that match this regular expression. +E.g., '(\"John Q. Public\") +") + + +(defun bbdb-passwd-input (domain-name org-name to-file) + "Parse current buffer which contains a UNIX passwd file to generate a .bif format file" + (interactive (list (setq bpf-default-domain-name (read-string "Domain name: " + bpf-default-domain-name)) + (setq bpf-default-org-name (read-string "Organization name: " + bpf-default-org-name)) + (setq bpf-default-bif-file + (read-file-name "Output To File: " + (concat + (file-name-directory bpf-default-bif-file) + (concat "bif-" bpf-default-domain-name ".el")) + (concat + (file-name-directory bpf-default-bif-file) + (concat "bif-" bpf-default-domain-name ".el")))))) + (let (to-buffer) + (save-excursion + (message (expand-file-name to-file)) + (set-buffer (find-file (expand-file-name to-file))) + (delete-region (point-min) (point-max)) + (bif-buffer-insert-header) + (setq to-buffer (current-buffer))) + + ;; walk the passwd file in the current buffer + (goto-char (point-min)) + (while (not (eobp)) + (beginning-of-line) + (bpf-parse-line domain-name org-name to-buffer) + (forward-line 1)) + + (message "Done.") + (set-buffer to-buffer) + )) + + +(defun bif-buffer-insert-header () + (insert "(require 'bbdb-passwd)\n\n")) + + +(defun bif-buffer-insert-record (pretty-name org-name email) + (insert (format "(bif-create-record")) + + (insert (format " \"%s\"" pretty-name)) ; NAME string + + (insert (format " \"%s\"" org-name)) ; COMPANY is a string or nil + + (insert (format " \"%s\"" email)) ; NET is a comma-separated list of email address, + ; or a list of strings + + ;; (insert " nil") ; ADDRS is a list of address objects. + ; An address is a vector of the form + ; ["location" "line1" "line2" "line3" "City" "State" zip] + + ;; (insert " nil") ; PHONES is a list of phone-number objects. + ; A phone-number is a vector of the form + ; ["location" areacode prefix suffix extension-or-nil] + ; or + ; ["location" "phone-number"] + + ;; (insert " nil") ; NOTES is a string, or an alist associating symbols with + ; strings. + + (insert ")\n") + ) + +(defun bpf-parse-line (domain-name org-name to-buffer) + "Parse the passwd file line. Point is assumed to be at the beginning of line." + (let (record-string uid user-name pretty-name email) + (setq record-string (buffer-substring (point) + (progn (end-of-line) (point)))) + + (message "Processing record: %s" record-string) + + ;; (setq record-string "mohsen:x:100:10:Mohsen Banan:/home/arash/mohsen:/bin/csh") + + ;; check for a valid and qualifying uid on line, else skip + (cond ((and + ;; + ;; extract and test uid + ;; + (string-match "^\\w*:\\w*:\\([0-9]+\\):" record-string) + (setq uid (read (substring record-string + (match-beginning 1) + (match-end 1)))) + (>= uid bpf-omit-uid-limit) + ;; + ;; extract and test user name + ;; + (string-match "^\\([^:]+\\):" record-string) + (setq user-name (substring record-string (match-beginning 1) (match-end 1))) + (or (null bpf-omit-user-name-regexp) + (not (string-match bpf-omit-user-name-regexp user-name))) + (or (null bpf-omit-user-name-list) + (not (member user-name bpf-omit-user-name-list))) + ;; + ;; extract and test pretty name + ;; + (string-match "^[^:]*:[^:]*:[^:]*:[^:]*:\\([^:]+\\):" record-string) + (setq pretty-name (substring record-string (match-beginning 1) (match-end 1))) + (or (null bpf-omit-pretty-name-regexp) + (not (string-match bpf-omit-pretty-name-regexp pretty-name))) + (or (null bpf-omit-pretty-name-list) + (not (member pretty-name bpf-omit-pretty-name-list))) + ) + + ;; synthesize email address + (setq email (concat user-name "@" domain-name)) + + ;; output bif record + (save-excursion + (set-buffer to-buffer) + (bif-buffer-insert-record pretty-name org-name email) + ) + ) + (t + ;; not a valid line, skip + nil)) + )) + +(defun bif-create-record (name company net &optional addrs phones notes) + "Try to add a record to BBDB; if one does not already exist." + (condition-case err + (progn + (bbdb-create-internal name company net addrs phones notes) + (message "%s <%s> added." name net)) + (error (message "%s" (car (cdr err))) + (sleep-for 1)))) + + +(provide 'bbdb-passwd) + |