Merge branch 'master' into checkout

Conflicts:
	debian/changelog
	doc/backends.mdwn

Annex.hs

@@ -19,7 +19,9 @@ module Annex (
 	flagGet,
 	Flag(..),
 	queue,
-	queueGet
+	queueGet,
+	queueRun,
+	setConfig
 ) where
 
 import Control.Monad.State
@@ -118,3 +120,21 @@ queueGet :: Annex GitQueue.Queue
 queueGet = do
 	state <- get
 	return (Internals.repoqueue state)
+
+{- Runs (and empties) the queue. -}
+queueRun :: Annex ()
+queueRun = do
+	state <- get
+	let q = Internals.repoqueue state
+	g <- gitRepo
+	liftIO $ GitQueue.run g q
+	put state { Internals.repoqueue = GitQueue.empty }
+
+{- Changes a git config setting in both internal state and .git/config -}
+setConfig :: String -> String -> Annex ()
+setConfig key value = do
+	g <- Annex.gitRepo
+	liftIO $ Git.run g ["config", key, value]
+	-- re-read git config and update the repo's state
+	g' <- liftIO $ Git.configRead g Nothing
+	Annex.gitRepoChange g'

Backend.hs

@@ -31,13 +31,13 @@ import Control.Monad.State
 import IO (try)
 import System.FilePath
 import System.Posix.Files
-import Core
 
 import Locations
 import qualified GitRepo as Git
 import qualified Annex
 import Types
 import qualified TypeInternals as Internals
+import Messages
 
 {- List of backends in the order to try them when storing a new key. -}
 list :: Annex [Backend]

Backend/File.hs

@@ -25,6 +25,7 @@ import qualified GitRepo as Git
 import Core
 import qualified Annex
 import UUID
