{-# LANGUAGE CPP #-}
module ProjectM36.FSType where
#if defined(mingw32_HOST_OS)
# if defined(i386_HOST_ARCH)
# define WINDOWS_CCONV stdcall
# elif defined(x86_64_HOST_ARCH)
# define WINDOWS_CCONV ccall
# endif
import System.Win32.Types
import Foreign.ForeignPtr
import Data.Word
import Data.Bits
import Foreign.Storable
foreign import WINDOWS_CCONV unsafe "windows.h GetVolumePathNameW"
c_GetVolumePathName :: LPCTSTR -> LPTSTR -> DWORD -> IO BOOL
foreign import WINDOWS_CCONV unsafe "windows.h GetVolumeInformationW"
c_GetVolumeInformation :: LPCTSTR -> LPTSTR -> DWORD -> LPDWORD -> LPDWORD -> LPDWORD -> LPTSTR -> DWORD -> IO BOOL
#define FILE_SUPPORTS_USN_JOURNAL 0x02000000
getVolumePathName :: FilePath -> IO String
getVolumePathName path = do
let maxpathlen = 260
withTString path $ \c_path -> do
fp_pathout <- mallocForeignPtrBytes maxpathlen
withForeignPtr fp_pathout $ \pathout -> do
failIfFalse_ ("GetVolumePathNameW " ++ path) (c_GetVolumePathName c_path pathout (fromIntegral maxpathlen))
peekTString pathout
fsTypeSupportsJournaling :: FilePath -> IO Bool
fsTypeSupportsJournaling path = do
drive <- getVolumePathName path
withTString drive $ \c_drive -> do
foreign_flags <- mallocForeignPtrBytes 8
withForeignPtr foreign_flags $ \ptr_fsFlags -> do
failIfFalse_ (unwords ["GetVolumeInformationW", path]) (c_GetVolumeInformation c_drive nullPtr 0 nullPtr nullPtr ptr_fsFlags nullPtr 0)
fsFlags <- peekByteOff ptr_fsFlags 0 :: IO Word64
pure (fsFlags .&. FILE_SUPPORTS_USN_JOURNAL /= 0)
#elif darwin_HOST_OS
import Foreign.C.Error
import Foreign.C.String
import Foreign.C.Types
type CStatFS = ()
foreign import ccall unsafe "cDarwinFSJournaled"
c_DarwinFSJournaled :: CString -> IO CInt
fsTypeSupportsJournaling :: FilePath -> IO Bool
fsTypeSupportsJournaling path =
withCString path $ \c_path -> do
ret <- throwErrnoIfMinus1 "statfs" (c_DarwinFSJournaled c_path)
pure (ret > (0 :: CInt))
#elif linux_HOST_OS
import Foreign
import Foreign.C.Error
import Foreign.C.String
import Foreign.C.Types
#include "MachDeps.h"
type CStatFS = ()
foreign import ccall unsafe "sys/vfs.h statfs"
c_statfs :: CString -> Ptr CStatFS -> IO CInt
#if WORD_SIZE_IN_BITS == 64
type CFSType = Word64
sizeofStructStatFS :: Int
sizeofStructStatFS :: Int
sizeofStructStatFS = Int
120
#else
#error 32-bit not supported due to sizeof struct statfs missing
type CFSType = Word32
sizeofStructStatFS :: Int
sizeofStructStatFS = undefined
#endif
fsTypeSupportsJournaling :: FilePath -> IO Bool
fsTypeSupportsJournaling :: FilePath -> IO Bool
fsTypeSupportsJournaling FilePath
path = do
ForeignPtr CStatFS
struct_statfs <- Int -> IO (ForeignPtr CStatFS)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sizeofStructStatFS
FilePath -> (CString -> IO Bool) -> IO Bool
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
path ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
c_path -> do
ForeignPtr CStatFS -> (Ptr CStatFS -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CStatFS
struct_statfs ((Ptr CStatFS -> IO Bool) -> IO Bool)
-> (Ptr CStatFS -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CStatFS
ptr_statfs -> do
FilePath -> IO CInt -> IO CStatFS
forall a. (Eq a, Num a) => FilePath -> IO a -> IO CStatFS
throwErrnoIfMinus1_ FilePath
"statfs" (CString -> Ptr CStatFS -> IO CInt
c_statfs CString
c_path Ptr CStatFS
ptr_statfs)
CFSType
cfstype <- Ptr CStatFS -> Int -> IO CFSType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CStatFS
ptr_statfs Int
0 :: IO CFSType
let journaledFS :: [CFSType]
journaledFS = [CFSType
0xEF53,
CFSType
0x5346544e,
CFSType
0x52654973,
CFSType
0x58465342,
CFSType
0x3153464a
]
Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CFSType -> [CFSType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem CFSType
cfstype [CFSType]
journaledFS)
#endif