From 0e2202b5181bc68425cd8dec8486f99b8d0c67c5 Mon Sep 17 00:00:00 2001 From: teranisi Date: Tue, 28 Aug 2001 04:43:45 +0000 Subject: [PATCH] * slp.el: New file. --- elmo/ChangeLog | 2 + elmo/slp.el | 155 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 157 insertions(+) create mode 100644 elmo/slp.el diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 98e22b5..d2acada 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,5 +1,7 @@ 2001-08-28 Yuuichi Teranishi + * slp.el: New file. + * acap.el: New file. (acap-network-stream-open): Show "Connecting..." message. (acap-parse-response): Fixed problem for BYE untagged response. diff --git a/elmo/slp.el b/elmo/slp.el new file mode 100644 index 0000000..5ca27c3 --- /dev/null +++ b/elmo/slp.el @@ -0,0 +1,155 @@ +;;; slp.el --- An SLP interface. + +;; Author: Yuuichi Teranishi +;; Keywords: SLP + +;; Copyright (C) 2001 Yuuichi Teranishi + +;; This file is not part of GNU Emacs + +;; 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. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. +;; + +;;; Commentary: +;; +;; slp.el is an elisp library providing an interface for SLP (RFC2614) +;; using OpenSLP(http://www.openslp.org/) slptool . +;; +;;; History: +;; 28 Aug 2001 Created. + +;;; Code: + +(defgroup slp nil + "Interface for `Service Location Protocol'." + :group 'comm) + +(defcustom slp-program "slptool" + "SLP client program (OpenSLP's slptool)." + :type 'string + :group 'slp) + +(defcustom slp-program-arguments nil + "Option argument for SLP client program." + :type '(repeat string) + :group 'slp) + +(defun slp-exec-wait (type &rest args) + "Synchronous execution of slp-program. +TYPE is a symbol (one of `srvs', `attrs', `srvtypes', `as-is', `ignore')." + (with-temp-buffer + (let ((result (apply 'call-process slp-program nil t nil (delq nil args)))) + (unless (zerop result) + (error "SLP error: " (buffer-string))) + (goto-char (point-min)) + (case type + (srvs (slp-parse-srvs)) + (attrs (slp-parse-attrs)) + (srvtypes (slp-parse-srvtypes)) + (as-is (buffer-string)))))) + +;; Response parser. +(defun slp-parse-srvs () + (let (srvtype hostport host port lifetime srvs) + (while (and + (not (eobp)) + (looking-at "service:\\([^:]+\\):/[^/]*/\\([^,]+\\),\\([0-9]+\\)")) + (setq srvtype (match-string 1) + hostport (match-string 2) + lifetime (string-to-number (match-string 3))) + (if (string-match ":\\([0-9]+\\)" hostport) + (setq host (substring hostport 0 (match-beginning 0)) + port (string-to-number (match-string 1 hostport))) + (setq host hostport + port nil)) + (push (cons (list srvtype host port) lifetime) srvs) + (forward-line 1)) + (list 'srvs (nreverse srvs)))) + +(defsubst slp-forward () + (or (eobp) (forward-char))) + +(defun slp-parse-attr () + (when (looking-at "(\\([^=]+\\)=\\([^)]+\\))") + (prog1 (cons (match-string 1) (match-string 2)) + (goto-char (match-end 0))))) + +(defun slp-parse-attrs () + (let (attrs) + (push (slp-parse-attr) attrs) + (while (eq (char-after (point)) ?,) + (slp-forward) + (push (slp-parse-attr) attrs)) + (list 'attrs (nreverse attrs)))) + +(defun slp-parse-srvtypes () + (let (types) + (while (not (eobp)) + (when (looking-at "^service:\\([^/\n]+\\)$") + (push (buffer-substring (match-beginning 1) (match-end 1)) types)) + (forward-line 1)) + (list 'srvtypes (nreverse types)))) + +;; Response accessor. +(defsubst slp-response-type (response) + (nth 0 response)) + +(defsubst slp-response-body (response) + (nth 1 response)) + +(defsubst slp-response-srv-url-service-type (srv) + (nth 0 (car srv))) + +(defsubst slp-response-srv-url-host (srv) + (nth 1 (car srv))) + +(defsubst slp-response-srv-url-port (srv) + (nth 2 (car srv))) + +(defsubst slp-response-srv-lifetime (srv) + (cdr srv)) + +;; Commands +(defun slp-findsrvs (service-type &optional filter) + (slp-exec-wait 'srvs "findsrvs" service-type filter)) + +(defun slp-findattrs (url &rest attrids) + (apply 'slp-exec-wait 'attrs "findattrs" url attrids)) + +(defun slp-findsrvtypes (&optional authority) + (slp-exec-wait 'srvtypes "findsrvtypes" authority)) + +(defun slp-findscopes () + (slp-exec-wait 'as-is "findscopes")) + +(defun slp-register (url &optional attrs) + (slp-exec-wait 'ignore "register" url (mapconcat + (lambda (pair) + (format "(%s=%s)" + (car pair) + (cdr pair))) + attrs + ","))) + +(defun slp-deregister (url) + (slp-exec-wait 'ignore "deregister" url)) + +(defun slp-getproperty (propertyname) + (slp-exec-wait 'as-is "getproperty" propertyname)) + +(provide 'slp) + +;;; slp.el ends here -- 1.7.10.4