1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
;;;; 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)
|
