source: project/release/3/remote-repl/trunk/remote-repl-client.scm @ 11670

Last change on this file since 11670 was 11670, checked in by elf, 13 years ago

fix for documentation building

File size: 6.8 KB
Line 
1;;;; egg:        remote-repl
2;;;; file:       remote-repl-client.scm
3;;;; author:     elf <elf@ephemeral.net>
4;;;; date:       16 Aug 2008
5;;;; purpose:    client component of the remote repl
6;;;;
7;;;; licence:    BSD (see LICENCE)
8;;;; copyright:  Copyright (C) 2008, Elf
9;;;;             All rights reserved.
10;;;;
11;;;; changelog:  20080816 [elf]  Initial release.
12;;;;             20080817 [elf]  Fix for read timeouts. (reported by certainty)
13;;;;             20080817 [elf]  Bumped version to 1.1.0
14;;;;             20080817 [elf]  Compilation warnings cleaned up.
15;;;;             20080817 [elf]  Bumped version to 1.1.1
16;;;;             20080817 [elf]  Bumped version to 1.1.2
17;;;;
18
19
20
21;;; chicken library loading
22
23
24(require-extension tcp)       ; tcp sockets
25(require-extension srfi-18)   ; lightweight thread library
26
27
28
29;;; chicken compile-time directives
30
31
32(eval-when (compile)
33    (declare
34        (uses library extras eval tcp srfi-18)
35        (bound-to-procedure
36            rrepl-client-new
37            rrepl-client?
38            rrepl-client:read
39            rrepl-client:read!
40            rrepl-client:print
41            rrepl-client:print!
42            rrepl-client:close
43            rrepl-client:close!
44            rrepl-client:inport
45            rrepl-client:inport!
46            rrepl-client:outport
47            rrepl-client:outport!
48            rrepl-client:active
49            rrepl-client:active!
50            print-default
51            auth-default
52            close
53            rrepl-client-connect
54            rrepl-client-send
55            rrepl-client-close
56        )
57        (export
58            rrepl-client?
59            rrepl-client:read
60            rrepl-client:print
61            rrepl-client:close
62            rrepl-client:inport
63            rrepl-client:outport
64            rrepl-client:active
65            rrepl-client-connect
66            rrepl-client-send
67            rrepl-client-close
68            )
69        (emit-exports "remote-repl-client.exports")
70        (unused
71            rrepl-client:read!
72            rrepl-client:print!
73            rrepl-client:close!
74            )
75        (inline)
76        (inline-limit 100)
77        (lambda-lift)
78        (disable-interrupts)
79        (no-bound-checks)
80        (no-procedure-checks)
81        (standard-bindings)
82        (extended-bindings)
83        (usual-integrations)
84    ))
85
86
87
88;;; data structures
89
90
91;; record: rrepl-client
92;; structure containing client (remote controller) data
93;; fields:
94;;    reader   (read)    :  proc to read a line from input port (iport)
95;;    printer  (print)   :  proc to print (send) to output port (expr oport)
96;;    close    (close)   :  proc to close client ports (client)
97;;    inport   (inport)  :  input socket port
98;;    outport  (outport) :  output socket port
99;;    active   (active)  :  boolean, is client active?
100(define-record-type rrepl-client
101    (rrepl-client-new reader printer close inport outport active)
102    rrepl-client?
103        (reader     rrepl-client:read       rrepl-client:read!)
104        (printer    rrepl-client:print      rrepl-client:print!)
105        (close      rrepl-client:close      rrepl-client:close!)
106        (inport     rrepl-client:inport     rrepl-client:inport!)
107        (outport    rrepl-client:outport    rrepl-client:outport!)
108        (active     rrepl-client:active     rrepl-client:active!)
109    )
110
111
112
113;; generic and default procedures
114
115
116;; (print-default EXPRESSION OUTPUT-PORT)
117;; default handler for sending data (newline is important!)
118(define (print-default expr port)
119    (write expr port)
120    (newline port))
121
122;; (auth-default CLIENT-RECORD)
123;; default handler for authentication (do nothing and return client record)
124(define (auth-default cli)
125    cli)
126
127;; (close INPUT-PORT-CLOSE-PROC OUTPUT-PORT-CLOSE-PROC)
128;; wrapper for cleanup when closing client ports
129(define (close close-in close-out)
130    (lambda (cli)
131        (condition-case
132            (close-in (rrepl-client:inport cli))
133                (var ()    #f))
134        (condition-case
135            (close-out (rrepl-client:outport cli))
136                (var ()    #f))
137        (rrepl-client:inport! cli #f)
138        (rrepl-client:outport! cli #f)
139        (rrepl-client:active! cli #f)))
140
141
142
143;;; high-level interface
144
145
146;; rrepl-client-connect
147;; connect to a remote-repl server
148;; args:
149;;    host       :  string hostname/ip where server resides
150;;    port       :  integer port number where server resides
151;;    connect    :  proc to perform socket connection (host port)
152;;    auth       :  proc to handle authentication (client)
153;;    reader     :  proc to read a line from input port (iport)
154;;    printer    :  proc to send data to output port (expr oport)
155;;    close-in   :  proc to close input port (iport)
156;;    close-out  :  proc to close output port (oport)
157(define (rrepl-client-connect host port #!key (connect     tcp-connect)
158                                              (auth        auth-default)
159                                              (reader      read-line)
160                                              (printer     print-default)
161                                              (close-in    close-input-port)
162                                              (close-out   close-output-port))
163    (##sys#check-string host 'rrepl-client-connect)
164    (##sys#check-range port 1 32767 'rrepl-client-connect)
165    (tcp-read-timeout #f)
166    (call-with-values
167        (lambda ()
168            (connect host port))
169        (lambda (i o)
170            (auth (rrepl-client-new reader
171                                    printer
172                                    (close close-in close-out)
173                                    i
174                                    o
175                                    #t)))))
176
177;; (rrepl-client-send CLIENT-RECORD EXPRESSION)
178;; send data for evaluation on remote server and get result
179(define (rrepl-client-send cli expr)
180    (##sys#check-structure cli 'rrepl-client 'rrepl-client-send)
181    (if (rrepl-client:active cli)
182        (let ((t   #t))
183            (condition-case
184                ((rrepl-client:print cli) expr (rrepl-client:outport cli))
185                    (var ()
186                        ((rrepl-client:close cli) cli)
187                        (display "write error - closing\n")))
188            (if (rrepl-client:active cli)
189                (condition-case
190                    ((rrepl-client:read cli) (rrepl-client:inport cli))
191                        (var ()
192                            ((rrepl-client:close cli) cli)
193                            (display "read error - closing\n")))))
194        (display "client is not active\n")))
195
196;; (rrepl-client-close CLIENT-RECORD)
197;; shut down a client connection
198(define (rrepl-client-close cli)
199    (##sys#check-structure cli 'rrepl-client 'rrepl-client-close)
200    (if (rrepl-client:active cli)
201        (begin
202            (display (rrepl-client-send cli '(rrepl-session-close)))
203            ((rrepl-client:close cli) cli))
204        #t))
205
Note: See TracBrowser for help on using the repository browser.