1;;;; Guile Debugger UI server 2 3;;; Copyright (C) 2003 Free Software Foundation, Inc. 4;;; 5;; This library is free software; you can redistribute it and/or 6;; modify it under the terms of the GNU Lesser General Public 7;; License as published by the Free Software Foundation; either 8;; version 2.1 of the License, or (at your option) any later version. 9;; 10;; This library is distributed in the hope that it will be useful, 11;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13;; Lesser General Public License for more details. 14;; 15;; You should have received a copy of the GNU Lesser General Public 16;; License along with this library; if not, write to the Free Software 17;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18 19(define-module (ice-9 gds-server) 20 #:export (run-server)) 21 22;; UI is normally via a pipe to Emacs, so make sure to flush output 23;; every time we write. 24(define (write-to-ui form) 25 (write form) 26 (newline) 27 (force-output)) 28 29(define (trc . args) 30 (write-to-ui (cons '* args))) 31 32(define (with-error->eof proc port) 33 (catch #t 34 (lambda () (proc port)) 35 (lambda args the-eof-object))) 36 37(define connection->id (make-object-property)) 38 39(define (run-server port-or-path) 40 41 (or (integer? port-or-path) 42 (string? port-or-path) 43 (error "port-or-path should be an integer (port number) or a string (file name)" 44 port-or-path)) 45 46 (let ((server (socket (if (integer? port-or-path) PF_INET PF_UNIX) 47 SOCK_STREAM 48 0))) 49 50 ;; Initialize server socket. 51 (if (integer? port-or-path) 52 (begin 53 (setsockopt server SOL_SOCKET SO_REUSEADDR 1) 54 (bind server AF_INET INADDR_ANY port-or-path)) 55 (begin 56 (catch #t 57 (lambda () (delete-file port-or-path)) 58 (lambda _ #f)) 59 (bind server AF_UNIX port-or-path))) 60 61 ;; Start listening. 62 (listen server 5) 63 64 (let loop ((clients '()) (readable-sockets '())) 65 66 (define (do-read port) 67 (cond ((eq? port (current-input-port)) 68 (do-read-from-ui)) 69 ((eq? port server) 70 (accept-new-client)) 71 (else 72 (do-read-from-client port)))) 73 74 (define (do-read-from-ui) 75 (trc "reading from ui") 76 (let* ((form (with-error->eof read (current-input-port))) 77 (client (assq-ref (map (lambda (port) 78 (cons (connection->id port) port)) 79 clients) 80 (car form)))) 81 (with-error->eof read-char (current-input-port)) 82 (if client 83 (begin 84 (write (cdr form) client) 85 (newline client)) 86 (trc "client not found"))) 87 clients) 88 89 (define (accept-new-client) 90 (let ((new-port (car (accept server)))) 91 ;; Read the client's ID. 92 (let ((name-form (read new-port))) 93 ;; Absorb the following newline character. 94 (read-char new-port) 95 ;; Check that we have a name form. 96 (or (eq? (car name-form) 'name) 97 (error "Invalid name form:" name-form)) 98 ;; Store an association from the connection to the ID. 99 (set! (connection->id new-port) (cadr name-form)) 100 ;; Pass the name form on to Emacs. 101 (write-to-ui (cons (connection->id new-port) name-form))) 102 ;; Add the new connection to the set that we select on. 103 (cons new-port clients))) 104 105 (define (do-read-from-client port) 106 (trc "reading from client") 107 (let ((next-char (with-error->eof peek-char port))) 108 ;;(trc 'next-char next-char) 109 (cond ((eof-object? next-char) 110 (write-to-ui (list (connection->id port) 'closed)) 111 (close port) 112 (delq port clients)) 113 ((char=? next-char #\() 114 (write-to-ui (cons (connection->id port) 115 (with-error->eof read port))) 116 clients) 117 (else 118 (with-error->eof read-char port) 119 clients)))) 120 121 ;;(trc 'clients clients) 122 ;;(trc 'readable-sockets readable-sockets) 123 124 (if (null? readable-sockets) 125 (loop clients (car (select (cons (current-input-port) 126 (cons server clients)) 127 '() 128 '()))) 129 (loop (do-read (car readable-sockets)) (cdr readable-sockets)))))) 130 131;; What happens if there are multiple copies of Emacs running on the 132;; same machine, and they all try to start up the GDS server? They 133;; can't all listen on the same TCP port, so the short answer is that 134;; all of them except the first will get an EADDRINUSE error when 135;; trying to bind. 136;; 137;; We want to be able to handle this scenario, though, so that Scheme 138;; code can be evaluated, and help invoked, in any of those Emacsen. 139;; So we introduce the idea of a "slave server". When a new GDS 140;; server gets an EADDRINUSE bind error, the implication is that there 141;; is already a GDS server running, so the new server instead connects 142;; to the existing one (by issuing a connect to the GDS port number). 143;; 144;; Let's call the first server the "master", and the new one the 145;; "slave". In principle the master can now proxy any GDS client 146;; connections through to the slave, so long as there is sufficient 147;; information in the protocol for it to decide when and how to do 148;; this. 149;; 150;; The basic information and mechanism that we need for this is as 151;; follows. 152;; 153;; - A unique ID for each Emacs; this can be each Emacs's PID. When a 154;; slave server connects to the master, it announces itself by sending 155;; the protocol (emacs ID). 156;; 157;; - A way for a client to indicate which Emacs it wants to use. At 158;; the protocol level, this is an extra argument in the (name ...) 159;; protocol. (The absence of this argument means "no preference". A 160;; simplistic master server might then decide to use its own Emacs; a 161;; cleverer one might monitor which Emacs appears to be most in use, 162;; and use that one.) At the API level this can be an optional 163;; argument to the `gds-connect' procedure, and the Emacs GDS code 164;; would obviously set this argument when starting a client from 165;; within Emacs. 166;; 167;; We also want a strategy for continuing seamlessly if the master 168;; server shuts down. 169;; 170;; - Each slave server will detect this as an error on the connection 171;; to the master socket. Each server then tries to bind to the GDS 172;; port again (a race which the OS will resolve), and if that fails, 173;; connect again. The result of this is that there should be a new 174;; master, and the others all slaves connected to the new master. 175;; 176;; - Each client will also detect this as an error on the connection 177;; to the (master) server. Either the client should try to connect 178;; again (perhaps after a short delay), or the reconnection can be 179;; delayed until the next time that the client requires the server. 180;; (Probably the latter, all done within `gds-read'.) 181;; 182;; (Historical note: Before this master-slave idea, clients were 183;; identified within gds-server.scm and gds*.el by an ID which was 184;; actually the file descriptor of their connection to the server. 185;; That is no good in the new scheme, because each client's ID must 186;; persist when the master server changes, so we now use the client's 187;; PID instead. We didn't use PID before because the client/server 188;; code was written to be completely asynchronous, which made it 189;; tricky for the server to discover each client's PID and associate 190;; it with a particular connection. Now we solve that problem by 191;; handling the initial protocol exchange synchronously.) 192(define (run-slave-server port) 193 'not-implemented) 194