diff --git a/backend/backend.lisp b/backend/backend.lisp index 930335e..0cd1b47 100644 --- a/backend/backend.lisp +++ b/backend/backend.lisp @@ -344,6 +344,10 @@ form suitable for testing with #+." "Create a listening TCP socket on interface HOST and port PORT. BACKLOG queue length for incoming connections.") +(definterface create-local-socket (socket-path &key backlog) + "Create a listening local (currently: UNIX domain) socket at SOCKET-PATH. +BACKLOG queue length for incomming connections.") + (definterface local-port (socket) "Return the local port number of SOCKET.") diff --git a/backend/sbcl.lisp b/backend/sbcl.lisp index bcb52dd..d6ab4a4 100644 --- a/backend/sbcl.lisp +++ b/backend/sbcl.lisp @@ -134,6 +134,19 @@ (sb-bsd-sockets:socket-listen socket (or backlog 5)) socket)) +;; Local socket on unix + +#+unix +(defimplementation create-local-socket (socket-path &key backlog) + (handler-case + (sb-posix:unlink socket-path) + ;; We don't care if it doesn't exist yet + (sb-posix:syscall-error ())) + (let ((socket (make-instance 'sb-bsd-sockets:local-socket :type :stream))) + (sb-bsd-sockets:socket-bind socket socket-path) + (sb-bsd-sockets:socket-listen socket (or backlog 5)) + socket)) + (defimplementation local-port (socket) (nth-value 1 (sb-bsd-sockets:socket-name socket))) diff --git a/micros.lisp b/micros.lisp index 355b619..33781dc 100644 --- a/micros.lisp +++ b/micros.lisp @@ -704,9 +704,9 @@ If PACKAGE is not specified, the home package of SYMBOL is used." (dont-close *dont-close*)) "Start the server and write the listen port number to PORT-FILE. This is the entry point for Emacs." - (setup-server 0 + (setup-server (lambda () (socket-quest 0 nil)) (lambda (port) (announce-server-port port-file port)) - style dont-close nil)) + style dont-close)) (defun create-server (&key (port default-server-port) (style *communication-style*) @@ -721,8 +721,22 @@ Optionally, an INTERFACE could be specified and swank will bind the PORT on this interface. By default, interface is \"localhost\"." (let ((*loopback-interface* (or interface *loopback-interface*))) - (setup-server port #'simple-announce-function - style dont-close backlog))) + (setup-server (lambda () (socket-quest port backlog)) + #'simple-announce-function + style dont-close))) + +#+(and unix sbcl) +(defun create-server-unix (&key (socket-path "/tmp/micros.sock") + (style *communication-style*) + (dont-close *dont-close*) + backlog) + "Start a SWANK server on the UNIX socket at SOCKET-PATH running in STYLE. +If DONT-CLOSE is true then the listen socket will accept multiple +connections, otherwise it will be closed after the first." + (setup-server + (lambda () (create-local-socket socket-path :backlog backlog)) + #'simple-announce-function + style dont-close)) (defun find-external-format-or-lose (coding-system) (or (find-external-format coding-system) @@ -746,9 +760,9 @@ e.g.: (restart-loop (http-request url) (use-value (new) (setq url new)))" (ignore-errors (list (parse-integer (read-line *query-io*))))) (setq port new-port)))) -(defun setup-server (port announce-fn style dont-close backlog) +(defun setup-server (socket-provider-fn announce-fn style dont-close) (init-log-output) - (let* ((socket (socket-quest port backlog)) + (let* ((socket (funcall socket-provider-fn)) (port (local-port socket))) (funcall announce-fn port) (labels ((serve () (accept-connections socket style dont-close)) diff --git a/packages.lisp b/packages.lisp index 778a0a2..1156a5b 100644 --- a/packages.lisp +++ b/packages.lisp @@ -135,6 +135,7 @@ (:export #:startup-multiprocessing #:start-server #:create-server + #:create-server-unix #:stop-server #:restart-server #:ed-in-emacs