Permalink
Browse files

Merge development branch and promote to master.

Works on SBCL ... all other implementations are failing on Travis CI due
to lacking FD streams (for example).
  • Loading branch information...
2 parents 23eae11 + 82482a7 commit 2bcef82a6ec761be946e484c2c9f9ce0a626dc1a @Ferada committed Aug 29, 2016
Showing with 291 additions and 62 deletions.
  1. +33 −0 .travis.yml
  2. +11 −10 README.md
  3. +38 −0 cl-inotify-tests.asd
  4. +14 −8 cl-inotify.asd
  5. +3 −3 { → src}/grovel.lisp
  6. +33 −32 { → src}/inotify.lisp
  7. +3 −3 { → src}/iolib.lisp
  8. +6 −6 { → src}/package.lisp
  9. +87 −0 tests/inotify.lisp
  10. +32 −0 tests/package.lisp
  11. +31 −0 tests/suite.lisp
View
@@ -0,0 +1,33 @@
+language: lisp
+
+sudo: required
+
+env:
+ matrix:
+ - LISP=abcl
+ - LISP=allegro
+ - LISP=sbcl
+ - LISP=sbcl32
+ - LISP=ccl
+ - LISP=ccl32
+ - LISP=clisp
+ - LISP=clisp32
+ - LISP=cmucl
+ - LISP=ecl
+
+matrix:
+ allow_failures:
+ # CIM not available for CMUCL
+ - env: LISP=cmucl
+
+install:
+ - curl -L https://github.com/luismbo/cl-travis/raw/master/install.sh | sh
+
+script:
+ # work around fiveam
+ - cl -e '(ql:quickload :cffi-grovel)
+ (ql:quickload :cl-inotify-tests)
+ (unless (let ((results (fiveam:run (find-symbol "CL-INOTIFY" "CL-INOTIFY-TESTS"))))
+ (fiveam:explain! results)
+ (notany (function fiveam::test-failure-p) results))
+ (uiop:quit 1))'
View
@@ -1,20 +1,20 @@
-CL-INOTIFY - Interface to the Linux inotify(7) API.
+CL-INOTIFY - Binding to the Linux inotify(7) API.
-Copyright (C) 2011-12 Olof-Joachim Frahm
+Copyright (C) 2011-15 Olof-Joachim Frahm
Released under a Simplified BSD license.
Working, but unfinished.
-Implementations currently running on: SBCL.
+[![Build Status](https://travis-ci.org/Ferada/cl-inotify.svg?branch=master)](https://travis-ci.org/Ferada/cl-inotify)
Uses CFFI, binary-types (from [my Github][1] or see [CLiki][2]) and
-trivial-utf-8. Doesn't use iolib, because I don't need most of the
-functionality, although it might gain us some implementation
-independence (patches which can be conditionally compiled are most
-welcome; in any case patches are welcome).
+trivial-utf-8. Doesn't require iolib, because I don't need most of the
+functionality, although it might add some implementation independence
+(patches which can be conditionally compiled are most welcome; in any
+case patches are always welcome). The tests require fiveam.
-A similar package is at [stassats Github][3].
+Similar packages are [inotify][3] and [cl-fsnotify][4].
This document helps only with the aspects of this binding, so reading
the man-page and other information on the inotify-facility may be
@@ -92,7 +92,7 @@ rely on that) which can be fed to `UNWATCH` and can be translated from
events with `EVENT-PATHNAME/FLAGS`.
To finally get the events from the queue, use `READ-EVENT` (which
-blocks) or `NEXT-EVENT` (which doesn't block). `EVENT-AVAILABLEP` does
+blocks) or `NEXT-EVENT` (which doesn't block). `EVENT-AVAILABLE-P` does
what it should do, `NEXT-EVENTS` retrieves all currently available
events as a list and `DO-EVENTS` (nonblocking) iterates over available
events.
@@ -105,7 +105,7 @@ read event.
`UNWATCH` has to be called with the path or the handle of the watched
file or directory (a path will be looked up in the same table as with
-`PATHNAME-HANDLE/FLAGS`).
+`PATHNAME-HANDLE/FLAGS`).
The raw API, which doesn't register watched paths, consists of
@@ -194,3 +194,4 @@ only adds the `WATCHED` slot under the same `CONC-NAME`.
[1]: https://github.com/Ferada/binary-types
[2]: http://www.cliki.net/Binary-types
[3]: https://github.com/stassats/inotify
+[4]: https://github.com/howeyc/cl-fsnotify
View
@@ -0,0 +1,38 @@
+;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*-
+
+;; Copyright (c) 2011-15, Olof-Joachim Frahm
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-user)
+
+(asdf:defsystem #:cl-inotify-tests
+ :depends-on (#:cl-inotify #:fiveam)
+ :serial T
+ :components ((:module "tests"
+ :components
+ ((:file "package")
+ (:file "suite")
+ (:file "inotify")))))
View
@@ -1,6 +1,6 @@
-;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*-
+;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*-
-;; Copyright (c) 2011-12, Olof-Joachim Frahm
+;; Copyright (c) 2011-15, Olof-Joachim Frahm
;; All rights reserved.
;; Redistribution and use in source and binary forms, with or without
@@ -25,14 +25,14 @@
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
+
(in-package #:cl-user)
(eval-when (:load-toplevel :execute)
(asdf:operate 'asdf:load-op 'cffi-grovel))
-(asdf:defsystem :cl-inotify
- :description "Inotify binding"
+(asdf:defsystem #:cl-inotify
+ :description "Inotify binding."
:long-description "Binding to the Linux inotify(7) API."
:author "Olof-Joachim Frahm <olof@macrolet.net>"
:license "Simplified BSD License"
@@ -41,7 +41,13 @@
#:trivial-utf-8
#:osicat)
:weakly-depends-on (#:iolib)
+ :in-order-to ((asdf:test-op (asdf:load-op #:cl-inotify-tests)))
+ :perform (asdf:test-op :after (op c)
+ (funcall (find-symbol (symbol-name '#:run!) '#:fiveam)
+ (find-symbol (symbol-name '#:cl-inotify) '#:cl-inotify-tests)))
:serial T
- :components ((:file "package")
- (cffi-grovel:grovel-file "grovel")
- (:file "inotify")))
+ :components ((:module "src"
+ :components
+ ((:file "package")
+ (cffi-grovel:grovel-file "grovel")
+ (:file "inotify")))))
@@ -1,6 +1,6 @@
-;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
+;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
-;; Copyright (c) 2011, Olof-Joachim Frahm
+;; Copyright (c) 2011-2015, Olof-Joachim Frahm
;; All rights reserved.
;; Redistribution and use in source and binary forms, with or without
@@ -27,7 +27,7 @@
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package #:cl-inotify)
-
+
(include "sys/inotify.h")
;; since 2.6.27 according to inotify_init(2)
@@ -1,6 +1,6 @@
-;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
+;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
-;; Copyright (c) 2011-12, Olof-Joachim Frahm
+;; Copyright (c) 2011-15, Olof-Joachim Frahm
;; All rights reserved.
;; Redistribution and use in source and binary forms, with or without
@@ -27,7 +27,7 @@
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package #:cl-inotify)
-
+
(eval-when (:compile-toplevel :load-toplevel :execute)
(when (boundp 'in-cloexec)
(pushnew 'inotify1 *features*)))
@@ -83,9 +83,9 @@
(member :dont-follow :mask-add :oneshot :onlydir)))
(defun valid-watch-flag-p (x)
- (and (typep x 'inotify-add-flag)
- (not (eq :mask-add x))
- (not (eq :oneshot x))))
+ (or (typep x 'inotify-read-flag)
+ (eq :dont-follow x)
+ (eq :onlydir x)))
(defun valid-watch-flag-list-p (list)
(every #'valid-watch-flag-p list))
@@ -175,10 +175,9 @@ called when the library is loaded."
(let* ((event (binary-types:read-binary 'inotify-event stream))
(len (binary-types:read-binary 'binary-types:u32 stream)))
(when (plusp len)
- (with-slots (name) event
- (let ((buffer (make-array len :element-type '(unsigned-byte 8))))
- (read-sequence buffer stream :end len)
- (setf name (trivial-utf-8:utf-8-bytes-to-string buffer :end (position 0 buffer))))))
+ (let ((buffer (make-array len :element-type '(unsigned-byte 8))))
+ (read-sequence buffer stream :end len)
+ (setf (inotify-event-name event) (trivial-utf-8:utf-8-bytes-to-string buffer :end (position 0 buffer)))))
event))
(defun read-event-from-stream (stream)
@@ -282,31 +281,30 @@ for validity though). Returns a handle which can be used with UNWATCH-RAW."
(:conc-name inotify-))
"Additionally to the information in INOTIFY-INSTANCE, records watched
paths in a dictionary."
- watched)
+ pathnames
+ handles)
(defun make-inotify (&optional (nonblocking T))
"Creates a new registered INOTIFY instance. In NONBLOCKING mode, the file
descriptor is set to non-blocking mode. The resulting object has to be
closed with CLOSE-INOTIFY."
(let ((result (make-registered-inotify-instance)))
(init-unregistered-inotify result nonblocking)
- (with-slots (watched) result
- (setf watched (make-hash-table :test 'equal)))
+ (setf (inotify-pathnames result) (make-hash-table :test 'equal)
+ (inotify-handles result) (make-hash-table))
result))
(defun pathname-handle/flags (inotify pathname)
"Returns a CONS cell with the values HANDLE and FLAGS if PATHNAME is
being watched by INOTIFY, else NIL. The match is exact."
- (gethash pathname (inotify-watched inotify)))
+ (cdr (gethash pathname (inotify-pathnames inotify))))
(defun event-pathname/flags (inotify event &optional (handle (slot-value event 'wd)))
"Returns two values PATHNAME and FLAGS for an EVENT which were used during
registration. If HANDLE is specified EVENT is ignored."
- (block NIL
- (maphash (lambda (pathname entry)
- (when (eql (car entry) handle)
- (return (values pathname (cdr entry)))))
- (inotify-watched inotify))))
+ (let ((list (gethash handle (inotify-handles inotify))))
+ (when list
+ (values (first list) (third list)))))
(defun sane-user-flags (inotify pathname flags &key (replace-p T))
(check-type flags watch-flag-list)
@@ -316,7 +314,7 @@ registration. If HANDLE is specified EVENT is ignored."
(rep-flags (if replace-p
(cons :mask-add flags)
flags)))
- (let ((it (gethash pathname (slot-value inotify 'watched))))
+ (let ((it (gethash pathname (inotify-pathnames inotify))))
(if it
(union (cdr it) rep-flags :test #'eq)
rep-flags))))
@@ -329,9 +327,10 @@ with UNWATCH and EVENT-PATHNAME/FLAGS. If REPLACE-P is set to T (default),
the flags mask is replaced rather than OR-ed to the current mask (if it
exists). The :MASK-ADD flag is therefore removed from the FLAGS argument."
(let* ((flags (sane-user-flags inotify pathname flags :replace-p replace-p))
- (handle (watch-raw inotify pathname flags)))
- (with-slots (watched) inotify
- (setf (gethash pathname watched) (cons handle flags)))
+ (handle (watch-raw inotify pathname flags))
+ (list (list pathname handle flags)))
+ (setf (gethash pathname (inotify-pathnames inotify)) list
+ (gethash handle (inotify-handles inotify)) list)
handle))
(defun unwatch (inotify &key pathname event handle)
@@ -341,20 +340,22 @@ may be one from a given EVENT) or PATHNAME."
(error "either PATHNAME, EVENT or HANDLE have to be specified"))
(when event
(setf handle (slot-value event 'wd)))
- (if handle
- (unwatch-raw inotify handle)
- (let ((handle (car (pathname-handle/flags inotify pathname))))
- (unless handle
- (error "PATHNAME ~S isn't being watched" pathname))
- ;; remove even if unwatch-raw throws an error (which can happen if :oneshot is specified)
- (remhash pathname (inotify-watched inotify))
- (unwatch-raw inotify handle)))
+ (let ((handle (or handle
+ (car (pathname-handle/flags inotify pathname))
+ (error "PATHNAME ~S isn't being watched" pathname)))
+ (pathname (or pathname
+ (event-pathname/flags inotify NIL handle)
+ (error "No PATHNAME found for HANDLE ~S" handle))))
+ ;; remove even if unwatch-raw throws an error (which can happen if :oneshot is specified)
+ (remhash pathname (inotify-pathnames inotify))
+ (remhash handle (inotify-handles inotify))
+ (unwatch-raw inotify handle))
(values))
(defun list-watched (inotify)
"Returns a LIST of all watched pathnames in no particular order."
(loop
- for pathname being each hash-key in (inotify-watched inotify)
+ for pathname being each hash-key in (inotify-pathnames inotify)
collect pathname))
(defun unix-eagain-p (fd)
@@ -1,6 +1,6 @@
-;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
+;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
-;; Copyright (c) 2011-12, Olof-Joachim Frahm
+;; Copyright (c) 2011-15, Olof-Joachim Frahm
;; All rights reserved.
;; Redistribution and use in source and binary forms, with or without
@@ -27,7 +27,7 @@
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package #:cl-inotify)
-
+
(defun run-inotify-event-handler (watch event-handler &key (nonblocking T) (registered T))
"Registers an INOTIFY queue and runs EVENT-HANDLER with it as only
parameter whenever input happens."
@@ -1,6 +1,6 @@
-;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*-
+;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*-
-;; Copyright (c) 2011-12, Olof-Joachim Frahm
+;; Copyright (c) 2011-15, Olof-Joachim Frahm
;; All rights reserved.
;; Redistribution and use in source and binary forms, with or without
@@ -27,8 +27,8 @@
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package #:cl-user)
-
-(defpackage cl-inotify
+
+(defpackage #:cl-inotify
(:use #:cl #:cffi)
(:import-from #:osicat-posix #:defsyscall)
(:export ;;; used types for documentation
@@ -65,7 +65,7 @@
#:event-pathname/flags
#:watch
#:unwatch
- #:event-availablep
+ #:event-available-p
#:read-event
#:next-event
@@ -77,4 +77,4 @@
;;; macros
#:with-inotify
#:with-unregistered-inotify)
- (:documentation "A binding (not only?) for the LINUX inotify(7) API."))
+ (:documentation "Binding to the Linux inotify(7) API."))
Oops, something went wrong.

0 comments on commit 2bcef82

Please sign in to comment.