diff --git a/ANNOUNCE b/ANNOUNCE new file mode 100644 --- /dev/null +++ b/ANNOUNCE @@ -0,0 +1,58 @@ +Greetings! + +I'm pleased to announce hinotify 0.1, a library to inotify[1] which has +been part of the Linux kernel since 2.6.13. + +inotify provides file system event notification, simply add a watcher to +a file or directory and get an event when it is accessed or modified. + +The API basically consists of: + +inotify_init :: IO INotify +inotify_add_watch :: INotify + -> [EventVariety] -- different events to listen on + -> FilePath -- file/directory to watch + -> (Event -> IO ()) -- event handler + -> IO WatchDescriptor +inotify_rm_watch :: INotify -> WatchDescriptor -> IO () + +A sample program: + +> import System.Directory +> import System.IO +> +> import System.INotify +> +> main :: IO () +> main = do +> inotify <- inotify_init +> print inotify +> home <- getHomeDirectory +> wd <- inotify_add_watch inotify +> [Open,Close,Access,Modify,Move] +> home +> print +> print wd +> putStrLn "Listens to your home directory. Hit enter to terminate." +> getLine +> inotify_rm_watch inotify wd + +The code is available via www: + +http://haskell.org/~kolmodin/code/hinotify/download/hinotify-0.1.tar.gz + +and via darcs: + + darcs get http://haskell.org/~kolmodin/code/hinotify/ + +The API is available at: + + http://haskell.org/~kolmodin/code/hinotify/docs/api/ + +The library is very young and I'm most grateful for feedback on the API, +and what else you might have to suggest. + +Cheers, + Lennart Kolmodin + +[1] http://www.kernel.org/pub/linux/kernel/people/rml/inotify/ diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,7 @@ + +.PHONY : docs + +docs : README.html + +%.html : % + pandoc -s -S --toc -c hinotify.css $< -o $@ diff --git a/README b/README --- a/README +++ b/README @@ -1,6 +1,6 @@ % hinotify: inotify for Haskell -% Lennart Kolmodin -% December 26, 2007-2009 +% Lennart Kolmodin +% December 26, 2007-2011 About ----- @@ -21,21 +21,36 @@ News ---- +**hinotify 0.3.2** + +* Make each `WatchDescriptor` contain its `INotify`. Changes to the function types: + +> -removeWatch :: INotify -> WatchDescriptor -> IO () +> +removeWatch :: WatchDescriptor -> IO () + +* Fix typo in declaration of `Deleted` in `data Event`; + +> - { isDirecotry :: Bool +> + { isDirectory :: Bool + **hinotify 0.3.1** -: * Use `inotify.h` from `glibc` rather than from the linux headers, as + +* Use `inotify.h` from `glibc` rather than from the linux headers, as recommended upstream. **hinotify 0.3** -: * Compiles with GHC 6.12, GHC 6.10.4, GHC 6.8.2 and GHC 6.6.1 +* Compiles with GHC 6.12, GHC 6.10.4, GHC 6.8.2 and GHC 6.6.1 + **hinotify 0.2** -: * Updates to the API - - Function names is now in semiCamelCase - - Restructure event parameters to make it more consistent - * Small test suit in `tests/` - * Compiles with GHC 6.8.2 and GHC 6.6.1 - * Requires Cabal 1.2 +* Updates to the API + - Function names is now in semiCamelCase + - Restructure event parameters to make it more consistent +* Small test suit in `tests/` +* Compiles with GHC 6.8.2 and GHC 6.6.1 +* Requires Cabal 1.2 + **hinotify 0.1** : Initial release @@ -50,7 +65,7 @@ -> FilePath -- file/directory to watch -> (Event -> IO ()) -- event handler -> IO WatchDescriptor - removeWatch :: INotify -> WatchDescriptor -> IO () + removeWatch :: WatchDescriptor -> IO () A sample program: @@ -72,7 +87,7 @@ print wd putStrLn "Listens to your home directory. Hit enter to terminate." getLine - removeWatch inotify wd + removeWatch wd Download @@ -80,7 +95,7 @@ The code is available via the [homepage], and via darcs: - darcs get --partial http://haskell.org/~kolmodin/code/hinotify/ + darcs get --partial http://code.haskell.org/hinotify/ The [API] is available online. @@ -92,7 +107,7 @@ Lennart Kolmodin -`kolmodin at gentoo.org` +`kolmodin at gmail.com` Legal ----- @@ -100,8 +115,8 @@ This software is released under a BSD-style license. See LICENSE for more details. -Copyright © 2007 Lennart Kolmodin +Copyright © 2007-2011 Lennart Kolmodin -[homepage]: http://haskell.org/~kolmodin/code/hinotify/ +[homepage]: http://code.haskell.org/hinotify/ [API]: http://hackage.haskell.org/packages/archive/hinotify/latest/doc/html/System-INotify.html diff --git a/README.html b/README.html new file mode 100644 --- /dev/null +++ b/README.html @@ -0,0 +1,247 @@ + + + + hinotify: inotify for Haskell + + + + + + + +

