diff options
Diffstat (limited to 'module/ice-9/gds-server.scm')
| -rw-r--r-- | module/ice-9/gds-server.scm | 188 |
1 files changed, 0 insertions, 188 deletions
diff --git a/module/ice-9/gds-server.scm b/module/ice-9/gds-server.scm deleted file mode 100644 index 5ec867535..000000000 --- a/module/ice-9/gds-server.scm +++ /dev/null @@ -1,188 +0,0 @@ -;;;; Guile Debugger UI server - -;;; Copyright (C) 2003 Free Software Foundation, Inc. -;;; -;;;; This library is free software; you can redistribute it and/or -;;;; modify it under the terms of the GNU Lesser General Public -;;;; License as published by the Free Software Foundation; either -;;;; version 3 of the License, or (at your option) any later version. -;;;; -;;;; This library is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;;; Lesser General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU Lesser General Public -;;;; License along with this library; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - -(define-module (ice-9 gds-server) - #:export (run-server)) - -;; UI is normally via a pipe to Emacs, so make sure to flush output -;; every time we write. -(define (write-to-ui form) - (write form) - (newline) - (force-output)) - -(define (trc . args) - (write-to-ui (cons '* args))) - -(define (with-error->eof proc port) - (catch #t - (lambda () (proc port)) - (lambda args the-eof-object))) - -(define connection->id (make-object-property)) - -(define (run-server unix-socket-name tcp-port) - - (let ((unix-server (socket PF_UNIX SOCK_STREAM 0)) - (tcp-server (socket PF_INET SOCK_STREAM 0))) - - ;; Bind and start listening on the Unix domain socket. - (false-if-exception (delete-file unix-socket-name)) - (bind unix-server AF_UNIX unix-socket-name) - (listen unix-server 5) - - ;; Bind and start listening on the TCP socket. - (setsockopt tcp-server SOL_SOCKET SO_REUSEADDR 1) - (false-if-exception (bind tcp-server AF_INET INADDR_ANY tcp-port)) - (listen tcp-server 5) - - ;; Main loop. - (let loop ((clients '()) (readable-sockets '())) - - (define (do-read port) - (cond ((eq? port (current-input-port)) - (do-read-from-ui)) - ((eq? port unix-server) - (accept-new-client unix-server)) - ((eq? port tcp-server) - (accept-new-client tcp-server)) - (else - (do-read-from-client port)))) - - (define (do-read-from-ui) - (trc "reading from ui") - (let* ((form (with-error->eof read (current-input-port))) - (client (assq-ref (map (lambda (port) - (cons (connection->id port) port)) - clients) - (car form)))) - (with-error->eof read-char (current-input-port)) - (if client - (begin - (write (cdr form) client) - (newline client)) - (trc "client not found"))) - clients) - - (define (accept-new-client server) - (let ((new-port (car (accept server)))) - ;; Read the client's ID. - (let ((name-form (read new-port))) - ;; Absorb the following newline character. - (read-char new-port) - ;; Check that we have a name form. - (or (eq? (car name-form) 'name) - (error "Invalid name form:" name-form)) - ;; Store an association from the connection to the ID. - (set! (connection->id new-port) (cadr name-form)) - ;; Pass the name form on to Emacs. - (write-to-ui (cons (connection->id new-port) name-form))) - ;; Add the new connection to the set that we select on. - (cons new-port clients))) - - (define (do-read-from-client port) - (trc "reading from client") - (let ((next-char (with-error->eof peek-char port))) - ;;(trc 'next-char next-char) - (cond ((eof-object? next-char) - (write-to-ui (list (connection->id port) 'closed)) - (close port) - (delq port clients)) - ((char=? next-char #\() - (write-to-ui (cons (connection->id port) - (with-error->eof read port))) - clients) - (else - (with-error->eof read-char port) - clients)))) - - ;;(trc 'clients clients) - ;;(trc 'readable-sockets readable-sockets) - - (if (null? readable-sockets) - (loop clients (car (select (cons* (current-input-port) - unix-server - tcp-server - clients) - '() - '()))) - (loop (do-read (car readable-sockets)) (cdr readable-sockets)))))) - -;; What happens if there are multiple copies of Emacs running on the -;; same machine, and they all try to start up the GDS server? They -;; can't all listen on the same TCP port, so the short answer is that -;; all of them except the first will get an EADDRINUSE error when -;; trying to bind. -;; -;; We want to be able to handle this scenario, though, so that Scheme -;; code can be evaluated, and help invoked, in any of those Emacsen. -;; So we introduce the idea of a "slave server". When a new GDS -;; server gets an EADDRINUSE bind error, the implication is that there -;; is already a GDS server running, so the new server instead connects -;; to the existing one (by issuing a connect to the GDS port number). -;; -;; Let's call the first server the "master", and the new one the -;; "slave". In principle the master can now proxy any GDS client -;; connections through to the slave, so long as there is sufficient -;; information in the protocol for it to decide when and how to do -;; this. -;; -;; The basic information and mechanism that we need for this is as -;; follows. -;; -;; - A unique ID for each Emacs; this can be each Emacs's PID. When a -;; slave server connects to the master, it announces itself by sending -;; the protocol (emacs ID). -;; -;; - A way for a client to indicate which Emacs it wants to use. At -;; the protocol level, this is an extra argument in the (name ...) -;; protocol. (The absence of this argument means "no preference". A -;; simplistic master server might then decide to use its own Emacs; a -;; cleverer one might monitor which Emacs appears to be most in use, -;; and use that one.) At the API level this can be an optional -;; argument to the `gds-connect' procedure, and the Emacs GDS code -;; would obviously set this argument when starting a client from -;; within Emacs. -;; -;; We also want a strategy for continuing seamlessly if the master -;; server shuts down. -;; -;; - Each slave server will detect this as an error on the connection -;; to the master socket. Each server then tries to bind to the GDS -;; port again (a race which the OS will resolve), and if that fails, -;; connect again. The result of this is that there should be a new -;; master, and the others all slaves connected to the new master. -;; -;; - Each client will also detect this as an error on the connection -;; to the (master) server. Either the client should try to connect -;; again (perhaps after a short delay), or the reconnection can be -;; delayed until the next time that the client requires the server. -;; (Probably the latter, all done within `gds-read'.) -;; -;; (Historical note: Before this master-slave idea, clients were -;; identified within gds-server.scm and gds*.el by an ID which was -;; actually the file descriptor of their connection to the server. -;; That is no good in the new scheme, because each client's ID must -;; persist when the master server changes, so we now use the client's -;; PID instead. We didn't use PID before because the client/server -;; code was written to be completely asynchronous, which made it -;; tricky for the server to discover each client's PID and associate -;; it with a particular connection. Now we solve that problem by -;; handling the initial protocol exchange synchronously.) -(define (run-slave-server port) - 'not-implemented) |