Created
January 27, 2015 15:14
-
-
Save jgarvin/a6c4f45500386c4f2a13 to your computer and use it in GitHub Desktop.
mandimus network implementation
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; needed for with-timeout | |
(require 'timer) | |
(defvar md-server-clients '()) | |
(defvar md-server-eval-timeout 5) | |
(defun md-server-start nil | |
(interactive) | |
(unless (process-status "mandimus-eval-server") | |
(make-network-process :name "mandimus-eval-server" | |
:server t | |
:service 23233 | |
:buffer "*mandimus-server*" | |
:family 'ipv4 | |
:sentinel 'md-server-sentinel | |
:filter 'md-server-filter) | |
(setq md-server-clients '()))) | |
(defun md-server-stop nil | |
(interactive) | |
(while md-server-clients | |
(delete-process (car (car md-server-clients))) | |
(setq md-server-clients (cdr md-server-clients))) | |
(delete-process "mandimus-eval-server")) | |
(defun md-server-filter (proc string) | |
(let ((pending (assoc proc md-server-clients)) | |
message | |
index | |
command | |
result) | |
;;create entry if required | |
(unless pending | |
(setq md-server-clients (cons (cons proc "") md-server-clients)) | |
(setq pending (assoc proc md-server-clients))) | |
(setq message (concat (cdr pending) string)) | |
(while (setq index (string-match "\n" message)) | |
(setq index (1+ index)) | |
(setq command (substring message 0 index)) | |
(unwind-protect | |
(setq result | |
(condition-case err | |
(with-timeout (md-server-eval-timeout (message "Timeout exceeded")) | |
(eval (car (read-from-string command)))) | |
(error (message "Mandimus error: [%S] in [%S]" (error-message-string err) command)))) | |
;; We always want to send the newline because the client will block until | |
;; it receives it. | |
(process-send-string proc (format "%S\n" result)) | |
(setq message (substring message index)) | |
(md-server-log command proc)) | |
(setcdr pending message)))) | |
(defun md-server-sentinel (proc msg) | |
(when (string= msg "connection broken by remote peer\n") | |
(setq md-servers-clients (assq-delete-all proc md-server-clients)) | |
(md-server-log (format "client %s has quit" proc)))) | |
;;from server.el | |
(defun md-server-log (string &optional client) | |
"If a *mandimus-server* buffer exists, write STRING to it for logging purposes." | |
(if (get-buffer "*mandimus-server*") | |
(with-current-buffer "*mandimus-server*" | |
(unless buffer-read-only | |
(read-only-mode t)) | |
(let ((inhibit-read-only t)) | |
(goto-char (point-max)) | |
(insert (current-time-string) | |
(if client (format " %s:" client) " ") | |
string) | |
(or (bolp) (newline)))))) | |
;; always run so mandimus can hook up | |
(condition-case nil | |
(md-server-start) | |
(file-error (message "ERROR: Mandimus server already running!"))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment