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

Last change on this file since 11665 was 11665, checked in by elf, 12 years ago

fixes and version bump

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