Get or set the file caching mode (#340)

Author: jorisdral

System/Posix/Fcntl.hsc

@@ -16,23 +16,34 @@
 -----------------------------------------------------------------------------
 
 #include "HsUnix.h"
+#include <fcntl.h>
 
 module System.Posix.Fcntl (
     -- * File allocation
     Advice(..), fileAdvise,
     fileAllocate,
+    -- * File caching
+    fileGetCaching,
+    fileSetCaching,
   ) where
 
-#if HAVE_POSIX_FALLOCATE || HAVE_POSIX_FADVISE
 import Foreign.C
-#endif
 import System.Posix.Types
 
-#if !HAVE_POSIX_FALLOCATE
+#if !HAVE_POSIX_FALLOCATE || !HAVE_O_DIRECT
 import System.IO.Error ( ioeSetLocation )
 import GHC.IO.Exception ( unsupportedOperation )
 #endif
 
+#if HAVE_O_DIRECT
+import Data.Bits (complement, (.&.), (.|.))
+import System.Posix.Internals (c_fcntl_read)
+#endif
+
+#if HAVE_O_DIRECT || HAVE_F_NOCACHE
+import System.Posix.Internals (c_fcntl_write)
+#endif
+
 -- -----------------------------------------------------------------------------
 -- File control
 
@@ -101,3 +112,71 @@ foreign import capi safe "fcntl.h posix_fallocate"
 fileAllocate _ _ _ = ioError (ioeSetLocation unsupportedOperation
                               "fileAllocate")
 #endif
+
+-- -----------------------------------------------------------------------------
+-- File caching
+
+-- | Performs the @fcntl(2)@ operation on a file-desciptor to get the cache mode.
+--
+-- If the cache mode is 'False', then cache effects for file system reads and
+-- writes are minimised or otherwise eliminated. If the cache mode is 'True',
+-- then cache effects occur like normal.
+--
+-- On Linux, FreeBSD, and NetBSD this checks whether the @O_DIRECT@ file flag is
+-- set.
+--
+-- Throws 'IOError' (\"unsupported operation\") if platform does not support
+-- getting the cache mode.
+--
+-- Use @#if HAVE_O_DIRECT@ CPP guard to detect availability. Use @#include
+-- "HsUnix.h"@ to bring @HAVE_O_DIRECT@ into scope.
+--
+-- @since 2.8.x.y
+fileGetCaching :: Fd -> IO Bool
+#if HAVE_O_DIRECT
+fileGetCaching (Fd fd) = do
+    r <- throwErrnoIfMinus1 "fileGetCaching" (c_fcntl_read fd #{const F_GETFL})
+    return ((r .&. opt_val) == 0)
+  where
+    opt_val = #{const O_DIRECT}
+#else
+{-# WARNING fileGetCaching
+     "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_O_DIRECT@)" #-}
+fileGetCaching _ = ioError (ioeSetLocation unsupportedOperation "fileGetCaching")
+#endif
+
+-- | Performs the @fcntl(2)@ operation on a file-desciptor to set the cache
+-- mode.
+--
+-- If the cache mode is 'False', then cache effects for file system reads and
+-- writes are minimised or otherwise eliminated. If the cache mode is 'True',
+-- then cache effects occur like normal.
+--
+-- On Linux, FreeBSD, and NetBSD this sets the @O_DIRECT@ file flag. On OSX,
+-- this sets the @F_NOCACHE@ @fcntl@ flag.
+--
+-- Throws 'IOError' (\"unsupported operation\") if platform does not support
+-- setting the cache mode.
+--
+-- Use @#if HAVE_O_DIRECT || HAVE_F_NOCACHE@ CPP guard to detect availability.
+-- Use @#include "HsUnix.h"@ to bring @HAVE_O_DIRECT@ and @HAVE_F_NOCACHE@ into
+-- scope.
+--
+-- @since 2.8.x.y
+fileSetCaching :: Fd -> Bool -> IO ()
+#if HAVE_O_DIRECT
+fileSetCaching (Fd fd) val = do
+    r <- throwErrnoIfMinus1 "fileSetCaching" (c_fcntl_read fd #{const F_GETFL})
+    let r' | val       = fromIntegral r .&. complement opt_val
+           | otherwise = fromIntegral r .|. opt_val
+    throwErrnoIfMinus1_ "fileSetCaching" (c_fcntl_write fd #{const F_SETFL} r')
+  where
+    opt_val = #{const O_DIRECT}
+#elif HAVE_F_NOCACHE
+fileSetCaching (Fd fd) val = do
+    throwErrnoIfMinus1_ "fileSetCaching" (c_fcntl_write fd #{const F_NOCACHE} (if val then 0 else 1))
+#else
+{-# WARNING fileSetCaching
+     "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_O_DIRECT || HAVE_F_NOCACHE @)" #-}
+fileSetCaching _ _ = ioError (ioeSetLocation unsupportedOperation "fileSetCaching")
+#endif

configure.ac

@@ -120,6 +120,34 @@ AC_EGREP_CPP(yes,
   AC_MSG_RESULT(no)
   ])
 
+AC_MSG_CHECKING(for O_DIRECT open flag)
+AC_EGREP_CPP(yes,
+[
+ #include <fcntl.h>
+ #ifdef O_DIRECT
+        yes
+ #endif
+], [
+  AC_MSG_RESULT(yes)
+  AC_DEFINE([HAVE_O_DIRECT], [1], [Define to 1 if O_DIRECT open flag is available.])
+], [
+  AC_MSG_RESULT(no)
+  ])
+
+AC_MSG_CHECKING(for F_NOCACHE from fcntl.h)
+AC_EGREP_CPP(yes,
+[
+ #include <fcntl.h>
+ #ifdef F_NOCACHE
+        yes
+ #endif
+], [
+  AC_MSG_RESULT(yes)
+  AC_DEFINE([HAVE_F_NOCACHE], [1], [Define to 1 if F_NOCACHE available.])
+], [
+  AC_MSG_RESULT(no)
+  ])
+
 dnl not available on android so check for it
 AC_CANONICAL_TARGET
 AS_CASE([$target_os],[*-android*],[],[AC_CHECK_FUNCS([telldir seekdir])])