lisp/muse-ipc.el

   1 ;;; muse-ipc.el --- publish Muse documents from other processes
   2
   3 ;; Copyright (C) 2009  Free Software Foundation, Inc.
   4
   5 ;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
   6
   7 ;; Emacs Muse is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published
   9 ;; by the Free Software Foundation; either version 3, or (at your
  10 ;; option) any later version.
  11
  12 ;; Emacs Muse is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with Emacs Muse; see the file COPYING.  If not, write to the
  19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  20 ;; Boston, MA 02110-1301, USA.
  21
  22 ;;; Commentary:
  23
  24 ;; This file is still in alpha state.  Not for production use!
  25
  26 ;;; Contributors:
  27
  28 ;;; Code:
  29
  30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31 ;;
  32 ;; Muse Inter-Process Communication
  33 ;;
  34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35
  36 (eval-when-compile (require 'cl))
  37
  38 (require 'muse)
  39 (require 'muse-publish)
  40
  41 (defgroup muse-ipc nil
  42   "Options controlling the behavior of Muse's IPC module."
  43   :group 'muse-publish)
  44
  45 (defcustom muse-ipc-timeout 60
  46   "Maximum time to wait for a client to respond."
  47   :group 'muse-ipc
  48   :type 'number)
  49
  50 (defcustom muse-ipc-ignore-done nil
  51   "If non-nil, ignore any 'done' messages that we get from clients."
  52   :group 'muse-ipc
  53   :type 'boolean)
  54
  55 (defvar muse-ipc-server-port nil
  56   "Port of the Emacs server.")
  57
  58 (defvar muse-ipc-server-process nil
  59   "Process of the Emacs server.")
  60
  61 (defvar muse-ipc-server-registered nil
  62   "Whether we have successfully registered our port with the client.")
  63
  64 (defun muse-ipc-init-filter (proc string)
  65   "Handle data from client while initiating a connection."
  66   (unless muse-ipc-server-registered
  67     (when (string-match "\\`ok$" string)
  68       (setq muse-ipc-server-registered t))))
  69
  70 (defun muse-ipc-delete-client (proc)
  71   "Delete a client."
  72   (let ((buffer (process-get proc :buffer)))
  73     (when (and buffer (buffer-live-p buffer))
  74       (with-current-buffer buffer
  75         (set-buffer-modified-p nil))
  76       (kill-buffer buffer)))
  77   (when (eq (process-status proc) 'open)
  78     (delete-process proc)))
  79
  80 (defun* muse-ipc-server-filter (proc string)
  81   "Handle data from a client after it connects."
  82   ;; Authenticate
  83   (unless (process-get proc :authenticated)
  84     (if (and (string-match "\\`begin \\(.+\\)$" string)
  85              (equal (match-string 1 string)
  86                     (process-get proc :shared-secret)))
  87         (progn
  88           (setq string (substring string (match-end 0)))
  89           (process-put proc :authenticated t)
  90           (process-send-string proc "ok\n"))
  91       (process-send-string proc "nok\n")
  92       (delete-process proc))
  93     (return-from muse-ipc-server-filter))
  94
  95   ;; Handle case where the client is sending data to be published
  96   (when (process-get proc :sending-data)
  97     (with-current-buffer (process-get proc :buffer)
  98       (insert string)
  99       (let ((buf-len (1- (point)))
 100             (expected-len (process-get proc :data-bytes)))
 101         (cond ((= buf-len expected-len)
 102                (process-put proc :sending-data nil))
 103               ((> buf-len expected-len)
 104                (process-send-string proc "nok\n")
 105                (muse-ipc-delete-client proc)))))
 106     (return-from muse-ipc-server-filter))
 107
 108   ;; Dispatch commands
 109   (cond
 110    ((string-match "\\`done$" string)
 111     ;; done, close the server
 112     (unless muse-ipc-ignore-done
 113       (muse-ipc-stop-server)))
 114
 115    ((string-match "\\`name \\(.+\\)$" string)
 116     ;; set name
 117     (process-put proc :file-name (match-string 1 string))
 118     (process-send-string proc "ok\n"))
 119
 120    ((string-match "\\`title \\(.+\\)$" string)
 121     ;; set title
 122     (process-put proc :title (match-string 1 string))
 123     (process-send-string proc "ok\n"))
 124
 125    (t
 126     ;; unrecognized command
 127     (process-send-string proc "nok\n"))))
 128
 129 (defun muse-ipc-stop-server ()
 130   "Stop Muse IPC server and reset connection data."
 131   (stop-process muse-ipc-server-process)
 132   (delete-process muse-ipc-server-process)
 133   (setq muse-ipc-server-port nil)
 134   (setq muse-ipc-server-process nil))
 135
 136 (defun muse-ipc-start (shared-secret publish-fn client-port &optional server-port)
 137   "Start an IPC connection and send a response to CLIENT-PORT.
 138 If SERVER-PORT is provided, start the IPC server on that port, otherwise
 139 choose a random port.
 140
 141 SHARED-SECRET is used as a very minimal security measure to
 142 authenticate the Muse IPC server during initialization, and also
 143 any incoming clients once the server is started.
 144
 145 PUBLISH-FN is the function which should be called in buffer of
 146 the received contents.  It should transform the buffer into a
 147 published state.  It must take at least two arguments.  The first
 148 argument is the full path of the file that the contents
 149 correspond with.  The second argument is the title to use when
 150 publishing the file."
 151   (when (stringp client-port)
 152     (setq client-port (string-to-number client-port)))
 153   (when (stringp server-port)
 154     (setq server-port (string-to-number server-port)))
 155   (setq muse-ipc-server-process
 156         (make-network-process
 157          :name "muse-ipc"
 158          :buffer nil
 159          :host 'local :service (or server-port t)
 160          :server t :noquery t :nowait t
 161          :plist (list :authenticated nil :shared-secret shared-secret
 162                       :publish-fn publish-fn)
 163          :filter 'muse-ipc-server-filter))
 164   (unless muse-ipc-server-process
 165     (error "Error: Could not start Muse IPC Server process"))
 166   (set-process-coding-system muse-ipc-server-process
 167                              'raw-text-unix 'raw-text-unix)
 168   (setq muse-ipc-server-port
 169         (number-to-string
 170          (cadr (process-contact muse-ipc-server-process))))
 171   (let ((client-proc
 172          (make-network-process
 173           :name "muse-ipc-client"
 174           :buffer nil
 175           :host 'local :service client-port
 176           :noquery t
 177           :filter 'muse-ipc-init-filter)))
 178     (setq muse-ipc-server-registered nil)
 179     (process-send-string client-proc
 180                          (concat "begin " shared-secret "\n"))
 181     (accept-process-output client-proc muse-ipc-timeout nil t)
 182     (unless muse-ipc-server-registered
 183       (error "Error: Did not register listener"))
 184     (process-send-string client-proc
 185                          (concat "port " muse-ipc-server-port "\n"))
 186     (stop-process client-proc)
 187     (delete-process client-proc))
 188
 189   ;; Accept process output until the server dies
 190   (while muse-ipc-server-process (accept-process-output nil 1)))
 191
 192 (provide 'muse-ipc)
 193
 194 ;;; muse-ipc.el ends here