diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2012, Luite Stegeman + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * 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. + + * Neither the name of Luite Stegeman nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/System/OSX/FSEvents.hs b/System/OSX/FSEvents.hs new file mode 100644 --- /dev/null +++ b/System/OSX/FSEvents.hs @@ -0,0 +1,184 @@ +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} + +-- | Event-based file and folder watching for OS X + +module System.OSX.FSEvents + ( EventStream + , eventStreamCreate + , eventStreamDestroy + , Event (..) + -- event callback flags + , eventFlagMustScanSubDirs, eventFlagUserDropped, eventFlagKernelDropped + , eventFlagEventIdsWrapped, eventFlagHistoryDone, eventFlagRootChanged + , eventFlagMount, eventFlagUnmount + -- item flags: enable file-level events to get these + , eventFlagItemCreated, eventFlagItemRemoved, eventFlagItemInodeMetaMod + , eventFlagItemRenamed, eventFlagItemModified, eventFlagItemFinderInfoMod + , eventFlagItemChangeOwner, eventFlagItemXattrMod + , eventFlagItemIsFile, eventFlagItemIsDir, eventFlagItemIsSymlink + ) where + +import Control.Concurrent +import Control.Concurrent.MVar +import Control.Exception (bracket) +import Control.Monad +import Data.Bits +import Data.Serialize.Get +import Data.Word +import Foreign.C.String +import Foreign.C.Types +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Ptr +import Foreign.Storable +import System.IO +import System.Posix.IO +import System.Posix.Types + +import qualified Data.ByteString as B +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Encoding.Error as TE + +data EventStream = EventStream (Ptr CWatch) (MVar Bool) +data Event = Event + { eventPath :: FilePath + , eventId :: Word64 + , eventFlags :: Word64 + } deriving (Show, Ord, Eq) +data CWatch + +eventFlagMustScanSubDirs :: Word64 +eventFlagMustScanSubDirs = 0x00000001 +eventFlagUserDropped :: Word64 +eventFlagUserDropped = 0x00000002 +eventFlagKernelDropped :: Word64 +eventFlagKernelDropped = 0x00000004 +eventFlagEventIdsWrapped :: Word64 +eventFlagEventIdsWrapped = 0x00000008 +eventFlagHistoryDone :: Word64 +eventFlagHistoryDone = 0x00000010 +eventFlagRootChanged :: Word64 +eventFlagRootChanged = 0x00000020 +eventFlagMount :: Word64 +eventFlagMount = 0x00000040 +eventFlagUnmount :: Word64 +eventFlagUnmount = 0x00000080 +-- These flags are only set if you enabled file events when creating the stream +eventFlagItemCreated :: Word64 +eventFlagItemCreated = 0x00000100 +eventFlagItemRemoved :: Word64 +eventFlagItemRemoved = 0x00000200 +eventFlagItemInodeMetaMod :: Word64 +eventFlagItemInodeMetaMod = 0x00000400 +eventFlagItemRenamed :: Word64 +eventFlagItemRenamed = 0x00000800 +eventFlagItemModified :: Word64 +eventFlagItemModified = 0x00001000 +eventFlagItemFinderInfoMod :: Word64 +eventFlagItemFinderInfoMod = 0x00002000 +eventFlagItemChangeOwner :: Word64 +eventFlagItemChangeOwner = 0x00004000 +eventFlagItemXattrMod :: Word64 +eventFlagItemXattrMod = 0x00008000 +eventFlagItemIsFile :: Word64 +eventFlagItemIsFile = 0x00010000 +eventFlagItemIsDir :: Word64 +eventFlagItemIsDir = 0x00020000 +eventFlagItemIsSymlink :: Word64 +eventFlagItemIsSymlink = 0x00040000 + +withCStrings :: [String] -> (Ptr (Ptr CChar) -> Int -> IO a) -> IO a +withCStrings xss act = bracket alloc release (\p -> act p n) + where + n = length xss + alloc = mapM newCString xss >>= newArray + release pp = peekArray n pp >>= mapM_ free >> free pp + + +-- | Create an FSEvents watch for a list of paths. +-- The callback action will be called for each event in the watched paths +-- until the 'EventStream' is destroyed again. All callbacks are from a +-- single thread, so if you take too long to process an event, further +-- events will be delayed. +-- Note: it's relatively expensive to create a watch, since each watch +-- uses an operating system thread for its event loop. +eventStreamCreate :: [FilePath] -- ^ The paths to watch + -> Double -- ^ Latency + -> Bool -- ^ Process event immediately if no other events received for at least latency + -> Bool -- ^ Ignore events caused by current process + -> Bool -- ^ Get file-level notifications instead of directory level + -> (Event -> IO a) -- ^ The action to run when an event has taken place + -> IO EventStream -- ^ The event stream, use this to destroy the stream +eventStreamCreate ps latency nodefer noself filelevel a = withCStrings ps $ \pp n -> + alloca $ \pfd -> do + alloca $ \ppw -> do + when (latency < 0) $ ioError (userError "latency must be nonnegative") + r <- c_createWatch pp (fromIntegral n) flags 0 (realToFrac latency) pfd ppw + when (r /= 0) $ ioError (userError "could not create file system event stream") + h <- fdToHandle . Fd =<< peek pfd + pw <- peek ppw + destroyed <- newMVar False + forkIO $ consumeMsgs h a + return $ EventStream pw destroyed + where + flags = condFlag createFlagNoDefer nodefer .|. + condFlag createFlagIgnoreSelf noself .|. + condFlag createFlagFileEvents filelevel + +condFlag :: Word32 -> Bool -> Word32 +condFlag f False = 0 +condFlag f True = f + +createFlagNoDefer :: Word32 +createFlagNoDefer = 0x00000002 + +createFlagIgnoreSelf :: Word32 +createFlagIgnoreSelf = 0x00000008 + +createFlagFileEvents :: Word32 +createFlagFileEvents = 0x00000010 + +-- | Destroy an event stream, the callback action will not be run for new events +-- (but there may be pending events remaining) +eventStreamDestroy :: EventStream -> IO () +eventStreamDestroy (EventStream ptr d) = do + destroyed <- takeMVar d + when (not destroyed) $ c_destroyWatch ptr + putMVar d True + +consumeMsgs :: Handle -> (Event -> IO a) -> IO () +consumeMsgs h a = readEvents + where + readEvents = do + b <- B.hGet h 24 + if B.length b < 24 + then stop + else do + let header = runGet readHeader b + case header of + Left _ -> stop + Right (eventId, flags, pathLen) -> do + bp <- B.hGet h (fromIntegral pathLen) + if B.length bp /= fromIntegral pathLen + then stop + else do + let p = TE.decodeUtf8With TE.lenientDecode bp + a $ Event (T.unpack p) eventId flags + readEvents + + stop = hClose h >> return () + readHeader = liftM3 (,,) getWord64host getWord64host getWord64host + +foreign import ccall safe "c_fsevents.h createWatch" c_createWatch :: Ptr (Ptr CChar) + -> CInt + -> Word32 + -> Word64 + -> CDouble + -> Ptr (CInt) + -> Ptr (Ptr CWatch) + -> IO CInt + +foreign import ccall safe "c_fsevents.h destroyWatch" c_destroyWatch :: Ptr CWatch + -> IO () + diff --git a/cbits/c_fsevents.c b/cbits/c_fsevents.c new file mode 100644 --- /dev/null +++ b/cbits/c_fsevents.c @@ -0,0 +1,98 @@ +#include +#include +#include + +#include "c_fsevents.h" + +void writeEvent(int fd, UInt64 eventId, UInt64 eventFlags, char* path) { + UInt64 buf[3]; + buf[0] = eventId; + buf[1] = eventFlags; + buf[2] = (UInt64)strlen(path); + write(fd, buf, 3*sizeof(UInt64)); + write(fd, path, strlen(path)); +} + +void watchCallback(ConstFSEventStreamRef streamRef, void *clientCallBackInfo, + size_t n, void *eventPaths, const FSEventStreamEventFlags eventFlags[], + const FSEventStreamEventId eventIds[]) { + int i; + watch *w = clientCallBackInfo; + char **paths = eventPaths; + for (i=0; iwritefd, eventIds[i], eventFlags[i], paths[i]); + } +} + +void *watchRunLoop(void *vw) { + watch* w = (watch*) vw; + CFRunLoopRef rl = CFRunLoopGetCurrent(); + CFRetain(rl); + w->runLoop = rl; + FSEventStreamScheduleWithRunLoop(w->eventStream, rl, kCFRunLoopDefaultMode); + FSEventStreamStart(w->eventStream); + CFRunLoopRun(); + pthread_exit(NULL); +} + +#define MAX_WATCH_PATHS 4096 + +int createWatch( char** folders + , int n + , UInt32 createFlags + , UInt64 since + , double latency + , int* fd + , void** wp + ) { + int i; + int rv; + int pfds[2]; + if(n>MAX_WATCH_PATHS) return -1; + if(pipe(pfds)) return -1; + if(!since) since = kFSEventStreamEventIdSinceNow; + CFStringRef *cffolders = malloc(n * sizeof(CFStringRef)); + watch *w; + w = malloc(sizeof(watch)); + FSEventStreamContext ctx; + ctx.version = 0; + ctx.info = (void*)w; + ctx.retain = NULL; + ctx.release = NULL; + ctx.copyDescription = NULL; + for(i=0;iwritefd = pfds[1]; + w->eventStream = es; + w->runLoop = NULL; + pthread_create(&t, NULL, &watchRunLoop, (void*)w); + *fd = pfds[0]; + *wp = w; + rv = 0; + } else { + close(pfds[0]); + close(pfds[1]); + free(w); + rv = -1; + } + for(i=0;ieventStream); + if(w->runLoop != NULL) { + CFRunLoopStop(w->runLoop); + CFRelease(w->runLoop); + } + close(w->writefd); + free(w); +} + diff --git a/hfsevents.cabal b/hfsevents.cabal new file mode 100644 --- /dev/null +++ b/hfsevents.cabal @@ -0,0 +1,29 @@ +name: hfsevents +version: 0.1 +synopsis: File/folder watching for OS X +homepage: http://github.com/luite/hfsevents +license: BSD3 +license-file: LICENSE +author: Luite Stegeman +maintainer: stegeman@gmail.com +category: System +build-type: Simple +cabal-version: >=1.8 + +library + exposed-modules: System.OSX.FSEvents + if os(darwin) + buildable: True + else + buildable: False + frameworks: Cocoa + C-sources: cbits/c_fsevents.c + include-dirs: cbits + extra-libraries: pthread + build-depends: + base >= 4 && < 5, + bytestring, + cereal >= 0.3 && < 0.4, + unix, + text +