{-# LINE 1 "System\\Win32\\File.hsc" #-}
{-# LINE 2 "System\\Win32\\File.hsc" #-}
{-# LANGUAGE Safe #-}
{-# LINE 6 "System\\Win32\\File.hsc" #-}
module System.Win32.File
(
AccessMode
, gENERIC_NONE
, gENERIC_READ
, gENERIC_WRITE
, gENERIC_EXECUTE
, gENERIC_ALL
, dELETE
, rEAD_CONTROL
, wRITE_DAC
, wRITE_OWNER
, sYNCHRONIZE
, sTANDARD_RIGHTS_REQUIRED
, sTANDARD_RIGHTS_READ
, sTANDARD_RIGHTS_WRITE
, sTANDARD_RIGHTS_EXECUTE
, sTANDARD_RIGHTS_ALL
, sPECIFIC_RIGHTS_ALL
, aCCESS_SYSTEM_SECURITY
, mAXIMUM_ALLOWED
, fILE_ADD_FILE
, fILE_ADD_SUBDIRECTORY
, fILE_ALL_ACCESS
, fILE_APPEND_DATA
, fILE_CREATE_PIPE_INSTANCE
, fILE_DELETE_CHILD
, fILE_EXECUTE
, fILE_LIST_DIRECTORY
, fILE_READ_ATTRIBUTES
, fILE_READ_DATA
, fILE_READ_EA
, fILE_TRAVERSE
, fILE_WRITE_ATTRIBUTES
, fILE_WRITE_DATA
, fILE_WRITE_EA
, ShareMode
, fILE_SHARE_NONE
, fILE_SHARE_READ
, fILE_SHARE_WRITE
, fILE_SHARE_DELETE
, CreateMode
, cREATE_NEW
, cREATE_ALWAYS
, oPEN_EXISTING
, oPEN_ALWAYS
, tRUNCATE_EXISTING
, FileAttributeOrFlag
, fILE_ATTRIBUTE_READONLY
, fILE_ATTRIBUTE_HIDDEN
, fILE_ATTRIBUTE_SYSTEM
, fILE_ATTRIBUTE_DIRECTORY
, fILE_ATTRIBUTE_ARCHIVE
, fILE_ATTRIBUTE_NORMAL
, fILE_ATTRIBUTE_TEMPORARY
, fILE_ATTRIBUTE_COMPRESSED
, fILE_ATTRIBUTE_REPARSE_POINT
, fILE_FLAG_WRITE_THROUGH
, fILE_FLAG_OVERLAPPED
, fILE_FLAG_NO_BUFFERING
, fILE_FLAG_RANDOM_ACCESS
, fILE_FLAG_SEQUENTIAL_SCAN
, fILE_FLAG_DELETE_ON_CLOSE
, fILE_FLAG_BACKUP_SEMANTICS
, fILE_FLAG_POSIX_SEMANTICS
{-# LINE 92 "System\\Win32\\File.hsc" #-}
, sECURITY_ANONYMOUS
, sECURITY_IDENTIFICATION
, sECURITY_IMPERSONATION
, sECURITY_DELEGATION
, sECURITY_CONTEXT_TRACKING
, sECURITY_EFFECTIVE_ONLY
, sECURITY_SQOS_PRESENT
, sECURITY_VALID_SQOS_FLAGS
{-# LINE 101 "System\\Win32\\File.hsc" #-}
, MoveFileFlag
, mOVEFILE_REPLACE_EXISTING
, mOVEFILE_COPY_ALLOWED
, mOVEFILE_DELAY_UNTIL_REBOOT
, FilePtrDirection
, fILE_BEGIN
, fILE_CURRENT
, fILE_END
, DriveType
, dRIVE_UNKNOWN
, dRIVE_NO_ROOT_DIR
, dRIVE_REMOVABLE
, dRIVE_FIXED
, dRIVE_REMOTE
, dRIVE_CDROM
, dRIVE_RAMDISK
, DefineDosDeviceFlags
, dDD_RAW_TARGET_PATH
, dDD_REMOVE_DEFINITION
, dDD_EXACT_MATCH_ON_REMOVE
, BinaryType
, sCS_32BIT_BINARY
, sCS_DOS_BINARY
, sCS_WOW_BINARY
, sCS_PIF_BINARY
, sCS_POSIX_BINARY
, sCS_OS216_BINARY
, FileNotificationFlag
, fILE_NOTIFY_CHANGE_FILE_NAME
, fILE_NOTIFY_CHANGE_DIR_NAME
, fILE_NOTIFY_CHANGE_ATTRIBUTES
, fILE_NOTIFY_CHANGE_SIZE
, fILE_NOTIFY_CHANGE_LAST_WRITE
, fILE_NOTIFY_CHANGE_SECURITY
, FileType
, fILE_TYPE_UNKNOWN
, fILE_TYPE_DISK
, fILE_TYPE_CHAR
, fILE_TYPE_PIPE
, fILE_TYPE_REMOTE
, LockMode
, lOCKFILE_EXCLUSIVE_LOCK
, lOCKFILE_FAIL_IMMEDIATELY
, GET_FILEEX_INFO_LEVELS
, getFileExInfoStandard
, getFileExMaxInfoLevel
, SECURITY_ATTRIBUTES(..)
, PSECURITY_ATTRIBUTES
, LPSECURITY_ATTRIBUTES
, MbLPSECURITY_ATTRIBUTES
, BY_HANDLE_FILE_INFORMATION(..)
, WIN32_FILE_ATTRIBUTE_DATA(..)
, failIfWithRetry
, failIfWithRetry_
, failIfFalseWithRetry_
, deleteFile
, copyFile
, moveFile
, moveFileEx
, setCurrentDirectory
, createDirectory
, createDirectoryEx
, removeDirectory
, getBinaryType
, getTempFileName
, createFile
, createFile_NoRetry
, closeHandle
, getFileType
, flushFileBuffers
, setEndOfFile
, setFileAttributes
, getFileAttributes
, getFileAttributesExStandard
, getFileInformationByHandle
, OVERLAPPED(..)
, LPOVERLAPPED
, MbLPOVERLAPPED
, win32_ReadFile
, win32_WriteFile
, setFilePointerEx
, findFirstChangeNotification
, findNextChangeNotification
, findCloseChangeNotification
, FindData
, getFindDataFileName
, findFirstFile
, findNextFile
, findClose
, defineDosDevice
, areFileApisANSI
, setFileApisToOEM
, setFileApisToANSI
, setHandleCount
, getLogicalDrives
, getDiskFreeSpace
, setVolumeLabel
, lockFile
, unlockFile
) where
import System.Win32.File.Internal
import System.Win32.Types
import Foreign hiding (void)
import Control.Monad
import Control.Concurrent
import Data.Maybe (fromMaybe)
#include "windows_cconv.h"
failIfWithRetry :: (a -> Bool) -> String -> IO a -> IO a
failIfWithRetry cond msg action = retryOrFail retries
where
delay = 100*1000
retries = 20 :: Int
retryOrFail times
| times <= 0 = errorWin msg
| otherwise = do
ret <- action
if not (cond ret)
then return ret
else do
err_code <- getLastError
if err_code == (32)
{-# LINE 281 "System\\Win32\\File.hsc" #-}
then do threadDelay delay; retryOrFail (times - 1)
else errorWin msg
failIfWithRetry_ :: (a -> Bool) -> String -> IO a -> IO ()
failIfWithRetry_ cond msg action = void $ failIfWithRetry cond msg action
failIfFalseWithRetry_ :: String -> IO Bool -> IO ()
failIfFalseWithRetry_ = failIfWithRetry_ not
deleteFile :: String -> IO ()
deleteFile name =
withFilePath name $ \ c_name ->
failIfFalseWithRetry_ (unwords ["DeleteFile",show name]) $
c_DeleteFile c_name
copyFile :: String -> String -> Bool -> IO ()
copyFile src dest over =
withFilePath src $ \ c_src ->
withFilePath dest $ \ c_dest ->
failIfFalseWithRetry_ (unwords ["CopyFile",show src,show dest]) $
c_CopyFile c_src c_dest over
moveFile :: String -> String -> IO ()
moveFile src dest =
withFilePath src $ \ c_src ->
withFilePath dest $ \ c_dest ->
failIfFalseWithRetry_ (unwords ["MoveFile",show src,show dest]) $
c_MoveFile c_src c_dest
moveFileEx :: String -> Maybe String -> MoveFileFlag -> IO ()
moveFileEx src dest flags =
withFilePath src $ \ c_src ->
maybeWith withFilePath dest $ \ c_dest ->
failIfFalseWithRetry_ (unwords ["MoveFileEx",show src,show dest]) $
c_MoveFileEx c_src c_dest flags
setCurrentDirectory :: String -> IO ()
setCurrentDirectory name =
withFilePath name $ \ c_name ->
failIfFalse_ (unwords ["SetCurrentDirectory",show name]) $
c_SetCurrentDirectory c_name
createDirectory :: String -> Maybe LPSECURITY_ATTRIBUTES -> IO ()
createDirectory name mb_attr =
withFilePath name $ \ c_name ->
failIfFalseWithRetry_ (unwords ["CreateDirectory",show name]) $
c_CreateDirectory c_name (maybePtr mb_attr)
createDirectoryEx :: String -> String -> Maybe LPSECURITY_ATTRIBUTES -> IO ()
createDirectoryEx template name mb_attr =
withFilePath template $ \ c_template ->
withFilePath name $ \ c_name ->
failIfFalseWithRetry_ (unwords ["CreateDirectoryEx",show template,show name]) $
c_CreateDirectoryEx c_template c_name (maybePtr mb_attr)
removeDirectory :: String -> IO ()
removeDirectory name =
withFilePath name $ \ c_name ->
failIfFalseWithRetry_ (unwords ["RemoveDirectory",show name]) $
c_RemoveDirectory c_name
getBinaryType :: String -> IO BinaryType
getBinaryType name =
withFilePath name $ \ c_name ->
alloca $ \ p_btype -> do
failIfFalse_ (unwords ["GetBinaryType",show name]) $
c_GetBinaryType c_name p_btype
peek p_btype
getTempFileName :: String
-> String
-> Maybe UINT
-> IO (String, UINT)
getTempFileName dir prefix unique = allocaBytes ((260) * sizeOf (undefined :: TCHAR)) $ \c_buf -> do
{-# LINE 359 "System\\Win32\\File.hsc" #-}
uid <- withFilePath dir $ \c_dir ->
withFilePath prefix $ \ c_prefix -> do
failIfZero "getTempFileName" $
c_GetTempFileNameW c_dir c_prefix (fromMaybe 0 unique) c_buf
fname <- peekTString c_buf
return (fname, uid)
createFile :: String -> AccessMode -> ShareMode -> Maybe LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> Maybe HANDLE -> IO HANDLE
createFile = createFile' failIfWithRetry
createFile' :: ((HANDLE -> Bool) -> String -> IO HANDLE -> IO HANDLE) -> String -> AccessMode -> ShareMode -> Maybe LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> Maybe HANDLE -> IO HANDLE
createFile' f name access share mb_attr mode flag mb_h =
withFilePath name $ \ c_name ->
f (==iNVALID_HANDLE_VALUE) (unwords ["CreateFile",show name]) $
c_CreateFile c_name access share (maybePtr mb_attr) mode flag (maybePtr mb_h)
createFile_NoRetry :: String -> AccessMode -> ShareMode -> Maybe LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> Maybe HANDLE -> IO HANDLE
createFile_NoRetry = createFile' failIf
closeHandle :: HANDLE -> IO ()
closeHandle h =
failIfFalse_ "CloseHandle" $ c_CloseHandle h
flushFileBuffers :: HANDLE -> IO ()
flushFileBuffers h =
failIfFalse_ "FlushFileBuffers" $ c_FlushFileBuffers h
setEndOfFile :: HANDLE -> IO ()
setEndOfFile h =
failIfFalse_ "SetEndOfFile" $ c_SetEndOfFile h
setFileAttributes :: String -> FileAttributeOrFlag -> IO ()
setFileAttributes name attr =
withFilePath name $ \ c_name ->
failIfFalseWithRetry_ (unwords ["SetFileAttributes",show name])
$ c_SetFileAttributes c_name attr
getFileAttributes :: String -> IO FileAttributeOrFlag
getFileAttributes name =
withFilePath name $ \ c_name ->
failIfWithRetry (== 0xFFFFFFFF) (unwords ["GetFileAttributes",show name]) $
c_GetFileAttributes c_name
getFileAttributesExStandard :: String -> IO WIN32_FILE_ATTRIBUTE_DATA
getFileAttributesExStandard name = alloca $ \res -> do
withFilePath name $ \ c_name ->
failIfFalseWithRetry_ "getFileAttributesExStandard" $
c_GetFileAttributesEx c_name getFileExInfoStandard res
peek res
getFileInformationByHandle :: HANDLE -> IO BY_HANDLE_FILE_INFORMATION
getFileInformationByHandle h = alloca $ \res -> do
failIfFalseWithRetry_ "GetFileInformationByHandle" $ c_GetFileInformationByHandle h res
peek res
win32_ReadFile :: HANDLE -> Ptr a -> DWORD -> Maybe LPOVERLAPPED -> IO DWORD
win32_ReadFile h buf n mb_over =
alloca $ \ p_n -> do
failIfFalse_ "ReadFile" $ c_ReadFile h buf n p_n (maybePtr mb_over)
peek p_n
win32_WriteFile :: HANDLE -> Ptr a -> DWORD -> Maybe LPOVERLAPPED -> IO DWORD
win32_WriteFile h buf n mb_over =
alloca $ \ p_n -> do
failIfFalse_ "WriteFile" $ c_WriteFile h buf n p_n (maybePtr mb_over)
peek p_n
setFilePointerEx :: HANDLE -> LARGE_INTEGER -> FilePtrDirection -> IO LARGE_INTEGER
setFilePointerEx h dist dir =
alloca $ \p_pos -> do
failIfFalse_ "SetFilePointerEx" $ c_SetFilePointerEx h dist p_pos dir
peek p_pos
findFirstChangeNotification :: String -> Bool -> FileNotificationFlag -> IO HANDLE
findFirstChangeNotification path watch flag =
withFilePath path $ \ c_path ->
failIfNull (unwords ["FindFirstChangeNotification",show path]) $
c_FindFirstChangeNotification c_path watch flag
findNextChangeNotification :: HANDLE -> IO ()
findNextChangeNotification h =
failIfFalse_ "FindNextChangeNotification" $ c_FindNextChangeNotification h
findCloseChangeNotification :: HANDLE -> IO ()
findCloseChangeNotification h =
failIfFalse_ "FindCloseChangeNotification" $ c_FindCloseChangeNotification h
getFindDataFileName :: FindData -> IO FilePath
getFindDataFileName (FindData fp) =
withForeignPtr fp $ \p ->
peekTString (((\hsc_ptr -> hsc_ptr `plusPtr` 44)) p)
{-# LINE 476 "System\\Win32\\File.hsc" #-}
findFirstFile :: String -> IO (HANDLE, FindData)
findFirstFile str = do
fp_finddata <- mallocForeignPtrBytes (592)
{-# LINE 480 "System\\Win32\\File.hsc" #-}
withForeignPtr fp_finddata $ \p_finddata -> do
handle <- withFilePath str $ \tstr -> do
failIf (== iNVALID_HANDLE_VALUE) "findFirstFile" $
c_FindFirstFile tstr p_finddata
return (handle, FindData fp_finddata)
findNextFile :: HANDLE -> FindData -> IO Bool
findNextFile h (FindData finddata) = do
withForeignPtr finddata $ \p_finddata -> do
b <- c_FindNextFile h p_finddata
if b
then return True
else do
err_code <- getLastError
if err_code == (18)
{-# LINE 495 "System\\Win32\\File.hsc" #-}
then return False
else failWith "findNextFile" err_code
findClose :: HANDLE -> IO ()
findClose h = failIfFalse_ "findClose" $ c_FindClose h
defineDosDevice :: DefineDosDeviceFlags -> String -> Maybe String -> IO ()
defineDosDevice flags name path =
maybeWith withFilePath path $ \ c_path ->
withFilePath name $ \ c_name ->
failIfFalse_ "DefineDosDevice" $ c_DefineDosDevice flags c_name c_path
getLogicalDrives :: IO DWORD
getLogicalDrives =
failIfZero "GetLogicalDrives" $ c_GetLogicalDrives
getDiskFreeSpace :: Maybe String -> IO (DWORD,DWORD,DWORD,DWORD)
getDiskFreeSpace path =
maybeWith withFilePath path $ \ c_path ->
alloca $ \ p_sectors ->
alloca $ \ p_bytes ->
alloca $ \ p_nfree ->
alloca $ \ p_nclusters -> do
failIfFalse_ "GetDiskFreeSpace" $
c_GetDiskFreeSpace c_path p_sectors p_bytes p_nfree p_nclusters
sectors <- peek p_sectors
bytes <- peek p_bytes
nfree <- peek p_nfree
nclusters <- peek p_nclusters
return (sectors, bytes, nfree, nclusters)
setVolumeLabel :: Maybe String -> Maybe String -> IO ()
setVolumeLabel path name =
maybeWith withFilePath path $ \ c_path ->
maybeWith withFilePath name $ \ c_name ->
failIfFalse_ "SetVolumeLabel" $ c_SetVolumeLabel c_path c_name
lockFile :: HANDLE
-> LockMode
-> DWORD64
-> DWORD64
-> IO BOOL
lockFile hwnd mode size f_offset =
do let s_low = fromIntegral (size .&. 0xFFFFFFFF)
s_hi = fromIntegral (size `shiftR` 32)
o_low = fromIntegral (f_offset .&. 0xFFFFFFFF)
o_hi = fromIntegral (f_offset `shiftR` 32)
ovlp = OVERLAPPED 0 0 o_low o_hi nullPtr
with ovlp $ \ptr -> c_LockFileEx hwnd mode 0 s_low s_hi ptr
unlockFile :: HANDLE
-> DWORD64
-> DWORD64
-> IO BOOL
unlockFile hwnd size f_offset =
do let s_low = fromIntegral (size .&. 0xFFFFFFFF)
s_hi = fromIntegral (size `shiftR` 32)
o_low = fromIntegral (f_offset .&. 0xFFFFFFFF)
o_hi = fromIntegral (f_offset `shiftR` 32)
ovlp = OVERLAPPED 0 0 o_low o_hi nullPtr
with ovlp $ \ptr -> c_UnlockFileEx hwnd 0 s_low s_hi ptr