diff options
Diffstat (limited to 'bits/bbdb-filters/bbdb-passwd.el')
| -rw-r--r-- | bits/bbdb-filters/bbdb-passwd.el | 192 |
1 files changed, 0 insertions, 192 deletions
diff --git a/bits/bbdb-filters/bbdb-passwd.el b/bits/bbdb-filters/bbdb-passwd.el deleted file mode 100644 index 74dc8fd..0000000 --- a/bits/bbdb-filters/bbdb-passwd.el +++ /dev/null @@ -1,192 +0,0 @@ -;;; 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) - |