io.multiplex/multiplexer.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Base class for multiplexers.
   4 ;;;
   5
   6 (in-package :io.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 (nix:getrlimit nix:rlimit-nofile)))
  17     (unless (eql fd-limit nix:rlim-infinity)
  18       (1- fd-limit))))
  19
  20 (defclass multiplexer ()
  21   ((fd :reader fd-of)
  22    (fd-limit :initform (get-fd-limit)
  23              :initarg :fd-limit
  24              :reader fd-limit-of)
  25    (closedp :accessor multiplexer-closedp
  26             :initform nil))
  27   (:documentation "Base class for I/O multiplexers."))
  28
  29 (defgeneric close-multiplexer (mux)
  30   (:method-combination progn :most-specific-last)
  31   (:documentation "Close multiplexer MUX, calling close() on the multiplexer's FD if bound."))
  32
  33 (defgeneric monitor-fd (mux fd-entry)
  34   (:documentation "Add the descriptor reppresented by FD-ENTRY to multiplexer MUX.
  35 Must return NIL on failure, T otherwise."))
  36
  37 (defgeneric update-fd (mux fd-entry event-type edge-change)
  38   (:documentation "Update the status of the descriptor reppresented by FD-ENTRY in multiplexer MUX.
  39 Must return NIL on failure, T otherwise."))
  40
  41 (defgeneric unmonitor-fd (mux fd-entry)
  42   (:documentation "Remove the descriptor reppresented by FD-ENTRY from multiplexer MUX.
  43 Must return NIL on failure, T otherwise."))
  44
  45 (defgeneric harvest-events (mux timeout)
  46   (:documentation "Wait for events on multiplexer MUX for a maximum time of TIMEOUT seconds.
  47 Returns a list of fd/result pairs which have one of these forms:
  48   (fd (:read))
  49   (fd (:write))
  50   (fd (:read :write))
  51   (fd . :error)"))
  52
  53 (defmethod close-multiplexer :around ((mux multiplexer))
  54   (unless (multiplexer-closedp mux)
  55     (call-next-method)
  56     (setf (multiplexer-closedp mux) t)))
  57
  58 (defmethod close-multiplexer progn ((mux multiplexer))
  59   (when (and (slot-boundp mux 'fd) (not (null (fd-of mux))))
  60     (nix:close (fd-of mux))
  61     (setf (slot-value mux 'fd) nil))
  62   (values mux))
  63
  64 (defmethod monitor-fd :around ((mux multiplexer) fd-entry)
  65   (if (ignore-and-print-errors (call-next-method))
  66       t
  67       (warn "FD monitoring failed for FD ~A."
  68             (fd-entry-fd fd-entry))))
  69
  70 (defmethod update-fd :around ((mux multiplexer) fd-entry event-type edge-change)
  71   (declare (ignore event-type edge-change))
  72   (if (ignore-and-print-errors (call-next-method))
  73       t
  74       (warn "FD status update failed for FD ~A."
  75             (fd-entry-fd fd-entry))))
  76
  77 (defmethod unmonitor-fd :around ((mux multiplexer) fd-entry)
  78   (if (ignore-and-print-errors (call-next-method))
  79       t
  80       (warn "FD unmonitoring failed for FD ~A."
  81             (fd-entry-fd fd-entry))))
  82
  83 (defmacro define-multiplexer (name priority superclasses slots &rest options)
  84   `(progn
  85      (defclass ,name ,superclasses ,slots ,@options)
  86      (pushnew (cons ,priority ',name) *available-multiplexers*
  87               :test #'equal)))