1 ;;; slp.el --- An SLP interface.
3 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
8 ;; This file is not part of GNU Emacs
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)
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.
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.
28 ;; slp.el is an elisp library providing an interface for SLP (RFC2614)
29 ;; using OpenSLP(http://www.openslp.org/) slptool .
32 ;; 28 Aug 2001 Created.
35 (eval-when-compile (require 'cl))
38 "Interface for `Service Location Protocol'."
41 (defcustom slp-program "slptool"
42 "SLP client program (OpenSLP's slptool)."
46 (defcustom slp-program-arguments nil
47 "Option argument for SLP client program."
48 :type '(repeat string)
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')."
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))
61 (srvs (slp-parse-srvs))
62 (attrs (slp-parse-attrs))
63 (srvtypes (slp-parse-srvtypes))
64 (as-is (buffer-string))))))
67 (defun slp-parse-srvs ()
68 (let (srvtype hostport host port lifetime srvs)
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)))
80 (push (cons (list srvtype host port) lifetime) srvs)
82 (list 'srvs (nreverse srvs))))
84 (defsubst slp-forward ()
85 (or (eobp) (forward-char)))
87 (defun slp-parse-attr ()
88 (when (looking-at "(\\([^=]+\\)=\\([^)]+\\))")
89 (prog1 (cons (match-string 1) (match-string 2))
90 (goto-char (match-end 0)))))
92 (defun slp-parse-attrs ()
94 (push (slp-parse-attr) attrs)
95 (while (eq (char-after (point)) ?,)
97 (push (slp-parse-attr) attrs))
98 (list 'attrs (nreverse attrs))))
100 (defun slp-parse-srvtypes ()
103 (when (looking-at "^service:\\([^/\n]+\\)$")
104 (push (buffer-substring (match-beginning 1) (match-end 1)) types))
106 (list 'srvtypes (nreverse types))))
108 ;; Response accessor.
109 (defsubst slp-response-type (response)
112 (defsubst slp-response-body (response)
115 (defsubst slp-response-srv-url-service-type (srv)
118 (defsubst slp-response-srv-url-host (srv)
121 (defsubst slp-response-srv-url-port (srv)
124 (defsubst slp-response-srv-lifetime (srv)
128 (defun slp-findsrvs (service-type &optional filter)
129 (slp-exec-wait 'srvs "findsrvs" service-type filter))
131 (defun slp-findattrs (url &rest attrids)
132 (apply 'slp-exec-wait 'attrs "findattrs" url attrids))
134 (defun slp-findsrvtypes (&optional authority)
135 (slp-exec-wait 'srvtypes "findsrvtypes" authority))
137 (defun slp-findscopes ()
138 (slp-exec-wait 'as-is "findscopes"))
140 (defun slp-register (url &optional attrs)
141 (slp-exec-wait 'ignore "register" url (mapconcat
149 (defun slp-deregister (url)
150 (slp-exec-wait 'ignore "deregister" url))
152 (defun slp-getproperty (propertyname)
153 (slp-exec-wait 'as-is "getproperty" propertyname))