;;; bbdb-whois.el -- Big Brother gets a little help from Big Brother ;;; This file is part of the Insidious Big Brother Database (aka BBDB). ;;; ;;; Copyright (C) 1992, 1993 Roland McGrath ;;; ;;; This program 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. ;;; ;;; This program 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. ;;; ;;; A copy of the GNU General Public License can be obtained from this ;;; program's author (send electronic mail to roland@gnu.ai.mit.edu) or ;;; from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA ;;; 02139, USA. ;;; ;;; Send bug reports to bbdb@waider.ie (require 'bbdb-com) (defmacro bbdb-add-to-field (record field text) (let ((get (intern (concat "bbdb-record-" (symbol-name field)))) (set (intern (concat "bbdb-record-set-" (symbol-name field))))) (` (let ((old ((, get) (, record))) (text (, text))) (or (member text old) ((, set) (, record) (nconc old (list text)))))))) (defcustom bbdb-whois-server (or (and (boundp 'whois-server) whois-server) "whois.geektools.com") "*Server for \\[bbdb-whois] lookups." :group 'bbdb-utilities :type 'string) (defvar bbdb-whois-name nil "Used to store the name during a whois call.") (make-variable-buffer-local 'bbdb-whois-name) (defvar bbdb-whois-record nil "Used to store the record during a whois call.") (make-variable-buffer-local 'bbdb-whois-record) ;;; main entry point. it'd be nice if we could bbdb-whois an arbitrary ;;; name and make a record from that directly. ;;;###autoload (defun bbdb-whois (the-record &optional server) (interactive (list (bbdb-get-record "BBDB Whois: ") (and current-prefix-arg (read-string "Query whois server: " bbdb-whois-server)))) (or server (setq server bbdb-whois-server)) (if (or (bbdb-record-lastname the-record) (bbdb-record-firstname the-record)) ;; XXX we seem to get called with a vector of nils. (save-excursion (set-buffer (generate-new-buffer " *bbdb-whois*")) (set bbdb-whois-record the-record) (set bbdb-whois-name (if (bbdb-record-getprop the-record 'nic) (concat "!" (bbdb-record-getprop the-record 'nic)) (concat (bbdb-record-lastname the-record) ", " (bbdb-record-firstname the-record)))) (let ((proc (open-network-stream "whois" (current-buffer) server 43))) (set-process-sentinel proc 'bbdb-whois-sentinel) (process-send-string proc (concat bbdb-whois-name "\r\n")))))) ;;; This function parses the results from the server. (defun bbdb-whois-sentinel (proc status) (save-excursion (let (rec) (set-buffer (process-buffer proc)) (setq rec bbdb-whois-record) (goto-char 1) ;; check for multiple replies ;; should maybe present a menu/completion buffer of multiples and do a ;; refetch. (if (not (re-search-forward "Record last updated" (point-max) t)) (if (re-search-forward "No match" (point-max) t) (message "Can not find a whois record for `%s'" bbdb-whois-name) (if (re-search-forward "Access Limit Exceeded" (point-max) t) (message "Per-day access limit to %s exceeded." bbdb-whois-server) ;; bah! (message "%s is ambiguous to whois; try a different name" bbdb-whois-name))) ;; clean up & parse buffer, otherwise. (replace-string "\r\n" "\n") (goto-char 1) (if (re-search-forward (concat (if (string-match "^!" bbdb-whois-name) (concat "(\\(" (regexp-quote (substring bbdb-whois-name 1)) "\\))") (concat (regexp-quote bbdb-whois-name) ".*(\\([A-Z0-9]+\\))")) "\\s *\\(\\S +@\\S +\\)?$") nil t) (let ((net (if (match-beginning 2) (downcase (buffer-substring (match-beginning 2) (match-end 2))))) (nic (buffer-substring (match-beginning 1) (match-end 1))) (lines nil)) (if net (bbdb-add-to-field rec net net)) (bbdb-record-putprop rec 'nic nic) ;; Snarf company. ;; not all nic records have companies, though. (forward-line 1) (back-to-indentation) (let ((company (buffer-substring (point) (progn (end-of-line) (point)))) (old (bbdb-record-company rec))) (cond ((not old) (bbdb-record-set-company rec company)) ((string= old company) nil) (t (bbdb-record-putprop rec 'nic-organization company)))) ;; Read the address info into LINES. (while (progn (forward-line 1) (not (looking-at "^$"))) (back-to-indentation) (setq lines (cons (buffer-substring (point) (progn (end-of-line) (point))) lines))) ;; Snarf phone number. ;; phone, fax are presented, it seems, as ;; +country area prefix number +country area prefix number ;; we can look for the " +" and split there, I guess. (if (car lines) (let ((phones (car lines)) (n 1) phone-numbers) (while (string-match "^\\(.+\\) \\+" phones) (setq phone-numbers (append phone-numbers (list (substring phones 0 (match-end 1)))) phones (substring phones (+ 1 (match-end 1))))) (setq phone-numbers (append phone-numbers (list phones))) ;; now add each member of the list to the bbdb record ;; it'd be nice if we could be smarter about this. (mapcar (function (lambda(p) (if (not (bbdb-find-phone p (bbdb-record-phones rec))) (let ((p-n (vector (format "nic-phone-%d" n) p))) (bbdb-add-to-field rec phones p-n) (setq n (+ 1 n)))))) phone-numbers) ;; throw away phones line from what we've snarfed (setq lines (cdr lines)))) ;; Snarf address. (if (car lines) (let ((addr (make-vector bbdb-address-length nil)) (city "") (state "") (zip "") (country "")) ;; extract country (if (string-match "^[A-Z][A-Z]$" (car lines)) (setq country (car lines) ;; could convert from ISO... lines (cdr lines))) ;; extract city, state, zip ;; it would be nice if this could all use bbdb-snarf. ;; or if NICs would hand out something machine ;; readable, like XML. ;; ;; note the zipcode check at the end of the regexp ;; isn't really a zipcode check, because we don't do ;; zipcode checks any more. (if (string-match "\\([^,]+\\),\\s *\\(\\S +\\)\\s *\\(.+\\)" (car lines)) (setq city (substring (car lines) (match-beginning 1) (match-end 1)) state (substring (car lines) (match-beginning 2) (match-end 2)) zip (substring (car lines) (match-beginning 3) (match-end 3)) lines (cdr lines)) ;; otherwise we just stuff everything into the ;; streets list and let the user clean it up. This ;; would be nice to do heuristically, if I knew ;; enough about variable address formats. ;; (bbdb-snarf-grok-address (ADDR)) would be neat. ) (bbdb-address-set-location addr "nic-address") (bbdb-address-set-city addr (or city "")) (bbdb-address-set-state addr (or state "")) (bbdb-address-set-zip addr (or zip "")) (bbdb-address-set-country addr (or country "")) (setq lines (nreverse lines)) (bbdb-address-set-streets addr lines) ;; should probably overwrite existing nic-address field. (bbdb-add-to-field rec addresses addr))) ;; Snarf any random notes. (setq lines nil) (while (progn (forward-line 1) (back-to-indentation) (not (looking-at "$\\|Record last updated on"))) (if (looking-at "Alternate mailbox: \\(\\S +\\)$") (bbdb-add-to-field rec net (buffer-substring (match-beginning 1) (match-end 1))) (setq lines (cons (buffer-substring (point) (progn (end-of-line) (point))) lines)))) (if lines (bbdb-record-putprop rec 'nic-notes (mapconcat 'identity (nreverse lines) "\n"))) ;; Snarf the last-update date. (if (re-search-forward "Record last updated on \\(\\S *\\)\\." nil t) (bbdb-record-putprop rec 'nic-updated (buffer-substring (match-beginning 1) (match-end 1)))) (save-excursion (set-buffer bbdb-buffer-name) (bbdb-redisplay-one-record rec))) (message "No whois information for %s" bbdb-whois-name))) (delete-process proc) (kill-buffer (current-buffer))))) (defun bbdb-find-phone (string record) "Return the vector entry if STRING is a phone number listed in RECORD." (let ((phone nil) (done nil)) (while (and record (not done)) (setq phone (car record)) (if (string= string (bbdb-phone-string phone)) (setq done phone)) (setq record (cdr record))) done)) (provide 'bbdb-whois)