iolib.lisp

   1 ;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
   2
   3 ;; Copyright (c) 2011-12, Olof-Joachim Frahm
   4 ;; All rights reserved.
   5
   6 ;; Redistribution and use in source and binary forms, with or without
   7 ;; modification, are permitted provided that the following conditions
   8 ;; are met:
   9
  10 ;; 1. Redistributions of source code must retain the above copyright
  11 ;; notice, this list of conditions and the following disclaimer.
  12
  13 ;; 2. Redistributions in binary form must reproduce the above copyright
  14 ;; notice, this list of conditions and the following disclaimer in the
  15 ;; documentation and/or other materials provided with the distribution.
  16
  17 ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  18 ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  19 ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  20 ;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  21 ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  22 ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  23 ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  24 ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  25 ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  26 ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  27 ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  28
  29 (in-package #:cl-inotify)
  30
  31 (defun run-inotify-event-handler (watch event-handler &key (nonblocking T) (registered T))
  32   "Registers an INOTIFY queue and runs EVENT-HANDLER with it as only
  33 parameter whenever input happens."
  34   (let ((inotify (funcall (if registered #'make-inotify #'make-unregistered-inotify) nonblocking)))
  35     (unwind-protect
  36          (iolib:with-event-base (event-base)
  37            (dolist (watch watch)
  38              (apply #'watch inotify watch))
  39            (flet ((events (&rest args)
  40                     (declare (ignore args))
  41                     (do-events (event inotify :blocking-p NIL)
  42                       (funcall event-handler inotify event))))
  43              (iolib:set-io-handler event-base (inotify-fd inotify) :read #'events)
  44              (iolib:event-dispatch event-base)))
  45       (close-inotify inotify))))
  46
  47 (defun run-inotify-program (program args rest directories flags
  48                             &key event-handler (registered T))
  49   "Runs a program and records all matched events in all DIRECTORIES using
  50 FLAGS.  If EVENT-HANDLER is set, it is instead called with every available
  51 event.
  52
  53 PROGRAM, ARGS and REST are the arguments to SB-EXT:RUN-PROGRAM.  REST is
  54 passed on verbatim except for the WAIT parameter, which is set to false.
  55
  56 PROGRAM may also be a FUNCTION, in which case it is called with
  57 \(ARGS . REST) as arguments and has to return a process object like from
  58 SB-EXT:RUN-PROGRAM.  The process also shouldn't be spawned with WAIT set.
  59
  60 DIRECTORIES is a list of directory arguments for WATCH/-RAW.
  61
  62 Returns the process structure and if EVENT-HANDLER wasn't set, a LIST of
  63 recorded events as second value."
  64   (let (events)
  65     (flet ((events (inotify)
  66              (do-events (event inotify)
  67                (if event-handler
  68                    (funcall event-handler event)
  69                    (push event events)))))
  70       (let ((inotify (if registered (make-inotify) (make-unregistered-inotify))))
  71         (unwind-protect
  72              (progn
  73                (let ((register (if registered #'watch #'watch-raw)))
  74                  (mapcar (lambda (directory)
  75                            (funcall register inotify directory flags))
  76                          directories))
  77                (let ((process (etypecase program
  78                                 (string
  79                                  (apply #'sb-ext:run-program program args :wait NIL rest))
  80                                 (function
  81                                  (apply program args rest)))))
  82                  (loop
  83                    while (sb-ext:process-alive-p process)
  84                    do (events inotify))
  85                  (events inotify)
  86                  (if event-handler
  87                      process
  88                      (values process (nreverse events)))))
  89           (close-inotify inotify))))))