git-annex/Command/Unlock.hs
Joey Hess 54ad1b4cfb
Windows: Support long filenames in more (possibly all) of the code
Works around this bug in unix-compat:
https://github.com/jacobstanley/unix-compat/issues/56
getFileStatus and other FilePath using functions in unix-compat do not do
UNC conversion on Windows.

Made Utility.RawFilePath use convertToWindowsNativeNamespace to do the
necessary conversion on windows to support long filenames.

Audited all imports of System.PosixCompat.Files to make sure that no
functions that operate on FilePath were imported from it. Instead, use
the equvilants from Utility.RawFilePath. In particular the
re-export of that module in Common had to be removed, which led to lots
of other changes throughout the code.

The changes to Build.Configure, Build.DesktopFile, and Build.TestConfig
make Utility.Directory not be needed to build setup. And so let it use
Utility.RawFilePath, which depends on unix, which cannot be in
setup-depends.

Sponsored-by: Dartmouth College's Datalad project
2023-03-01 15:55:58 -04:00

72 lines
2.1 KiB
Haskell

{- git-annex command
-
- Copyright 2010-2022 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.Unlock where
import Command
import Annex.Content
import Annex.Perms
import Annex.Link
import Annex.ReplaceFile
import Annex.InodeSentinal
import Utility.InodeCache
import Git.FilePath
import qualified Database.Keys
import qualified Utility.RawFilePath as R
import System.PosixCompat.Files (fileMode)
cmd :: Command
cmd = mkcmd "unlock" "unlock files for modification"
editcmd :: Command
editcmd = mkcmd "edit" "same as unlock"
mkcmd :: String -> String -> Command
mkcmd n d = withAnnexOptions [jsonOptions, annexedMatchingOptions] $
command n SectionCommon d paramPaths (withParams seek)
seek :: CmdParams -> CommandSeek
seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
where
ww = WarnUnmatchLsFiles
seeker = AnnexedFileSeeker
{ startAction = start
, checkContentPresent = Nothing
, usesLocationLog = False
}
start :: SeekInput -> RawFilePath -> Key -> CommandStart
start si file key = ifM (isJust <$> isAnnexLink file)
( starting "unlock" ai si $ perform file key
, stop
)
where
ai = mkActionItem (key, AssociatedFile (Just file))
perform :: RawFilePath -> Key -> CommandPerform
perform dest key = do
destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus dest
destic <- replaceWorkTreeFile (fromRawFilePath dest) $ \tmp -> do
ifM (inAnnex key)
( do
r <- linkFromAnnex' key (toRawFilePath tmp) destmode
case r of
LinkAnnexOk -> return ()
LinkAnnexNoop -> return ()
LinkAnnexFailed -> error "unlock failed"
, liftIO $ writePointerFile (toRawFilePath tmp) key destmode
)
withTSDelta (liftIO . genInodeCache (toRawFilePath tmp))
next $ cleanup dest destic key destmode
cleanup :: RawFilePath -> Maybe InodeCache -> Key -> Maybe FileMode -> CommandCleanup
cleanup dest destic key destmode = do
stagePointerFile dest destmode =<< hashPointerFile key
maybe noop (restagePointerFile (Restage True) dest) destic
Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath dest)
return True