elmo/slp.el

   1 ;;; slp.el --- An SLP interface.
   2
   3 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   4 ;; Keywords: SLP
   5
   6 ;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
   7
   8 ;; This file is not part of GNU Emacs
   9
  10 ;; This program 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 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program 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; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24 ;;
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; slp.el is an elisp library providing an interface for SLP (RFC2614)
  29 ;; using OpenSLP(http://www.openslp.org/) slptool .
  30 ;;
  31 ;;; History:
  32 ;; 28 Aug 2001 Created.
  33
  34 ;;; Code:
  35 (eval-when-compile (require 'cl))
  36
  37 (defgroup slp nil
  38   "Interface for `Service Location Protocol'."
  39   :group 'comm)
  40
  41 (defcustom slp-program "slptool"
  42   "SLP client program (OpenSLP's slptool)."
  43   :type 'string
  44   :group 'slp)
  45
  46 (defcustom slp-program-arguments nil
  47   "Option argument for SLP client program."
  48   :type '(repeat string)
  49   :group 'slp)
  50
  51 (defun slp-exec-wait (type &rest args)
  52   "Synchronous execution of slp-program.
  53 TYPE is a symbol (one of `srvs', `attrs', `srvtypes', `as-is', `ignore')."
  54   (with-temp-buffer
  55     (let ((result (apply 'call-process slp-program nil t nil
  56                          (append slp-program-arguments (delq nil args)))))
  57       (unless (zerop result)
  58         (error "SLP error: %s" (buffer-string)))
  59       (goto-char (point-min))
  60       (case type
  61         (srvs (slp-parse-srvs))
  62         (attrs (slp-parse-attrs))
  63         (srvtypes (slp-parse-srvtypes))
  64         (as-is (buffer-string))))))
  65
  66 ;; Response parser.
  67 (defun slp-parse-srvs ()
  68   (let (srvtype hostport host port lifetime srvs)
  69     (while (and
  70             (not (eobp))
  71             (looking-at "service:\\([^:]+\\):/[^/]*/\\([^,]+\\),\\([0-9]+\\)"))
  72       (setq srvtype (match-string 1)
  73             hostport (match-string 2)
  74             lifetime (string-to-number (match-string 3)))
  75       (if (string-match ":\\([0-9]+\\)" hostport)
  76           (setq host (substring hostport 0 (match-beginning 0))
  77                 port (string-to-number (match-string 1 hostport)))
  78         (setq host hostport
  79               port nil))
  80       (push (cons (list srvtype host port) lifetime) srvs)
  81       (forward-line 1))
  82     (list 'srvs (nreverse srvs))))
  83
  84 (defsubst slp-forward ()
  85   (or (eobp) (forward-char)))
  86
  87 (defun slp-parse-attr ()
  88   (when (looking-at "(\\([^=]+\\)=\\([^)]+\\))")
  89     (prog1 (cons (match-string 1) (match-string 2))
  90       (goto-char (match-end 0)))))
  91
  92 (defun slp-parse-attrs ()
  93   (let (attrs)
  94     (push (slp-parse-attr) attrs)
  95     (while (eq (char-after (point)) ?,)
  96       (slp-forward)
  97       (push (slp-parse-attr) attrs))
  98     (list 'attrs (nreverse attrs))))
  99
 100 (defun slp-parse-srvtypes ()
 101   (let (types)
 102     (while (not (eobp))
 103       (when (looking-at "^service:\\([^/\n]+\\)$")
 104         (push (buffer-substring (match-beginning 1) (match-end 1)) types))
 105       (forward-line 1))
 106     (list 'srvtypes (nreverse types))))
 107
 108 ;; Response accessor.
 109 (defsubst slp-response-type (response)
 110   (nth 0 response))
 111
 112 (defsubst slp-response-body (response)
 113   (nth 1 response))
 114
 115 (defsubst slp-response-srv-url-service-type (srv)
 116   (nth 0 (car srv)))
 117
 118 (defsubst slp-response-srv-url-host (srv)
 119   (nth 1 (car srv)))
 120
 121 (defsubst slp-response-srv-url-port (srv)
 122   (nth 2 (car srv)))
 123
 124 (defsubst slp-response-srv-lifetime (srv)
 125   (cdr srv))
 126
 127 ;; Commands
 128 (defun slp-findsrvs (service-type &optional filter)
 129   (slp-exec-wait 'srvs "findsrvs" service-type filter))
 130
 131 (defun slp-findattrs (url &rest attrids)
 132   (apply 'slp-exec-wait 'attrs "findattrs" url attrids))
 133
 134 (defun slp-findsrvtypes (&optional authority)
 135   (slp-exec-wait 'srvtypes "findsrvtypes" authority))
 136
 137 (defun slp-findscopes ()
 138   (slp-exec-wait 'as-is "findscopes"))
 139
 140 (defun slp-register (url &optional attrs)
 141   (slp-exec-wait 'ignore "register" url (mapconcat
 142                                          (lambda (pair)
 143                                            (format "(%s=%s)"
 144                                                    (car pair)
 145                                                    (cdr pair)))
 146                                          attrs
 147                                          ",")))
 148
 149 (defun slp-deregister (url)
 150   (slp-exec-wait 'ignore "deregister" url))
 151
 152 (defun slp-getproperty (propertyname)
 153   (slp-exec-wait 'as-is "getproperty" propertyname))
 154
 155 (provide 'slp)
 156
 157 ;;; slp.el ends here