impl-sbcl.lisp

   1 ;;; -*- Mode:Lisp; Syntax:Common-lisp; Package: modlisp; Base:10 -*-
   2
   3 (in-package #:modlisp)
   4
   5 (defun make-socket-server (name function port &key wait format)
   6   (declare (ignore name))
   7   (let ((listener (listen-to-inet-port :port port :reuse 1)))
   8     (values
   9      (sb-thread:make-thread
  10       (lambda () (start-socket-server listener function)))
  11      listener)))
  12
  13
  14 (defun start-socket-server (listener function)
  15   (handler-case
  16       (when (sb-sys:wait-until-fd-usable
  17              (sb-bsd-sockets:socket-file-descriptor listener) :input)
  18         (unwind-protect
  19              (loop
  20               (let* ((socket (sb-bsd-sockets:socket-accept listener))
  21                      (stream (sb-bsd-sockets:socket-make-stream
  22                               socket
  23                               :element-type 'base-char
  24                               :input t :output t)))
  25                 (sb-thread:make-thread
  26                  #'(lambda () (apache-command-issuer stream function)))))
  27           (sb-unix:unix-close
  28            (sb-bsd-sockets:socket-file-descriptor listener))))
  29     (sb-kernel::timeout (c)
  30       (format t "interrupted, time to die~%"))))
  31
  32 (defun listen-to-inet-port (&key (port 0) (kind :stream) (reuse nil))
  33   "Create, bind and listen to an inet socket on *:PORT.
  34 setsockopt SO_REUSEADDR if :reuse is not nil"
  35   (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
  36                                :type :stream
  37                                :protocol :tcp)))
  38     (if reuse
  39         (setf (sb-bsd-sockets:sockopt-reuse-address socket) t))
  40     (sb-bsd-sockets:socket-bind
  41      socket (sb-bsd-sockets:make-inet-address "0.0.0.0") port)
  42     (sb-bsd-sockets:socket-listen socket 15)
  43     socket))
  44