hinotify: inotify for Haskell

+ +

About

hinotify, a library to inotify which has been part of the Linux kernel since 2.6.13.

inotify provides file system event notification, simply add a watcher to a file or directory and get an event when it is accessed or modified.

This module is named hinotify.

See example code in the examples directory, distributed with the source code.

News

hinotify 0.3.2

  • Make each WatchDescriptor contain its INotify. Changes to the function types:
 -removeWatch :: INotify -> WatchDescriptor -> IO ()
+ +removeWatch :: WatchDescriptor -> IO ()
+
  • Fix typo in declaration of Deleted in data Event;
 - { isDirecotry :: Bool
+ + { isDirectory :: Bool
+

hinotify 0.3.1

  • Use inotify.h from glibc rather than from the linux headers, as recommended upstream.

hinotify 0.3

  • Compiles with GHC 6.12, GHC 6.10.4, GHC 6.8.2 and GHC 6.6.1

hinotify 0.2

  • Updates to the API
    • Function names is now in semiCamelCase
    • Restructure event parameters to make it more consistent
  • Small test suit in tests/
  • Compiles with GHC 6.8.2 and GHC 6.6.1
  • Requires Cabal 1.2
hinotify 0.1
Initial release

API

The API basically consists of:

initINotify :: IO INotify
+addWatch :: INotify
+         -> [EventVariety]   -- different events to listen on
+         -> FilePath         -- file/directory to watch
+         -> (Event -> IO ()) -- event handler
+         -> IO WatchDescriptor
+removeWatch :: WatchDescriptor -> IO ()
+

A sample program:

import System.Directory
+import System.IO
+
+import System.INotify
+
+main :: IO ()
+main = do
+    inotify <- initINotify
+    print inotify
+    home <- getHomeDirectory
+    wd <- addWatch
+            inotify
+            [Open,Close,Access,Modify,Move]
+            home
+            print
+    print wd
+    putStrLn "Listens to your home directory. Hit enter to terminate."
+    getLine
+    removeWatch wd
+

Download

The code is available via the homepage, and via darcs:

darcs get --partial http://code.haskell.org/hinotify/
+

The API is available online.

I’m most grateful for feedback on the API, and what else you might have to suggest.

Author

Lennart Kolmodin

kolmodin at gmail.com

+ + + diff --git a/docs/hcar/hinotify-Lh.tex b/docs/hcar/hinotify-Lh.tex new file mode 100644 --- /dev/null +++ b/docs/hcar/hinotify-Lh.tex @@ -0,0 +1,36 @@ +\begin{hcarentry}{hinotify} +\report{Lennart Kolmodin} +\status{alive} +\makeheader + +``hinotify'' is a simple Haskell wrapper for the Linux kernel's inotify +mechanism. inotify allows applications to watch file changes since +Linux kernel 2.6.13. You can for example use it to do a proper +locking procedure on a set of files, or keep your application up do +date on a directory of files in a fast and clean way. + +As file and directory notification is available for many operating systems +upcoming work will include to try to find a common API that could be shared +for all platforms. Last work has been to see what's possible to do under +Microsoft Windows, and finding a suiting API for both platforms. This has +been a joint work with Niklas Broberg. We're still looking for contributors +to *BSD and Mac OS X. If you're interested, contact us. + +\FurtherReading +\begin{compactitem} +\item Development version: + + \texttt{darcs get} + + \url{http://www.haskell.org/~kolmodin/code/hinotify/} +\item Latest released version: + + \url{http://www.haskell.org/~kolmodin/code/hinotify/download/} +\item Documentation: + + \url{http://www.haskell.org/~kolmodin/code/hinotify/docs/api} +\item inotify: + + \url{http://www.kernel.org/pub/linux/kernel/people/rml/inotify/} +\end{compactitem} +\end{hcarentry} diff --git a/examples/DirTree/DirTree.hs b/examples/DirTree/DirTree.hs new file mode 100644 --- /dev/null +++ b/examples/DirTree/DirTree.hs @@ -0,0 +1,111 @@ +-- Duncan Coutts 2006-2007 +-- Requires gtk2hs 0.9.11 + +import qualified Data.Map as Map +import System.Directory +import System.Environment +import Control.Concurrent + +import Data.IORef +import Control.Monad (liftM) +import Ix (inRange) + +import System.INotify + +import Graphics.UI.Gtk hiding (TreeModelFlags(TreeModelListOnly), cellText) +import Graphics.UI.Gtk.ModelView.CellLayout +import Graphics.UI.Gtk.ModelView.Types (TypedTreeModelClass) +import Graphics.UI.Gtk.ModelView.TreeModel (TreeModelFlags(TreeModelListOnly)) +import Graphics.UI.Gtk.ModelView.CellRendererText (cellText) +import Graphics.UI.Gtk.ModelView.CustomStore +import Graphics.UI.Gtk.TreeList.TreeIter + +instance TypedTreeModelClass (CustomTreeModel a) + +dirModelNew :: FilePath -> IO (CustomTreeModel () FilePath) +dirModelNew path = do + + dirContents <- getDirectoryContents path + + rows <- newIORef (Map.fromList (zip dirContents (repeat ()))) + + model <- customTreeModelNew () CustomTreeModelImplementation { + customTreeModelGetFlags = return [TreeModelListOnly], + customTreeModelGetIter = \[n] -> return (Just (TreeIter 0 (fromIntegral n) 0 0)), + customTreeModelGetPath = \(TreeIter _ n _ _) -> return [fromIntegral n], + customTreeModelGetRow = \(TreeIter _ n _ _) -> + readIORef rows >>= \rows -> + if inRange (0, Map.size rows - 1) (fromIntegral n) + then return (fst $ Map.elemAt (fromIntegral n) rows) + else fail "DirModel.getRow: iter does not refer to a valid entry", + + customTreeModelIterNext = \(TreeIter _ n _ _) -> + readIORef rows >>= \rows -> + if n >= fromIntegral (Map.size rows) - 1 + then return Nothing + else return (Just (TreeIter 0 (n+1) 0 0)), + customTreeModelIterChildren = \_ -> return Nothing, + customTreeModelIterHasChild = \_ -> return False, + customTreeModelIterNChildren = \index -> readIORef rows >>= \rows -> + case index of + Nothing -> return $! Map.size rows + _ -> return 0, + customTreeModelIterNthChild = \index n -> case index of + Nothing -> return (Just (TreeIter 0 (fromIntegral n) 0 0)) + _ -> return Nothing, + customTreeModelIterParent = \_ -> return Nothing, + customTreeModelRefNode = \_ -> return (), + customTreeModelUnrefNode = \_ -> return () + } + + notify <- initINotify + watch <- addWatch notify [Move, Create, Delete] path $ \event -> + let add file = do + index <- atomicModifyIORef rows (\map -> + let map' = Map.insert file () map + in (map', Map.findIndex file map')) + treeModelRowInserted model [index] (TreeIter 0 (fromIntegral index) 0 0) + remove file = do + index <- atomicModifyIORef rows (\map -> + let map' = Map.delete file map + in (map', Map.findIndex file map)) + treeModelRowDeleted model [index] + + in case event of + MovedIn _ file _ -> add file + MovedOut _ file _ -> remove file + Created _ file -> add file + Deleted _ file -> remove file + _ -> putStrLn $ "other event: " ++ show event + + -- TODO: on destroy model (INotify.removeWatch watch) + + return model + +main = do + initGUI + + win <- windowNew + win `onDestroy` mainQuit + + args <- getArgs + let dir = case args of + [d] -> d + _ -> "." + + model <- dirModelNew dir + + tv <- treeViewNewWithModel model + win `containerAdd` tv + + tvc <- treeViewColumnNew + treeViewAppendColumn tv tvc + + text <- cellRendererTextNew + cellLayoutPackStart tvc text True + cellLayoutSetAttributes tvc text model + (\file -> [cellText := file]) + + widgetShowAll win + timeoutAddFull (yield >> return True) priorityDefaultIdle 50 + mainGUI diff --git a/examples/simple/simple.hs b/examples/simple/simple.hs new file mode 100644 --- /dev/null +++ b/examples/simple/simple.hs @@ -0,0 +1,17 @@ +module Main where + +import System.Directory +import System.IO + +import System.INotify + +main :: IO () +main = do + inotify <- initINotify + print inotify + home <- getHomeDirectory + wd <- addWatch inotify [Open,Close,Access,Modify,Move] home print + print wd + putStrLn "Listens to your home directory. Hit enter to terminate." + getLine + removeWatch inotify wd diff --git a/hinotify.cabal b/hinotify.cabal --- a/hinotify.cabal +++ b/hinotify.cabal @@ -1,5 +1,5 @@ name: hinotify -version: 0.3.1 +version: 0.3.2 build-type: Simple synopsis: Haskell binding to INotify description: @@ -9,11 +9,11 @@ accessed or modified. . category: System -homepage: http://haskell.org/~kolmodin/code/hinotify/README.html +homepage: http://code.haskell.org/hinotify/README.html license: BSD3 license-file: LICENSE author: Lennart Kolmodin -maintainer: Lennart Kolmodin +maintainer: Lennart Kolmodin extra-source-files: README cabal-version: >= 1.2 @@ -33,6 +33,6 @@ other-modules: System.INotify.Masks - ghc-options: -fvia-C -Wall + ghc-options: -Wall hs-source-dirs: src diff --git a/hinotify.css b/hinotify.css new file mode 100644 --- /dev/null +++ b/hinotify.css @@ -0,0 +1,89 @@ +body { + margin: auto; + padding-right: 1em; + padding-left: 1em; + max-width: 50em; + border-left: 1px solid black; + border-right: 1px solid black; + color: black; + font-family: Verdana, sans-serif; + font-size: 100%; + line-height: 140%; + color: #333; +} +pre { + border: 1px dotted gray; + background-color: #9999ff; + color: #111111; + padding: 0.5em; +} +code { + font-family: monospace; + font-size: 110%; +} +h1 a, h2 a, h3 a, h4 a, h5 a { + text-decoration: none; + color: #000099; +} +h1, h2, h3, h4, h5 { font-family: verdana; + font-weight: bold; + border-bottom: 1px dotted black; + color: #000099; } +h1 { + font-size: 130%; +} + +h2 { + font-size: 110%; + border-bottom: 1px dotted black; +} + +h3 { + font-size: 95%; +} + +h4 { + font-size: 90%; + font-style: italic; +} + +h5 { + font-size: 90%; + font-style: italic; +} + +h1.title { + font-size: 150%; + font-weight: bold; + text-align: left; + border: none; +} + +dt code { + font-weight: bold; +} +dd p { + margin-top: 0; +} + +a:link { + color: #000099 + } + +a:visited { + color: #666699 + } +a:hover { + color: #666699 + } +a:active { + color: #000099 + } + +#footer { + padding-top: 1em; + font-size: 70%; + color: gray; + text-align: center; +} + diff --git a/src/System/INotify.hsc b/src/System/INotify.hsc --- a/src/System/INotify.hsc +++ b/src/System/INotify.hsc @@ -67,8 +67,11 @@ type WDEvent = (WD, Event) data INotify = INotify Handle FD (MVar EventMap) ThreadId ThreadId -data WatchDescriptor = WatchDescriptor Handle WD deriving Eq +data WatchDescriptor = WatchDescriptor INotify WD deriving Eq +instance Eq INotify where + (INotify _ fd1 _ _ _) == (INotify _ fd2 _ _ _) = fd1 == fd2 + newtype Cookie = Cookie CUInt deriving (Eq,Ord) data FDEvent = FDEvent WD Masks CUInt{-Cookie-} (Maybe String) deriving (Eq, Show) @@ -79,7 +82,7 @@ { isDirectory :: Bool , maybeFilePath :: Maybe FilePath } - -- | A file was modified. @Modified isDiroctory file@ + -- | A file was modified. @Modified isDirectory file@ | Modified { isDirectory :: Bool , maybeFilePath :: Maybe FilePath @@ -123,7 +126,7 @@ } -- | A file was deleted. @Deleted isDirectory file@ | Deleted - { isDirecotry :: Bool + { isDirectory :: Bool , filePath :: FilePath } -- | The file watched was deleted. @@ -183,7 +186,7 @@ return (INotify h fd em tid1 tid2) addWatch :: INotify -> [EventVariety] -> FilePath -> (Event -> IO ()) -> IO WatchDescriptor -addWatch inotify@(INotify h fd em _ _) masks fp cb = do +addWatch inotify@(INotify _ fd em _ _) masks fp cb = do is_dir <- doesDirectoryExist fp when (not is_dir) $ do file_exist <- doesFileExist fp @@ -195,9 +198,8 @@ Nothing (Just fp) let mask = joinMasks (map eventVarietyToMask masks) - em' <- takeMVar em wd <- withCString fp $ \fp_c -> - throwErrnoIfMinus1 "addWatch" $ + throwErrnoIfMinus1 "addWatch" $ c_inotify_add_watch (fromIntegral fd) fp_c mask let event = \e -> do when (OneShot `elem` masks) $ @@ -208,8 +210,8 @@ Ignored -> rm_watch inotify wd _ -> return () cb e - putMVar em (Map.insert wd event em') - return (WatchDescriptor h wd) + modifyMVar_ em $ \em' -> return (Map.insert wd event em') + return (WatchDescriptor inotify wd) where eventVarietyToMask ev = case ev of @@ -233,8 +235,8 @@ OneShot -> inOneshot AllEvents -> inAllEvents -removeWatch :: INotify -> WatchDescriptor -> IO () -removeWatch (INotify _ fd _ _ _) (WatchDescriptor _ wd) = do +removeWatch :: WatchDescriptor -> IO () +removeWatch (WatchDescriptor (INotify _ fd _ _ _) wd) = do _ <- throwErrnoIfMinus1 "removeWatch" $ c_inotify_rm_watch (fromIntegral fd) wd return () diff --git a/tests/Utils.hs b/tests/Utils.hs new file mode 100644 --- /dev/null +++ b/tests/Utils.hs @@ -0,0 +1,55 @@ +module Utils where + +import Control.Concurrent.Chan +import Control.Exception + +import System.Directory +import System.Environment +import System.Exit + +import System.INotify + +testName = do + n <- getProgName + return (n ++ "-playground") + +withTempDir f = do + path <- testName + bracket + ( createDirectory path >> return path ) + ( removeDirectoryRecursive ) + ( f ) + +withWatch inot events path action f = + bracket + ( addWatch inot events path action ) + removeWatch + ( const f ) + +inTestEnviron events action f = do + withTempDir $ \testPath -> do + inot <- initINotify + chan <- newChan + withWatch inot events testPath (writeChan chan) $ do + action testPath + events <- getChanContents chan + f events + +(~=) :: Eq a => [a] -> [a] -> Bool +[] ~= _ = True +(x:xs) ~= (y:ys) = x == y && xs ~= ys +_ ~= _ = False + +asMany :: [a] -> [a] -> [a] +asMany xs ys = take (length xs) ys + +explainFailure expected reality = do + putStrLn "Expected:" + mapM_ (\x -> putStr "> " >> print x) expected + putStrLn "But got:" + mapM_ (\x -> putStr "< " >> print x) (asMany expected reality) + testFailure + +testFailure = exitFailure + +testSuccess = exitWith ExitSuccess diff --git a/tests/test-all b/tests/test-all new file mode 100644 --- /dev/null +++ b/tests/test-all @@ -0,0 +1,31 @@ +#!/bin/bash + +GHC=ghc + +if [[ -n $1 ]]; then + GHC="$1" + echo Using GHC: $GHC +fi + +TESTS=( `ls test*.hs | cut -d. -f1` ) + +rm -rf *.o *.hi + +for t in ${TESTS[@]}; do + rm -rf $t{,.o,.hi} + rm -rf $t-playground + $GHC -v0 --make $t.hs -o $t + echo -n Testing $t ... + if [[ -x $t ]]; then + ./$t + exitCode=$? + if [[ $exitCode == 0 ]]; then + echo Success + rm -rf $t{,.o,.hi} + else + echo Failure with exit code $exitCode + fi + else + echo Compilation failed + fi +done diff --git a/tests/test001-list-dir-contents.hs b/tests/test001-list-dir-contents.hs new file mode 100644 --- /dev/null +++ b/tests/test001-list-dir-contents.hs @@ -0,0 +1,20 @@ +module Main where + +import Control.Monad + +import System.Directory + +import System.INotify as INotify + +import Utils + +main = + inTestEnviron [Open, Close] getDirectoryContents $ \ events -> do + when (expected ~= events) + testSuccess + explainFailure expected events + +expected = + [ Opened True Nothing + , Closed True Nothing False + ] diff --git a/tests/test002-writefile.hs b/tests/test002-writefile.hs new file mode 100644 --- /dev/null +++ b/tests/test002-writefile.hs @@ -0,0 +1,24 @@ +module Main where + +import Control.Monad + +import System.INotify as INotify + +import Utils + +write path = do + writeFile (path ++ "/hello") "" + -- actually writing any contents gives me two Modified + +main = + inTestEnviron [AllEvents] write $ \ events -> do + when (expected ~= events) + testSuccess + explainFailure expected events + +expected = + [ Created False "hello" + , Opened False (Just "hello") + , Modified False (Just "hello") + , Closed False (Just "hello") True + ] diff --git a/tests/test003-removefile.hs b/tests/test003-removefile.hs new file mode 100644 --- /dev/null +++ b/tests/test003-removefile.hs @@ -0,0 +1,35 @@ +module Main where + +import Control.Monad + +import System.Directory + +import System.INotify as INotify + +import Utils + +file = "hello" + +write path = do + writeFile (path ++ '/':file) "" + +remove path = do + removeFile (path ++ '/':file) + +action path = do + write path + remove path + +main = + inTestEnviron [AllEvents] action $ \ events -> do + when (expected ~= events) + testSuccess + explainFailure expected events + +expected = + [ Created False file + , Opened False (Just file) + , Modified False (Just file) + , Closed False (Just file) True + , Deleted False file + ] diff --git a/tests/test004-modify-file.hs b/tests/test004-modify-file.hs new file mode 100644 --- /dev/null +++ b/tests/test004-modify-file.hs @@ -0,0 +1,47 @@ +module Main where + +import Control.Exception +import Control.Monad + +import System.Directory +import System.IO + +import System.INotify as INotify + +import Utils + +file = "hello" + +write path = do + writeFile (path ++ '/':file) "" + +modify path = do + bracket + (openFile (path ++ '/':file) AppendMode) + (hClose) + (\h -> hPutStr h "yarr!") + +remove path = do + removeFile (path ++ '/':file) + +action path = do + write path + modify path + remove path + +main = + inTestEnviron [AllEvents] action $ \ events -> do + when (expected ~= events) + testSuccess + explainFailure expected events + +expected = + [ Created False file + , Opened False (Just file) + , Modified False (Just file) + , Closed False (Just file) True + , Opened False (Just file) + , Modified False (Just file) + , Closed False (Just file) True + , Deleted False file + ] diff --git a/tests/test005-move-file.hs b/tests/test005-move-file.hs new file mode 100644 --- /dev/null +++ b/tests/test005-move-file.hs @@ -0,0 +1,46 @@ +module Main where + +import Data.Maybe + +import Control.Monad + +import System.Directory +import System.IO + +import System.INotify as INotify + +import Utils + +file = "hello" +file2 = file ++ "2" + +write path = do + writeFile (path ++ '/':file) "" + +move path = do + renameFile (path ++ '/':file) (path ++ '/':file2) + +remove path = do + removeFile (path ++ '/':file2) + +action path = do + write path + move path + remove path + +main = + inTestEnviron [AllEvents] action $ \ events -> do + let cookie = head [ c | MovedOut _ _ c <- events ] + when (expected cookie ~= events) + testSuccess + explainFailure (expected cookie) events + +expected cookie = + [ Created False file + , Opened False (Just file) + , Modified False (Just file) + , Closed False (Just file) True + , MovedOut False file cookie + , MovedIn False file2 cookie + , Deleted False file2 + ]