diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,15 @@ +hinotify +====== + +hinotify-0.3.8 +-------------- + +- Use file system encoding for file names. + + When run in a locale like LANG=C, this ensures that the filename is encoded + as a filename, so that arbitrary bytes in it will round-trip correctly, + rather than being stripped out. + + Fixes https://github.com/kolmodin/hinotify/issues/13 + + Patch contributed by Joey Hess joeyh@joeyh.name diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,8 @@ hinotify: inotify for Haskell ============================= +[![Build Status](https://api.travis-ci.org/kolmodin/hinotify.png?branch=master)](http://travis-ci.org/kolmodin/hinotify) + About ----- diff --git a/hinotify.cabal b/hinotify.cabal --- a/hinotify.cabal +++ b/hinotify.cabal @@ -1,35 +1,26 @@ name: hinotify -version: 0.3.7 +version: 0.3.8 build-type: Simple synopsis: Haskell binding to inotify description: - . This library provides a wrapper to the Linux Kernel's inotify feature, allowing applications to subscribe to notifications when a file is accessed or modified. - . category: System homepage: https://github.com/kolmodin/hinotify.git license: BSD3 license-file: LICENSE author: Lennart Kolmodin maintainer: Lennart Kolmodin -extra-source-files: README.md -cabal-version: >= 1.6 +extra-source-files: README.md, CHANGELOG.md +cabal-version: >= 1.8 source-repository head type: git location: git://github.com/kolmodin/hinotify.git -flag split-base - description: Choose the new smaller, split-up base package. - library - build-depends: unix - if flag(split-base) - build-depends: base >= 4.5.0.0 && < 5, containers, directory - else - build-depends: base < 3 + build-depends: base >= 4.5.0.0 && < 5, containers, directory, unix extensions: ForeignFunctionInterface exposed-modules: @@ -38,5 +29,40 @@ System.INotify.Masks ghc-options: -Wall - + includes: sys/inotify.h hs-source-dirs: src + +test-suite test001 + type: exitcode-stdio-1.0 + build-depends: base, directory, hinotify + hs-source-dirs: src tests + main-is: test001-list-dir-contents.hs + ghc-options: -Wall + +test-suite test002 + type: exitcode-stdio-1.0 + build-depends: base, directory, hinotify + hs-source-dirs: src tests + main-is: test002-writefile.hs + ghc-options: -Wall + +test-suite test003 + type: exitcode-stdio-1.0 + build-depends: base, directory, hinotify + hs-source-dirs: src tests + main-is: test003-removefile.hs + ghc-options: -Wall + +test-suite test004 + type: exitcode-stdio-1.0 + build-depends: base, directory, hinotify + hs-source-dirs: src tests + main-is: test004-modify-file.hs + ghc-options: -Wall + +test-suite test005 + type: exitcode-stdio-1.0 + build-depends: base, directory, hinotify + hs-source-dirs: src tests + main-is: test005-move-file.hs + ghc-options: -Wall diff --git a/src/System/INotify.hsc b/src/System/INotify.hsc --- a/src/System/INotify.hsc +++ b/src/System/INotify.hsc @@ -41,7 +41,7 @@ import Data.Maybe import Data.Map (Map) import qualified Data.Map as Map -import Foreign.C hiding (withCString) +import Foreign.C hiding (withCString, peekCString) import Foreign.Marshal hiding (void) import Foreign.Ptr import Foreign.Storable @@ -56,7 +56,7 @@ #endif import System.Posix.Files import GHC.IO.Encoding (getFileSystemEncoding) -import GHC.Foreign (withCString) +import GHC.Foreign (withCString, peekCString) import System.INotify.Masks @@ -268,7 +268,9 @@ len <- (#peek struct inotify_event, len) ptr :: IO CUInt nameM <- if len == 0 then return Nothing - else fmap Just $ peekCString ((#ptr struct inotify_event, name) ptr) + else do + enc <- getFileSystemEncoding + fmap Just $ peekCString enc ((#ptr struct inotify_event, name) ptr) let event_size = (#size struct inotify_event) + (fromIntegral len) event = cEvent2Haskell (FDEvent wd mask cookie nameM) rest <- read_events' (ptr `plusPtr` event_size) (r - event_size) 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,23 @@ +module Main where + +import Control.Monad + +import System.Directory + +import System.INotify as INotify + +import Utils + +main :: IO () +main = + inTestEnviron [Open, Close] getDirectoryContents $ \ events -> do + when (expected ~= events) + testSuccess + putStrLn $ explainFailure expected events + testFailure + +expected :: [Event] +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,28 @@ +module Main where + +import Control.Monad + +import System.INotify as INotify + +import Utils + +write :: String -> IO () +write path = do + writeFile (path ++ "/hello") "" + -- actually writing any contents gives me two Modified + +main :: IO () +main = + inTestEnviron [AllEvents] write $ \ events -> do + when (expected ~= events) + testSuccess + putStrLn $ explainFailure expected events + testFailure + +expected :: [Event] +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,42 @@ +module Main where + +import Control.Monad + +import System.Directory + +import System.INotify as INotify + +import Utils + +file :: String +file = "hello" + +write :: String -> IO () +write path = do + writeFile (path ++ '/':file) "" + +remove :: String -> IO () +remove path = do + removeFile (path ++ '/':file) + +action :: String -> IO () +action path = do + write path + remove path + +main :: IO () +main = + inTestEnviron [AllEvents] action $ \ events -> do + when (expected ~= events) + testSuccess + putStrLn $ explainFailure expected events + testFailure + +expected :: [Event] +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,55 @@ +module Main where + +import Control.Exception +import Control.Monad + +import System.Directory +import System.IO + +import System.INotify as INotify + +import Utils + +file :: String +file = "hello" + +write :: String -> IO () +write path = do + writeFile (path ++ '/':file) "" + +modify :: String -> IO () +modify path = do + bracket + (openFile (path ++ '/':file) AppendMode) + (hClose) + (\h -> hPutStr h "yarr!") + +remove :: String -> IO () +remove path = do + removeFile (path ++ '/':file) + +action :: String -> IO () +action path = do + write path + modify path + remove path + +main :: IO () +main = + inTestEnviron [AllEvents] action $ \ events -> do + when (expected ~= events) + testSuccess + putStrLn $ explainFailure expected events + testFailure + +expected :: [Event] +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,50 @@ +module Main where + +import Control.Monad +import System.Directory + +import System.INotify as INotify + +import Utils + +file, file2 :: String +file = "hello" +file2 = file ++ "2" + +write :: String -> IO () +write path = do + writeFile (path ++ '/':file) "" + +move :: String -> IO () +move path = do + renameFile (path ++ '/':file) (path ++ '/':file2) + +remove :: String -> IO () +remove path = do + removeFile (path ++ '/':file2) + +action :: String -> IO () +action path = do + write path + move path + remove path + +main :: IO () +main = + inTestEnviron [AllEvents] action $ \ events -> do + let cookie = head [ c | MovedOut _ _ c <- events ] + when (expected cookie ~= events) + testSuccess + putStrLn $ explainFailure (expected cookie) events + testFailure + +expected :: Cookie -> [Event] +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 + ]