mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

more RawFilePath conversion

Browse source 
Most of Git/ builds now.

Notable win is toTopFilePath no longer double converts

This commit was sponsored by Boyd Stephen Smith Jr. on Patreon.
This commit is contained in:
Joey Hess 2020-10-28 15:40:50 -04:00
parent d6e94a6b2e
commit 08cbaee1f8
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
15 changed files with 105 additions and 76 deletions
Download patch file Download diff file Expand all files Collapse all files

8
Utility/LockFile/PidLock.hs
View file

@ -23,7 +23,7 @@ import Utility.Exception
import Utility.Applicative
import Utility.Directory
import Utility.Monad
import Utility.Path
import Utility.Path.AbsRel
import Utility.FileMode
import Utility.LockFile.LockStatus
import Utility.ThreadScheduler
@ -108,7 +108,7 @@ dropSideLock (Just (f, h)) = do
-- locks. /tmp is used as a fallback.
sideLockFile :: LockFile -> IO LockFile
sideLockFile lockfile = do
f <- absPath lockfile
f <- fromRawFilePath <$> absPath (toRawFilePath lockfile)
let base = intercalate "_" (splitDirectories (makeRelative "/" f))
let shortbase = reverse $ take 32 $ reverse base
let md5sum = if base == shortbase
@ -131,7 +131,7 @@ sideLockFile lockfile = do
-- "PIDLOCK_lockfile" environment variable, does not block either.
tryLock :: LockFile -> IO (Maybe LockHandle)
tryLock lockfile = do
abslockfile <- absPath lockfile
abslockfile <- fromRawFilePath <$> absPath (toRawFilePath lockfile)
lockenv <- pidLockEnv abslockfile
getEnv lockenv >>= \case
Nothing -> trySideLock lockfile (go abslockfile)
@ -299,7 +299,7 @@ checkSaneLock _ ParentLocked = return True
-- not see unsetLockEnv.
pidLockEnv :: FilePath -> IO String
pidLockEnv lockfile = do
abslockfile <- absPath lockfile
abslockfile <- fromRawFilePath <$> absPath (toRawFilePath lockfile)
return $ "PIDLOCK_" ++ filter legalInEnvVar abslockfile
pidLockEnvValue :: String