X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=inotify.lisp;h=8c9738655c932373371df6e8bff01c907254be31;hb=HEAD;hp=16c309927bb5701bfa55ea7b8d7ce291934d4976;hpb=da749411569c2763b265fe56a2c128b7991efde0;p=cl-inotify.git diff --git a/inotify.lisp b/inotify.lisp index 16c3099..8c97386 100644 --- a/inotify.lisp +++ b/inotify.lisp @@ -1,4 +1,4 @@ -;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8; package: cl-inotify; -*- +;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*- ;; Copyright (c) 2011-12, Olof-Joachim Frahm ;; All rights reserved. @@ -28,6 +28,11 @@ (in-package #:cl-inotify) +(eval-when (:compile-toplevel :load-toplevel :execute) + (when (boundp 'in-cloexec) + (pushnew 'inotify1 *features*))) + +#+cl-inotify::inotify1 (defbitfield (inotify1-flag :int) (:cloexec #.in-cloexec) (:nonblock #.in-nonblock)) @@ -97,18 +102,19 @@ thus should be used only with WATCH-RAW)." (defsyscall inotify-init :int "Initialises a new inotify event queue.") +#+cl-inotify::inotify1 (defsyscall inotify-init1 :int "Initialises a new inotify event queue and passes some flags along." (flags inotify1-flag)) (defsyscall inotify-add-watch :int - "Watches a path on a event queue." + "Watches a path on an event queue." (fd :int) (pathname :string) (mask inotify-flag)) (defsyscall inotify-rm-watch :int - "Removes a watched path from a event queue." + "Removes a watched path from an event queue." (fd :int) (wd :int)) @@ -198,8 +204,14 @@ the file descriptor is set to non-blocking I/O." (unwind-protect ;; file descriptor is collected with auto-close (progn - (setf fd (inotify-init1 (and (setf non-block nonblocking) - :nonblock))) + (setf non-block nonblocking) + #+inotify1 + (setf fd (inotify-init1 (and non-block :nonblock))) + #-inotify1 + (setf fd (inotify-init)) + #-inotify1 + (when non-block + (set-nonblocking fd T)) (setf stream ;; TODO: what about the blocking? #-(or clisp sbcl) @@ -374,7 +386,9 @@ error." (defmacro do-events ((var inotify &key blocking-p) &body body) "Loops BODY with VAR bound to the next events retrieved from INOTIFY. The macro uses NEXT-EVENT, so reading an event won't block and the loop -terminates if no events are available." +terminates if no events are available. If BLOCKING-P is set, the loop +blocks if no events are available, otherwise it exits as soon as no +events were encountered." (check-type var symbol) (let ((inotify-sym (gensym))) `(loop @@ -396,12 +410,13 @@ terminates if no events are available." (defmacro with-unregistered-inotify ((inotify &optional (nonblocking T) &rest rest) &body body) "Like WITH-INOTIFY, but uses MAKE-UNREGISTERED-INOTIFY and WATCH-RAW instead. Useful if you need to monitor just a fixed set of paths." - `(let* ((,inotify (make-unregistered-inotify ,nonblocking))) + `(let ((,inotify (make-unregistered-inotify ,nonblocking))) (unwind-protect (progn ,.(mapcar (lambda (specifier) `(watch-raw ,inotify ,@specifier)) rest) + (values) ,@body) (close-inotify ,inotify)))) @@ -414,101 +429,12 @@ more forms (PATHNAME FLAGS &KEY (REPLACE-P T)). Since the QUEUE is closed on unwinding, this macro doesn't bother with UNWATCH calls on all WATCHed paths." - `(let* ((,inotify (make-inotify ,nonblocking))) + `(let ((,inotify (make-inotify ,nonblocking))) (unwind-protect (progn ,.(mapcar (lambda (specifier) `(watch ,inotify ,@specifier)) rest) + (values) ,@body) (close-inotify ,inotify)))) - -;; TODO: what about other implementations? -#+sbcl -(defmacro with-inotify-event-handler ((inotify - &optional (nonblocking T) (registered T) - &rest rest) - event-handler - &body body) - "Registers an INOTIFY queue and runs EVENT-HANDLER with it as only -parameter whenever input happens while the BODY is executed. - -Other parameters are passed to WITH-(UNREGISTERED)-INOTIFY depending on the -value of REGISTERED (default T)." - (let ((handle (gensym "HANDLE"))) - `(,(if registered 'with-inotify 'with-unregistered-inotify) - (,inotify ,nonblocking ,@rest) - (sb-sys:with-fd-handler - ((inotify-fd ,inotify) - :input - (lambda (,handle) - (declare (ignore ,handle)) - (funcall ,event-handler ,inotify))) - ,@body)))) - -(defun run-inotify-program (program args rest directories flags - &key function (wait T) event-handler (registered T)) - "Runs a program and records all matched events in all DIRECTORIES using -FLAGS. If EVENT-HANDLER is set, it is instead called with every available -event. - -PROGRAM, ARGS and REST are the arguments to SB-EXT:RUN-PROGRAM. REST is -passed on verbatim except for the WAIT parameter, which is set to false. - -PROGRAM may also be a FUNCTION, in which case it is called with -\(ARGS . REST) as arguments and has to return a process object like from -SB-EXT:RUN-PROGRAM. The process also shouldn't be spawned with WAIT set. - -DIRECTORIES is a list of directory arguments for WATCH/-RAW. - -WAIT is only valid if FUNCTION is set. If it is true, after FUNCTION has -returned, we wait until the process has quit. - -On supported implementations (SBCL) the FUNCTION parameter may be used to -do some work while the program is running and watched by the inotify queue. -It is called with the process object and the inotify queue as arguments." - (let (events) - (labels ((run () - (typecase program - (function (apply program args rest)) - (T - (apply #'sb-ext:run-program program args :wait NIL rest)))) - (events (inotify) - (do-events (event inotify) - (if event-handler - (funcall event-handler event) - (push event events)))) - (body (inotify) - (unwind-protect - (progn - (let ((register (if registered #'watch #'watch-raw))) - (mapcar (lambda (directory) - (funcall register inotify directory flags)) - directories)) - (let ((process (run))) - (if function - (unwind-protect - (funcall function process inotify) - ;; wait in any case so catching the files will work - (when wait - (sb-ext:process-wait process))) - (loop - while (sb-ext:process-alive-p process) - do (events inotify) - finally (return (if event-handler - process - (values (nreverse events) process))))))) - (close-inotify inotify)))) - (let ((inotify (if registered (make-inotify) (make-unregistered-inotify)))) - (if function - #-sbcl - (error "the FUNCTION parameter is only supported on SBCL for now") - #+sbcl - (sb-sys:with-fd-handler - ((inotify-fd inotify) - :input - (lambda (handle) - (declare (ignore handle)) - (events inotify))) - (body inotify)) - (body inotify))))))