;;; rudel-infinote-group-directory.el --- Infinote directory group -*- lexical-binding:t -*- ;; ;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc. ;; ;; Author: Jan Moringen ;; Keywords: rudel, infinote, group, communication ;; X-RCS: $Id:$ ;; ;; This file is part of Rudel. ;; ;; Rudel 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 3 of the License, or ;; (at your option) any later version. ;; ;; Rudel 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 Rudel. If not, see . ;;; Commentary: ;; ;; Implementation of the infinote 'InfDirectory' communication ;; group. This special group is used to perform and announce changes ;; to the document tree and for session management. ;; See http://gobby.0x539.de/trac/wiki/Infinote/Protocol ;;; History: ;; ;; 0.1 - Initial version ;;; Code: ;; (eval-when-compile (require 'cl-lib)) (require 'warnings) (require 'eieio) (require 'xml) (require 'rudel-xml) (require 'rudel-infinote-group) ;;; Class rudel-infinote-directory-state-new ;; ;; TODO rename to rudel-infinote-group-directory-state-new (defclass rudel-infinote-directory-state-new (rudel-infinote-group-state) ((sequence-number :initarg :sequence-number :type (integer 0) :documentation "The sequence number the server reserved for this exchange.") (plugins :initarg :plugins :type list :initform nil :documentation "The list of plugins is stored here temporarily after receiving it from the server.")) "New state of the directory group. Initial state of the state machine of the infinote directory group.") (cl-defmethod rudel-infinote/welcome ((this rudel-infinote-directory-state-new) xml) "Handle infinote welcome message." ;; Temporarily store list of plugins and sequence ;; number. Ultimately, the plugin list belongs in the :plugins slot ;; of the connection object and the sequence-number should be used ;; by all groups to identify server replies. (with-slots (sequence-number plugins) this (with-tag-attrs (;; (version protocol-version number) (sequence sequence-id number)) xml (setq sequence-number sequence plugins (mapcar (lambda (plugin) (xml-get-attribute plugin 'type)) (xml-node-children (car (xml-get-children xml 'note-plugins))))))) ;; Switch to idle state. 'idle) ;;; Class rudel-infinote-directory-state-idle ;; (defclass rudel-infinote-directory-state-idle (rudel-infinote-group-state) () "Idle state of the directory group.") (cl-defmethod rudel-infinote/add-node ((this rudel-infinote-directory-state-idle) xml) "" ;; TODO there can be a child: ;; ;; or can it? here in idle state? ;; Maybe this attribute can only be used for client -> server ;; communication. (with-slots (group) this ;; TODO how should/does this handle absent attributes? (with-tag-attrs ((id id number) (parent parent number) name type) xml (rudel-add-node group id parent name type))) nil) (cl-defmethod rudel-infinote/remove-node ((_this rudel-infinote-directory-state-idle) _xml) "" ;; (with-tag-attrs (id) xml ;; seq nil) (cl-defmethod rudel-infinote/sync-in ((_this rudel-infinote-directory-state-idle) _xml) "" ;; TODO can contain child ;; (with-tag-attrs (id parent name type group method) xml ;; optional? seq nil) ;;; Class rudel-infinote-directory-state-exploring ;; (defclass rudel-infinote-directory-state-exploring (rudel-infinote-group-state) ((remaining-messages :initarg :remaining-messages :type (integer 0) :documentation "")) "Directory group state entered when the children of a node are explored.") (cl-defmethod rudel-enter ((this rudel-infinote-directory-state-exploring) id) "" (rudel-send this `(explore-node ((id . ,(format "%d" id))))) nil) (cl-defmethod rudel-infinote/explore-begin ;; TODO there should be another state ((this rudel-infinote-directory-state-exploring) xml) "" ;; (with-slots (remaining-messages) this (with-tag-attrs ((total total number)) xml (setq remaining-messages total))) ;; TODO in hex? nil) (cl-defmethod rudel-infinote/add-node ((this rudel-infinote-directory-state-exploring) xml) ;; TODO identical to idle state "" (with-slots (group remaining-messages) this (with-tag-attrs ((id id number) (parent parent number) name type) xml (rudel-add-node group id parent name type)) (cl-decf remaining-messages)) nil) (cl-defmethod rudel-infinote/explore-end ((this rudel-infinote-directory-state-exploring) _xml) "" (with-slots (remaining-messages) this (unless (zerop remaining-messages) (display-warning '(rudel infinote) (format "received 'explore-end' message when still expecting %d messages" remaining-messages) :warning))) 'idle) ;;; Class rudel-infinote-directory-state-subscribing ;; (defclass rudel-infinote-directory-state-subscribing (rudel-infinote-group-state) ((id :initarg :id :type (or null (integer 0)) :documentation "The id of the target node of the subscription.")) "Directory group state entered when subscribing to a session.") (cl-defmethod rudel-enter ((this rudel-infinote-directory-state-subscribing) id) "Send 'subscribe-session' message and store ID in THIS for later." (with-slots ((id1 :id)) this (setq id1 id) (rudel-send this `(subscribe-session ((id . ,(format "%d" id1)))))) nil) (cl-defmethod rudel-infinote/subscribe-session ((this rudel-infinote-directory-state-subscribing) xml) "" (with-slots ((id1 :id)) this (with-tag-attrs ((name group) method (id id number)) xml ;; optional seq ;; Check received id against stored id. (unless (= id1 id) (setq id1 nil) (display-warning '(rudel infinote) (format "Did not request subscription to group %d (was expecting %d)" id id1) :warning)) ;; Check method and subscribe. (let ((method-symbol (intern-soft method))) ;; TODO (make-symbol method) (unless (memq method-symbol '(central)) (error "Invalid method: `%s'" method)) ;; TODO proper error handling (rudel-subscribe-session this name method-symbol id1)))) 'idle) ;; TODO this message is used when the server requested the subscription? (cl-defmethod rudel-leave ((this rudel-infinote-directory-state-subscribing)) "Acknowledge the subscription when leaving the state." (with-slots (id) this (when id (rudel-send this `(subscribe-ack ((id . ,(format "%d" id)))) t))) ;; no sequence number ) ;;; Directory group states ;; (defvar rudel-infinote-group-directory-states '((new . rudel-infinote-directory-state-new) (idle . rudel-infinote-directory-state-idle) (exploring . rudel-infinote-directory-state-exploring) (subscribing . rudel-infinote-directory-state-subscribing) (closed . rudel-infinote-group-state-closed)) "States of the state machine used by the directory group.") ;;; Class rudel-infinote-group-directory ;; (defclass rudel-infinote-group-directory (rudel-infinote-sequence-number-group) ((method :initform 'central)) "Objects of this class represent infinote directory communication groups.") (cl-defmethod initialize-instance ((this rudel-infinote-group-directory) _slots) "" ;; Initialize slots of THIS. (cl-call-next-method) ;; Register states. (rudel-register-states this rudel-infinote-group-directory-states) ) (cl-defmethod rudel-add-node ((this rudel-infinote-group-directory) id parent name type) "" (with-slots (connection) this (rudel-make-and-add-node connection id parent name type))) (cl-defmethod rudel-remove-node ((_this rudel-infinote-group-directory)) "" (error "Removing nodes is not implemented")) (cl-defmethod rudel-subscribe-session ((this rudel-infinote-group-directory) name method id) "" (with-slots (connection) this (rudel-subscribe-session connection name method id))) (provide 'rudel-infinote-group-directory) ;;; rudel-infinote-group-directory.el ends here