+import Messages
 
 backend :: Backend
 backend = Backend {

Backend/SHA1.hs

@@ -14,7 +14,7 @@ import System.IO
 
 import qualified Backend.File
 import TypeInternals
-import Core
+import Messages
 
 backend :: Backend
 backend = Backend.File.backend {

Backend/URL.hs

@@ -11,8 +11,8 @@ import Control.Monad.State (liftIO)
 import Data.String.Utils
 
 import TypeInternals
-import Core
 import Utility
+import Messages
 
 backend :: Backend
 backend = Backend {

Command.hs

@@ -9,7 +9,7 @@ module Command where
 
 import Types
 import qualified Backend
-import Core
+import Messages
 import qualified Annex
 
 {- A subcommand runs in four stages.

Command/Add.hs

@@ -9,16 +9,14 @@ module Command.Add where
 
 import Control.Monad.State (liftIO)
 import System.Posix.Files
-import System.Directory
 
 import Command
 import qualified Annex
-import Utility
-import Locations
 import qualified Backend
 import LocationLog
 import Types
 import Core
+import Messages
 
 {- The add subcommand annexes a file, storing it in a backend, and then
  - moving it into the annex directory and setting up the symlink pointing
@@ -41,11 +39,9 @@ perform (file, backend) = do
 
 cleanup :: FilePath -> Key -> SubCmdCleanup
 cleanup file key = do
+	moveAnnex key file
 	logStatus key ValuePresent
-	g <- Annex.gitRepo
+
-	let dest = annexLocation g key
-	liftIO $ createDirectoryIfMissing True (parentDir dest)
-	liftIO $ renameFile file dest
 	link <- calcGitLink file key
 	liftIO $ createSymbolicLink link file
 	Annex.queue "add" [] file

Command/Drop.hs

@@ -7,16 +7,14 @@
 
 module Command.Drop where
 
-import Control.Monad.State (liftIO)
+import Control.Monad (when)
-import System.Directory
 
 import Command
-import qualified Annex
-import Locations
 import qualified Backend
 import LocationLog
 import Types
 import Core
+import Messages
 
 {- Indicates a file's content is not wanted anymore, and should be removed
  - if it's safe to do so. -}
@@ -38,13 +36,7 @@ perform key backend = do
 
 cleanup :: Key -> SubCmdCleanup
 cleanup key = do
-	logStatus key ValueMissing
 	inannex <- inAnnex key
-	if (inannex)
+	when (inannex) $ removeAnnex key
-		then do
+	logStatus key ValueMissing
-			g <- Annex.gitRepo
+	return True
-			let loc = annexLocation g key
-			liftIO $ removeFile loc
-			return True
-		else return True
-

Command/DropKey.hs

@@ -7,16 +7,13 @@
 
 module Command.DropKey where
 
-import Control.Monad.State (liftIO)
-import System.Directory
-
 import Command
 import qualified Annex
-import Locations
 import qualified Backend
 import LocationLog
 import Types
 import Core
+import Messages
 
 {- Drops cached content for a key. -}
 start :: SubCmdStartString
@@ -35,9 +32,7 @@ start keyname = do
 
 perform :: Key -> SubCmdPerform
 perform key = do
-	g <- Annex.gitRepo
+	removeAnnex key
-	let loc = annexLocation g key
-	liftIO $ removeFile loc
 	return $ Just $ cleanup key
 
 cleanup :: Key -> SubCmdCleanup

Command/Fix.hs

@@ -15,6 +15,7 @@ import Command
 import qualified Annex
 import Utility
 import Core
+import Messages
 
 {- Fixes the symlink to an annexed file. -}
 start :: SubCmdStartString

Command/FromKey.hs

@@ -18,6 +18,7 @@ import Utility
 import qualified Backend
 import Types
 import Core
+import Messages
 
 {- Adds a file pointing at a manually-specified key -}
 start :: SubCmdStartString

Command/Fsck.hs

@@ -8,19 +8,11 @@
 module Command.Fsck where
 
 import qualified Data.Map as M
-import System.Directory
-import System.Posix.Files
-import Monad (filterM)
-import Control.Monad.State (liftIO)
-import Data.Maybe
 
 import Command
 import Types
 import Core
-import Locations
+import Messages
-import qualified Annex
-import qualified GitRepo as Git
-import qualified Backend
 
 {- Checks the whole annex for problems. -}
 start :: SubCmdStart
@@ -71,22 +63,3 @@ unusedKeys = do
 
 existsMap :: Ord k => [k] -> M.Map k Int
 existsMap l = M.fromList $ map (\k -> (k, 1)) l
-
-getKeysPresent :: Annex [Key]
-getKeysPresent = do
-	g <- Annex.gitRepo
-	let top = annexDir g
-	contents <- liftIO $ getDirectoryContents top
-	files <- liftIO $ filterM (isreg top) contents
-	return $ map fileKey files
-	where
-		isreg top f = do
-			s <- getFileStatus $ top ++ "/" ++ f
-			return $ isRegularFile s
-
-getKeysReferenced :: Annex [Key]
-getKeysReferenced = do
-	g <- Annex.gitRepo
-	files <- liftIO $ Git.inRepo g $ Git.workTree g
-	keypairs <- mapM Backend.lookupFile files
-	return $ map fst $ catMaybes keypairs

Command/Get.hs

@@ -11,6 +11,7 @@ import Command
 import qualified Backend
 import Types
 import Core
+import Messages
 
 {- Gets an annexed file from one of the backends. -}
 start :: SubCmdStartString

Command/Init.hs

@@ -15,6 +15,8 @@ import qualified Annex
 import Core
 import qualified GitRepo as Git
 import UUID
+import Version
+import Messages
 
 {- Stores description for the repository etc. -}
 start :: SubCmdStartString
@@ -29,6 +31,7 @@ perform description = do
 	g <- Annex.gitRepo
 	u <- getUUID g
 	describeUUID u description
+	setVersion
 	liftIO $ gitAttributes g
 	liftIO $ gitPreCommitHook g
 	return $ Just $ cleanup

Command/Move.hs

@@ -20,6 +20,7 @@ import Core
 import qualified GitRepo as Git
 import qualified Remotes
 import UUID
+import Messages
 
 {- Move a file either --to or --from a repository.
  -
@@ -64,7 +65,7 @@ moveToPerform key = do
 			showNote $ show err
 			return Nothing
 		Right False -> do
-			Core.showNote $ "moving to " ++ (Git.repoDescribe remote) ++ "..."
+			showNote $ "moving to " ++ (Git.repoDescribe remote) ++ "..."
 			let tmpfile = (annexTmpLocation remote) ++ (keyFile key)
 			ok <- Remotes.copyToRemote remote key tmpfile
 			if (ok)
@@ -112,7 +113,7 @@ moveFromPerform key = do
 	if (ishere)
 		then return $ Just $ moveFromCleanup remote key
 		else do
-			Core.showNote $ "moving from " ++ (Git.repoDescribe remote) ++ "..."
+			showNote $ "moving from " ++ (Git.repoDescribe remote) ++ "..."
 			ok <- getViaTmp key (Remotes.copyFromRemote remote key)
 			if (ok)
 				then return $ Just $ moveFromCleanup remote key

Command/SetKey.hs

@@ -13,29 +13,30 @@ import Control.Monad (when)
 import Command
 import qualified Annex
 import Utility
-import Locations
 import qualified Backend
 import LocationLog
 import Types
 import Core
+import Messages
 
 {- Sets cached content for a key. -}
 start :: SubCmdStartString
-start tmpfile = do
+start file = do
 	keyname <- Annex.flagGet "key"
 	when (null keyname) $ error "please specify the key with --key"
 	backends <- Backend.list
 	let key = genKey (backends !! 0) keyname
-	showStart "setkey" tmpfile
+	showStart "setkey" file
-	return $ Just $ perform tmpfile key
+	return $ Just $ perform file key
 perform :: FilePath -> Key -> SubCmdPerform
-perform tmpfile key = do
+perform file key = do
-	g <- Annex.gitRepo
+	-- the file might be on a different filesystem, so mv is used
-	let loc = annexLocation g key
+	-- rather than simply calling moveToObjectDir key file
-	ok <- liftIO $ boolSystem "mv" [tmpfile, loc]
+	ok <- getViaTmp key $ \dest -> liftIO $ boolSystem "mv" [file, dest]
-	if (not ok)
+	if ok
-		then error "mv failed!"
+		then return $ Just $ cleanup key
-		else return $ Just $ cleanup key
+		else error "mv failed!"
+
 cleanup :: Key -> SubCmdCleanup
 cleanup key = do
 	logStatus key ValuePresent

Command/Unannex.hs

@@ -13,12 +13,12 @@ import System.Directory
 import Command
 import qualified Annex
 import Utility
-import Locations
 import qualified Backend
 import LocationLog
 import Types
 import Core
 import qualified GitRepo as Git
+import Messages
 
 {- The unannex subcommand undoes an add. -}
 start :: SubCmdStartString
@@ -37,12 +37,14 @@ perform file key backend = do
 
 cleanup :: FilePath -> Key -> SubCmdCleanup
 cleanup file key = do
-	logStatus key ValueMissing
 	g <- Annex.gitRepo
-	let src = annexLocation g key
+
 	liftIO $ removeFile file
 	liftIO $ Git.run g ["rm", "--quiet", file]
 	-- git rm deletes empty directories; put them back
 	liftIO $ createDirectoryIfMissing True (parentDir file)
-	liftIO $ renameFile src file
+
+	fromAnnex key file
+	logStatus key ValueMissing
+
 	return True

Core.hs

@@ -8,12 +8,12 @@
 module Core where
 
 import IO (try)
-import System.IO
 import System.Directory
 import Control.Monad.State (liftIO)
 import System.Path
-import Data.String.Utils
+import Control.Monad (when, unless, filterM)
-import Control.Monad (when, unless)
+import System.Posix.Files
+import Data.Maybe
 
 import Types
 import Locations
@@ -22,7 +22,10 @@ import UUID
 import qualified GitRepo as Git
 import qualified GitQueue
 import qualified Annex
+import qualified Backend
 import Utility
+import Messages
+import Version
 
 {- Runs a list of Annex actions. Catches IO errors and continues
  - (but explicitly thrown errors terminate the whole command).
@@ -46,21 +49,20 @@ tryRun' _ errnum [] =
 startup :: Annex Bool
 startup = do
 	prepUUID
+	autoUpgrade
 	return True
 
 {- When git-annex is done, it runs this. -}
 shutdown :: Annex Bool
 shutdown = do
-	g <- Annex.gitRepo
-
-	-- Runs all queued git commands.
 	q <- Annex.queueGet
 	unless (q == GitQueue.empty) $ do
-		verbose $ liftIO $ putStrLn "Recording state in git..."
+		showSideAction "Recording state in git..."
-		liftIO $ GitQueue.run g q
+		Annex.queueRun
 
 	-- clean up any files left in the temp directory, but leave
 	-- the tmp directory itself
+	g <- Annex.gitRepo
 	let tmp = annexTmpLocation g
 	exists <- liftIO $ doesDirectoryExist tmp
 	when (exists) $ liftIO $ removeDirectoryRecursive tmp
@@ -137,13 +139,12 @@ logStatus key status = do
 getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool
 getViaTmp key action = do
 	g <- Annex.gitRepo
-	let dest = annexLocation g key
 	let tmp = annexTmpLocation g ++ keyFile key
 	liftIO $ createDirectoryIfMissing True (parentDir tmp)
 	success <- action tmp
 	if (success)
 		then do
-			liftIO $ renameFile tmp dest
+			moveAnnex key tmp
 			logStatus key ValuePresent
 			return True
 		else do
@@ -151,36 +152,113 @@ getViaTmp key action = do
 			-- to resume its transfer
 			return False
 
-{- Output logging -}
+{- Removes the write bits from a file. -}
-verbose :: Annex () -> Annex ()
+preventWrite :: FilePath -> IO ()
-verbose a = do
+preventWrite f = unsetFileMode f writebits
-	q <- Annex.flagIsSet "quiet"
-	unless q a
-showStart :: String -> String -> Annex ()
-showStart command file = verbose $ do
-	liftIO $ putStr $ command ++ " " ++ file ++ " "
-	liftIO $ hFlush stdout
-showNote :: String -> Annex ()
-showNote s = verbose $ do
-	liftIO $ putStr $ "(" ++ s ++ ") "
-	liftIO $ hFlush stdout
-showProgress :: Annex ()
-showProgress = verbose $ liftIO $ putStr "\n"
-showLongNote :: String -> Annex ()
-showLongNote s = verbose $ do
-	liftIO $ putStr $ "\n" ++ indented
 	where
-		indented = join "\n" $ map (\l -> "  " ++ l) $ lines s 
+		writebits = foldl unionFileModes ownerWriteMode
-showEndOk :: Annex ()
+					[groupWriteMode, otherWriteMode]
-showEndOk = verbose $ do
-	liftIO $ putStrLn "ok"
-showEndFail :: Annex ()
-showEndFail = verbose $ do
-	liftIO $ putStrLn "\nfailed"
 
-{- Exception pretty-printing. -}
+{- Turns a file's write bit back on. -}
-showErr :: (Show a) => a -> Annex ()
+allowWrite :: FilePath -> IO ()
-showErr e = warning $ show e
+allowWrite f = do
+	s <- getFileStatus f
+	setFileMode f $ (fileMode s) `unionFileModes` ownerWriteMode
 
-warning :: String -> Annex ()
+{- Moves a file into .git/annex/objects/ -}
-warning s = liftIO $ hPutStrLn stderr $ "git-annex: " ++ s
+moveAnnex :: Key -> FilePath -> Annex ()
+moveAnnex key src = do
+	g <- Annex.gitRepo
+	let dest = annexLocation g key
+	let dir = parentDir dest
+	liftIO $ do
+		createDirectoryIfMissing True dir
+		renameFile src dest
+		preventWrite dest
+		preventWrite dir
+
+{- Removes a key's file from .git/annex/objects/ -}
+removeAnnex :: Key -> Annex ()
+removeAnnex key = do
+	g <- Annex.gitRepo
+	let file = annexLocation g key
+	let dir = parentDir file
+	liftIO $ do
+		allowWrite dir
+		removeFile file
+		removeDirectory dir
+
+{- Moves a key's file out of .git/annex/objects/ -}
+fromAnnex :: Key -> FilePath -> Annex ()
+fromAnnex key dest = do
+	g <- Annex.gitRepo
+	let file = annexLocation g key
+	let dir = parentDir file
+	liftIO $ do
+		allowWrite dir
+		allowWrite file
+		renameFile file dest
+		removeDirectory dir
+
+{- List of keys whose content exists in .git/annex/objects/ -}
+getKeysPresent :: Annex [Key]
+getKeysPresent = do
+	g <- Annex.gitRepo
+	getKeysPresent' $ annexObjectDir g
+getKeysPresent' :: FilePath -> Annex [Key]
+getKeysPresent' dir = do
+	contents <- liftIO $ getDirectoryContents dir
+	files <- liftIO $ filterM isreg contents
+	return $ map fileKey files
+	where
+		isreg f = do
+			s <- getFileStatus $ dir ++ "/" ++ f
+			return $ isRegularFile s
+
+{- List of keys referenced by symlinks in the git repo. -}
+getKeysReferenced :: Annex [Key]
+getKeysReferenced = do
+	g <- Annex.gitRepo
+	files <- liftIO $ Git.inRepo g $ Git.workTree g
+	keypairs <- mapM Backend.lookupFile files
+	return $ map fst $ catMaybes keypairs
+
+{- Uses the annex.version git config setting to automate upgrades. -}
+autoUpgrade :: Annex ()
+autoUpgrade = do
+	version <- getVersion
+	case version of
+		Just "0" -> upgradeFrom0
+		Nothing -> return () -- repo not initted yet, no version
+		Just v | v == currentVersion -> return ()
+		Just _ -> error "this version of git-annex is too old for this git repository!"
+
+upgradeFrom0 :: Annex ()
+upgradeFrom0 = do
+	showSideAction "Upgrading object directory layout..."
+	g <- Annex.gitRepo
+
+	-- do the reorganisation of the files
+	let olddir = annexDir g
+	keys <- getKeysPresent' olddir
+	_ <- mapM (\k -> moveAnnex k $ olddir ++ "/" ++ keyFile k) keys
+
+	-- update the symlinks to the files
+	files <- liftIO $ Git.inRepo g $ Git.workTree g
+	fixlinks files
+	Annex.queueRun
+
+	setVersion
+
+	where
+		fixlinks [] = return ()
+		fixlinks (f:fs) = do
+			r <- Backend.lookupFile f
+			case r of
+				Nothing -> return ()
+				Just (k, _) -> do
+					link <- calcGitLink f k
+					liftIO $ removeFile f
+					liftIO $ createSymbolicLink link f
+					Annex.queue "add" [] f
+			fixlinks fs

Locations.hs

@@ -13,7 +13,10 @@ module Locations (
 	annexLocation,
 	annexLocationRelative,
 	annexTmpLocation,
-	annexDir
+	annexDir,
+	annexObjectDir,
+
+	prop_idempotent_fileKey
 ) where
 
 import Data.String.Utils
@@ -28,12 +31,7 @@ stateLoc = ".git-annex/"
 gitStateDir :: Git.Repo -> FilePath
 gitStateDir repo = (Git.workTree repo) ++ "/" ++ stateLoc
 
-{- An annexed file's content is stored in 
+{- Annexed file's absolute location. -}
- - /path/to/repo/.git/annex/<key>, where <key> is of the form
- - <backend:fragment>
- -
- - That allows deriving the key and backend by looking at the symlink to it.
- -}
 annexLocation :: Git.Repo -> Key -> FilePath
 annexLocation r key = 
 	(Git.workTree r) ++ "/" ++ (annexLocationRelative key)
@@ -42,7 +40,9 @@ annexLocation r key =
  -
  - Note: Assumes repo is NOT bare.-}
 annexLocationRelative :: Key -> FilePath
-annexLocationRelative key = ".git/annex/" ++ (keyFile key)
+annexLocationRelative key = ".git/annex/objects/" ++ f ++ "/" ++ f
+	where
+		f = keyFile key
 
 {- The annex directory of a repository.
  -
@@ -50,6 +50,11 @@ annexLocationRelative key = ".git/annex/" ++ (keyFile key)
 annexDir :: Git.Repo -> FilePath
 annexDir r = Git.workTree r ++ "/.git/annex"
 
+{- The part of the annex directory where file contents are stored.
+ -}
+annexObjectDir :: Git.Repo -> FilePath
+annexObjectDir r = annexDir r ++ "/objects"
+
 {- .git-annex/tmp is used for temp files -}
 annexTmpLocation :: Git.Repo -> FilePath
 annexTmpLocation r = annexDir r ++ "/tmp/"
@@ -65,10 +70,15 @@ annexTmpLocation r = annexDir r ++ "/tmp/"
  -     is one to one.
  - -}
 keyFile :: Key -> FilePath
-keyFile key = replace "/" "%" $ replace "%" "&s" $ replace "&" "&a" $ show key
+keyFile key = replace "/" "%" $ replace "%" "&s" $ replace "&" "&a"  $ show key
 
 {- Reverses keyFile, converting a filename fragment (ie, the basename of
  - the symlink target) into a key. -}
 fileKey :: FilePath -> Key
 fileKey file = read $
 	replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file
+
+{- for quickcheck -}
+prop_idempotent_fileKey :: String -> Bool
+prop_idempotent_fileKey s = k == (fileKey $ keyFile k)
+	where k = read $ "test:" ++ s

Messages.hs

@@ -0,0 +1,57 @@
+{- git-annex output messages
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Messages where
+
+import Control.Monad.State (liftIO)
+import System.IO
+import Control.Monad (unless)
+import Data.String.Utils
+
+import Types
+import qualified Annex
+
+verbose :: Annex () -> Annex ()
+verbose a = do
+	q <- Annex.flagIsSet "quiet"
+	unless q a
+
+showSideAction :: String -> Annex ()
+showSideAction s = verbose $ liftIO $ putStrLn $ "(" ++ s ++ ")"
+
+showStart :: String -> String -> Annex ()
+showStart command file = verbose $ do
+	liftIO $ putStr $ command ++ " " ++ file ++ " "
+	liftIO $ hFlush stdout
+
+showNote :: String -> Annex ()
+showNote s = verbose $ do
+	liftIO $ putStr $ "(" ++ s ++ ") "
+	liftIO $ hFlush stdout
+
+showProgress :: Annex ()
+showProgress = verbose $ liftIO $ putStr "\n"
+
+showLongNote :: String -> Annex ()
+showLongNote s = verbose $ do
+	liftIO $ putStr $ "\n" ++ indented
+	where
+		indented = join "\n" $ map (\l -> "  " ++ l) $ lines s 
+showEndOk :: Annex ()
+showEndOk = verbose $ do
+	liftIO $ putStrLn "ok"
+
+showEndFail :: Annex ()
+showEndFail = verbose $ do
+	liftIO $ putStrLn "\nfailed"
+
+{- Exception pretty-printing. -}
+showErr :: (Show a) => a -> Annex ()
+showErr e = warning $ show e
+
+warning :: String -> Annex ()
+warning s = liftIO $ hPutStrLn stderr $ "git-annex: " ++ s

Remotes.hs

@@ -36,6 +36,7 @@ import Locations
 import UUID
 import Utility
 import qualified Core
+import Messages
 
 {- Human visible list of remotes. -}
 list :: [Git.Repo] -> String
@@ -64,7 +65,7 @@ keyPossibilities key = do
 			let expensive = filter Git.repoIsUrl allremotes
 			doexpensive <- filterM cachedUUID expensive
 			unless (null doexpensive) $ do
-				Core.showNote $ "getting UUID for " ++
+				showNote $ "getting UUID for " ++
 					(list doexpensive) ++ "..."
 			let todo = cheap ++ doexpensive
 			if (not $ null todo)
@@ -93,7 +94,7 @@ inAnnex r key = do
 			a <- Annex.new r []
 			Annex.eval a (Core.inAnnex key)
 		checkremote = do
-			Core.showNote ("checking " ++ Git.repoDescribe r ++ "...")
+			showNote ("checking " ++ Git.repoDescribe r ++ "...")
 			inannex <- runCmd r "test" ["-e", annexLocation r key]
 			-- XXX Note that ssh failing and the file not existing
 			-- are not currently differentiated.
@@ -228,7 +229,7 @@ sshLocation r file = (Git.urlHost r) ++ ":" ++ shellEscape file
 scp :: Git.Repo -> [String] -> Annex Bool
 scp r params = do
 	scpoptions <- repoConfig r "scp-options" ""
-	Core.showProgress -- make way for scp progress bar
+	showProgress -- make way for scp progress bar
 	liftIO $ boolSystem "scp" $ "-p":(words scpoptions) ++ params
 
 {- Runs a command in a remote, using ssh if necessary.

UUID.hs

@@ -65,7 +65,7 @@ getUUID r = do
 	where
 		uncached = Git.configGet r "annex.uuid" ""
 		cached g = Git.configGet g cachekey ""
-		updatecache g u = when (g /= r) $ setConfig cachekey u
+		updatecache g u = when (g /= r) $ Annex.setConfig cachekey u
 		cachekey = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid"
 
 {- Make sure that the repo has an annex.uuid setting. -}
@@ -75,16 +75,7 @@ prepUUID = do
 	u <- getUUID g
 	when ("" == u) $ do
 		uuid <- liftIO $ genUUID
-		setConfig configkey uuid
+		Annex.setConfig configkey uuid
-
-{- Changes a git config setting in both internal state and .git/config -}
-setConfig :: String -> String -> Annex ()
-setConfig key value = do
-	g <- Annex.gitRepo
-	liftIO $ Git.run g ["config", key, value]
-	-- re-read git config and update the repo's state
-	g' <- liftIO $ Git.configRead g Nothing
-	Annex.gitRepoChange g'
 
 {- Filters a list of repos to ones that have listed UUIDs. -}
 reposByUUID :: [Git.Repo] -> [UUID] -> Annex [Git.Repo]

Utility.hs

@@ -11,17 +11,21 @@ module Utility (
 	relPathCwdToDir,
 	relPathDirToDir,
 	boolSystem,
-	shellEscape
+	shellEscape,
+	unsetFileMode
 ) where
 
 import System.IO
 import System.Exit
 import System.Posix.Process
 import System.Posix.Signals
+import System.Posix.Files
+import System.Posix.Types
 import Data.String.Utils
 import System.Path
 import System.FilePath
 import System.Directory
+import Foreign (complement)
 
 {- A version of hgetContents that is not lazy. Ensures file is 
  - all read before it gets closed. -}
@@ -115,3 +119,10 @@ shellEscape f = "'" ++ escaped ++ "'"
 	where
 		-- replace ' with '"'"'
 		escaped = join "'\"'\"'" $ split "'" f
+
+{- Removes a FileMode from a file.
+ - For example, call with otherWriteMode to chmod o-w -}
+unsetFileMode :: FilePath -> FileMode -> IO ()
+unsetFileMode f m = do
+	s <- getFileStatus f
+	setFileMode f $ (fileMode s) `intersectFileModes` (complement m)

Version.hs

@@ -0,0 +1,39 @@
+{- git-annex repository versioning
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Version where
+
+import Control.Monad.State (liftIO)
+import System.Directory
+
+import Types
+import qualified Annex
+import qualified GitRepo as Git
+import Locations
+
+currentVersion :: String
+currentVersion = "1"
+
+versionField :: String
+versionField = "annex.version"
+
+getVersion :: Annex (Maybe String)
+getVersion = do
+	g <- Annex.gitRepo
+	let v = Git.configGet g versionField ""
+	if (not $ null v)
+		then return $ Just v
+		else do
+			-- version 0 was not recorded in .git/config;
+			-- such a repo should have an annexDir
+			d <- liftIO $ doesDirectoryExist $ annexDir g
+			if (d)
+				then return $ Just "0"
+				else return Nothing -- no version yet
+
+setVersion :: Annex ()
+setVersion = Annex.setConfig versionField currentVersion

debian/changelog

@@ -3,8 +3,19 @@ git-annex (0.04) UNRELEASED; urgency=low
   * Add checkout subcommand, which allows checking out file content
     in preparation of changing it.
   * Add uncheckout subcommand.
+  * Add build dep on libghc6-testpack-dev.
+  * Add annex.version, which will be used to automate upgrades
+    between incompatable versions.
+  * Reorganised the layout of .git/annex/
+  * The new layout will be automatically upgraded to the first time
+    git-annex is used in a repository with the old layout.
+  * Note that git-annex 0.04 cannot transfer content from old repositories
+    that have not yet been upgraded.
+  * Annexed file contents are now made unwritable and put in unwriteable
+    directories, to avoid them accidentially being removed or modified.
+    (Thanks Josh Triplett for the idea.)
 
- -- Joey Hess <joeyh@debian.org>  Sun, 07 Nov 2010 21:01:29 -0400
+ -- Joey Hess <joeyh@debian.org>  Mon, 08 Nov 2010 12:36:39 -0400
 
 git-annex (0.03) unstable; urgency=low
 

debian/control

@@ -1,7 +1,7 @@
 Source: git-annex
 Section: utils
 Priority: optional
-Build-Depends: debhelper (>= 7.0.50), ghc6, libghc6-missingh-dev, ikiwiki
+Build-Depends: debhelper (>= 7.0.50), ghc6, libghc6-missingh-dev, libghc6-testpack-dev, ikiwiki
 Maintainer: Joey Hess <joeyh@debian.org>
 Standards-Version: 3.9.1
 Vcs-Git: git://git.kitenet.net/git-annex

doc/backends.mdwn

@@ -10,14 +10,15 @@ Multiple pluggable backends are supported, and a single repository
 can use different backends for different files.
 
 * `WORM` ("Write Once, Read Many") This backend stores the file's content
-  only in `.git/annex/`, and assumes that any file with the same basename,
+  only in `.git/annex/objects/`, and assumes that any file with the same
-  size, and modification time has the same content. So with this backend,
+  basename, size, and modification time has the same content. So with
-  files can be moved around, but should never be added to or changed.
+  this backend, files can be moved around, but should never be added to
-  This is the default, and the least expensive backend.
+  or changed. This is the default, and the least expensive backend.
 * `SHA1` -- This backend stores the file's content in
-  `.git/annex/`, with a name based on its sha1 checksum. This backend allows
+  `.git/annex/objects/`, with a name based on its sha1 checksum. This backend
-  modifications of files to be tracked. Its need to generate checksums
+  allows modifications of files to be tracked. Its need to generate checksums
   can make it slower for large files.
+  for use.
 * `URL` -- This backend downloads the file's content from an external URL.
 
 The `annex.backends` git-config setting can be used to list the backends

doc/git-annex.mdwn

@@ -219,6 +219,8 @@ Here are all the supported configuration settings.
   to talk to this repository.
 * `annex.scp-options` and `annex.ssh-options` -- Default scp and ssh
   options to use if a remote does not have specific options.
+* `annex.version` -- Automatically maintained, and used to automate upgrades
+  between versions.
 
 The backend used when adding a new file to the annex can be configured
 on a per-file-type basis via the `.gitattributes` file. In the file,
@@ -233,7 +235,7 @@ but the SHA1 backend for ogg files:
 
 These files are used, in your git repository:
 
-`.git/annex/` contains the annexed file contents that are currently
+`.git/annex/objects/` contains the annexed file contents that are currently
 available. Annexed files in your git repository symlink to that content.
 
 `.git-annex/uuid.log` is used to map between repository UUID and

doc/todo/immutable_annexed_files.mdwn

@@ -4,3 +4,5 @@
 > josh: Oh, I just thought of another slightly crazy but handy idea.
 > josh: I'd hate to run into a program which somehow followed the symlink and then did an unlink to replace the file.
 > josh: To break that, you could create a new directory under annex's internal directory for each file, and make the directory have no write permission.
+
+[[done]] and done --[[Joey]] 

test.hs

@@ -5,9 +5,11 @@ import Test.HUnit
 import Test.HUnit.Tools
 
 import GitRepo
+import Locations
 
 alltests = [
-	qctest "prop_idempotent_deencode" prop_idempotent_deencode
+	qctest "prop_idempotent_deencode" prop_idempotent_deencode,
+	qctest "prop_idempotent_fileKey" prop_idempotent_fileKey
 	]
 
 main = runVerboseTests (TestList alltests)