impl-acl.lisp

   1 ;;; -*- Mode:Lisp; Syntax:Common-lisp; Package: modlisp; Base:10 -*-
   2
   3 (in-package #:modlisp)
   4
   5 (eval-when (compile load eval)
   6   (require :socket))
   7
   8 (defun make-socket-server (name function port &key wait (format :text))
   9   (let* ((listener (socket:make-socket
  10                     :connect :passive
  11                     :local-port port
  12                     :address-family
  13                     (if (stringp port)
  14                         :file
  15                         (if (or (null port) (integerp port))
  16                             :internet
  17                             (error "illegal value for port: ~s" port)))
  18                     :format format))
  19          (proc (mp::process-run-function name
  20                  #'(lambda ()
  21                      (start-socket-server listener function
  22                                           :wait wait)))))
  23     (values proc listener)))
  24
  25 (defun start-socket-server (passive-socket function &key wait)
  26   ;; internal function run in the server lightweight process
  27   ;; that continually processes the connection.
  28   ;; This code is careful to ensure that the sockets are
  29   ;; properly closed something abnormal happens.
  30   (unwind-protect
  31        (loop
  32         (let ((connection (socket:accept-connection passive-socket)))
  33           (if wait
  34               (unwind-protect
  35                    (funcall connection function)
  36                 (excl:errorset (close connection) nil))
  37               (let ((f function)
  38                     (c connection)
  39                     (name (next-worker-name)))
  40                 (mp:process-run-function
  41                  name
  42                  #'(lambda ()
  43                      (unwind-protect
  44                           (apache-command-issuer connection function)
  45                        #+ignore
  46                        (handler-case
  47                            (apache-command-issuer function connection)
  48                          (error (e)
  49                            #+ignore
  50                            (format t "~&Error ~A [~A]~%" e name))
  51                          (:no-error ()
  52                            #+ignore
  53                            (format t "~&~A ended" name)))
  54                        (excl:errorset (close connection) nil))))))))
  55     (ignore-errors (close passive-socket))))