more OsPath conversion

This commit is contained in:
Joey Hess 2025-02-11 14:00:01 -04:00
parent a5eaf3d4d2
commit 19dea33f57
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -161,7 +161,7 @@ tryLock lockfile = do
removeWhenExistsWith removeFile tmp removeWhenExistsWith removeFile tmp
return Nothing return Nothing
let tooklock st = return $ Just $ LockHandle abslockfile st sidelock let tooklock st = return $ Just $ LockHandle abslockfile st sidelock
linkToLock sidelock tmp' (fromOsPath abslockfile) >>= \case linkToLock sidelock tmp abslockfile >>= \case
Just lckst -> do Just lckst -> do
removeWhenExistsWith removeFile tmp removeWhenExistsWith removeFile tmp
tooklock lckst tooklock lckst
@ -190,36 +190,38 @@ tryLock lockfile = do
-- --
-- However, not all filesystems support hard links. So, first probe -- However, not all filesystems support hard links. So, first probe
-- to see if they are supported. If not, use open with O_EXCL. -- to see if they are supported. If not, use open with O_EXCL.
linkToLock :: SideLockHandle -> RawFilePath -> RawFilePath -> IO (Maybe FileStatus) linkToLock :: SideLockHandle -> OsPath -> OsPath -> IO (Maybe FileStatus)
linkToLock Nothing _ _ = return Nothing linkToLock Nothing _ _ = return Nothing
linkToLock (Just _) src dest = do linkToLock (Just _) src dest = do
let probe = src <> ".lnk" let probe = src <> literalOsPath ".lnk"
v <- tryIO $ createLink src probe v <- tryIO $ createLink src' (fromOsPath probe)
removeWhenExistsWith removeLink probe removeWhenExistsWith removeFile probe
case v of case v of
Right _ -> do Right _ -> do
_ <- tryIO $ createLink src dest _ <- tryIO $ createLink src' dest'
ifM (catchBoolIO checklinked) ifM (catchBoolIO checklinked)
( ifM (catchBoolIO $ not <$> checkInsaneLustre (toOsPath dest)) ( ifM (catchBoolIO $ not <$> checkInsaneLustre dest)
( catchMaybeIO $ getFileStatus dest ( catchMaybeIO $ getFileStatus dest'
, return Nothing , return Nothing
) )
, return Nothing , return Nothing
) )
Left _ -> catchMaybeIO $ do Left _ -> catchMaybeIO $ do
let setup = do let setup = do
fd <- openFdWithMode dest WriteOnly fd <- openFdWithMode dest' WriteOnly
(Just $ combineModes readModes) (Just $ combineModes readModes)
(defaultFileFlags {exclusive = True}) (defaultFileFlags {exclusive = True})
fdToHandle fd fdToHandle fd
let cleanup = hClose let cleanup = hClose
let go h = readFile (fromRawFilePath src) >>= hPutStr h let go h = readFile (fromOsPath src) >>= hPutStr h
bracket setup cleanup go bracket setup cleanup go
getFileStatus dest getFileStatus dest'
where where
src' = fromOsPath src
dest' = fromOsPath dest
checklinked = do checklinked = do
x <- getSymbolicLinkStatus src x <- getSymbolicLinkStatus src'
y <- getSymbolicLinkStatus dest y <- getSymbolicLinkStatus dest'
return $ and return $ and
[ deviceID x == deviceID y [ deviceID x == deviceID y
, fileID x == fileID y , fileID x == fileID y