diff --git a/Annex/Init.hs b/Annex/Init.hs index 79c505d4b1..663f23033c 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -29,6 +29,7 @@ import Logs.UUID import Logs.Trust.Basic import Logs.Config import Types.TrustLevel +import Types.RepoVersion import Annex.Version import Annex.Difference import Annex.UUID @@ -78,7 +79,7 @@ genDescription Nothing = do Right username -> [username, at, hostname, ":", reldir] Left _ -> [hostname, ":", reldir] -initialize :: AutoInit -> Maybe String -> Maybe Version -> Annex () +initialize :: AutoInit -> Maybe String -> Maybe RepoVersion -> Annex () initialize ai mdescription mversion = checkCanInitialize ai $ do {- Has to come before any commits are made as the shared - clone heuristic expects no local objects. -} @@ -98,7 +99,7 @@ initialize ai mdescription mversion = checkCanInitialize ai $ do -- Everything except for uuid setup, shared clone setup, and initial -- description. -initialize' :: AutoInit -> Maybe Version -> Annex () +initialize' :: AutoInit -> Maybe RepoVersion -> Annex () initialize' ai mversion = checkCanInitialize ai $ do checkLockSupport checkFifoSupport diff --git a/Annex/Version.hs b/Annex/Version.hs index 6fdc2c703b..95541dca4b 100644 --- a/Annex/Version.hs +++ b/Annex/Version.hs @@ -1,8 +1,8 @@ {- git-annex repository versioning - - - Copyright 2010,2013 Joey Hess + - Copyright 2010-2018 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - Licensed under the GNU AGPL version 3 or higher. -} {-# LANGUAGE CPP #-} @@ -11,48 +11,47 @@ module Annex.Version where import Annex.Common import Config +import Types.RepoVersion import qualified Annex -type Version = String +defaultVersion :: RepoVersion +defaultVersion = RepoVersion 5 -defaultVersion :: Version -defaultVersion = "5" +latestVersion :: RepoVersion +latestVersion = RepoVersion 7 -latestVersion :: Version -latestVersion = "6" +supportedVersions :: [RepoVersion] +supportedVersions = map RepoVersion [3, 5, 7] -supportedVersions :: [Version] -supportedVersions = ["3", "5", "6"] +versionForAdjustedClone :: RepoVersion +versionForAdjustedClone = RepoVersion 6 -versionForAdjustedClone :: Version -versionForAdjustedClone = "6" - -upgradableVersions :: [Version] +upgradableVersions :: [RepoVersion] #ifndef mingw32_HOST_OS -upgradableVersions = ["0", "1", "2", "3", "4", "5"] +upgradableVersions = map RepoVersion [0..6] #else -upgradableVersions = ["2", "3", "4", "5"] +upgradableVersions = map RepoVersion [2..6] #endif -autoUpgradeableVersions :: [Version] -autoUpgradeableVersions = ["3", "4"] +autoUpgradeableVersions :: [RepoVersion] +autoUpgradeableVersions = map RepoVersion [3, 4, 6] versionField :: ConfigKey versionField = annexConfig "version" -getVersion :: Annex (Maybe Version) +getVersion :: Annex (Maybe RepoVersion) getVersion = annexVersion <$> Annex.getGitConfig versionSupportsDirectMode :: Annex Bool versionSupportsDirectMode = go <$> getVersion where - go (Just "6") = False + go (Just v) | v >= RepoVersion 6 = False go _ = True versionSupportsUnlockedPointers :: Annex Bool versionSupportsUnlockedPointers = go <$> getVersion where - go (Just "6") = True + go (Just v) | v >= RepoVersion 6 = True go _ = False versionSupportsAdjustedBranch :: Annex Bool @@ -61,8 +60,8 @@ versionSupportsAdjustedBranch = versionSupportsUnlockedPointers versionUsesKeysDatabase :: Annex Bool versionUsesKeysDatabase = versionSupportsUnlockedPointers -setVersion :: Version -> Annex () -setVersion = setConfig versionField +setVersion :: RepoVersion -> Annex () +setVersion (RepoVersion v) = setConfig versionField (show v) removeVersion :: Annex () removeVersion = unsetConfig versionField diff --git a/CHANGELOG b/CHANGELOG index ce74d99160..40a994902e 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,8 @@ -git-annex (6.20181012) UNRELEASED; urgency=medium +git-annex (7.20181025) UNRELEASED; urgency=medium + * Added v7 repository mode. v6 upgrades automatically to v7, but + v5 is still the default for now. While v6 was always experimental + to some degree, its successor v7 is ready for production use! * At long last there's a way to hide annexed files whose content is missing from the working tree: git-annex adjust --hide-missing See https://git-annex.branchable.com/tips/hiding_missing_files/ @@ -10,23 +13,12 @@ git-annex (6.20181012) UNRELEASED; urgency=medium * git-annex sync --content supports --hide-missing; it can be used to get the content of hidden files, and it updates the adjusted branch to hide/unhide files as necessary. - * Removed the old Android app. - * Removed support for building with very old ghc < 8.0.1, - and with yesod < 1.4.3, and without concurrent-output, - which were onyl being used for the Android cross build. - * Webapp: Fix termux detection. - * runshell: Use system locales when built with - GIT_ANNEX_PACKAGE_INSTALL set. (For Neurodebian packages.) - * v6: Fix database inconsistency that could cause git-annex to - get confused about whether a locked file's content was present. - * Fix concurrency bug that occurred on the first download from an - exporttree remote. * smudge: The smudge filter no longer provides git with annexed file content, to avoid a git memory leak, and because that did not honor annex.thin. Now git annex smudge --update has to be run after a checkout to update unlocked files in the working tree with annexed file contents. - * init, upgrade: Install git post-checkout and post-merge hooks that run + * v7 init, upgrade: Install git post-checkout and post-merge hooks that run git annex smudge --update. * precommit: Run git annex smudge --update, because the post-merge hook is not run when there is a merge conflict. So the work tree will @@ -34,6 +26,17 @@ git-annex (6.20181012) UNRELEASED; urgency=medium * Note that git has no hooks run after git stash or git cherry-pick, so the user will have to manually run git annex smudge --update after such commands. + * Removed the old Android app. + * Removed support for building with very old ghc < 8.0.1, + and with yesod < 1.4.3, and without concurrent-output, + which were only being used for the Android cross build. + * Webapp: Fix termux detection. + * runshell: Use system locales when built with + GIT_ANNEX_PACKAGE_INSTALL set. (For Neurodebian packages.) + * Fix database inconsistency that could cause git-annex to + get confused about whether a locked file's content was present. + * Fix concurrency bug that occurred on the first download from an + exporttree remote. -- Joey Hess Sat, 13 Oct 2018 00:52:02 -0400 diff --git a/Command/Init.hs b/Command/Init.hs index 8ce82a75e8..f0aed4dc04 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -10,6 +10,7 @@ module Command.Init where import Command import Annex.Init import Annex.Version +import Types.RepoVersion import qualified Annex.SpecialRemote cmd :: Command @@ -19,21 +20,23 @@ cmd = dontCheck repoExists $ data InitOptions = InitOptions { initDesc :: String - , initVersion :: Maybe Version + , initVersion :: Maybe RepoVersion } optParser :: CmdParamsDesc -> Parser InitOptions optParser desc = InitOptions <$> (unwords <$> cmdParams desc) - <*> optional (option (str >>= parseVersion) + <*> optional (option (str >>= parseRepoVersion) ( long "version" <> metavar paramValue <> help "Override default annex.version" )) -parseVersion :: Monad m => String -> m Version -parseVersion v - | v `elem` supportedVersions = return v - | otherwise = fail $ v ++ " is not a currently supported repository version" +parseRepoVersion :: Monad m => String -> m RepoVersion +parseRepoVersion s = case RepoVersion <$> readish s of + Nothing -> fail $ "version parse error" + Just v + | v `elem` supportedVersions -> return v + | otherwise -> fail $ s ++ " is not a currently supported repository version" seek :: InitOptions -> CommandSeek seek = commandAction . start diff --git a/Command/Smudge.hs b/Command/Smudge.hs index af80f1122a..569f4a985d 100644 --- a/Command/Smudge.hs +++ b/Command/Smudge.hs @@ -99,15 +99,15 @@ clean file = do -- Optimization when the file is already annexed -- and is unmodified. case oldkey of - Nothing -> ingest oldkey + Nothing -> doingest oldkey Just ko -> ifM (isUnmodifiedCheap ko file) ( liftIO $ emitPointer ko - , ingest oldkey + , doingest oldkey ) , liftIO $ B.hPut stdout b ) - ingest oldkey = do + doingest oldkey = do -- Look up the backend that was used for this file -- before, so that when git re-cleans a file its -- backend does not change. diff --git a/Command/Version.hs b/Command/Version.hs index a7a5d503eb..9b0ae66576 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -12,6 +12,7 @@ import Annex.Version import BuildInfo import BuildFlags import Types.Key +import Types.RepoVersion import qualified Types.Backend as B import qualified Types.Remote as R import qualified Remote @@ -49,7 +50,7 @@ seekNoRepo o showVersion :: Annex () showVersion = do liftIO showPackageVersion - maybe noop (liftIO . vinfo "local repository version") + maybe noop (liftIO . vinfo "local repository version" . showRepoVersion) =<< getVersion showPackageVersion :: IO () @@ -62,9 +63,14 @@ showPackageVersion = do vinfo "remote types" $ unwords $ map R.typename Remote.remoteTypes vinfo "operating system" $ unwords [os, arch] vinfo "supported repository versions" $ - unwords supportedVersions + verlist supportedVersions vinfo "upgrade supported from repository versions" $ - unwords upgradableVersions + verlist upgradableVersions + where + verlist = unwords . map showRepoVersion + +showRepoVersion :: RepoVersion -> String +showRepoVersion = show . fromRepoVersion showRawVersion :: IO () showRawVersion = do diff --git a/Test.hs b/Test.hs index 2deb212796..135814143a 100644 --- a/Test.hs +++ b/Test.hs @@ -1,6 +1,6 @@ {- git-annex test suite - - - Copyright 2010-2017 Joey Hess + - Copyright 2010-2018 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,6 +10,7 @@ module Test where import Types.Test +import Types.RepoVersion import Test.Framework import Options.Applicative.Types @@ -148,10 +149,10 @@ tests crippledfilesystem opts = testGroup "Tests" $ properties : map (\(d, te) -> withTestMode te initTests (unitTests d)) testmodes where testmodes = catMaybes - [ Just ("v6 unlocked", (testMode opts "6") { unlockedFiles = True }) - , unlesscrippled ("v5", testMode opts "5") - , unlesscrippled ("v6 locked", testMode opts "6") - , Just ("v5 direct", (testMode opts "5") { forceDirect = True }) + [ Just ("v7 unlocked", (testMode opts (RepoVersion 7)) { unlockedFiles = True }) + , unlesscrippled ("v5", testMode opts (RepoVersion 5)) + , unlesscrippled ("v7 locked", testMode opts (RepoVersion 7)) + , Just ("v5 direct", (testMode opts (RepoVersion 5)) { forceDirect = True }) ] unlesscrippled v | crippledfilesystem = Nothing @@ -225,7 +226,7 @@ unitTests note = testGroup ("Unit Tests " ++ note) , testCase "move (ssh remote)" test_move_ssh_remote , testCase "copy" test_copy , testCase "lock" test_lock - , testCase "lock (v6 --force)" test_lock_v6_force + , testCase "lock (v7 --force)" test_lock_v7_force , testCase "edit (no pre-commit)" test_edit , testCase "edit (pre-commit)" test_edit_precommit , testCase "partial commit" test_partial_commit @@ -280,7 +281,7 @@ test_init = innewrepo $ do ver <- annexVersion <$> getTestMode if ver == Annex.Version.defaultVersion then git_annex "init" [reponame] @? "init failed" - else git_annex "init" [reponame, "--version", ver] @? "init failed" + else git_annex "init" [reponame, "--version", show (fromRepoVersion ver)] @? "init failed" setupTestMode where reponame = "test repo" @@ -601,11 +602,11 @@ test_lock = intmpclonerepoInDirect $ do annexed_notpresent annexedfile -- regression test: unlock of newly added, not committed file - -- should fail in v5 mode. In v6 mode, this is allowed. + -- should fail in v5 mode. In v7 mode, this is allowed. writeFile "newfile" "foo" git_annex "add" ["newfile"] @? "add new file failed" ifM (annexeval Annex.Version.versionSupportsUnlockedPointers) - ( git_annex "unlock" ["newfile"] @? "unlock failed on newly added, never committed file in v6 repository" + ( git_annex "unlock" ["newfile"] @? "unlock failed on newly added, never committed file in v7 repository" , not <$> git_annex "unlock" ["newfile"] @? "unlock failed to fail on newly added, never committed file in v5 repository" ) @@ -619,7 +620,7 @@ test_lock = intmpclonerepoInDirect $ do writeFile annexedfile $ content annexedfile ++ "foo" not <$> git_annex "lock" [annexedfile] @? "lock failed to fail without --force" git_annex "lock" ["--force", annexedfile] @? "lock --force failed" - -- In v6 mode, the original content of the file is not always + -- In v7 mode, the original content of the file is not always -- preserved after modification, so re-get it. git_annex "get" [annexedfile] @? "get of file failed after lock --force" annexed_present_locked annexedfile @@ -642,19 +643,19 @@ test_lock = intmpclonerepoInDirect $ do -- Regression test: lock --force when work tree file -- was modified lost the (unmodified) annex object. -- (Only occurred when the keys database was out of sync.) -test_lock_v6_force :: Assertion -test_lock_v6_force = intmpclonerepoInDirect $ do +test_lock_v7_force :: Assertion +test_lock_v7_force = intmpclonerepoInDirect $ do git_annex "upgrade" [] @? "upgrade failed" whenM (annexeval Annex.Version.versionSupportsUnlockedPointers) $ do git_annex "get" [annexedfile] @? "get of file failed" - git_annex "unlock" [annexedfile] @? "unlock failed in v6 mode" + git_annex "unlock" [annexedfile] @? "unlock failed in v7 mode" annexeval $ do Database.Keys.closeDb dbdir <- Annex.fromRepo Annex.Locations.gitAnnexKeysDb liftIO $ renameDirectory dbdir (dbdir ++ ".old") - writeFile annexedfile "test_lock_v6_force content" - not <$> git_annex "lock" [annexedfile] @? "lock of modified file failed to fail in v6 mode" - git_annex "lock" ["--force", annexedfile] @? "lock --force of modified file failed in v6 mode" + writeFile annexedfile "test_lock_v7_force content" + not <$> git_annex "lock" [annexedfile] @? "lock of modified file failed to fail in v7 mode" + git_annex "lock" ["--force", annexedfile] @? "lock --force of modified file failed in v7 mode" annexed_present_locked annexedfile test_edit :: Assertion @@ -693,7 +694,7 @@ test_partial_commit = intmpclonerepoInDirect $ do changecontent annexedfile ifM (annexeval Annex.Version.versionSupportsUnlockedPointers) ( boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "test", File annexedfile] - @? "partial commit of unlocked file should be allowed in v6 repository" + @? "partial commit of unlocked file should be allowed in v7 repository" , not <$> boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "test", File annexedfile] @? "partial commit of unlocked file not blocked by pre-commit hook" ) @@ -723,7 +724,7 @@ test_direct = intmpclonerepoInDirect $ do git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile ifM (annexeval Annex.Version.versionSupportsUnlockedPointers) - ( not <$> git_annex "direct" [] @? "switch to direct mode failed to fail in v6 repository" + ( not <$> git_annex "direct" [] @? "switch to direct mode failed to fail in v7 repository" , do git_annex "direct" [] @? "switch to direct mode failed" annexed_present annexedfile @@ -1111,7 +1112,7 @@ test_conflict_resolution_adjusted_branch = whenM (annexeval Annex.AdjustedBranch writeFile conflictor "conflictor2" add_annex conflictor @? "add conflicter failed" git_annex "sync" [] @? "sync failed in r2" - -- need v6 to use adjust + -- need v7 to use adjust git_annex "upgrade" [] @? "upgrade failed" -- We might be in an adjusted branch -- already, when eg on a crippled @@ -1405,7 +1406,7 @@ test_conflict_resolution_symlink_bit = unlessM (unlockedFiles <$> getTestMode) $ all (\i -> Git.Types.toTreeItemType (Git.LsTree.mode i) == Just Git.Types.TreeSymlink) l @? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l) -{- A v6 unlocked file that conflicts with a locked file should be resolved +{- A v7 unlocked file that conflicts with a locked file should be resolved - in favor of the unlocked file, with no variant files, as long as they - both point to the same key. -} test_mixed_lock_conflict_resolution :: Assertion diff --git a/Test/Framework.hs b/Test/Framework.hs index c5908faf92..76c4c76fb0 100644 --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -17,6 +17,7 @@ import Types.Test import qualified Annex import qualified Annex.UUID import qualified Annex.Version +import qualified Types.RepoVersion import qualified Backend import qualified Git.CurrentRepo import qualified Git.Construct @@ -198,7 +199,7 @@ clonerepo old new cfg = do ver <- annexVersion <$> getTestMode if ver == Annex.Version.defaultVersion then git_annex "init" ["-q", new] @? "git annex init failed" - else git_annex "init" ["-q", new, "--version", ver] @? "git annex init failed" + else git_annex "init" ["-q", new, "--version", show (Types.RepoVersion.fromRepoVersion ver)] @? "git annex init failed" unless (bareClone cfg) $ indir new $ setupTestMode @@ -387,11 +388,11 @@ add_annex f = ifM (unlockedFiles <$> getTestMode) data TestMode = TestMode { forceDirect :: Bool , unlockedFiles :: Bool - , annexVersion :: Annex.Version.Version + , annexVersion :: Types.RepoVersion.RepoVersion , keepFailures :: Bool } deriving (Read, Show) -testMode :: TestOptions -> Annex.Version.Version -> TestMode +testMode :: TestOptions -> Types.RepoVersion.RepoVersion -> TestMode testMode opts v = TestMode { forceDirect = False , unlockedFiles = False diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 63e0d77f4e..2dc922569f 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -30,6 +30,7 @@ import Types.Concurrency import Types.NumCopies import Types.Difference import Types.RefSpec +import Types.RepoVersion import Config.DynamicConfig import Utility.HumanTime import Utility.Gpg (GpgCmd, mkGpgCmd) @@ -52,7 +53,7 @@ data Configurable a {- Main git-annex settings. Each setting corresponds to a git-config key - such as annex.foo -} data GitConfig = GitConfig - { annexVersion :: Maybe String + { annexVersion :: Maybe RepoVersion , annexUUID :: UUID , annexNumCopies :: Maybe NumCopies , annexDiskReserve :: Integer @@ -110,7 +111,7 @@ data GitConfig = GitConfig extractGitConfig :: Git.Repo -> GitConfig extractGitConfig r = GitConfig - { annexVersion = notempty $ getmaybe (annex "version") + { annexVersion = RepoVersion <$> getmayberead (annex "version") , annexUUID = maybe NoUUID toUUID $ getmaybe (annex "uuid") , annexNumCopies = NumCopies <$> getmayberead (annex "numcopies") , annexDiskReserve = fromMaybe onemegabyte $ diff --git a/Types/RepoVersion.hs b/Types/RepoVersion.hs new file mode 100644 index 0000000000..e79d5b21c8 --- /dev/null +++ b/Types/RepoVersion.hs @@ -0,0 +1,11 @@ +{- git-annex repository versioning + - + - Copyright 2010-2018 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Types.RepoVersion where + +newtype RepoVersion = RepoVersion { fromRepoVersion :: Int } + deriving (Eq, Ord, Read, Show) diff --git a/Upgrade.hs b/Upgrade.hs index c6552f89c0..b943584cef 100644 --- a/Upgrade.hs +++ b/Upgrade.hs @@ -11,6 +11,7 @@ module Upgrade where import Annex.Common import Annex.Version +import Types.RepoVersion #ifndef mingw32_HOST_OS import qualified Upgrade.V0 import qualified Upgrade.V1 @@ -19,11 +20,12 @@ import qualified Upgrade.V2 import qualified Upgrade.V3 import qualified Upgrade.V4 import qualified Upgrade.V5 +import qualified Upgrade.V6 -checkUpgrade :: Version -> Annex () +checkUpgrade :: RepoVersion -> Annex () checkUpgrade = maybe noop giveup <=< needsUpgrade -needsUpgrade :: Version -> Annex (Maybe String) +needsUpgrade :: RepoVersion -> Annex (Maybe String) needsUpgrade v | v `elem` supportedVersions = ok | v `elem` autoUpgradeableVersions = ifM (upgrade True defaultVersion) @@ -33,11 +35,12 @@ needsUpgrade v | v `elem` upgradableVersions = err "Upgrade this repository: git-annex upgrade" | otherwise = err "Upgrade git-annex." where - err msg = return $ Just $ "Repository version " ++ v ++ + err msg = return $ Just $ "Repository version " ++ + show (fromRepoVersion v) ++ " is not supported. " ++ msg ok = return Nothing -upgrade :: Bool -> Version -> Annex Bool +upgrade :: Bool -> RepoVersion -> Annex Bool upgrade automatic destversion = do upgraded <- go =<< getVersion when upgraded $ @@ -46,14 +49,15 @@ upgrade automatic destversion = do where go (Just v) | v >= destversion = return True #ifndef mingw32_HOST_OS - go (Just "0") = Upgrade.V0.upgrade - go (Just "1") = Upgrade.V1.upgrade + go (Just (RepoVersion 0)) = Upgrade.V0.upgrade + go (Just (RepoVersion 1)) = Upgrade.V1.upgrade #else - go (Just "0") = giveup "upgrade from v0 on Windows not supported" - go (Just "1") = giveup "upgrade from v1 on Windows not supported" + go (Just (RepoVersion 0)) = giveup "upgrade from V0 on Windows not supported" + go (Just (RepoVersion 1)) = giveup "upgrade from V1 on Windows not supported" #endif - go (Just "2") = Upgrade.V2.upgrade - go (Just "3") = Upgrade.V3.upgrade automatic - go (Just "4") = Upgrade.V4.upgrade automatic - go (Just "5") = Upgrade.V5.upgrade automatic + go (Just (RepoVersion 2)) = Upgrade.V2.upgrade + go (Just (RepoVersion 3)) = Upgrade.V3.upgrade automatic + go (Just (RepoVersion 4)) = Upgrade.V4.upgrade automatic + go (Just (RepoVersion 5)) = Upgrade.V5.upgrade automatic + go (Just (RepoVersion 6)) = Upgrade.V6.upgrade automatic go _ = return True diff --git a/Upgrade/V5.hs b/Upgrade/V5.hs index b5cd410bcd..9998901506 100644 --- a/Upgrade/V5.hs +++ b/Upgrade/V5.hs @@ -17,7 +17,6 @@ import Annex.Direct import Annex.Content import Annex.CatFile import Annex.WorkTree -import Annex.Hook import qualified Database.Keys import qualified Annex.Content.Direct as Direct import qualified Git @@ -64,9 +63,6 @@ upgrade automatic = do - adjust branch. Instead, update HEAD manually. -} inRepo $ setHeadRef b configureSmudgeFilter - unlessM isBareRepo $ do - hookWrite postCheckoutHook - hookWrite postMergeHook -- Inode sentinal file was only used in direct mode and when -- locking down files as they were added. In v6, it's used more -- extensively, so make sure it exists, since old repos that didn't diff --git a/Upgrade/V6.hs b/Upgrade/V6.hs new file mode 100644 index 0000000000..95f5f0d45e --- /dev/null +++ b/Upgrade/V6.hs @@ -0,0 +1,21 @@ +{- git-annex v6 -> v7 upgrade support + - + - Copyright 2018 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Upgrade.V6 where + +import Annex.Common +import Config +import Annex.Hook + +upgrade :: Bool -> Annex Bool +upgrade automatic = do + unless automatic $ + showAction "v6 to v7" + unlessM isBareRepo $ do + hookWrite postCheckoutHook + hookWrite postMergeHook + return True diff --git a/Utility/Yesod.hs b/Utility/Yesod.hs index c39ca8783a..956ad2bddd 100644 --- a/Utility/Yesod.hs +++ b/Utility/Yesod.hs @@ -22,7 +22,6 @@ import Yesod.Default.Util import Language.Haskell.TH.Syntax (Q, Exp) import Data.Default (def) import Text.Hamlet hiding (Html) -import Data.Text (Text) widgetFile :: String -> Q Exp widgetFile = widgetFileNoReload $ def diff --git a/doc/tips/hiding_missing_files.mdwn b/doc/tips/hiding_missing_files.mdwn index 55a26d00fd..3ee2add76b 100644 --- a/doc/tips/hiding_missing_files.mdwn +++ b/doc/tips/hiding_missing_files.mdwn @@ -8,10 +8,10 @@ but it needs some different workflows of using git-annex. ## getting started -To get started, your repository needs to be upgraded to v6, since the +To get started, your repository needs to be upgraded to v7, since the feature does not work in v5 repositories. - git annex upgrade --version=6 + git annex upgrade --version=7 The [[git-annex adjust|git-annex-adjust]] command sets up an adjusted form of a git branch, in this case we'll ask it to hide missing files. @@ -124,7 +124,7 @@ I set up the repository like this: git clone server:/path/to/podcasts cd podcasts - git annex upgrade --version=6 + git annex upgrade --version=7 git annex adjust --hide-missing git annex group here client git annex wanted here standard diff --git a/doc/tips/unlocked_files.mdwn b/doc/tips/unlocked_files.mdwn index 0f5fad0c0f..683d93abf8 100644 --- a/doc/tips/unlocked_files.mdwn +++ b/doc/tips/unlocked_files.mdwn @@ -15,7 +15,7 @@ by running `git annex unlock`. # git annex unlock some_file # echo "new content" > some_file -Back before git-annex version 6, and its v6 repository mode, unlocking a file +Back before git-annex version 7, and its v7 repository mode, unlocking a file like this was a transient thing. You'd modify it and then `git annex add` the modified version to the annex, and finally `git commit`. The new version of the file was then back to being locked. @@ -29,31 +29,28 @@ to edit files repeatedly, without manually having to unlock them every time. The [[direct_mode]] made all files be unlocked all the time, but it had many problems of its own. -## enter v6 mode +## enter v7 mode -/!\ This is a new feature; see its [[todo_list|todo/smudge]] -for known issues. - -This led to the v6 repository mode, which makes unlocked files remain +This led to the v7 repository mode, which makes unlocked files remain unlocked after they're committed, so you can keep changing them and committing the changes whenever you'd like. It also lets you use more normal git commands (or even interfaces on top of git) for handling annexed files. -To get a repository into v6 mode, you can [[upgrade|upgrades]] it. +To get a repository into v7 mode, you can [[upgrade|upgrades]] it. This will eventually happen automatically, but for now it's a manual process (be sure to read [[upgrades]] before doing this): # git annex upgrade -Or, you can init a new repository in v6 mode. +Or, you can init a new repository in v7 mode. # git init - # git annex init --version=6 + # git annex init --version=7 ## using it -Using a v6 repository is easy! Simply use regular git commands to add +Using a v7 repository is easy! Simply use regular git commands to add and commit files. In a git-annex repository, git will use git-annex to store the file contents, and the files will be left unlocked. @@ -97,7 +94,7 @@ mode is used. To make them always use unlocked mode, run: ## mixing locked and unlocked files -A v6 repository can contain both locked and unlocked files. You can switch +A v7 repository can contain both locked and unlocked files. You can switch a file back and forth using the `git annex lock` and `git annex unlock` commands. This changes what's stored in git between a git-annex symlink (locked) and a git-annex pointer file (unlocked). To add a file to diff --git a/doc/upgrades.mdwn b/doc/upgrades.mdwn index c7ade4a9c3..5669ed24a5 100644 --- a/doc/upgrades.mdwn +++ b/doc/upgrades.mdwn @@ -46,11 +46,18 @@ the upgrade would need to be run in a copy of the repository. The upgrade events, so far: -## v5 -> v6 (git-annex version 6.x) +## v6 -> v7 (git-annex version 7.x) -The upgrade from v5 to v6 is handled manually for now. +The upgrade from v5 to v7 is handled manually for now. Run `git-annex upgrade` to perform the upgrade. +v6 repositories are automatically upgraded to v7. + +The only difference between v6 and v7 is that some additional git hooks +were added in v7. + +## v5 -> v6 (git-annex version 6.x) + A v6 git-annex repository can have some files locked while other files are unlocked, and all git and git-annex commands can be used on both locked and unlocked files. (Although for locked files to be accessible, the filesystem diff --git a/git-annex.cabal b/git-annex.cabal index dfa30b1246..c9667592ec 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 6.20181011 +Version: 7.20181011 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess @@ -970,6 +970,7 @@ Executable git-annex Types.NumCopies Types.RefSpec Types.Remote + Types.RepoVersion Types.ScheduledActivity Types.StandardGroups Types.StoreRetrieve @@ -986,6 +987,7 @@ Executable git-annex Upgrade.V3 Upgrade.V4 Upgrade.V5 + Upgrade.V6 Utility.Aeson Utility.Android Utility.Applicative