Use lower case hash directories for storing files on crippled filesystems, same as is already done for bare repositories.
* since this is a crippled filesystem anyway, git-annex doesn't use symlinks on it * so there's no reason to use the mixed case hash directories that we're stuck using to avoid breaking everyone's symlinks to the content * so we can do what is already done for all bare repos, and make non-bare repos on crippled filesystems use the all-lower case hash directories * which are, happily, all 3 letters long, so they cannot conflict with mixed case hash directories * so I was able to 100% fix this and even resuming `git annex add` in the test case will recover and it will all just work.
This commit is contained in:
parent
c20143ee32
commit
f1b0a4b404
22 changed files with 90 additions and 70 deletions
6
Annex.hs
6
Annex.hs
|
@ -28,6 +28,7 @@ module Annex (
|
|||
gitRepo,
|
||||
inRepo,
|
||||
fromRepo,
|
||||
calcRepo,
|
||||
getGitConfig,
|
||||
changeGitConfig,
|
||||
changeGitRepo,
|
||||
|
@ -203,6 +204,11 @@ inRepo a = liftIO . a =<< gitRepo
|
|||
fromRepo :: (Git.Repo -> a) -> Annex a
|
||||
fromRepo a = a <$> gitRepo
|
||||
|
||||
calcRepo :: (Git.Repo -> GitConfig -> IO a) -> Annex a
|
||||
calcRepo a = do
|
||||
s <- getState id
|
||||
liftIO $ a (repo s) (gitconfig s)
|
||||
|
||||
{- Gets the GitConfig settings. -}
|
||||
getGitConfig :: Annex GitConfig
|
||||
getGitConfig = getState gitconfig
|
||||
|
|
|
@ -9,7 +9,6 @@ module Annex.Content (
|
|||
inAnnex,
|
||||
inAnnexSafe,
|
||||
lockContent,
|
||||
calcGitLink,
|
||||
getViaTmp,
|
||||
getViaTmpChecked,
|
||||
getViaTmpUnchecked,
|
||||
|
@ -101,7 +100,7 @@ inAnnexSafe = inAnnex' (fromMaybe False) (Just False) go
|
|||
- it. (If the content is not present, no locking is done.) -}
|
||||
lockContent :: Key -> Annex a -> Annex a
|
||||
lockContent key a = do
|
||||
file <- inRepo $ gitAnnexLocation key
|
||||
file <- calcRepo $ gitAnnexLocation key
|
||||
bracketIO (openforlock file >>= lock) unlock a
|
||||
where
|
||||
{- Since files are stored with the write bit disabled, have
|
||||
|
@ -123,16 +122,6 @@ lockContent key a = do
|
|||
unlock Nothing = noop
|
||||
unlock (Just l) = closeFd l
|
||||
|
||||
{- Calculates the relative path to use to link a file to a key. -}
|
||||
calcGitLink :: FilePath -> Key -> Annex FilePath
|
||||
calcGitLink file key = do
|
||||
cwd <- liftIO getCurrentDirectory
|
||||
let absfile = fromMaybe whoops $ absNormPath cwd file
|
||||
loc <- inRepo $ gitAnnexLocation key
|
||||
return $ relPathDirToFile (parentDir absfile) loc
|
||||
where
|
||||
whoops = error $ "unable to normalize " ++ file
|
||||
|
||||
{- Runs an action, passing it a temporary filename to get,
|
||||
- and if the action succeeds, moves the temp file into
|
||||
- the annex as a key's content. -}
|
||||
|
@ -251,7 +240,7 @@ moveAnnex key src = withObjectLoc key storeobject storedirect
|
|||
storedirect fs = storedirect' =<< filterM validsymlink fs
|
||||
validsymlink f = (==) (Just key) <$> isAnnexLink f
|
||||
|
||||
storedirect' [] = storeobject =<< inRepo (gitAnnexLocation key)
|
||||
storedirect' [] = storeobject =<< calcRepo (gitAnnexLocation key)
|
||||
storedirect' (dest:fs) = do
|
||||
updateInodeCache key src
|
||||
thawContent src
|
||||
|
@ -341,11 +330,11 @@ withObjectLoc key indirect direct = ifM isDirect
|
|||
, goindirect
|
||||
)
|
||||
where
|
||||
goindirect = indirect =<< inRepo (gitAnnexLocation key)
|
||||
goindirect = indirect =<< calcRepo (gitAnnexLocation key)
|
||||
|
||||
cleanObjectLoc :: Key -> Annex ()
|
||||
cleanObjectLoc key = do
|
||||
file <- inRepo $ gitAnnexLocation key
|
||||
file <- calcRepo $ gitAnnexLocation key
|
||||
unlessM crippledFileSystem $
|
||||
void $ liftIO $ catchMaybeIO $ allowWrite $ parentDir file
|
||||
liftIO $ removeparents file (3 :: Int)
|
||||
|
@ -374,7 +363,7 @@ removeAnnex key = withObjectLoc key remove removedirect
|
|||
removeInodeCache key
|
||||
mapM_ (resetfile cache) fs
|
||||
resetfile cache f = whenM (sameInodeCache f cache) $ do
|
||||
l <- calcGitLink f key
|
||||
l <- inRepo $ gitAnnexLink f key
|
||||
top <- fromRepo Git.repoPath
|
||||
cwd <- liftIO getCurrentDirectory
|
||||
let top' = fromMaybe top $ absNormPath cwd top
|
||||
|
@ -384,7 +373,7 @@ removeAnnex key = withObjectLoc key remove removedirect
|
|||
{- Moves a key's file out of .git/annex/objects/ -}
|
||||
fromAnnex :: Key -> FilePath -> Annex ()
|
||||
fromAnnex key dest = do
|
||||
file <- inRepo $ gitAnnexLocation key
|
||||
file <- calcRepo $ gitAnnexLocation key
|
||||
unlessM crippledFileSystem $
|
||||
liftIO $ allowWrite $ parentDir file
|
||||
thawContent file
|
||||
|
@ -395,7 +384,7 @@ fromAnnex key dest = do
|
|||
- returns the file it was moved to. -}
|
||||
moveBad :: Key -> Annex FilePath
|
||||
moveBad key = do
|
||||
src <- inRepo $ gitAnnexLocation key
|
||||
src <- calcRepo $ gitAnnexLocation key
|
||||
bad <- fromRepo gitAnnexBadDir
|
||||
let dest = bad </> takeFileName src
|
||||
createAnnexDirectory (parentDir dest)
|
||||
|
@ -468,7 +457,7 @@ preseedTmp key file = go =<< inAnnex key
|
|||
copy = ifM (liftIO $ doesFileExist file)
|
||||
( return True
|
||||
, do
|
||||
s <- inRepo $ gitAnnexLocation key
|
||||
s <- calcRepo $ gitAnnexLocation key
|
||||
liftIO $ copyFileExternal s file
|
||||
)
|
||||
|
||||
|
|
|
@ -42,7 +42,7 @@ associatedFiles key = do
|
|||
- the top of the repo. -}
|
||||
associatedFilesRelative :: Key -> Annex [FilePath]
|
||||
associatedFilesRelative key = do
|
||||
mapping <- inRepo $ gitAnnexMapping key
|
||||
mapping <- calcRepo $ gitAnnexMapping key
|
||||
liftIO $ catchDefaultIO [] $ do
|
||||
h <- openFile mapping ReadMode
|
||||
fileEncoding h
|
||||
|
@ -52,7 +52,7 @@ associatedFilesRelative key = do
|
|||
- transformation to the list. Returns new associatedFiles value. -}
|
||||
changeAssociatedFiles :: Key -> ([FilePath] -> [FilePath]) -> Annex [FilePath]
|
||||
changeAssociatedFiles key transform = do
|
||||
mapping <- inRepo $ gitAnnexMapping key
|
||||
mapping <- calcRepo $ gitAnnexMapping key
|
||||
files <- associatedFilesRelative key
|
||||
let files' = transform files
|
||||
when (files /= files') $ do
|
||||
|
@ -124,7 +124,7 @@ removeInodeCache key = withInodeCacheFile key $ \f -> do
|
|||
liftIO $ nukeFile f
|
||||
|
||||
withInodeCacheFile :: Key -> (FilePath -> Annex a) -> Annex a
|
||||
withInodeCacheFile key a = a =<< inRepo (gitAnnexInodeCache key)
|
||||
withInodeCacheFile key a = a =<< calcRepo (gitAnnexInodeCache key)
|
||||
|
||||
{- Checks if a InodeCache matches the current version of a file. -}
|
||||
sameInodeCache :: FilePath -> Maybe InodeCache -> Annex Bool
|
||||
|
|
|
@ -89,7 +89,8 @@ addDirect file cache = do
|
|||
return False
|
||||
got (Just (key, _)) = ifM (sameInodeCache file $ Just cache)
|
||||
( do
|
||||
stageSymlink file =<< hashSymlink =<< calcGitLink file key
|
||||
l <- inRepo $ gitAnnexLink file key
|
||||
stageSymlink file =<< hashSymlink l
|
||||
writeInodeCache key cache
|
||||
void $ addAssociatedFile key file
|
||||
logStatus key InfoPresent
|
||||
|
@ -152,7 +153,7 @@ mergeDirectCleanup d oldsha newsha = do
|
|||
-
|
||||
- Symlinks are replaced with their content, if it's available. -}
|
||||
movein k f = do
|
||||
l <- calcGitLink f k
|
||||
l <- inRepo $ gitAnnexLink f k
|
||||
replaceFile f $ makeAnnexLink l
|
||||
toDirect k f
|
||||
|
||||
|
@ -169,7 +170,7 @@ toDirect k f = fromMaybe noop =<< toDirectGen k f
|
|||
|
||||
toDirectGen :: Key -> FilePath -> Annex (Maybe (Annex ()))
|
||||
toDirectGen k f = do
|
||||
loc <- inRepo $ gitAnnexLocation k
|
||||
loc <- calcRepo $ gitAnnexLocation k
|
||||
absf <- liftIO $ absPath f
|
||||
locs <- filter (/= absf) <$> addAssociatedFile k f
|
||||
case locs of
|
||||
|
|
|
@ -312,7 +312,7 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
|
|||
done change file key = liftAnnex $ do
|
||||
logStatus key InfoPresent
|
||||
link <- ifM isDirect
|
||||
( calcGitLink file key
|
||||
( inRepo $ gitAnnexLink file key
|
||||
, Command.Add.link file key True
|
||||
)
|
||||
whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ do
|
||||
|
|
|
@ -201,7 +201,7 @@ onAddDirect matcher file fs = do
|
|||
- just been deleted and been put back,
|
||||
- so it symlink is restaged to make sure. -}
|
||||
( do
|
||||
link <- liftAnnex $ calcGitLink file key
|
||||
link <- liftAnnex $ inRepo $ gitAnnexLink file key
|
||||
addLink file link (Just key)
|
||||
, do
|
||||
debug ["changed direct", file]
|
||||
|
@ -222,7 +222,7 @@ onAddSymlink isdirect file filestatus = go =<< liftAnnex (Backend.lookupFile fil
|
|||
go (Just (key, _)) = do
|
||||
when isdirect $
|
||||
liftAnnex $ void $ addAssociatedFile key file
|
||||
link <- liftAnnex $ calcGitLink file key
|
||||
link <- liftAnnex $ inRepo $ gitAnnexLink file key
|
||||
ifM ((==) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file))
|
||||
( ensurestaged (Just link) (Just key) =<< getDaemonStatus
|
||||
, do
|
||||
|
|
|
@ -168,13 +168,13 @@ undo file key e = do
|
|||
-- fromAnnex could fail if the file ownership is weird
|
||||
tryharder :: IOException -> Annex ()
|
||||
tryharder _ = do
|
||||
src <- inRepo $ gitAnnexLocation key
|
||||
src <- calcRepo $ gitAnnexLocation key
|
||||
liftIO $ moveFile src file
|
||||
|
||||
{- Creates the symlink to the annexed content, returns the link target. -}
|
||||
link :: FilePath -> Key -> Bool -> Annex String
|
||||
link file key hascontent = handle (undo file key) $ do
|
||||
l <- calcGitLink file key
|
||||
l <- inRepo $ gitAnnexLink file key
|
||||
replaceFile file $ makeAnnexLink l
|
||||
|
||||
#ifndef __ANDROID__
|
||||
|
@ -206,7 +206,9 @@ cleanup file key hascontent = do
|
|||
when hascontent $
|
||||
logStatus key InfoPresent
|
||||
ifM (isDirect <&&> pure hascontent)
|
||||
( stageSymlink file =<< hashSymlink =<< calcGitLink file key
|
||||
( do
|
||||
l <- inRepo $ gitAnnexLink file key
|
||||
stageSymlink file =<< hashSymlink l
|
||||
, ifM (coreSymlinks <$> Annex.getGitConfig)
|
||||
( do
|
||||
_ <- link file key hascontent
|
||||
|
|
|
@ -10,7 +10,6 @@ module Command.Fix where
|
|||
import Common.Annex
|
||||
import Command
|
||||
import qualified Annex.Queue
|
||||
import Annex.Content
|
||||
|
||||
def :: [Command]
|
||||
def = [notDirect $ noCommit $ command "fix" paramPaths seek
|
||||
|
@ -22,7 +21,7 @@ seek = [withFilesInGit $ whenAnnexed start]
|
|||
{- Fixes the symlink to an annexed file. -}
|
||||
start :: FilePath -> (Key, Backend) -> CommandStart
|
||||
start file (key, _) = do
|
||||
link <- calcGitLink file key
|
||||
link <- inRepo $ gitAnnexLink file key
|
||||
stopUnless ((/=) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) $ do
|
||||
showStart "fix" file
|
||||
next $ perform file link
|
||||
|
|
|
@ -33,7 +33,7 @@ start _ = error "specify a key and a dest file"
|
|||
|
||||
perform :: Key -> FilePath -> CommandPerform
|
||||
perform key file = do
|
||||
link <- calcGitLink file key
|
||||
link <- inRepo $ gitAnnexLink file key
|
||||
liftIO $ createDirectoryIfMissing True (parentDir file)
|
||||
liftIO $ createSymbolicLink link file
|
||||
next $ cleanup file
|
||||
|
|
|
@ -188,7 +188,7 @@ check cs = all id <$> sequence cs
|
|||
-}
|
||||
fixLink :: Key -> FilePath -> Annex Bool
|
||||
fixLink key file = do
|
||||
want <- calcGitLink file key
|
||||
want <- inRepo $ gitAnnexLink file key
|
||||
have <- getAnnexLinkTarget file
|
||||
maybe noop (go want) have
|
||||
return True
|
||||
|
@ -223,7 +223,7 @@ verifyLocationLog key desc = do
|
|||
{- Since we're checking that a key's file is present, throw
|
||||
- in a permission fixup here too. -}
|
||||
when (present && not direct) $ do
|
||||
file <- inRepo $ gitAnnexLocation key
|
||||
file <- calcRepo $ gitAnnexLocation key
|
||||
freezeContent file
|
||||
freezeContentDir file
|
||||
|
||||
|
@ -281,7 +281,7 @@ checkKeySize :: Key -> Annex Bool
|
|||
checkKeySize key = ifM isDirect
|
||||
( return True
|
||||
, do
|
||||
file <- inRepo $ gitAnnexLocation key
|
||||
file <- calcRepo $ gitAnnexLocation key
|
||||
ifM (liftIO $ doesFileExist file)
|
||||
( checkKeySizeOr badContent key file
|
||||
, return True
|
||||
|
@ -322,7 +322,7 @@ checkKeySizeOr bad key file = case Types.Key.keySize key of
|
|||
-}
|
||||
checkBackend :: Backend -> Key -> Annex Bool
|
||||
checkBackend backend key = do
|
||||
file <- inRepo $ gitAnnexLocation key
|
||||
file <- calcRepo $ gitAnnexLocation key
|
||||
ifM isDirect
|
||||
( ifM (goodContent key file)
|
||||
( checkBackendOr' (badContentDirect file) backend key file
|
||||
|
@ -443,14 +443,14 @@ needFsck _ _ = return True
|
|||
-}
|
||||
recordFsckTime :: Key -> Annex ()
|
||||
recordFsckTime key = do
|
||||
parent <- parentDir <$> inRepo (gitAnnexLocation key)
|
||||
parent <- parentDir <$> calcRepo (gitAnnexLocation key)
|
||||
liftIO $ void $ tryIO $ do
|
||||
touchFile parent
|
||||
setSticky parent
|
||||
|
||||
getFsckTime :: Key -> Annex (Maybe EpochTime)
|
||||
getFsckTime key = do
|
||||
parent <- parentDir <$> inRepo (gitAnnexLocation key)
|
||||
parent <- parentDir <$> calcRepo (gitAnnexLocation key)
|
||||
liftIO $ catchDefaultIO Nothing $ do
|
||||
s <- getFileStatus parent
|
||||
return $ if isSticky $ fileMode s
|
||||
|
|
|
@ -82,13 +82,13 @@ perform = do
|
|||
cleandirect k -- clean before content directory gets frozen
|
||||
whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do
|
||||
moveAnnex k f
|
||||
l <- calcGitLink f k
|
||||
l <- inRepo $ gitAnnexLink f k
|
||||
liftIO $ createSymbolicLink l f
|
||||
showEndOk
|
||||
|
||||
cleandirect k = do
|
||||
liftIO . nukeFile =<< inRepo (gitAnnexInodeCache k)
|
||||
liftIO . nukeFile =<< inRepo (gitAnnexMapping k)
|
||||
liftIO . nukeFile =<< calcRepo (gitAnnexInodeCache k)
|
||||
liftIO . nukeFile =<< calcRepo (gitAnnexMapping k)
|
||||
|
||||
cleanup :: CommandCleanup
|
||||
cleanup = do
|
||||
|
|
|
@ -63,7 +63,7 @@ perform file oldkey oldbackend newbackend = do
|
|||
go newkey = stopUnless (Command.ReKey.linkKey oldkey newkey) $
|
||||
next $ Command.ReKey.cleanup file oldkey newkey
|
||||
genkey = do
|
||||
content <- inRepo $ gitAnnexLocation oldkey
|
||||
content <- calcRepo $ gitAnnexLocation oldkey
|
||||
let source = KeySource
|
||||
{ keyFilename = file
|
||||
, contentLocation = content
|
||||
|
|
|
@ -49,7 +49,7 @@ perform file oldkey newkey = do
|
|||
{- Make a hard link to the old key content, to avoid wasting disk space. -}
|
||||
linkKey :: Key -> Key -> Annex Bool
|
||||
linkKey oldkey newkey = getViaTmpUnchecked newkey $ \tmp -> do
|
||||
src <- inRepo $ gitAnnexLocation oldkey
|
||||
src <- calcRepo $ gitAnnexLocation oldkey
|
||||
ifM (liftIO $ doesFileExist tmp)
|
||||
( return True
|
||||
, ifM crippledFileSystem
|
||||
|
|
|
@ -14,7 +14,6 @@ import qualified Remote
|
|||
import qualified Annex
|
||||
import qualified Annex.Branch
|
||||
import qualified Annex.Queue
|
||||
import Annex.Content
|
||||
import Annex.Direct
|
||||
import Annex.CatFile
|
||||
import Annex.Link
|
||||
|
@ -268,7 +267,7 @@ resolveMerge' u
|
|||
[Just SymlinkBlob, Nothing]
|
||||
makelink (Just key) = do
|
||||
let dest = mergeFile file key
|
||||
l <- calcGitLink dest key
|
||||
l <- inRepo $ gitAnnexLink dest key
|
||||
liftIO $ nukeFile dest
|
||||
addAnnexLink l dest
|
||||
whenM (isDirect) $
|
||||
|
|
|
@ -60,7 +60,7 @@ cleanup file key = do
|
|||
where
|
||||
goFast = do
|
||||
-- fast mode: hard link to content in annex
|
||||
src <- inRepo $ gitAnnexLocation key
|
||||
src <- calcRepo $ gitAnnexLocation key
|
||||
-- creating a hard link could fall; fall back to non fast mode
|
||||
ifM (liftIO $ catchBoolIO $ createLink src file >> return True)
|
||||
( thawContent file
|
||||
|
|
|
@ -35,7 +35,7 @@ perform dest key = do
|
|||
unlessM (inAnnex key) $ error "content not present"
|
||||
unlessM (checkDiskSpace Nothing key 0) $ error "cannot unlock"
|
||||
|
||||
src <- inRepo $ gitAnnexLocation key
|
||||
src <- calcRepo $ gitAnnexLocation key
|
||||
tmpdest <- fromRepo $ gitAnnexTmpLocation key
|
||||
liftIO $ createDirectoryIfMissing True (parentDir tmpdest)
|
||||
showAction "copying"
|
||||
|
|
|
@ -3,6 +3,6 @@ module Common.Annex (module X) where
|
|||
import Common as X
|
||||
import Types as X
|
||||
import Types.UUID as X (toUUID, fromUUID)
|
||||
import Annex as X (gitRepo, inRepo, fromRepo)
|
||||
import Annex as X (gitRepo, inRepo, fromRepo, calcRepo)
|
||||
import Locations as X
|
||||
import Messages as X
|
||||
|
|
50
Locations.hs
50
Locations.hs
|
@ -11,6 +11,7 @@ module Locations (
|
|||
keyPaths,
|
||||
keyPath,
|
||||
gitAnnexLocation,
|
||||
gitAnnexLink,
|
||||
gitAnnexMapping,
|
||||
gitAnnexInodeCache,
|
||||
gitAnnexInodeSentinal,
|
||||
|
@ -88,7 +89,7 @@ annexLocations key = map (annexLocation key) annexHashes
|
|||
annexLocation :: Key -> Hasher -> FilePath
|
||||
annexLocation key hasher = objectDir </> keyPath key hasher
|
||||
|
||||
{- Annexed file's absolute location in a repository.
|
||||
{- Annexed object's absolute location in a repository.
|
||||
-
|
||||
- When there are multiple possible locations, returns the one where the
|
||||
- file is actually present.
|
||||
|
@ -99,35 +100,50 @@ annexLocation key hasher = objectDir </> keyPath key hasher
|
|||
- This does not take direct mode into account, so in direct mode it is not
|
||||
- the actual location of the file's content.
|
||||
-}
|
||||
gitAnnexLocation :: Key -> Git.Repo -> IO FilePath
|
||||
gitAnnexLocation key r
|
||||
| Git.repoIsLocalBare r =
|
||||
{- Bare repositories default to hashDirLower for new
|
||||
- content, as it's more portable. -}
|
||||
gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO FilePath
|
||||
gitAnnexLocation key r config = gitAnnexLocation' key r (annexCrippledFileSystem config)
|
||||
gitAnnexLocation' :: Key -> Git.Repo -> Bool -> IO FilePath
|
||||
gitAnnexLocation' key r crippled
|
||||
{- Bare repositories default to hashDirLower for new
|
||||
- content, as it's more portable.
|
||||
-
|
||||
- Repositories on filesystems that are crippled also use
|
||||
- hashDirLower, since they do not use symlinks and it's
|
||||
- more portable. -}
|
||||
| Git.repoIsLocalBare r || crippled =
|
||||
check $ map inrepo $ annexLocations key
|
||||
| otherwise =
|
||||
{- Non-bare repositories only use hashDirMixed, so
|
||||
- don't need to do any work to check if the file is
|
||||
- present. -}
|
||||
return $ inrepo $ annexLocation key hashDirMixed
|
||||
{- Non-bare repositories only use hashDirMixed, so
|
||||
- don't need to do any work to check if the file is
|
||||
- present. -}
|
||||
| otherwise = return $ inrepo $ annexLocation key hashDirMixed
|
||||
where
|
||||
inrepo d = Git.localGitDir r </> d
|
||||
check locs@(l:_) = fromMaybe l <$> firstM doesFileExist locs
|
||||
check [] = error "internal"
|
||||
|
||||
{- Calculates a symlink to link a file to an annexed object. -}
|
||||
gitAnnexLink :: FilePath -> Key -> Git.Repo -> IO FilePath
|
||||
gitAnnexLink file key r = do
|
||||
cwd <- getCurrentDirectory
|
||||
let absfile = fromMaybe whoops $ absNormPath cwd file
|
||||
loc <- gitAnnexLocation' key r False
|
||||
return $ relPathDirToFile (parentDir absfile) loc
|
||||
where
|
||||
whoops = error $ "unable to normalize " ++ file
|
||||
|
||||
{- File that maps from a key to the file(s) in the git repository.
|
||||
- Used in direct mode. -}
|
||||
gitAnnexMapping :: Key -> Git.Repo -> IO FilePath
|
||||
gitAnnexMapping key r = do
|
||||
loc <- gitAnnexLocation key r
|
||||
gitAnnexMapping :: Key -> Git.Repo -> GitConfig -> IO FilePath
|
||||
gitAnnexMapping key r config = do
|
||||
loc <- gitAnnexLocation key r config
|
||||
return $ loc ++ ".map"
|
||||
|
||||
{- File that caches information about a key's content, used to determine
|
||||
- if a file has changed.
|
||||
- Used in direct mode. -}
|
||||
gitAnnexInodeCache :: Key -> Git.Repo -> IO FilePath
|
||||
gitAnnexInodeCache key r = do
|
||||
loc <- gitAnnexLocation key r
|
||||
gitAnnexInodeCache :: Key -> Git.Repo -> GitConfig -> IO FilePath
|
||||
gitAnnexInodeCache key r config = do
|
||||
loc <- gitAnnexLocation key r config
|
||||
return $ loc ++ ".cache"
|
||||
|
||||
gitAnnexInodeSentinal :: Git.Repo -> FilePath
|
||||
|
|
|
@ -111,6 +111,7 @@ gen r u _ gc = go <$> remoteCost gc defcst
|
|||
else Nothing
|
||||
, repo = r
|
||||
, gitconfig = gc
|
||||
{ remoteGitConfig = Just $ extractGitConfig r }
|
||||
, readonly = Git.repoIsHttp r
|
||||
, globallyAvailable = not $ Git.repoIsLocal r || Git.repoIsLocalUnknown r
|
||||
, remotetype = remote
|
||||
|
@ -332,7 +333,8 @@ copyFromRemote r key file dest
|
|||
copyFromRemoteCheap :: Remote -> Key -> FilePath -> Annex Bool
|
||||
copyFromRemoteCheap r key file
|
||||
| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do
|
||||
loc <- liftIO $ gitAnnexLocation key (repo r)
|
||||
loc <- liftIO $ gitAnnexLocation key (repo r) $
|
||||
fromJust $ remoteGitConfig $ gitconfig r
|
||||
liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
|
||||
| Git.repoIsSsh (repo r) =
|
||||
ifM (Annex.Content.preseedTmp key file)
|
||||
|
|
|
@ -88,7 +88,8 @@ data RemoteGitConfig = RemoteGitConfig
|
|||
, remoteAnnexStartCommand :: Maybe String
|
||||
, remoteAnnexStopCommand :: Maybe String
|
||||
|
||||
-- these settings are specific to particular types of remotes
|
||||
{- These settings are specific to particular types of remotes
|
||||
- including special remotes. -}
|
||||
, remoteAnnexSshOptions :: [String]
|
||||
, remoteAnnexRsyncOptions :: [String]
|
||||
, remoteAnnexGnupgOptions :: [String]
|
||||
|
@ -97,6 +98,8 @@ data RemoteGitConfig = RemoteGitConfig
|
|||
, remoteAnnexBupSplitOptions :: [String]
|
||||
, remoteAnnexDirectory :: Maybe FilePath
|
||||
, remoteAnnexHookType :: Maybe String
|
||||
{- A regular git remote's git repository config. -}
|
||||
, remoteGitConfig :: Maybe GitConfig
|
||||
}
|
||||
|
||||
extractRemoteGitConfig :: Git.Repo -> String -> RemoteGitConfig
|
||||
|
@ -117,6 +120,7 @@ extractRemoteGitConfig r remotename = RemoteGitConfig
|
|||
, remoteAnnexBupSplitOptions = getoptions "bup-split-options"
|
||||
, remoteAnnexDirectory = notempty $ getmaybe "directory"
|
||||
, remoteAnnexHookType = notempty $ getmaybe "hooktype"
|
||||
, remoteGitConfig = Nothing
|
||||
}
|
||||
where
|
||||
getbool k def = fromMaybe def $ getmaybebool k
|
||||
|
|
|
@ -92,7 +92,7 @@ updateSymlinks = do
|
|||
case r of
|
||||
Nothing -> noop
|
||||
Just (k, _) -> do
|
||||
link <- calcGitLink f k
|
||||
link <- inRepo $ gitAnnexLink f k
|
||||
liftIO $ removeFile f
|
||||
liftIO $ createSymbolicLink link f
|
||||
Annex.Queue.addCommand "add" [Param "--"] [f]
|
||||
|
|
2
debian/changelog
vendored
2
debian/changelog
vendored
|
@ -30,6 +30,8 @@ git-annex (4.20130324) UNRELEASED; urgency=low
|
|||
* webapp: Improved transfer queue management.
|
||||
* init: Probe whether the filesystem supports fifos, and if not,
|
||||
disable ssh connection caching.
|
||||
* Use lower case hash directories for storing files on crippled filesystems,
|
||||
same as is already done for bare repositories.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Mon, 25 Mar 2013 10:21:46 -0400
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue