io.multiplex/kqueue.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- kequeue(2) multiplexer implementation.
   4 ;;;
   5
   6 (in-package :io.multiplex)
   7
   8 (defconstant +kqueue-priority+ 1)
   9
  10 (define-multiplexer kqueue-multiplexer +kqueue-priority+ (multiplexer)
  11   ())
  12
  13 (defmethod print-object ((mux kqueue-multiplexer) stream)
  14   (print-unreadable-object (mux stream :type nil :identity nil)
  15     (format stream "kqueue(2) multiplexer")))
  16
  17 (defvar *kqueue-max-events* 200)
  18
  19 (defmethod initialize-instance :after ((mux kqueue-multiplexer) &key)
  20   (setf (slot-value mux 'fd) (kqueue)))
  21
  22 (defun do-kqueue-event-request (kqueue-fd fd-entry filter request-type)
  23   (let ((fd (fd-entry-fd fd-entry)))
  24     (with-foreign-object (kev 'kevent)
  25       (bzero kev size-of-kevent)
  26       (ev-set kev fd filter request-type 0 0 (null-pointer))
  27       (kevent kqueue-fd
  28               kev 1
  29               (null-pointer) 0
  30               (null-pointer)))))
  31
  32 (defun calc-kqueue-monitor-filter (fd-entry)
  33   (if (null (fd-entry-read-event fd-entry))
  34       evfilt-write
  35       evfilt-read))
  36
  37 (defmethod monitor-fd ((mux kqueue-multiplexer) fd-entry)
  38   (assert fd-entry (fd-entry) "Must supply an FD-ENTRY!")
  39   (handler-case
  40       (do-kqueue-event-request (fd-of mux) fd-entry
  41                                (calc-kqueue-monitor-filter fd-entry)
  42                                ev-add)
  43     (nix:ebadf ()
  44       (warn "FD ~A is invalid, cannot monitor it." (fd-entry-fd fd-entry)))))
  45
  46 (defun calc-kqueue-update-filter-and-flags (event-type edge-change)
  47   (case event-type
  48     (:read
  49      (case edge-change
  50        (:add (values evfilt-read ev-add))
  51        (:del (values evfilt-read ev-delete))))
  52     (:write
  53      (case edge-change
  54        (:add (values evfilt-write ev-add))
  55        (:del (values evfilt-write ev-delete))))))
  56
  57 (defmethod update-fd ((mux kqueue-multiplexer) fd-entry event-type edge-change)
  58   (assert fd-entry (fd-entry) "Must supply an FD-ENTRY!")
  59   (handler-case
  60       (multiple-value-call #'do-kqueue-event-request (fd-of mux) fd-entry
  61                            (calc-kqueue-update-filter-and-flags event-type edge-change))
  62     (nix:ebadf ()
  63       (warn "FD ~A is invalid, cannot update its status."
  64             (fd-entry-fd fd-entry)))
  65     (nix:enoent ()
  66       (warn "FD ~A was not monitored, cannot update its status."
  67             (fd-entry-fd fd-entry)))))
  68
  69 (defun calc-kqueue-unmonitor-filter (fd-entry)
  70   (if (null (fd-entry-read-event fd-entry))
  71       evfilt-read
  72       evfilt-write))
  73
  74 (defmethod unmonitor-fd ((mux kqueue-multiplexer) fd-entry)
  75   (handler-case
  76       (do-kqueue-event-request (fd-of mux) fd-entry
  77                                (calc-kqueue-unmonitor-filter fd-entry)
  78                                ev-delete)
  79     (nix:ebadf ()
  80       (warn "FD ~A is invalid, cannot unmonitor it." (fd-entry-fd fd-entry)))
  81     (nix:enoent ()
  82       (warn "FD ~A was not monitored, cannot unmonitor it."
  83             (fd-entry-fd fd-entry)))))
  84
  85 (defmethod harvest-events ((mux kqueue-multiplexer) timeout)
  86   (with-foreign-objects ((events 'kevent *kqueue-max-events*)
  87                          (ts 'timespec))
  88     (bzero events (* *kqueue-max-events* size-of-kevent))
  89     (let (ready-fds)
  90       (nix:repeat-upon-condition-decreasing-timeout
  91           ((nix:eintr) tmp-timeout timeout)
  92         (when tmp-timeout
  93           (timeout->timespec tmp-timeout ts))
  94         (setf ready-fds
  95               (kevent (fd-of mux) (null-pointer) 0
  96                       events *kqueue-max-events*
  97                       (if tmp-timeout ts (null-pointer)))))
  98       (macrolet ((kevent-slot (slot-name)
  99                    `(foreign-slot-value (mem-aref events 'kevent i) 'kevent ',slot-name)))
 100         (loop for i below ready-fds
 101               for fd = (kevent-slot ident)
 102               for flags = (kevent-slot flags)
 103               for filter = (kevent-slot filter)
 104               for data = (kevent-slot data)
 105               for kqueue-event = (make-kqueue-event fd flags filter data)
 106               when kqueue-event collect kqueue-event)))))
 107
 108 ;;; TODO: do something with DATA
 109 (defun make-kqueue-event (fd flags filter data)
 110   (declare (ignore data))
 111   (let ((event ()))
 112     (switch (filter :test #'=)
 113       (evfilt-write (push :write event))
 114       (evfilt-read  (push :read event)))
 115     (flags-case flags
 116       ;; TODO: check what exactly EV_EOF means
 117       ;; (ev-eof   (pushnew :read event))
 118       (ev-error (push :error event)))
 119     (when event
 120       (list fd event))))