lisp/url/url-ns.el

   1 ;;; url-ns.el --- Various netscape-ish functions for proxy definitions
   2
   3 ;; Copyright (C) 1997, 1998, 1999, 2004, 2005,
   4 ;;   2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
   5
   6 ;; Keywords: comm, data, processes, hypermedia
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Code:
  24
  25 (require 'url-gw)
  26
  27 ;;;###autoload
  28 (defun isPlainHostName (host)
  29   (not (string-match "\\." host)))
  30
  31 ;;;###autoload
  32 (defun dnsDomainIs (host dom)
  33   (string-match (concat (regexp-quote dom) "$") host))
  34
  35 ;;;###autoload
  36 (defun dnsResolve (host)
  37   (url-gateway-nslookup-host host))
  38
  39 ;;;###autoload
  40 (defun isResolvable (host)
  41   (if (string-match "^[0-9.]+$" host)
  42       t
  43     (not (string= host (url-gateway-nslookup-host host)))))
  44
  45 ;;;###autoload
  46 (defun isInNet (ip net mask)
  47   (let ((netc (split-string ip "\\."))
  48         (ipc  (split-string net "\\."))
  49         (maskc (split-string mask "\\.")))
  50     (if (or (/= (length netc) (length ipc))
  51             (/= (length ipc) (length maskc)))
  52         nil
  53       (setq netc (mapcar 'string-to-number netc)
  54             ipc (mapcar 'string-to-number ipc)
  55             maskc (mapcar 'string-to-number maskc))
  56       (and
  57        (= (logand (nth 0 netc) (nth 0 maskc))
  58           (logand (nth 0 ipc)  (nth 0 maskc)))
  59        (= (logand (nth 1 netc) (nth 1 maskc))
  60           (logand (nth 1 ipc)  (nth 1 maskc)))
  61        (= (logand (nth 2 netc) (nth 2 maskc))
  62           (logand (nth 2 ipc)  (nth 2 maskc)))
  63        (= (logand (nth 3 netc) (nth 3 maskc))
  64           (logand (nth 3 ipc)  (nth 3 maskc)))))))
  65
  66 ;; Netscape configuration file parsing
  67 (defvar url-ns-user-prefs nil
  68   "Internal, do not use.")
  69
  70 ;;;###autoload
  71 (defun url-ns-prefs (&optional file)
  72   (if (not file)
  73       (setq file (expand-file-name "~/.netscape/preferences.js")))
  74   (if (not (and (file-exists-p file)
  75                 (file-readable-p file)))
  76       (message "Could not open %s for reading" file)
  77     (save-excursion
  78       (let ((false nil)
  79             (true t))
  80         (setq url-ns-user-prefs (make-hash-table :size 13 :test 'equal))
  81         (set-buffer (get-buffer-create " *ns-parse*"))
  82         (erase-buffer)
  83         (insert-file-contents file)
  84         (goto-char (point-min))
  85         (while (re-search-forward "^//" nil t)
  86           (replace-match ";;"))
  87         (goto-char (point-min))
  88         (while (re-search-forward "^user_pref(" nil t)
  89           (replace-match "(url-ns-set-user-pref "))
  90         (goto-char (point-min))
  91         (while (re-search-forward "\"," nil t)
  92           (replace-match "\""))
  93         (goto-char (point-min))
  94         (eval-buffer)))))
  95
  96 (defun url-ns-set-user-pref (key val)
  97   (puthash key val url-ns-user-prefs))
  98
  99 ;;;###autoload
 100 (defun url-ns-user-pref (key &optional default)
 101   (gethash key url-ns-user-prefs default))
 102
 103 (provide 'url-ns)
 104
 105 ;;; url-ns.el ends here