impl-cmucl.lisp

   1 ;;; -*- Mode:Lisp; Syntax:Common-lisp; Package: modlisp; Base:10 -*-
   2
   3 (in-package #:modlisp)
   4
   5
   6 (defun make-socket-server (name function port &key wait (format :text))
   7   (let ((listener (ext:create-inet-listener port)))
   8   (values
   9    (mp:make-process
  10     (lambda () (start-socket-server listener function))
  11     :name name)
  12    listener)))
  13
  14 (defun start-socket-server (listener function)
  15   (unwind-protect
  16        (loop
  17         (mp:process-wait-until-fd-usable listener :input)
  18         (multiple-value-bind (new-fd remote-host)
  19             (ext:accept-tcp-connection listener)
  20           (let ((stream (sys:make-fd-stream new-fd :input t :output t)))
  21             (mp:make-process
  22              (lambda () (apache-command-issuer stream function))
  23              :name (next-worker-name)))))
  24     (unix:unix-close listener)))