Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

first commit

  • Loading branch information...
commit 446c199630821bcae438eed907baed30fabb6dd1 0 parents
@luite authored
30 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.
2  README
@@ -0,0 +1,2 @@
+Bindings for the OS X FSEvents API
+
2  Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
184 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 ()
+
98 cbits/c_fsevents.c
@@ -0,0 +1,98 @@
+#include <CoreServices/CoreServices.h>
+#include <pthread.h>
+#include <unistd.h>
+
+#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; i<n; i++) {
+ writeEvent(w->writefd, 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;i<n;i++) {
+ cffolders[i] = CFStringCreateWithCString(NULL, folders[i], kCFStringEncodingUTF8);
+ }
+ CFArrayRef paths = CFArrayCreate(NULL, (const void **)cffolders, n, NULL);
+ FSEventStreamRef es = FSEventStreamCreate(NULL, &watchCallback, &ctx, paths, since, latency, createFlags);
+ pthread_t t;
+ if(es != NULL) { /* fixme is this the correct way to check for failure? */
+ w->writefd = 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;i<n;i++) CFRelease(cffolders[i]);
+ free(cffolders);
+ CFRelease(paths);
+ return rv;
+}
+
+int destroyWatch(watch* w) {
+ FSEventStreamRelease(w->eventStream);
+ if(w->runLoop != NULL) {
+ CFRunLoopStop(w->runLoop);
+ CFRelease(w->runLoop);
+ }
+ close(w->writefd);
+ free(w);
+}
+
25 cbits/c_fsevents.h
@@ -0,0 +1,25 @@
+#ifndef CBITS_C_FSEVENTS_H
+#define CBITS_C_FSEVENTS_H 1
+
+#include <CoreServices/CoreServices.h>
+
+typedef struct {
+ FSEventStreamRef eventStream;
+ CFRunLoopRef runLoop;
+ int writefd;
+} watch;
+
+
+int createWatch ( char** folders
+ , int n
+ , UInt32 createFlags
+ , UInt64 since
+ , double latency
+ , int* fd
+ , void** wp
+ );
+
+int destroyWatch(watch* w);
+
+#endif
+
29 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
+
14 test/test.hs
@@ -0,0 +1,14 @@
+module Main where
+
+import System.OSX.FSEvents
+
+import Control.Monad
+import Control.Concurrent
+
+main = do
+ es <- eventStreamCreate ["/Users"] 1.0 True True True print
+ replicateM 30 (threadDelay 1000000)
+ putStrLn "destroying event stream"
+ eventStreamDestroy es
+ replicateM 30 (threadDelay 1000000)
+
Please sign in to comment.
Something went wrong with that request. Please try again.