summaryrefslogtreecommitdiff
path: root/lisp/bbdb-whois.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/bbdb-whois.el')
-rw-r--r--lisp/bbdb-whois.el264
1 files changed, 0 insertions, 264 deletions
diff --git a/lisp/bbdb-whois.el b/lisp/bbdb-whois.el
deleted file mode 100644
index af4c34d..0000000
--- a/lisp/bbdb-whois.el
+++ /dev/null
@@ -1,264 +0,0 @@
-;;; 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.
- (while (re-search-forward "\r\n" (point-max) t)
- (replace-match "\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.
- (mapc (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 <shudder> 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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-24 08:37:44 +0000