diff options
Diffstat (limited to 'Init.hs')
| -rw-r--r-- | Init.hs | 98 |
1 files changed, 36 insertions, 62 deletions
@@ -12,11 +12,10 @@ module Init ( isInitialized, initialize, uninitialize, - probeCrippledFileSystem + probeCrippledFileSystem, ) where import Common.Annex -import Utility.Tmp import Utility.Network import qualified Annex import qualified Git @@ -26,7 +25,6 @@ import qualified Annex.Branch import Logs.UUID import Annex.Version import Annex.UUID -import Utility.Shell import Config import Annex.Direct import Annex.Content.Direct @@ -36,6 +34,8 @@ import Backend import Utility.UserInfo import Utility.FileMode #endif +import Annex.Hook +import Upgrade genDescription :: Maybe String -> Annex String genDescription (Just d) = return d @@ -53,10 +53,19 @@ genDescription Nothing = do initialize :: Maybe String -> Annex () initialize mdescription = do prepUUID - setVersion defaultVersion - checkCrippledFileSystem checkFifoSupport - gitPreCommitHookWrite + checkCrippledFileSystem + unlessM isBare $ + hookWrite preCommitHook + ifM (crippledFileSystem <&&> not <$> isBare) + ( do + enableDirectMode + setDirect True + setVersion directModeVersion + , do + setVersion defaultVersion + setDirect False + ) createInodeSentinalFile u <- getUUID {- This will make the first commit to git, so ensure git is set up @@ -67,16 +76,19 @@ initialize mdescription = do uninitialize :: Annex () uninitialize = do - gitPreCommitHookUnWrite + hookUnWrite preCommitHook removeRepoUUID removeVersion {- Will automatically initialize if there is already a git-annex - branch from somewhere. Otherwise, require a manual init - to avoid git-annex accidentially being run in git - - repos that did not intend to use it. -} + - repos that did not intend to use it. + - + - Checks repository version and handles upgrades too. + -} ensureInitialized :: Annex () -ensureInitialized = getVersion >>= maybe needsinit checkVersion +ensureInitialized = getVersion >>= maybe needsinit checkUpgrade where needsinit = ifM Annex.Branch.hasSibling ( initialize Nothing @@ -87,45 +99,8 @@ ensureInitialized = getVersion >>= maybe needsinit checkVersion isInitialized :: Annex Bool isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion -{- set up a git pre-commit hook, if one is not already present -} -gitPreCommitHookWrite :: Annex () -gitPreCommitHookWrite = unlessBare $ do - hook <- preCommitHook - ifM (liftIO $ doesFileExist hook) - ( do - content <- liftIO $ readFile hook - when (content /= preCommitScript) $ - warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring" - , unlessM crippledFileSystem $ - liftIO $ do - viaTmp writeFile hook preCommitScript - p <- getPermissions hook - setPermissions hook $ p {executable = True} - ) - -gitPreCommitHookUnWrite :: Annex () -gitPreCommitHookUnWrite = unlessBare $ do - hook <- preCommitHook - whenM (liftIO $ doesFileExist hook) $ - ifM (liftIO $ (==) preCommitScript <$> readFile hook) - ( liftIO $ removeFile hook - , warning $ "pre-commit hook (" ++ hook ++ - ") contents modified; not deleting." ++ - " Edit it to remove call to git annex." - ) - -unlessBare :: Annex () -> Annex () -unlessBare = unlessM $ fromRepo Git.repoIsLocalBare - -preCommitHook :: Annex FilePath -preCommitHook = (</>) <$> fromRepo Git.localGitDir <*> pure "hooks/pre-commit" - -preCommitScript :: String -preCommitScript = unlines - [ shebang_local - , "# automatically configured by git-annex" - , "git annex pre-commit ." - ] +isBare :: Annex Bool +isBare = fromRepo Git.repoIsLocalBare {- A crippled filesystem is one that does not allow making symlinks, - or removing write access from files. -} @@ -158,25 +133,15 @@ checkCrippledFileSystem = whenM probeCrippledFileSystem $ do warning "Detected a crippled filesystem." setCrippledFileSystem True - {- Normally git disables core.symlinks itself when the filesystem does - - not support them, but in Cygwin, git does support symlinks, while - - git-annex, not linking with Cygwin, does not. -} + {- Normally git disables core.symlinks itself when the + - filesystem does not support them, but in Cygwin, git + - does support symlinks, while git-annex, not linking + - with Cygwin, does not. -} whenM (coreSymlinks <$> Annex.getGitConfig) $ do warning "Disabling core.symlinks." setConfig (ConfigKey "core.symlinks") (Git.Config.boolConfig False) - unlessBare $ do - unlessM isDirect $ do - warning "Enabling direct mode." - top <- fromRepo Git.repoPath - (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] - forM_ l $ \f -> - maybe noop (`toDirect` f) =<< isAnnexLink f - void $ liftIO clean - setDirect True - setVersion directModeVersion - probeFifoSupport :: Annex Bool probeFifoSupport = do #ifdef mingw32_HOST_OS @@ -199,3 +164,12 @@ checkFifoSupport = unlessM probeFifoSupport $ do warning "Detected a filesystem without fifo support." warning "Disabling ssh connection caching." setConfig (annexConfig "sshcaching") (Git.Config.boolConfig False) + +enableDirectMode :: Annex () +enableDirectMode = unlessM isDirect $ do + warning "Enabling direct mode." + top <- fromRepo Git.repoPath + (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] + forM_ l $ \f -> + maybe noop (`toDirect` f) =<< isAnnexLink f + void $ liftIO clean |