;;; 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)
