From e2d23cc0f8ef473a8248b86d8928c70d3cb92873 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 12 Oct 2006 23:24:02 +0000 Subject: [PATCH] * gds.el (gds-run-debug-server): Use variable gds-server-port-or-path instead of hardcoded 8333. (gds-server-port-or-path): New. * gds-server.el (gds-start-server): Change port arg to port-or-path, to support Unix domain sockets. * gds-client.scm (connect-to-gds): Try to connect by Unix domain socket if TCP connection fails. * gds-server.scm (run-server): Update to support listening on a Unix domain socket. --- THANKS | 1 + emacs/ChangeLog | 9 +++++++++ emacs/gds-server.el | 17 +++++++++-------- emacs/gds.el | 9 ++++++++- ice-9/ChangeLog | 10 ++++++++++ ice-9/gds-client.scm | 22 ++++++++++++++++------ ice-9/gds-server.scm | 24 ++++++++++++++++++++---- 7 files changed, 73 insertions(+), 19 deletions(-) diff --git a/THANKS b/THANKS index 59eaf13f9..6c805fe31 100644 --- a/THANKS +++ b/THANKS @@ -79,3 +79,4 @@ For fixes or providing information which led to a fix: Michael Tuexen Andy Wingo Keith Wright + William Xu diff --git a/emacs/ChangeLog b/emacs/ChangeLog index 6786c2844..0303fb064 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,3 +1,12 @@ +2006-10-13 Neil Jerram + + * gds.el (gds-run-debug-server): Use variable + gds-server-port-or-path instead of hardcoded 8333. + (gds-server-port-or-path): New. + + * gds-server.el (gds-start-server): Change port arg to + port-or-path, to support Unix domain sockets. + 2006-08-18 Neil Jerram * gds-server.el (gds-start-server): Change "ossau" to "ice-9". diff --git a/emacs/gds-server.el b/emacs/gds-server.el index 722e613db..86defc07b 100644 --- a/emacs/gds-server.el +++ b/emacs/gds-server.el @@ -44,24 +44,25 @@ :group 'gds :type '(choice (const :tag "nil" nil) directory)) -(defun gds-start-server (procname port protocol-handler &optional bufname) - "Start a GDS server process called PROCNAME, listening on TCP port PORT. -PROTOCOL-HANDLER should be a function that accepts and processes one -protocol form. Optional arg BUFNAME specifies the name of the buffer -that is used for process output\; if not specified the buffer name is -the same as the process name." +(defun gds-start-server (procname port-or-path protocol-handler &optional bufname) + "Start a GDS server process called PROCNAME, listening on TCP port +or Unix domain socket PORT-OR-PATH. PROTOCOL-HANDLER should be a +function that accepts and processes one protocol form. Optional arg +BUFNAME specifies the name of the buffer that is used for process +output; if not specified the buffer name is the same as the process +name." (with-current-buffer (get-buffer-create (or bufname procname)) (erase-buffer) (let* ((code (format "(begin %s (use-modules (ice-9 gds-server)) - (run-server %d))" + (run-server %S))" (if gds-scheme-directory (concat "(set! %load-path (cons " (format "%S" gds-scheme-directory) " %load-path))") "") - port)) + port-or-path)) (process-connection-type nil) ; use a pipe (proc (start-process procname (current-buffer) diff --git a/emacs/gds.el b/emacs/gds.el index 3ce4696b6..132b571a2 100644 --- a/emacs/gds.el +++ b/emacs/gds.el @@ -42,7 +42,9 @@ (interactive) (if gds-debug-server (gds-kill-debug-server)) (setq gds-debug-server - (gds-start-server "gds-debug" 8333 'gds-debug-protocol)) + (gds-start-server "gds-debug" + gds-server-port-or-path + 'gds-debug-protocol)) (process-kill-without-query gds-debug-server)) (defun gds-kill-debug-server () @@ -602,6 +604,11 @@ you would add an element to this alist to transform :type 'boolean :group 'gds) +(defcustom gds-server-port-or-path 8333 + "TCP port number or Unix domain socket path for the server to listen on." + :group 'gds + :type '(choice (integer :tag "TCP port number") + (file :tag "Unix domain socket path"))) ;;;; If requested, autostart the server after loading. diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 1b903da23..e241afed8 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,13 @@ +2006-10-13 Neil Jerram + + Integration of Unix domain socket patch from William Xu: + + * gds-client.scm (connect-to-gds): Try to connect by Unix domain + socket if TCP connection fails. + + * gds-server.scm (run-server): Update to support listening on a + Unix domain socket. + 2006-10-05 Kevin Ryde * ftw.scm (visited?-proc): Use hashv since we know we're getting diff --git a/ice-9/gds-client.scm b/ice-9/gds-client.scm index 26e76855e..8c7bdc742 100755 --- a/ice-9/gds-client.scm +++ b/ice-9/gds-client.scm @@ -174,12 +174,22 @@ (or gds-port (begin (set! gds-port - (let ((s (socket PF_INET SOCK_STREAM 0)) - (SOL_TCP 6) - (TCP_NODELAY 1)) - (setsockopt s SOL_TCP TCP_NODELAY 1) - (connect s AF_INET (inet-aton "127.0.0.1") 8333) - s)) + (or (let ((s (socket PF_INET SOCK_STREAM 0)) + (SOL_TCP 6) + (TCP_NODELAY 1)) + (setsockopt s SOL_TCP TCP_NODELAY 1) + (catch #t + (lambda () + (connect s AF_INET (inet-aton "127.0.0.1") 8333) + s) + (lambda _ #f))) + (let ((s (socket PF_UNIX SOCK_STREAM 0))) + (catch #t + (lambda () + (connect s AF_UNIX "/tmp/.gds_socket") + s) + (lambda _ #f))) + (error "Couldn't connect to GDS by TCP or Unix domain socket"))) (write-form (list 'name (getpid) (format #f "PID ~A" (getpid))))))) (if (not (defined? 'make-mutex)) diff --git a/ice-9/gds-server.scm b/ice-9/gds-server.scm index a8e9c99c8..f59758729 100644 --- a/ice-9/gds-server.scm +++ b/ice-9/gds-server.scm @@ -36,13 +36,29 @@ (define connection->id (make-object-property)) -(define (run-server port) +(define (run-server port-or-path) - (let ((server (socket PF_INET SOCK_STREAM 0))) + (or (integer? port-or-path) + (string? port-or-path) + (error "port-or-path should be an integer (port number) or a string (file name)" + port-or-path)) + + (let ((server (socket (if (integer? port-or-path) PF_INET PF_UNIX) + SOCK_STREAM + 0))) ;; Initialize server socket. - (setsockopt server SOL_SOCKET SO_REUSEADDR 1) - (bind server AF_INET INADDR_ANY port) + (if (integer? port-or-path) + (begin + (setsockopt server SOL_SOCKET SO_REUSEADDR 1) + (bind server AF_INET INADDR_ANY port-or-path)) + (begin + (catch #t + (lambda () (delete-file port-or-path)) + (lambda _ #f)) + (bind server AF_UNIX port-or-path))) + + ;; Start listening. (listen server 5) (let loop ((clients '()) (readable-sockets '()))