mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
* 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.
This commit is contained in:
parent
c1ab3a6d6b
commit
e2d23cc0f8
7 changed files with 73 additions and 19 deletions
1
THANKS
1
THANKS
|
@ -79,3 +79,4 @@ For fixes or providing information which led to a fix:
|
|||
Michael Tuexen
|
||||
Andy Wingo
|
||||
Keith Wright
|
||||
William Xu
|
||||
|
|
|
@ -1,3 +1,12 @@
|
|||
2006-10-13 Neil Jerram <neil@ossau.uklinux.net>
|
||||
|
||||
* 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 <neil@ossau.uklinux.net>
|
||||
|
||||
* gds-server.el (gds-start-server): Change "ossau" to "ice-9".
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -1,3 +1,13 @@
|
|||
2006-10-13 Neil Jerram <neil@ossau.uklinux.net>
|
||||
|
||||
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 <user42@zip.com.au>
|
||||
|
||||
* ftw.scm (visited?-proc): Use hashv since we know we're getting
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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 '()))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue