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
|
;;;;
;;;; Eusserver
;;;; executes eus remotely
;;;; 1989-May
;;;; T.Matsui, ETL
(defparameter *host* nil)
(defparameter *connection-count* 0)
(defparameter *connections* nil)
(defvar *server-connection* nil)
(defun server-signal (sig code)
(throw 'new-connection nil))
(defun new-connection ()
(warning-message 3 "new connection request arrived~%")
(push (make-server-socket-stream *server-connection*) *connections*)
(warning-message 4 "connection established ~d~%" (inc *connection-count*)))
;;;
;;; % rsh host eusserver port-no
;;;
(defun server (&optional argv)
(warning-message 6 "Internet EusLisp Server vers.1")
(alloc 50000)
(setq *host* (read-line (sys:piped-fork "hostname")))
(let ((port-no) (saddr) (requests))
(setq port-no
(if (> (length argv) 1)
(read-from-string (aref argv 1))
2011))
(warning-message 5 " host=~A port=~D~%" *host* port-no)
(setq saddr (make-socket-address :domain af_inet
:host *host*
:port port-no))
(setq *server-connection* (make-socket-port saddr))
(push *server-connection* *connections*)
(unix:signal unix:sigpipe 'server-signal)
(while t
(setq requests (select-stream *connections*))
(cond
((eq (first requests) *server-connection*)
(new-connection))
(t
(dolist (s requests)
(print (eval (read s)) s)))))
))
(defun connect-eusserver (host &optional (port-no 2011))
(setq *eusserver*
(make-client-socket-stream
(make-socket-address :domain af_inet
:host host
:port port-no))))
(defun submit-execution (file &optional ch)
`(progn (print ',(read file) *eusserver*)
(read *eusserver*)))
(set-macro-character #\! 'submit-execution)
|
