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
|
;; maxima-server.lisp -- create simultaneous, independent Maxima sessions via POSIX fork
;;
;; Copyright 2007 by Robert Dodier.
;; I release this file under the terms of
;; the GNU General Public License.
;;
;; The function SERVER-RUN implements a simple Unix server:
;; listen, accept, fork.
;;
;; Actually fork is called twice and child exits immediately,
;; so the grandchild process cannot become a zombie.
;;
;; This code only works for SBCL. It might work with some modification
;; for other Lisps which have POSIX functions.
;;
;; This code is experimental and if it causes all kinds of errors,
;; that's to be expected.
;;
;; Example:
;;
;; Server:
;;
;; $ maxima
;; (%i1) load ("./maxima-server.lisp");
;; (%i2) :lisp (server-run)
;; JUST BEFORE SOCKET-ACCEPT ...
;; (etc etc log messages here)
;;
;; Client:
;;
;; $ telnet localhost 1042
;; Trying 127.0.0.1...
;; Connected to localhost.
;; Escape character is '^]'.
;; Maxima restarted.
;; (%i2) build_info ();
;;
;; Maxima version: 5.12.0cvs
;; Maxima build date: 9:5 5/12/2007
;; host type: i686-pc-linux-gnu
;; lisp-implementation-type: SBCL
;; lisp-implementation-version: 1.0
;;
;; (%o2)
;; (%i3) ^]
;; telnet> quit
;; Connection closed.
(defvar listening-socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))
(sb-bsd-sockets:socket-bind listening-socket (sb-bsd-sockets:make-inet-address "127.0.0.1") 1042)
(sb-bsd-sockets:socket-listen listening-socket 5)
(defun server-run ()
(loop do
(format t "JUST BEFORE SOCKET-ACCEPT ...~%")
(multiple-value-bind (working-socket peer-address) (sb-bsd-sockets:socket-accept listening-socket)
(format t "ACCEPTED CLIENT; PEER-ADDRESS = ~S~%WORKING-SOCKET = ~S~%" peer-address working-socket)
; Conventional Unix hackery here:
; fork twice and immediate exit first child process,
; so that grandchild is eventually inherited by init process;
; thus grandchild doesn't become a zombie.
(let ((child-pid (sb-posix:fork)))
(if (eql child-pid 0)
(let ((grandchild-pid (sb-posix:fork)))
(if (eql grandchild-pid 0)
(progn
; Grandchild process: I execute the Maxima session here.
(let*
((working-stream (sb-bsd-sockets:socket-make-stream working-socket :input t :output t))
(*standard-input* working-stream)
(*standard-output* working-stream))
(handler-case (cl-user::run)
(error nil t)))
(format t "SERVER-RUN RETURNED; GRANDCHILD NOW QUITS~%")
(sb-bsd-sockets:socket-close working-socket)
(sb-ext:quit))
(progn
; Child process: I exit immediately.
(format t "CHILD: IMMEDIATE EXIT; GRANDCHILD PID = ~S~%" grandchild-pid)
(sb-bsd-sockets:socket-close working-socket)
(sb-ext:quit))))
(progn
(format t "PARENT: WAIT FOR CHILD; CHILD PID = ~S~%" child-pid)
(sb-bsd-sockets:socket-close working-socket)
(sb-posix:waitpid child-pid 0)))))))
|
