/[slime]/slime/swank-cmucl.lisp
ViewVC logotype

Diff of /slime/swank-cmucl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.46 by lgorrie, Tue Jan 13 04:22:07 2004 UTC revision 1.47 by heller, Tue Jan 13 18:20:04 2004 UTC
# Line 10  Line 10 
10    
11  ;;;; TCP server.  ;;;; TCP server.
12    
13  (defvar *start-swank-in-background* t)  (defmethod create-socket (port)
14      (ext:create-inet-listener port :stream
15  (defmethod accept-socket/stream (&key (port 0) announce-fn (host "localhost"))                              :reuse-address t
16    (let ((fd (ext:create-inet-listener port :stream                              :host (resolve-hostname "localhost")))
17                                        :reuse-address t  
18                                        :host (resolve-hostname host))))  (defmethod local-port (socket)
19      (funcall announce-fn (local-tcp-port fd))    (nth-value 1 (ext::get-socket-host-and-port (socket-fd socket))))
20      (let ((client-fd (ext:accept-tcp-connection fd)))  
21        (unix:unix-close fd)  (defmethod close-socket (socket)
22        (make-socket-io-stream client-fd))))    (ext:close-socket (socket-fd socket)))
23    
24  (defmethod accept-socket/run (&key (port 0) announce-fn init-fn (host "localhost"))  (defmethod accept-connection (socket)
25    "Run in the background if *START-SWANK-IN-BACKGROUND* is true."    (make-socket-io-stream (ext:accept-tcp-connection socket)))
26    (let ((fd (ext:create-inet-listener port :stream  
27                                        :reuse-address t  (defmethod add-input-handler (socket fn)
28                                        :host (resolve-hostname host))))    (flet ((callback (fd)
29      (funcall announce-fn (local-tcp-port fd))             (declare (ignore fd))
30      (add-input-handler fd (lambda ()             (funcall fn)))
31                              (setup-client (ext:accept-tcp-connection fd) init-fn)))))      (system:add-fd-handler (socket-fd socket) :input #'callback)))
   
 (defun setup-client (fd init-fn)  
   (let* ((socket-io (make-socket-io-stream fd))  
          (handler-fn (funcall init-fn socket-io)))  
     (add-input-handler fd handler-fn)))  
32    
33  (defmethod make-fn-streams (input-fn output-fn)  (defmethod make-fn-streams (input-fn output-fn)
34    (let* ((output (make-slime-output-stream output-fn))    (let* ((output (make-slime-output-stream output-fn))
# Line 43  Line 38 
38  ;;;  ;;;
39  ;;;;; Socket helpers.  ;;;;; Socket helpers.
40    
41  (defun local-tcp-port (fd)  (defun socket-fd (socket)
42    "Return the TCP port of the socket represented by FD."    "Return the filedescriptor for the socket represented by SOCKET."
43    (nth-value 1 (ext::get-socket-host-and-port fd)))    (etypecase socket
44        (fixnum socket)
45        (sys:fd-stream (sys:fd-stream-fd socket))))
46    
47  (defun resolve-hostname (hostname)  (defun resolve-hostname (hostname)
48    "Return the IP address of HOSTNAME as an integer."    "Return the IP address of HOSTNAME as an integer."
# Line 53  Line 50 
50           (address (car (ext:host-entry-addr-list hostent))))           (address (car (ext:host-entry-addr-list hostent))))
51      (ext:htonl address)))      (ext:htonl address)))
52    
 (defun add-input-handler (fd fn)  
   (let ((callback (lambda (fd)  
                     (declare (ignore fd))  
                     (funcall fn))))  
     (system:add-fd-handler fd :input callback)))  
   
53  (defun make-socket-io-stream (fd)  (defun make-socket-io-stream (fd)
54    "Create a new input/output fd-stream for FD."    "Create a new input/output fd-stream for FD."
55    (sys:make-fd-stream fd :input t :output t :element-type 'base-char))    (sys:make-fd-stream fd :input t :output t :element-type 'base-char))

Legend:
Removed from v.1.46  
changed lines
  Added in v.1.47

  ViewVC Help
Powered by ViewVC 1.1.5