@@ -1,93 +0,0 @@
1−-- confirm that the filesystem type is a journaled FS type expected by Project:M36
2−-- use statfs on Linux and macOS and GetVolumeInformation on Windows
3−-- this could still be fooled with symlinks or by disabling journaling on filesystems that support that
4−module ProjectM36.FSType where
5−import Foreign.C.Types
6−import Foreign.C.String
7−import Foreign.C.Error
8−
9−#ifdef mingw32_HOST_OS
10−import System.Win32.String
11−import System.Win32.File
12−
13−foreign import WINDOWS_CCONV unsafe "windows.h GetVolumeInformationW"
14− c_GetVolumeInformation :: LPCTSTR -> LPTSTR -> DWORD -> LPDWORD -> LPDWORD -> LPDWORD -> LPTSTR -> DWORD -> IO BOOL
15−
16−data VolumeInformation = VolumeInformation
17− { volumeName :: String
18− , volumeSerialNumber :: DWORD
19− , maximumComponentLength :: DWORD
20− , fileSystemFlags :: DWORD
21− , fileSystemName :: String
22− } deriving Show
23−
24−-- from https://github.com/haskell/win32/blob/master/System/Win32/HardLink.hs
25−getVolumeInformation :: Maybe String -> IO VolumeInformation
26−getVolumeInformation mPath =
27− maybeWith withTString mPath $ \c_path ->
28− withTStringBufferLen 256 $ \(vnBuf, vnLen) ->
29− alloca $ \serialNum ->
30− alloca $ \maxLen ->
31− alloca $ \fsFlags ->
32− withTStringBufferLen 256 $ \(fsBuf, fsLen) -> do
33− failIfFalse_ (unwords ["GetVolumeInformationW", c_path]) $
34− c_GetVolumeInformation c_path vnBuf (fromIntegral vnLen)
35− serialNum maxLen fsFlags
36− fsBuf (fromIntegral fsLen)
37− return VolumeInformation
38− <*> peekTString vnBuf
39− <*> peek serialNum
40− <*> peek maxLen
41− <*> peek fsFlags
42− <*> peekTString fsBuf
43−
44−fsTypeSupportsJournaling :: FilePath -> IO Bool
45−fsTypeSupportJournaling path = do
46− info <- getVolumeInformation
47−#define FILE_SUPPORTS_USN_JOURNAL 0x02000000
48− pure (fileSystemFlags info .&. FILE_SUPPORTS_USN_JOURNAL)
49−
50−#elif darwin_HOST_OS
51−--Darwin reports journaling directly in the fs flags
52−
53−type CStatFS = ()
54−foreign import ccall unsafe "cDarwinFSJournaled"
55− c_DarwinFSJournaled :: CString -> IO CInt
56−
57−fsTypeSupportsJournaling :: FilePath -> IO Bool
58−fsTypeSupportsJournaling path =
59− withCString path $ \c_path -> do
60− ret <- throwErrnoIfMinus1 "statfs" (c_DarwinFSJournaled c_path)
61− pure (ret > (0 :: CInt))
62−
63−#elif linux_HOST_OS
64−import Foreign
65−--Linux cannot report journaling, so we just check the filesystem type as a proxy
66−#include <sys/vfs.h>
67−#include <linux/magic.h>
68−type CStatFS = ()
69−foreign import ccall unsafe "sys/vfs.h statfs"
70− c_statfs :: CString -> Ptr CStatFS -> IO CInt
71−
72−type CFSType = #{type __SWORD_TYPE}
73−
74−fsTypeSupportsJournaling :: FilePath -> IO Bool
75−fsTypeSupportsJournaling path = do
76− struct_statfs <- mallocForeignPtrBytes #{size statfs}
77− withCString path $ \c_path -> do
78− withForeignPtr struct_statfs $ \ptr_statfs -> do
79− throwErrnoIfMinus1_ "statfs" (c_statfs c_path ptr_statfs)
80− cfstype <- peekByteOff ptr_statfs 0 :: IO CFSType
81− let journaledFS = [#{const EXT3_SUPER_MAGIC},
82− #{const EXT4_SUPER_MAGIC},
83− #{ifdef NTFS_SB_MAGIC
84− NTFS_SB_MAGIC,
85− #endif}
86− #{const REISERFS_SUPER_MAGIC},
87− #{ifdef XFS_SUPER_MAGIC
88− XFS_SUPER_MAGIC,
89− #endif}
90− 0]
91− pure (elem cfstype journaledFS)
92−#endif
93−