share/contrib/maxima-server.lisp

   1 ;; maxima-server.lisp -- create simultaneous, independent Maxima sessions via POSIX fork
   2 ;;
   3 ;; Copyright 2007 by Robert Dodier.
   4 ;; I release this file under the terms of
   5 ;; the GNU General Public License.
   6 ;;
   7 ;; The function SERVER-RUN implements a simple Unix server:
   8 ;; listen, accept, fork.
   9 ;;
  10 ;; Actually fork is called twice and child exits immediately,
  11 ;; so the grandchild process cannot become a zombie.
  12 ;;
  13 ;; This code only works for SBCL. It might work with some modification
  14 ;; for other Lisps which have POSIX functions.
  15 ;;
  16 ;; This code is experimental and if it causes all kinds of errors,
  17 ;; that's to be expected.
  18 ;;
  19 ;; Example:
  20 ;;
  21 ;; Server:
  22 ;;
  23 ;; $ maxima
  24 ;; (%i1) load ("./maxima-server.lisp");
  25 ;; (%i2) :lisp (server-run)
  26 ;; JUST BEFORE SOCKET-ACCEPT ...
  27 ;; (etc etc log messages here)
  28 ;;
  29 ;; Client:
  30 ;;
  31 ;; $ telnet localhost 1042
  32 ;; Trying 127.0.0.1...
  33 ;; Connected to localhost.
  34 ;; Escape character is '^]'.
  35 ;; Maxima restarted.
  36 ;; (%i2) build_info ();
  37 ;;
  38 ;; Maxima version: 5.12.0cvs
  39 ;; Maxima build date: 9:5 5/12/2007
  40 ;; host type: i686-pc-linux-gnu
  41 ;; lisp-implementation-type: SBCL
  42 ;; lisp-implementation-version: 1.0
  43 ;;
  44 ;; (%o2)
  45 ;; (%i3) ^]
  46 ;; telnet> quit
  47 ;; Connection closed.
  48
  49
  50 (defvar listening-socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))
  51 (sb-bsd-sockets:socket-bind listening-socket (sb-bsd-sockets:make-inet-address "127.0.0.1") 1042)
  52 (sb-bsd-sockets:socket-listen listening-socket 5)
  53
  54 (defun server-run ()
  55   (loop do
  56     (format t "JUST BEFORE SOCKET-ACCEPT ...~%")
  57     (multiple-value-bind (working-socket peer-address) (sb-bsd-sockets:socket-accept listening-socket)
  58       (format t "ACCEPTED CLIENT; PEER-ADDRESS = ~S~%WORKING-SOCKET = ~S~%" peer-address working-socket)
  59
  60       ; Conventional Unix hackery here:
  61       ; fork twice and immediate exit first child process,
  62       ; so that grandchild is eventually inherited by init process;
  63       ; thus grandchild doesn't become a zombie.
  64
  65       (let ((child-pid (sb-posix:fork)))
  66         (if (eql child-pid 0)
  67           (let ((grandchild-pid (sb-posix:fork)))
  68             (if (eql grandchild-pid 0)
  69               (progn
  70                 ; Grandchild process: I execute the Maxima session here.
  71                 (let*
  72                   ((working-stream (sb-bsd-sockets:socket-make-stream working-socket :input t :output t))
  73                    (*standard-input* working-stream)
  74                    (*standard-output* working-stream))
  75                   (handler-case (cl-user::run)
  76                     (error nil t)))
  77                 (format t "SERVER-RUN RETURNED; GRANDCHILD NOW QUITS~%")
  78                 (sb-bsd-sockets:socket-close working-socket)
  79                 (sb-ext:quit))
  80               (progn
  81                 ; Child process: I exit immediately.
  82                 (format t "CHILD: IMMEDIATE EXIT; GRANDCHILD PID = ~S~%" grandchild-pid)
  83                 (sb-bsd-sockets:socket-close working-socket)
  84                 (sb-ext:quit))))
  85           (progn
  86             (format t "PARENT: WAIT FOR CHILD; CHILD PID = ~S~%" child-pid)
  87             (sb-bsd-sockets:socket-close working-socket)
  88             (sb-posix:waitpid child-pid 0)))))))
  89