bugfixes

Annex.hs

@@ -24,15 +24,6 @@ import UUID
 import LocationLog
 import Types
 
-{- An annexed file's content is stored somewhere under .git/annex/,
- - based on the key. Since the symlink is user-visible, the filename
- - used should be as close to the key as possible, in case the key is a
- - filename or url. Just escape "/" in the key name, to keep a flat
- - tree of files and avoid issues with files ending with "/" etc. -}
-annexLocation :: State -> Key -> FilePath
-annexLocation state key = gitDir (repo state) ++ "/annex/" ++ (transform key)
-	where transform s = replace "/" "%" $ replace "%" "%%" s
-
 {- Checks if a given key is currently present in the annexLocation -}
 inAnnex :: State -> Key -> IO Bool
 inAnnex state key = doesFileExist $ annexLocation state key
@@ -62,15 +53,18 @@ annexFile state file = do
 			stored <- storeFile state file
 			case (stored) of
 				Nothing -> error $ "no backend could store: " ++ file
-				Just key -> symlink key
+				Just (key, backend) -> setup key backend
 	where
-		symlink key = do
+		setup key backend = do
 			let dest = annexLocation state key
 			createDirectoryIfMissing True (parentDir dest)
 			renameFile file dest
-			logChange (repo state) file (getUUID (repo state)) FilePresent
 			createSymbolicLink dest file
-			gitAdd (repo state) file
+			gitRun (repo state) ["add", file, bfile]
+			gitRun (repo state) ["commit", "-m", 
+				("git-annex annexed " ++ file), file, bfile]
+			logStatus state key ValuePresent
+				where bfile = backendFile state backend file
 		checkLegal file = do
 			s <- getSymbolicLinkStatus file
 			if ((isSymbolicLink s) || (not $ isRegularFile s))
@@ -87,11 +81,17 @@ unannexFile state file = do
 			mkey <- dropFile state file
 			case (mkey) of
 				Nothing -> return ()
-				Just key -> do
+				Just (key, backend) -> do
 					let src = annexLocation state key
 					removeFile file
+					gitRun (repo state) ["rm", file, bfile]
+					gitRun (repo state) ["commit", "-m",
+						("git-annex unannexed " ++ file),
+						file, bfile]
 					renameFile src file
+					logStatus state key ValueMissing
 					return ()
+						where bfile = backendFile state backend file
 
 {- Transfers the file from a remote. -}
 annexGetFile :: State -> FilePath -> IO ()
@@ -109,7 +109,9 @@ annexGetFile state file = do
 					createDirectoryIfMissing True (parentDir dest)
 					success <- retrieveFile state file dest
 					if (success)
-						then return ()
+						then do
+							logStatus state key ValuePresent
+							return ()
 						else error $ "failed to get " ++ file
 
 {- Indicates a file is wanted. -}
@@ -132,17 +134,28 @@ annexPullRepo state reponame = do error "not implemented" -- TODO
 gitPrep :: GitRepo -> IO ()
 gitPrep repo = do
 	-- configure git to use union merge driver on state files
-	let attrLine = stateLoc ++ "/*.log merge=union"
-	let attributes = gitAttributes repo
 	exists <- doesFileExist attributes
 	if (not exists)
 		then do
 			writeFile attributes $ attrLine ++ "\n"
-			gitAdd repo attributes
+			commit
 		else do
 			content <- readFile attributes
 			if (all (/= attrLine) (lines content))
 				then do
 					appendFile attributes $ attrLine ++ "\n"
-					gitAdd repo attributes
+					commit
 				else return ()
