src/multiplex/multiplexer.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Base class for multiplexers.
   4 ;;;
   5
   6 (in-package :iolib.multiplex)
   7
   8 (defvar *available-multiplexers* nil
   9   "An alist of (PRIORITY . MULTIPLEXER). Smaller values mean higher priority.")
  10
  11 (defvar *default-multiplexer* nil
  12   "The default multiplexer for the current OS.")
  13
  14 (defun get-fd-limit ()
  15   "Return the maximum number of FDs available for the current process."
  16   (let ((fd-limit (isys:getrlimit isys:rlimit-nofile)))
  17     (if (= fd-limit isys:rlim-infinity)
  18         65536 ; 64K should be enough for anybody
  19         fd-limit)))
  20
  21 (defclass multiplexer ()
  22   ((fd :reader fd-of)
  23    (fd-limit :initform (get-fd-limit)
  24              :initarg :fd-limit
  25              :reader fd-limit-of)
  26    (closedp :accessor multiplexer-closedp
  27             :initform nil))
  28   (:documentation "Base class for I/O multiplexers."))
  29
  30 (defgeneric close-multiplexer (mux)
  31   (:method-combination progn :most-specific-last)
  32   (:documentation "Close multiplexer MUX, calling close() on the multiplexer's FD if bound."))
  33
  34 (defgeneric monitor-fd (mux fd-entry)
  35   (:documentation "Add the descriptor represented by FD-ENTRY to multiplexer MUX.
  36 Must return NIL on failure, T otherwise."))
  37
  38 (defgeneric update-fd (mux fd-entry event-type edge-change)
  39   (:documentation "Update the status of the descriptor represented by FD-ENTRY in multiplexer MUX.
  40 Must return NIL on failure, T otherwise."))
  41
  42 (defgeneric unmonitor-fd (mux fd-entry)
  43   (:documentation "Remove the descriptor represented by FD-ENTRY from multiplexer MUX.
  44 Must return NIL on failure, T otherwise."))
  45
  46 (defgeneric harvest-events (mux timeout)
  47   (:documentation "Wait for events on multiplexer MUX for a maximum time of TIMEOUT seconds.
  48 Returns a list of fd/result pairs which have one of these forms:
  49   (fd (:read))
  50   (fd (:write))
  51   (fd (:read :write))
  52   (fd . :error)"))
  53
  54 (defmethod close-multiplexer :around ((mux multiplexer))
  55   (unless (multiplexer-closedp mux)
  56     (call-next-method)
  57     (setf (multiplexer-closedp mux) t)))
  58
  59 (defmethod close-multiplexer progn ((mux multiplexer))
  60   (when (and (slot-boundp mux 'fd) (not (null (fd-of mux))))
  61     (isys:close (fd-of mux))
  62     (setf (slot-value mux 'fd) nil))
  63   (values mux))
  64
  65 (defmethod monitor-fd :before ((mux multiplexer) fd-entry)
  66   (with-accessors ((fd-limit fd-limit-of))
  67       mux
  68     (let ((fd (fd-entry-fd fd-entry)))
  69       (when (and fd-limit (> fd fd-limit))
  70         (error "Cannot add such a large FD: ~A" fd)))))
  71
  72 (defmacro define-multiplexer (name priority superclasses slots &rest options)
  73   `(progn
  74      (defclass ,name ,superclasses ,slots ,@options)
  75      (pushnew (cons ,priority ',name) *available-multiplexers*
  76               :test #'equal)))