Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
161 lines (138 sloc) 5.66 KB
;;; epcs.el --- EPC Server
;; Copyright (C) 2011,2012,2013 Masashi Sakurai
;; Author: Masashi Sakurai <m.sakurai at>
;; Keywords: lisp
;; 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 3 of the License, 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
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <>.
;;; Commentary:
;;; Code:
(eval-when-compile (require 'cl))
(require 'epc)
(defvar epcs:client-processes nil
"[internal] A list of ([process object] . [`epc:manager' instance]).
When the server process accepts the client connection, the
`epc:manager' instance is created and stored in this variable
`epcs:client-processes'. This variable is used for the management
;; epcs:server
;; name : process name (string) ex: "EPC Server 1"
;; process : server process object
;; port : port number
;; connect-function : initialize function for `epc:manager' instances
(defstruct epcs:server name process port connect-function)
(defvar epcs:server-processes nil
"[internal] A list of ([process object] . [`epcs:server' instance]).
This variable is used for the management purpose.")
(defun epcs:server-start (connect-function &optional port)
"Start TCP Server and return the main process object."
((connect-function connect-function)
(name (format "EPC Server %s" (epc:uid)))
(buf (epc:make-procbuf (format "*%s*" name)))
:name name
:buffer buf
:family 'ipv4 :server t :nowait t
:host "" :service (or port t)
(lambda (process message)
(epcs:sentinel process message connect-function)))))
(unless port
;; notify port number to the parent process via STDOUT.
(message "%s\n" (process-contact main-process :service)))
(push (cons main-process
:name name :process main-process
:port (process-contact main-process :service)
:connect-function connect-function))
(defun epcs:server-stop (process)
"Stop the TCP server process."
((and process
(assq process epcs:server-processes))
(epc:log "EPCS: Shutdown Server: %S" process)
(let ((buf (process-buffer process)))
(delete-process process)
(kill-buffer buf))
(setq epcs:server-processes
(assq-delete-all process epcs:server-processes)))
(t (error "Not found in the server process list. [%S]" process))))
(defun epcs:get-manager-by-process (proc)
"[internal] Return the epc:manager instance for the PROC."
(loop for (pp . mngr) in epcs:client-processes
if (eql pp proc)
do (return mngr)
finally return nil))
(defun epcs:kill-all-processes ()
"Kill all child processes for debug purpose."
(loop for (proc . mngr) in epcs:client-processes
do (ignore-errors
(delete-process proc)
(kill-buffer (process-buffer proc)))))
(defun epcs:accept (process)
"[internal] Initialize the process and return epc:manager object."
(epc:log "EPCS: >> Connection accept: %S" process)
(lexical-let* ((connection-id (epc:uid))
(connection-name (format "epc con %s" connection-id))
(channel (cc:signal-channel connection-name))
(connection (make-epc:connection
:name connection-name
:process process
:buffer (process-buffer process)
:channel channel)))
(epc:log "EPCS: >> Connection establish")
(set-process-coding-system process 'binary 'binary)
(set-process-filter process
(lambda (p m)
(epc:process-filter connection p m)))
(set-process-sentinel process
(lambda (p e)
(epc:process-sentinel connection p e)))
(make-epc:manager :server-process process :port t
:connection connection)))
(defun epcs:sentinel (process message connect-function)
"[internal] Process sentinel handler for the server process."
(epc:log "EPCS: SENTINEL: %S %S" process message)
(let ((mngr (epcs:get-manager-by-process process)))
;; new connection
((and (string-match "open" message) (null mngr))
(condition-case err
(let ((mngr (epcs:accept process)))
(push (cons process mngr) epcs:client-processes)
(epc:init-epc-layer mngr)
(when connect-function (funcall connect-function mngr))
(epc:log "EPCS: Protocol error: %S" err)
(epc:log "EPCS: ABORT %S" process)
(delete-process process))))
;; ignore
((null mngr) nil )
;; disconnect
(let ((pair (assq process epcs:client-processes)) d)
(when pair
(epc:log "EPCS: DISCONNECT %S" process)
(epc:stop-epc (cdr pair))
(setq epcs:client-processes
(assq-delete-all process epcs:client-processes))
;; Management GUI
;; todo...
(provide 'epcs)
;;; epcs.el ends here