+	where
+		attrLine = stateLoc ++ "/*.log merge=union"
+		attributes = gitAttributes repo
+		commit = do
+			gitRun repo ["add", attributes]
+			gitRun repo ["commit", "-m", "git-annex setup", 
+					attributes]
+
+{- Updates the LocationLog when a key's presence changes. -}
+logStatus state key status = do
+	f <- logChange (repo state) key (getUUID (repo state)) status
+	gitRun (repo state) ["add", f]
+	gitRun (repo state) ["commit", "-m", "git-annex log update", f]

Backend.hs

@@ -31,9 +31,8 @@ import GitRepo
 import Utility
 import Types
 
-{- Attempts to store a file in one of the backends, and returns
- - its key. -}
-storeFile :: State -> FilePath -> IO (Maybe Key)
+{- Attempts to store a file in one of the backends. -}
+storeFile :: State -> FilePath -> IO (Maybe (Key, Backend))
 storeFile state file = storeFile' (backends state) state file
 storeFile' [] _ _ = return Nothing
 storeFile' (b:bs) state file = do
@@ -46,7 +45,7 @@ storeFile' (b:bs) state file = do
 				then nextbackend
 				else do
 					recordKey state b file key
-					return $ Just key
+					return $ Just (key, b)
 	where
 		nextbackend = storeFile' bs state file
 
@@ -62,7 +61,7 @@ retrieveFile state file dest = do
 			(retrieveKeyFile b) state key dest
 
 {- Drops the key for a file from the backend that has it. -}
-dropFile :: State -> FilePath -> IO (Maybe Key)
+dropFile :: State -> FilePath -> IO (Maybe (Key, Backend))
 dropFile state file = do
 	result <- lookupBackend state file
 	case (result) of
@@ -71,7 +70,7 @@ dropFile state file = do
 			key <- lookupKey state b file
 			(removeKey b) state key
 			removeFile $ backendFile state b file
-			return $ Just key
+			return $ Just (key, b)
 
 {- Looks up the backend used for an already annexed file. -}
 lookupBackend :: State -> FilePath -> IO (Maybe Backend)
@@ -85,13 +84,6 @@ lookupBackend' (b:bs) state file = do
 		else
 			lookupBackend' bs state file
 
-{- Name of state file that holds the key for an annexed file,
- - using a given backend. -}
-backendFile :: State -> Backend -> FilePath -> String
-backendFile state backend file =
-	gitStateDir (repo state) ++ (gitRelative (repo state) file) ++ 
-		"." ++ (name backend)
-
 {- Checks if a file is available via a given backend. -}
 checkBackend :: Backend -> State -> FilePath -> IO (Bool)
 checkBackend backend state file = doesFileExist $ backendFile state backend file
@@ -106,7 +98,7 @@ lookupKey state backend file = do
 				then (reverse . (drop 1) . reverse) s
 				else s
 
-{- Records the key a backend uses for an annexed file. -}
+{- Records the key used for an annexed file. -}
 recordKey :: State -> Backend -> FilePath -> Key -> IO ()
 recordKey state backend file key = do
 	createDirectoryIfMissing True (parentDir record)

GitRepo.hs

@@ -15,8 +15,6 @@ module GitRepo (
 	gitRelative,
 	gitConfig,
 	gitConfigRead,
-	gitAdd,
-	gitRm,
 	gitRun,
 	gitAttributes
 ) where
@@ -128,14 +126,6 @@ gitRelative repo file = drop (length absrepo) absfile
 			Just f -> f
 			Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo
 
-{- Stages a changed/new file in git's index. -}
-gitAdd :: GitRepo -> FilePath -> IO ()
-gitAdd repo file = gitRun repo ["add", file]
-
-{- Removes a file. -}
-gitRm :: GitRepo -> FilePath -> IO ()
-gitRm repo file = gitRun repo ["rm", file]
-
 {- Constructs a git command line operating on the specified repo. -}
 gitCommandLine :: GitRepo -> [String] -> [String]
 gitCommandLine repo params = assertlocal repo $

LocationLog.hs

@@ -1,13 +1,13 @@
 {- git-annex location log
  -
- - git-annex keeps track of on which repository it last saw a file's content.
+ - git-annex keeps track of on which repository it last saw a value.
  - This can be useful when using it for archiving with offline storage.
  - When you indicate you --want a file, git-annex will tell you which
- - repositories have the file's content.
+ - repositories have the value.
  -
- - Location tracking information is stored in `.git-annex/filename.log`.
+ - Location tracking information is stored in `.git-annex/key.log`.
  - Repositories record their UUID and the date when they --get or --drop
- - a file's content.
+ - a value.
  -
  - A line of the log will look like: "date N UUID"
  - Where N=1 when the repo has the file, and 0 otherwise.
@@ -31,6 +31,7 @@ import Data.Char
 import GitRepo
 import Utility
 import UUID
+import Types
 import Locations
 
 data LogLine = LogLine {
@@ -39,17 +40,17 @@ data LogLine = LogLine {
 	uuid :: UUID
 } deriving (Eq)
 
-data LogStatus = FilePresent | FileMissing | Undefined
+data LogStatus = ValuePresent | ValueMissing | Undefined
 	deriving (Eq)
 
 instance Show LogStatus where
-	show FilePresent = "1"
-	show FileMissing = "0"
+	show ValuePresent = "1"
+	show ValueMissing = "0"
 	show Undefined = "undefined"
 
 instance Read LogStatus where
-	readsPrec _ "1" = [(FilePresent, "")]
-	readsPrec _ "0" = [(FileMissing, "")]
+	readsPrec _ "1" = [(ValuePresent, "")]
+	readsPrec _ "0" = [(ValueMissing, "")]
 	readsPrec _ _   = [(Undefined, "")]
 
 instance Show LogLine where
@@ -61,7 +62,7 @@ instance Read LogLine where
 	-- read without an exception being thrown.
 	-- Such lines have a status of Undefined.
 	readsPrec _ string = 
-		if (length w >= 3)
+		if (length w == 3)
 			then case (pdate) of
 				Just v -> good v
 				Nothing -> undefined
@@ -70,28 +71,23 @@ instance Read LogLine where
 			w = words string
 			date = w !! 0
 			status = read $ w !! 1
-			uuid = w !! 3
+			uuid = w !! 2
 			pdate = (parseTime defaultTimeLocale "%s%Qs" date) :: Maybe UTCTime
 
 			good v = ret $ LogLine (utcTimeToPOSIXSeconds v) status uuid
 			undefined = ret $ LogLine (0) Undefined ""
 			ret v = [(v, "")]
 
-{- Log a change in the presence of a file in a repository,
- - and add the log to git so it will propigate to other repos. -}
-logChange :: GitRepo -> FilePath -> UUID -> LogStatus -> IO ()
-logChange repo file uuid status = do
+{- Log a change in the presence of a key's value in a repository,
+ - and return the log filename. -}
+logChange :: GitRepo -> Key -> UUID -> LogStatus -> IO FilePath
+logChange repo key uuid status = do
 	log <- logNow status uuid
-	if (status == FilePresent)
-		-- file added; just append to log
-		then appendLog logfile log
-		-- file removed; compact log
-		else do
-			ls <- readLog logfile
-			writeLog logfile (log:ls)
-	gitAdd repo logfile
+	ls <- readLog logfile
+	writeLog logfile (compactLog $ log:ls)
+	return logfile
 	where
-		logfile = logFile repo file
+		logfile = logFile repo key
 
 {- Reads a log file.
  - Note that the LogLines returned may be in any order. -}
@@ -129,22 +125,22 @@ logNow status uuid = do
 	now <- getPOSIXTime
 	return $ LogLine now status uuid
 
-{- Returns the filename of the log file for a given annexed file. -}
-logFile :: GitRepo -> FilePath -> String
-logFile repo annexedFile = (gitStateDir repo) ++
-		(gitRelative repo annexedFile) ++ ".log"
+{- Returns the filename of the log file for a given key. -}
+logFile :: GitRepo -> Key -> String
+logFile repo key = 
+	(gitStateDir repo) ++ (gitRelative repo (keyFile key)) ++ ".log"
 
 {- Returns a list of repository UUIDs that, according to the log, have
- - the content of a file -}
-fileLocations :: GitRepo -> FilePath -> IO [UUID]
-fileLocations thisrepo file = do
-	lines <- readLog $ logFile thisrepo file
+ - the value of a key. -}
+keyLocations :: GitRepo -> Key -> IO [UUID]
+keyLocations thisrepo key = do
+	lines <- readLog $ logFile thisrepo key
 	return $ map uuid (filterPresent lines)
 
-{- Filters the list of LogLines to find ones where the file
+{- Filters the list of LogLines to find ones where the value
  - is (or should still be) present. -}
 filterPresent :: [LogLine] -> [LogLine]
-filterPresent lines = filter (\l -> FilePresent == status l) $ compactLog lines
+filterPresent lines = filter (\l -> ValuePresent == status l) $ compactLog lines
 
 {- Compacts a set of logs, returning a subset that contains the current
  - status. -}

Locations.hs

@@ -3,9 +3,14 @@
 
 module Locations (
 	gitStateDir,
-	stateLoc
+	stateLoc,
+	keyFile,
+	annexLocation,
+	backendFile
 ) where
 
+import Data.String.Utils
+import Types
 import GitRepo
 
 {- Long-term, cross-repo state is stored in files inside the .git-annex
@@ -13,3 +18,21 @@ import GitRepo
 stateLoc = ".git-annex"
 gitStateDir :: GitRepo -> FilePath
 gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/"
+
+{- Generates a filename that can be used to record a key somewhere to disk.
+ - Just escape "/" in the key name, to keep a flat
+ - tree of files and avoid issues with files ending with "/" etc. -}
+keyFile :: Key -> FilePath
+keyFile key = replace "/" "%" $ replace "%" "%%" key
+
+{- An annexed file's content is stored somewhere under .git/annex/,
+ - based on the key. -}
+annexLocation :: State -> Key -> FilePath
+annexLocation state key = gitDir (repo state) ++ "/annex/" ++ (keyFile key)
+
+{- Name of state file that holds the key for an annexed file,
+ - using a given backend. -}
+backendFile :: State -> Backend -> FilePath -> String
+backendFile state backend file =
+	gitStateDir (repo state) ++ (gitRelative (repo state) file) ++ 
+		"." ++ (name backend)

Types.hs

@@ -6,6 +6,7 @@ module Types (
 	Backend(..)
 ) where
 
+import Data.String.Utils
 import GitRepo
 
 -- git-annex's runtime state