From 91d319e849ca912e1ff77046cb277985db5844d3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 9 Oct 2010 14:06:25 -0400 Subject: moved from my doc repo --- git-annex.mdwn | 165 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 165 insertions(+) create mode 100644 git-annex.mdwn diff --git a/git-annex.mdwn b/git-annex.mdwn new file mode 100644 index 000000000..bc3550398 --- /dev/null +++ b/git-annex.mdwn @@ -0,0 +1,165 @@ +git-annex allows managing files with git, without checking the file +contents into git. This is useful when dealing with files larger than git +can currently easily handle, whether due to limitations in memory, +checksumming time, or disk space (only one copy need be stored of an +annexed file). + +Even without file content tracking, being able to manage file metadata with +git, move files around and delete files with versioned directory trees, and use +branches and distributed clone, are all very handy reasons to use git. And +annexed files can co-exist in the same git repository with regularly versioned +files, which is convenient for maintaining code, Makefiles, etc that are +associated with annexed files but that benefit from full revision control. + +Enough broad picture, here's how it actually looks: + +* `git annex --add $file` moves the file into `.git/annex/`, and replaces + it with a symlink pointing at the annexed file, and then calls `git add` + to version the *symlink*. (If the file has already been annexed, it does + nothing.) +* You can move the symlink around, copy it, delete it, etc, and commit changes + as desired using git. Reading the symlink will always get you the annexed + file content, or the link may be broken if the content is not currently + available. +* If you use normal git push/pull commands, the annexed file contents + won't be sent, but the symlinks will be. So different clones of a repository + can have different sets of annexed files available. +* `git annex --push $repository` pushes *all* annexed files to the specified + repository. +* `git annex --pull $repository` pulls *all* annexed files from the specified + repository. +* `git annex --want $file` indicates that you want access to a file's + content, without immediatly transferring it. +* `git annex --get $file` is used to transfer a specified file, and/or + files previously indicated with --want. If a configured repository has it, + or it is available from other key/value storage, it will be immediatly + downloaded. +* `git annex --drop $file` indicates that you no longer want the file's + content to be available in this repository. +* `git annex $file` is a shorthand for either --add or --get. If the file + is already known, it does --get, otherwise it does --add. + +## copies + +git-annex can be configured to try to keep N copies of a file's content +available across all repositories. By default, N is 1 (configured by +annex.numcopies). + +`git annex --drop` attempts to communicate with all other configured +repositories, to check that N copies of the file exist. If enough +repositories cannot be contacted, it will retain the file content. +You can later use `git annex --drop --retry` to retry pending drops. +Or you can use `git annex --drop --force $file` to force dropping of +file content. + +For example, consider three repositories: Server, Laptop, and USB. Both Server +and USB have a copy of a file, and N=1. If on Laptop, you `git annex --get +$file`, this will transfer it from either Server or USB (depending on which +is available), and there are now 3 copies of the file. + +Suppose you want to free up space on laptop again, and you --drop the file +there. If USB is connected, or Server can be contacted, git-annex can check +that it still has a copy of the file, and the content is removed from +Laptop. But if USB is currently disconnected, and Server also cannot be +contacted, it can't check that and will retain the file content. + +With N=2, in order to drop the file content from Laptop, it would need access +to both USB and Server. + +Note that different repositories can be configured with different values of +N. So just because Laptop has N=2, this does not prevent the number of +copies falling to 1, when USB and Server have N=1, and of they have the +only copies of a file. + +## the .git-annex directory + +The `.git-annex` directory at the top of the repository, is used to store +git-annex information that should be propigated between repositories. + +Data is stored here in files that are arranged to avoid conflicts in most +cases. A conflict could occur if a file with the same name but different +content was added to multiple clones. + +## key/value storage + +git-annex uses a key/value abstraction layer to allow files contents to be +stored in different ways. In theory, any key/value storage system could be +used to store the file contents, and git-annex would then retrieve them +as needed and put them in `.git/annex/`. + +When a file is annexed, a key is generated from its content and/or metadata. +This key can later be used to retrieve the file's content (its value). This +key generation must be stable for a given file content, name, and size. + +The mapping from filename to its key is stored in the .git-annex directory, +in a file named `$filename.$backend` + +Multiple pluggable backends are supported, and more than one can be used +to store different files' contents in a given repository. + +* `file` -- This backend stores the file's content in + `.git/annex/`, and assumes that any file with the same basename + has the same content. So with this backend, files can be moved around, + but should never be added to or changed. This is the default, and + the least expensive backend. +* `sha1sum` -- This backend stores the file's content in + `.git/annex/`, with a name based on its sha1 checksum. This backend allows + modifications of files to be tracked. Its need to generate checksums + can make it slow for large files. +* `url` -- This backend downloads the file's content from an external URL. + +## location tracking + +git-annex keeps track of on which repository it last saw a file's content. +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. + +Location tracking information is stored in `.git-annex/$filename.log`. +Repositories record their name and the date when they --get or --drop +a file's content. (Git is configured to use a union merge for this file, +so the lines may be in arbitrary order, but it will never conflict.) + +## configuration + +* `annex.numcopies` -- number of copies of files to keep +* `annex.backend` -- name of the default key/value backend to use to + store new files +* `annex.name` -- allows specifying a unique name for this repository. + If not specified, the name is derived from its directory's location and + the hostname. When a repository is on removable media it is useful to give + it a more stable name. Typically the name of a repository is the same + name configured as a git remote to allow pulling from that repository. +* `remote..annex-cost` -- When determining which repository to + transfer annexed files from or to, ones with lower costs are preferred. + The default cost is 50. Note that other factors may be configured + when pushing files to repositories, in particular, whether the repository + is on a filesystem with sufficient free space. + +## issues + +### symlinks + +If the symlink to annexed content is relative, moving it to a subdir will +break it. But it it's absolute, moving the git repo (or mounting its drive +elsewhere) will break it. Either: + +* Use relative links and need `git annex mv` to move (or post-commit + hook that caches moves and updates links). +* Use absolute links and need `git annex fixlinks` when location changes; + note that would also mean that git would see the symlink targets changed + and want to commit the change. + +### free space determination + +Need a way to tell how much free space is available on the disk containing +a given repository. The repository may be remote, so ssh may need to be +used. + +Similarly, need a way to tell the size of a file before downloading it from +remote, to check local disk space. + +### auto-drop files on rm + +When git-rm removed a file, it should get dropped too. Of course, it may +not be dropped right away, depending on number of copies available. -- cgit v1.2.3 From a667d99cd1aa90691ded4fc110a1e11e965fc3a8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 9 Oct 2010 19:22:40 -0400 Subject: first module --- LocationLog.hs | 81 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 81 insertions(+) create mode 100644 LocationLog.hs diff --git a/LocationLog.hs b/LocationLog.hs new file mode 100644 index 000000000..c756a17b0 --- /dev/null +++ b/LocationLog.hs @@ -0,0 +1,81 @@ +{- git-annex location log + - + - git-annex keeps track of on which repository it last saw a file's content. + - 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. + - + - Location tracking information is stored in `.git-annex/$filename.log`. + - Repositories record their name and the date when they --get or --drop + - a file's content. (Git is configured to use a union merge for this file, + - so the lines may be in arbitrary order, but it will never conflict.) + - + - A line of the log will look like: "date reponame filename" + - + -} + +module LocationLog where + +import Data.DateTime +import System.IO +import System.Posix.IO + +data LogLine = LogLine { + date :: DateTime, + repo :: String, + file :: String +} deriving (Eq) + +-- a special value representing a log file line that could not be parsed +unparsable = (LogLine (fromSeconds 0) "" "") + +instance Show LogLine where + show (LogLine date repo file) = unwords + [(show (toSeconds date)), repo, file] + +instance Read LogLine where + -- this parser is robust in that even unparsable log lines are + -- read without an exception being thrown + readsPrec _ string = if (length w >= 3) + then [((LogLine time repo file), "")] + else [(unparsable, "")] + where + time = fromSeconds $ read $ w !! 0 + repo = w !! 1 + file = unwords $ rest w + w = words string + rest (_:_:l) = l + +{- Reads a log file -} +readLog :: String -> IO [LogLine] +readLog file = do + h <- openLocked file ReadMode + s <- hGetContents h + -- hClose handle' -- TODO disabled due to lazy IO issue + -- filter out any unparsable lines + return $ filter ( /= unparsable ) $ map read $ lines s + +{- Adds a LogLine to a log file -} +writeLog :: String -> LogLine -> IO () +writeLog file line = do + h <- openLocked file AppendMode + hPutStrLn h $ show line + hClose h + +{- Let's just say that Haskell makes reading/writing a file with + - file locking excessively difficult. -} +openLocked file mode = do + handle <- openFile file mode + lockfd <- handleToFd handle -- closes handle + waitToSetLock lockfd (lockType mode, AbsoluteSeek, 0, 0) + handle' <- fdToHandle lockfd + return handle' + where + lockType ReadMode = ReadLock + lockType _ = WriteLock + +{- Generates a new log line with the current date. -} +logNow :: String -> String -> IO LogLine +logNow repo file = do + now <- getCurrentTime + return $ LogLine now repo file -- cgit v1.2.3 From 6b54817f2688cffc8751b3b1552dca0a34744e61 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 9 Oct 2010 21:06:46 -0400 Subject: second module! --- GitRepo.hs | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) create mode 100644 GitRepo.hs diff --git a/GitRepo.hs b/GitRepo.hs new file mode 100644 index 000000000..fece79785 --- /dev/null +++ b/GitRepo.hs @@ -0,0 +1,57 @@ +{- git repository handling -} + +module GitRepo where + +import Directory +import System.Directory +import Data.String.Utils + +{- Returns the path to the current repository's .git directory. + - (For a bare repository, that is the root of the repository.) -} +gitDir :: IO String +gitDir = do + repo <- repoTop + bare <- isBareRepo repo + if (bare) + then return repo + else return $ repo ++ "/.git" + +{- Finds the top of the current git repository, which may be in a parent + - directory. -} +repoTop :: IO String +repoTop = do + dir <- getCurrentDirectory + top <- seekUp dir isRepoTop + case top of + (Just dir) -> return dir + Nothing -> error "Not in a git repository." + +seekUp :: String -> (String -> IO Bool) -> IO (Maybe String) +seekUp dir want = do + ok <- want dir + if ok + then return (Just dir) + else case (parentDir dir) of + (Just d) -> seekUp d want + Nothing -> return Nothing + +parentDir :: String -> Maybe String +parentDir dir = + if length dirs > 0 + then Just ("/" ++ (join "/" $ take ((length dirs) - 1) dirs)) + else Nothing + where + dirs = filter (\x -> length x > 0) $ split "/" dir + +isRepoTop dir = do + r <- isGitRepo dir + b <- isBareRepo dir + return (r || b) + +isGitRepo dir = gitSignature dir ".git" ".git/config" +isBareRepo dir = gitSignature dir "objects" "config" + +gitSignature dir subdir file = do + s <- (doesDirectoryExist (dir ++ "/" ++ subdir)) + f <- (doesFileExist (dir ++ "/" ++ file)) + return (s && f) -- cgit v1.2.3 From c920505a52ab3c42b7892b7f7a1c5244c39e916f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 9 Oct 2010 22:09:10 -0400 Subject: add gitRelative function --- GitRepo.hs | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index fece79785..f1372bf3a 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -4,8 +4,25 @@ module GitRepo where import Directory import System.Directory +import System.Path import Data.String.Utils +{- Given a relative or absolute filename, calculates the name to use + - relative to a git repository directory (which must be absolute). + - This is the same form displayed and used by git. -} +gitRelative :: String -> String -> String +gitRelative file repo = drop (length absrepo) absfile + where + -- normalize both repo and file, so that repo + -- will be substring of file + absrepo = case (absNormPath "/" repo) of + Just f -> f ++ "/" + Nothing -> error $ "bad repo" ++ repo + absfile = case (secureAbsNormPath absrepo file) of + Just f -> f + Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo + + {- Returns the path to the current repository's .git directory. - (For a bare repository, that is the root of the repository.) -} gitDir :: IO String @@ -20,8 +37,8 @@ gitDir = do - directory. -} repoTop :: IO String repoTop = do - dir <- getCurrentDirectory - top <- seekUp dir isRepoTop + cwd <- getCurrentDirectory + top <- seekUp cwd isRepoTop case top of (Just dir) -> return dir Nothing -> error "Not in a git repository." -- cgit v1.2.3 From dcfb24e5b5764c8a7bde0a1410022a903ba3c99b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 9 Oct 2010 22:14:13 -0400 Subject: add logFile --- GitRepo.hs | 2 +- LocationLog.hs | 8 ++++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/GitRepo.hs b/GitRepo.hs index f1372bf3a..01e6746ae 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -11,7 +11,7 @@ import Data.String.Utils - relative to a git repository directory (which must be absolute). - This is the same form displayed and used by git. -} gitRelative :: String -> String -> String -gitRelative file repo = drop (length absrepo) absfile +gitRelative repo file = drop (length absrepo) absfile where -- normalize both repo and file, so that repo -- will be substring of file diff --git a/LocationLog.hs b/LocationLog.hs index c756a17b0..ab109460a 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -19,6 +19,7 @@ module LocationLog where import Data.DateTime import System.IO import System.Posix.IO +import GitRepo data LogLine = LogLine { date :: DateTime, @@ -79,3 +80,10 @@ logNow :: String -> String -> IO LogLine logNow repo file = do now <- getCurrentTime return $ LogLine now repo file + +{- Returns the filename of the log file for a given annexed file. -} +logFile :: String -> IO String +logFile annexedFile = do + repo <- repoTop + return $ repo ++ "/.git-annex/" ++ + (gitRelative repo annexedFile) ++ ".log" -- cgit v1.2.3 From 9ae522bb7689842e1d0251d486c22d26bb6461da Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 9 Oct 2010 22:29:16 -0400 Subject: add status field to log --- LocationLog.hs | 48 +++++++++++++++++++++++++++++++----------------- 1 file changed, 31 insertions(+), 17 deletions(-) diff --git a/LocationLog.hs b/LocationLog.hs index ab109460a..ff357aaec 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -10,7 +10,8 @@ - a file's content. (Git is configured to use a union merge for this file, - so the lines may be in arbitrary order, but it will never conflict.) - - - A line of the log will look like: "date reponame filename" + - A line of the log will look like: "date N reponame filename" + - Where N=1 when the repo has the file, and 0 otherwise. - -} @@ -21,31 +22,44 @@ import System.IO import System.Posix.IO import GitRepo +data LogStatus = FilePresent | FileMissing | Undefined + deriving (Eq) + +instance Show LogStatus where + show FilePresent = "1" + show FileMissing = "0" + show Undefined = "undefined" + +instance Read LogStatus where + readsPrec _ "1" = [(FilePresent, "")] + readsPrec _ "0" = [(FileMissing, "")] + readsPrec _ _ = [(Undefined, "")] + data LogLine = LogLine { date :: DateTime, + status :: LogStatus, repo :: String, file :: String } deriving (Eq) --- a special value representing a log file line that could not be parsed -unparsable = (LogLine (fromSeconds 0) "" "") - instance Show LogLine where - show (LogLine date repo file) = unwords - [(show (toSeconds date)), repo, file] + show (LogLine date status repo file) = unwords + [(show (toSeconds date)), (show status), repo, file] instance Read LogLine where - -- this parser is robust in that even unparsable log lines are - -- read without an exception being thrown + -- This parser is robust in that even unparsable log lines are + -- read without an exception being thrown. + -- Such lines have a status of Undefined. readsPrec _ string = if (length w >= 3) - then [((LogLine time repo file), "")] - else [(unparsable, "")] + then [((LogLine date status repo file), "")] + else [((LogLine (fromSeconds 0) Undefined "" ""), "")] where - time = fromSeconds $ read $ w !! 0 - repo = w !! 1 + date = fromSeconds $ read $ w !! 0 + status = read $ w !! 1 + repo = w !! 2 file = unwords $ rest w w = words string - rest (_:_:l) = l + rest (_:_:_:l) = l {- Reads a log file -} readLog :: String -> IO [LogLine] @@ -54,7 +68,7 @@ readLog file = do s <- hGetContents h -- hClose handle' -- TODO disabled due to lazy IO issue -- filter out any unparsable lines - return $ filter ( /= unparsable ) $ map read $ lines s + return $ filter (\l -> (status l) /= Undefined ) $ map read $ lines s {- Adds a LogLine to a log file -} writeLog :: String -> LogLine -> IO () @@ -76,10 +90,10 @@ openLocked file mode = do lockType _ = WriteLock {- Generates a new log line with the current date. -} -logNow :: String -> String -> IO LogLine -logNow repo file = do +logNow :: LogStatus -> String -> String -> IO LogLine +logNow status repo file = do now <- getCurrentTime - return $ LogLine now repo file + return $ LogLine now status repo file {- Returns the filename of the log file for a given annexed file. -} logFile :: String -> IO String -- cgit v1.2.3 From 011118dbdff84458a5f9eea05547d79fbf7e88ac Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 9 Oct 2010 22:46:35 -0400 Subject: adding file presence calculation code --- LocationLog.hs | 55 +++++++++++++++++++++++++++---------------------------- 1 file changed, 27 insertions(+), 28 deletions(-) diff --git a/LocationLog.hs b/LocationLog.hs index ff357aaec..911e4765b 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -5,12 +5,12 @@ - When you indicate you --want a file, git-annex will tell you which - repositories have the file's content. - - - Location tracking information is stored in `.git-annex/$filename.log`. + - Location tracking information is stored in `.git-annex/filename.log`. - Repositories record their name and the date when they --get or --drop - a file's content. (Git is configured to use a union merge for this file, - so the lines may be in arbitrary order, but it will never conflict.) - - - A line of the log will look like: "date N reponame filename" + - A line of the log will look like: "date N reponame" - Where N=1 when the repo has the file, and 0 otherwise. - -} @@ -19,8 +19,8 @@ module LocationLog where import Data.DateTime import System.IO -import System.Posix.IO import GitRepo +import Utility data LogStatus = FilePresent | FileMissing | Undefined deriving (Eq) @@ -38,28 +38,26 @@ instance Read LogStatus where data LogLine = LogLine { date :: DateTime, status :: LogStatus, - repo :: String, - file :: String + repo :: String } deriving (Eq) instance Show LogLine where - show (LogLine date status repo file) = unwords - [(show (toSeconds date)), (show status), repo, file] + show (LogLine date status repo) = unwords + [(show (toSeconds date)), (show status), repo] instance Read LogLine where -- This parser is robust in that even unparsable log lines are -- read without an exception being thrown. -- Such lines have a status of Undefined. readsPrec _ string = if (length w >= 3) - then [((LogLine date status repo file), "")] - else [((LogLine (fromSeconds 0) Undefined "" ""), "")] + then [((LogLine date status repo), "")] + else [((LogLine (fromSeconds 0) Undefined ""), "")] where date = fromSeconds $ read $ w !! 0 status = read $ w !! 1 - repo = w !! 2 - file = unwords $ rest w + repo = unwords $ rest w w = words string - rest (_:_:_:l) = l + rest (_:_:l) = l {- Reads a log file -} readLog :: String -> IO [LogLine] @@ -77,23 +75,11 @@ writeLog file line = do hPutStrLn h $ show line hClose h -{- Let's just say that Haskell makes reading/writing a file with - - file locking excessively difficult. -} -openLocked file mode = do - handle <- openFile file mode - lockfd <- handleToFd handle -- closes handle - waitToSetLock lockfd (lockType mode, AbsoluteSeek, 0, 0) - handle' <- fdToHandle lockfd - return handle' - where - lockType ReadMode = ReadLock - lockType _ = WriteLock - -{- Generates a new log line with the current date. -} -logNow :: LogStatus -> String -> String -> IO LogLine -logNow status repo file = do +{- Generates a new LogLine with the current date. -} +logNow :: LogStatus -> String -> IO LogLine +logNow status repo = do now <- getCurrentTime - return $ LogLine now status repo file + return $ LogLine now status repo {- Returns the filename of the log file for a given annexed file. -} logFile :: String -> IO String @@ -101,3 +87,16 @@ logFile annexedFile = do repo <- repoTop return $ repo ++ "/.git-annex/" ++ (gitRelative repo annexedFile) ++ ".log" + +{- Returns a list of repositories that, according to the log, have + - the content of a file -} +fileLocations :: String -> IO [String] +fileLocations file = do + log <- logFile file + lines <- readLog log + return $ map repo (filterPresent lines) + +{- Filters the list of LogLines to find repositories where the file + - is (or should still be) present. -} +filterPresent :: [LogLine] -> [LogLine] +filterPresent lines = -- cgit v1.2.3 From 381e6f84e5f4ddc64ed86f08064ebaf2313b18db Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 9 Oct 2010 23:35:05 -0400 Subject: robustness --- GitRepo.hs | 13 +++---------- LocationLog.hs | 26 +++++++++++++++++--------- 2 files changed, 20 insertions(+), 19 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index 01e6746ae..2e7fff22e 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -6,6 +6,7 @@ import Directory import System.Directory import System.Path import Data.String.Utils +import Utility {- Given a relative or absolute filename, calculates the name to use - relative to a git repository directory (which must be absolute). @@ -49,16 +50,8 @@ seekUp dir want = do if ok then return (Just dir) else case (parentDir dir) of - (Just d) -> seekUp d want - Nothing -> return Nothing - -parentDir :: String -> Maybe String -parentDir dir = - if length dirs > 0 - then Just ("/" ++ (join "/" $ take ((length dirs) - 1) dirs)) - else Nothing - where - dirs = filter (\x -> length x > 0) $ split "/" dir + "" -> return Nothing + d -> seekUp d want isRepoTop dir = do r <- isGitRepo dir diff --git a/LocationLog.hs b/LocationLog.hs index 911e4765b..b6c85113d 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -19,6 +19,7 @@ module LocationLog where import Data.DateTime import System.IO +import System.Directory import GitRepo import Utility @@ -55,22 +56,29 @@ instance Read LogLine where where date = fromSeconds $ read $ w !! 0 status = read $ w !! 1 - repo = unwords $ rest w + repo = unwords $ drop 2 w w = words string - rest (_:_:l) = l -{- Reads a log file -} +{- Reads a log file. + - Note that the LogLines returned may be in any order. -} readLog :: String -> IO [LogLine] readLog file = do - h <- openLocked file ReadMode - s <- hGetContents h - -- hClose handle' -- TODO disabled due to lazy IO issue - -- filter out any unparsable lines - return $ filter (\l -> (status l) /= Undefined ) $ map read $ lines s + exists <- doesFileExist file + if exists + then do + h <- openLocked file ReadMode + s <- hGetContents h + -- hClose handle' -- TODO disabled due to lazy IO issue + -- filter out any unparsable lines + return $ filter (\l -> (status l) /= Undefined ) + $ map read $ lines s + else do + return [] {- Adds a LogLine to a log file -} writeLog :: String -> LogLine -> IO () writeLog file line = do + createDirectoryIfMissing True (parentDir file) h <- openLocked file AppendMode hPutStrLn h $ show line hClose h @@ -99,4 +107,4 @@ fileLocations file = do {- Filters the list of LogLines to find repositories where the file - is (or should still be) present. -} filterPresent :: [LogLine] -> [LogLine] -filterPresent lines = +filterPresent lines = error "unimplimented" -- TODO -- cgit v1.2.3 From e64d1becf429489f8c6ded230e6e17b63a89c483 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 00:02:07 -0400 Subject: robustness fix avoid crash if the seconds field is not numeric --- LocationLog.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/LocationLog.hs b/LocationLog.hs index b6c85113d..db1fac144 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -20,6 +20,7 @@ module LocationLog where import Data.DateTime import System.IO import System.Directory +import Data.Char import GitRepo import Utility @@ -50,14 +51,15 @@ instance Read LogLine where -- This parser is robust in that even unparsable log lines are -- read without an exception being thrown. -- Such lines have a status of Undefined. - readsPrec _ string = if (length w >= 3) - then [((LogLine date status repo), "")] - else [((LogLine (fromSeconds 0) Undefined ""), "")] + readsPrec _ string = + if (length w >= 3 && all isDigit date) + then [((LogLine (fromSeconds $ read date) status repo), "")] + else [((LogLine (fromSeconds 0) Undefined ""), "")] where - date = fromSeconds $ read $ w !! 0 + w = words string + date = w !! 0 status = read $ w !! 1 repo = unwords $ drop 2 w - w = words string {- Reads a log file. - Note that the LogLines returned may be in any order. -} -- cgit v1.2.3 From d0e82d0b9218a9ff3a693e066c4320c08d4d1c47 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 00:18:10 -0400 Subject: add --- Utility.hs | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 Utility.hs diff --git a/Utility.hs b/Utility.hs new file mode 100644 index 000000000..05b06dea7 --- /dev/null +++ b/Utility.hs @@ -0,0 +1,29 @@ +{- git-annex utility functions + -} + +module Utility where + +import System.IO +import System.Posix.IO +import Data.String.Utils + +{- Let's just say that Haskell makes reading/writing a file with + - file locking excessively difficult. -} +openLocked file mode = do + handle <- openFile file mode + lockfd <- handleToFd handle -- closes handle + waitToSetLock lockfd (lockType mode, AbsoluteSeek, 0, 0) + handle' <- fdToHandle lockfd + return handle' + where + lockType ReadMode = ReadLock + lockType _ = WriteLock + +{- Returns the parent directory of a path. Parent of / is "" -} +parentDir :: String -> String +parentDir dir = + if length dirs > 0 + then "/" ++ (join "/" $ take ((length dirs) - 1) dirs) + else "" + where + dirs = filter (\x -> length x > 0) $ split "/" dir -- cgit v1.2.3 From c67521741abd9a49ebf43d6c649fe0356fa68fb3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 00:18:16 -0400 Subject: add --- .gitignore | 5 +++++ Makefile | 7 +++++++ demo.log | 8 ++++++++ git-annex.hs | 8 ++++++++ 4 files changed, 28 insertions(+) create mode 100644 .gitignore create mode 100644 Makefile create mode 100644 demo.log create mode 100644 git-annex.hs diff --git a/.gitignore b/.gitignore new file mode 100644 index 000000000..7dd8869b1 --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +*.o +*.hi +*.ho +*.a +git-annex diff --git a/Makefile b/Makefile new file mode 100644 index 000000000..8b7c9d3a0 --- /dev/null +++ b/Makefile @@ -0,0 +1,7 @@ +git-annex: + ghc --make git-annex + +clean: + rm -f git-annex *.o *.hi *.ho *.a + +.PHONY: git-annex diff --git a/demo.log b/demo.log new file mode 100644 index 000000000..251a84c52 --- /dev/null +++ b/demo.log @@ -0,0 +1,8 @@ +1286654242 1 repo +1286652724 0 foo +a a a +a 1 a +-1 a a +1286652724 1 foo +1286656282 1 foo +1286656282 0 repo diff --git a/git-annex.hs b/git-annex.hs new file mode 100644 index 000000000..a57e9e2db --- /dev/null +++ b/git-annex.hs @@ -0,0 +1,8 @@ +{- git-annex main program + - -} + +import LocationLog + +main = do + l <- readLog "demo.log" + putStrLn "hi" -- cgit v1.2.3 From 60c672e444decf59c20beb70b89f030ad9d62b3e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 02:22:35 -0400 Subject: strictness and handle closing --- LocationLog.hs | 7 +++---- Utility.hs | 4 ++++ 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/LocationLog.hs b/LocationLog.hs index db1fac144..c921a2005 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -12,7 +12,6 @@ - - A line of the log will look like: "date N reponame" - Where N=1 when the repo has the file, and 0 otherwise. - - -} module LocationLog where @@ -69,8 +68,8 @@ readLog file = do if exists then do h <- openLocked file ReadMode - s <- hGetContents h - -- hClose handle' -- TODO disabled due to lazy IO issue + s <- hGetContentsStrict h + hClose h -- filter out any unparsable lines return $ filter (\l -> (status l) /= Undefined ) $ map read $ lines s @@ -95,7 +94,7 @@ logNow status repo = do logFile :: String -> IO String logFile annexedFile = do repo <- repoTop - return $ repo ++ "/.git-annex/" ++ + return $ (gitStateDir repo) ++ (gitRelative repo annexedFile) ++ ".log" {- Returns a list of repositories that, according to the log, have diff --git a/Utility.hs b/Utility.hs index 05b06dea7..ab9ce04f3 100644 --- a/Utility.hs +++ b/Utility.hs @@ -19,6 +19,10 @@ openLocked file mode = do lockType ReadMode = ReadLock lockType _ = WriteLock +{- A version of hgetContents that is not lazy. Ensures file is + - all read before it gets closed. -} +hGetContentsStrict h = hGetContents h >>= \s -> length s `seq` return s + {- Returns the parent directory of a path. Parent of / is "" -} parentDir :: String -> String parentDir dir = -- cgit v1.2.3 From 852ead470756744cd6663ee2d537f3d281f1e7c8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 02:22:47 -0400 Subject: add gitPrep to handle .gitattributes --- GitRepo.hs | 27 ++++++++++++++++++++++++++- git-annex.hs | 4 ++-- 2 files changed, 28 insertions(+), 3 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index 2e7fff22e..21c683bd2 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -8,6 +8,12 @@ import System.Path import Data.String.Utils import Utility +{- Long-term state is stored in files inside the .git-annex directory + - in the git repository. -} +stateLoc = ".git-annex" +gitStateDir :: String -> String +gitStateDir repo = repo ++ "/" ++ stateLoc ++ "/" + {- Given a relative or absolute filename, calculates the name to use - relative to a git repository directory (which must be absolute). - This is the same form displayed and used by git. -} @@ -23,9 +29,28 @@ gitRelative repo file = drop (length absrepo) absfile Just f -> f Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo +{- Sets up the current git repo for git-annex. May be called repeatedly. -} +gitPrep :: IO () +gitPrep = do + repo <- repoTop + bare <- isBareRepo repo + -- configure git to use union merge driver on state files + let attributes = repo ++ "/.gitattributes" + let attrLine = stateLoc ++ "/* merge=union" + exists <- doesFileExist attributes + if (not bare) + then if (not exists) + then writeFile attributes $ attrLine ++ "\n" + else do + content <- readFile attributes + if (all (/= attrLine) (lines content)) + then appendFile attributes $ attrLine ++ "\n" + else return () + else return () {- Returns the path to the current repository's .git directory. - - (For a bare repository, that is the root of the repository.) -} + - (For a bare repository, that is the root of the repository.) + - TODO: support GIT_DIR -} gitDir :: IO String gitDir = do repo <- repoTop diff --git a/git-annex.hs b/git-annex.hs index a57e9e2db..e8032a132 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -2,7 +2,7 @@ - -} import LocationLog +import GitRepo main = do - l <- readLog "demo.log" - putStrLn "hi" + gitPrep -- cgit v1.2.3 From 058cef945023843219e09d4cec80bb7e137b9876 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 02:27:14 -0400 Subject: handle bare repo right for gitattributes also simplere code! --- GitRepo.hs | 31 ++++++++++++++++++------------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index 21c683bd2..2e2c1d52b 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -32,21 +32,26 @@ gitRelative repo file = drop (length absrepo) absfile {- Sets up the current git repo for git-annex. May be called repeatedly. -} gitPrep :: IO () gitPrep = do - repo <- repoTop - bare <- isBareRepo repo -- configure git to use union merge driver on state files - let attributes = repo ++ "/.gitattributes" let attrLine = stateLoc ++ "/* merge=union" + attributes <- gitAttributes exists <- doesFileExist attributes - if (not bare) - then if (not exists) - then writeFile attributes $ attrLine ++ "\n" - else do - content <- readFile attributes - if (all (/= attrLine) (lines content)) - then appendFile attributes $ attrLine ++ "\n" - else return () - else return () + if (not exists) + then writeFile attributes $ attrLine ++ "\n" + else do + content <- readFile attributes + if (all (/= attrLine) (lines content)) + then appendFile attributes $ attrLine ++ "\n" + else return () + +{- Returns the path to the current repository's gitattributes file. -} +gitAttributes :: IO String +gitAttributes = do + repo <- repoTop + bare <- isBareRepo repo + if (bare) + then return $ repo ++ "/info/.gitattributes" + else return $ repo ++ "/.gitattributes" {- Returns the path to the current repository's .git directory. - (For a bare repository, that is the root of the repository.) @@ -56,7 +61,7 @@ gitDir = do repo <- repoTop bare <- isBareRepo repo if (bare) - then return repo + then return $ repo else return $ repo ++ "/.git" {- Finds the top of the current git repository, which may be in a parent -- cgit v1.2.3 From 11ad93f023fa5e867b5b7bd47f45393caceb401a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 02:29:58 -0400 Subject: reorg --- GitRepo.hs | 44 +++++++++++++++++++++++--------------------- 1 file changed, 23 insertions(+), 21 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index 2e2c1d52b..8737d8251 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -14,6 +14,26 @@ stateLoc = ".git-annex" gitStateDir :: String -> String gitStateDir repo = repo ++ "/" ++ stateLoc ++ "/" +{- Path to the current repository's gitattributes file. -} +gitAttributes :: IO String +gitAttributes = do + repo <- repoTop + bare <- isBareRepo repo + if (bare) + then return $ repo ++ "/info/.gitattributes" + else return $ repo ++ "/.gitattributes" + +{- Path to the current repository's .git directory. + - (For a bare repository, that is the root of the repository.) + - TODO: support GIT_DIR -} +gitDir :: IO String +gitDir = do + repo <- repoTop + bare <- isBareRepo repo + if (bare) + then return $ repo + else return $ repo ++ "/.git" + {- Given a relative or absolute filename, calculates the name to use - relative to a git repository directory (which must be absolute). - This is the same form displayed and used by git. -} @@ -41,29 +61,11 @@ gitPrep = do else do content <- readFile attributes if (all (/= attrLine) (lines content)) - then appendFile attributes $ attrLine ++ "\n" + then do + appendFile attributes $ attrLine ++ "\n" + -- TODO check attributes file into git? else return () -{- Returns the path to the current repository's gitattributes file. -} -gitAttributes :: IO String -gitAttributes = do - repo <- repoTop - bare <- isBareRepo repo - if (bare) - then return $ repo ++ "/info/.gitattributes" - else return $ repo ++ "/.gitattributes" - -{- Returns the path to the current repository's .git directory. - - (For a bare repository, that is the root of the repository.) - - TODO: support GIT_DIR -} -gitDir :: IO String -gitDir = do - repo <- repoTop - bare <- isBareRepo repo - if (bare) - then return $ repo - else return $ repo ++ "/.git" - {- Finds the top of the current git repository, which may be in a parent - directory. -} repoTop :: IO String -- cgit v1.2.3 From f98fa53d7f6d851b8a1ae804c02780769c98e07c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 11:08:40 -0400 Subject: fixed close after locking --- LocationLog.hs | 15 +++++++++------ Utility.hs | 7 +++++-- git-annex.hs | 2 ++ 3 files changed, 16 insertions(+), 8 deletions(-) diff --git a/LocationLog.hs b/LocationLog.hs index c921a2005..1523901df 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -12,6 +12,11 @@ - - A line of the log will look like: "date N reponame" - Where N=1 when the repo has the file, and 0 otherwise. + - + - TOOD: compact logs, by storing only current presence infomation when + - writing them. + - + - TODO: use ByteString -} module LocationLog where @@ -67,9 +72,8 @@ readLog file = do exists <- doesFileExist file if exists then do - h <- openLocked file ReadMode - s <- hGetContentsStrict h - hClose h + s <- withFileLocked file ReadMode $ \h -> + hGetContentsStrict h -- filter out any unparsable lines return $ filter (\l -> (status l) /= Undefined ) $ map read $ lines s @@ -80,9 +84,8 @@ readLog file = do writeLog :: String -> LogLine -> IO () writeLog file line = do createDirectoryIfMissing True (parentDir file) - h <- openLocked file AppendMode - hPutStrLn h $ show line - hClose h + withFileLocked file AppendMode $ \h -> + hPutStrLn h $ show line {- Generates a new LogLine with the current date. -} logNow :: LogStatus -> String -> IO LogLine diff --git a/Utility.hs b/Utility.hs index ab9ce04f3..d1eb247d3 100644 --- a/Utility.hs +++ b/Utility.hs @@ -9,12 +9,15 @@ import Data.String.Utils {- Let's just say that Haskell makes reading/writing a file with - file locking excessively difficult. -} -openLocked file mode = do +withFileLocked file mode action = do + -- TODO: find a way to use bracket here handle <- openFile file mode lockfd <- handleToFd handle -- closes handle waitToSetLock lockfd (lockType mode, AbsoluteSeek, 0, 0) handle' <- fdToHandle lockfd - return handle' + ret <- action handle' + hClose handle' + return ret where lockType ReadMode = ReadLock lockType _ = WriteLock diff --git a/git-annex.hs b/git-annex.hs index e8032a132..66b9491bd 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -6,3 +6,5 @@ import GitRepo main = do gitPrep + l <- readLog "demo.log" + writeLog "demo2.log" $ l !! 0 -- cgit v1.2.3 From 7ad4a0bb7d4beb469f0aba017fae1ac48060e862 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 12:31:14 -0400 Subject: log compaction --- LocationLog.hs | 44 +++++++++++++++++++++++++++++++++++--------- demo.log | 7 +++++-- git-annex.hs | 2 +- 3 files changed, 41 insertions(+), 12 deletions(-) diff --git a/LocationLog.hs b/LocationLog.hs index 1523901df..028ceed5f 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -7,21 +7,19 @@ - - Location tracking information is stored in `.git-annex/filename.log`. - Repositories record their name and the date when they --get or --drop - - a file's content. (Git is configured to use a union merge for this file, - - so the lines may be in arbitrary order, but it will never conflict.) + - a file's content. - - A line of the log will look like: "date N reponame" - Where N=1 when the repo has the file, and 0 otherwise. - - - - TOOD: compact logs, by storing only current presence infomation when - - writing them. - - - - TODO: use ByteString + - + - Git is configured to use a union merge for this file, + - so the lines may be in arbitrary order, but it will never conflict. -} module LocationLog where import Data.DateTime +import qualified Data.Map as Map import System.IO import System.Directory import Data.Char @@ -81,12 +79,19 @@ readLog file = do return [] {- Adds a LogLine to a log file -} -writeLog :: String -> LogLine -> IO () -writeLog file line = do +appendLog :: String -> LogLine -> IO () +appendLog file line = do createDirectoryIfMissing True (parentDir file) withFileLocked file AppendMode $ \h -> hPutStrLn h $ show line +{- Writes a set of lines to a log file -} +writeLog :: String -> [LogLine] -> IO () +writeLog file lines = do + createDirectoryIfMissing True (parentDir file) + withFileLocked file WriteMode $ \h -> + hPutStr h $ unlines $ map show lines + {- Generates a new LogLine with the current date. -} logNow :: LogStatus -> String -> IO LogLine logNow status repo = do @@ -112,3 +117,24 @@ fileLocations file = do - is (or should still be) present. -} filterPresent :: [LogLine] -> [LogLine] filterPresent lines = error "unimplimented" -- TODO + +{- Compacts a set of logs, returning a subset that contains the current + - status. -} +compactLog :: [LogLine] -> [LogLine] +compactLog lines = compactLog' Map.empty lines +compactLog' map [] = Map.elems map +compactLog' map (l:ls) = compactLog' (mapLog map l) ls + +{- Inserts a log into a map of logs, if the log has better (ie, newer) + - information about a repo than the other logs in the map -} +mapLog map log = + if (better) + then Map.insert (repo log) log map + else map + where + better = case (Map.lookup (repo log) map) of + -- <= used because two log entries could + -- have the same timestamp; if so the one that + -- is seen last should win. + Just l -> (date l <= date log) + Nothing -> True diff --git a/demo.log b/demo.log index 251a84c52..7a4263056 100644 --- a/demo.log +++ b/demo.log @@ -1,8 +1,11 @@ 1286654242 1 repo 1286652724 0 foo +1286656282 1 foo +1286656282 0 repo +1286656281 0 foo +# some garbage, should be ignored a a a + a 1 a -1 a a 1286652724 1 foo -1286656282 1 foo -1286656282 0 repo diff --git a/git-annex.hs b/git-annex.hs index 66b9491bd..cae72f00d 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -7,4 +7,4 @@ import GitRepo main = do gitPrep l <- readLog "demo.log" - writeLog "demo2.log" $ l !! 0 + writeLog "demo2.log" $ compactLog l -- cgit v1.2.3 From a745043e7db87ef43dbbb3f93cdf5807ff9958ec Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 12:35:28 -0400 Subject: don't repeatedly call repoTop, it's a bit expensive --- GitRepo.hs | 24 +++++++++++------------- git-annex.hs | 3 ++- 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index 8737d8251..140fb628a 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -14,21 +14,19 @@ stateLoc = ".git-annex" gitStateDir :: String -> String gitStateDir repo = repo ++ "/" ++ stateLoc ++ "/" -{- Path to the current repository's gitattributes file. -} -gitAttributes :: IO String -gitAttributes = do - repo <- repoTop +{- Path to a repository's gitattributes file. -} +gitAttributes :: FilePath -> IO String +gitAttributes repo = do bare <- isBareRepo repo if (bare) then return $ repo ++ "/info/.gitattributes" else return $ repo ++ "/.gitattributes" -{- Path to the current repository's .git directory. +{- Path to a repository's .git directory. - (For a bare repository, that is the root of the repository.) - TODO: support GIT_DIR -} -gitDir :: IO String -gitDir = do - repo <- repoTop +gitDir :: FilePath -> IO String +gitDir repo = do bare <- isBareRepo repo if (bare) then return $ repo @@ -37,7 +35,7 @@ gitDir = do {- Given a relative or absolute filename, calculates the name to use - relative to a git repository directory (which must be absolute). - This is the same form displayed and used by git. -} -gitRelative :: String -> String -> String +gitRelative :: FilePath -> String -> String gitRelative repo file = drop (length absrepo) absfile where -- normalize both repo and file, so that repo @@ -49,12 +47,12 @@ gitRelative repo file = drop (length absrepo) absfile Just f -> f Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo -{- Sets up the current git repo for git-annex. May be called repeatedly. -} -gitPrep :: IO () -gitPrep = do +{- Sets up a git repo for git-annex. May be called repeatedly. -} +gitPrep :: FilePath -> IO () +gitPrep repo = do -- configure git to use union merge driver on state files let attrLine = stateLoc ++ "/* merge=union" - attributes <- gitAttributes + attributes <- gitAttributes repo exists <- doesFileExist attributes if (not exists) then writeFile attributes $ attrLine ++ "\n" diff --git a/git-annex.hs b/git-annex.hs index cae72f00d..0f274e674 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -5,6 +5,7 @@ import LocationLog import GitRepo main = do - gitPrep + repo <- repoTop + gitPrep repo l <- readLog "demo.log" writeLog "demo2.log" $ compactLog l -- cgit v1.2.3 From a55f49efb6c05c5ddb031f077690e90ed7358642 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 12:41:20 -0400 Subject: update --- LocationLog.hs | 14 +++++++------- git-annex.hs | 1 + 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/LocationLog.hs b/LocationLog.hs index 028ceed5f..f9421cd9a 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -65,7 +65,7 @@ instance Read LogLine where {- Reads a log file. - Note that the LogLines returned may be in any order. -} -readLog :: String -> IO [LogLine] +readLog :: FilePath -> IO [LogLine] readLog file = do exists <- doesFileExist file if exists @@ -79,14 +79,14 @@ readLog file = do return [] {- Adds a LogLine to a log file -} -appendLog :: String -> LogLine -> IO () +appendLog :: FilePath -> LogLine -> IO () appendLog file line = do createDirectoryIfMissing True (parentDir file) withFileLocked file AppendMode $ \h -> hPutStrLn h $ show line {- Writes a set of lines to a log file -} -writeLog :: String -> [LogLine] -> IO () +writeLog :: FilePath -> [LogLine] -> IO () writeLog file lines = do createDirectoryIfMissing True (parentDir file) withFileLocked file WriteMode $ \h -> @@ -99,7 +99,7 @@ logNow status repo = do return $ LogLine now status repo {- Returns the filename of the log file for a given annexed file. -} -logFile :: String -> IO String +logFile :: FilePath -> IO String logFile annexedFile = do repo <- repoTop return $ (gitStateDir repo) ++ @@ -107,16 +107,16 @@ logFile annexedFile = do {- Returns a list of repositories that, according to the log, have - the content of a file -} -fileLocations :: String -> IO [String] +fileLocations :: FilePath -> IO [String] fileLocations file = do log <- logFile file lines <- readLog log return $ map repo (filterPresent lines) -{- Filters the list of LogLines to find repositories where the file +{- Filters the list of LogLines to find ones where the file - is (or should still be) present. -} filterPresent :: [LogLine] -> [LogLine] -filterPresent lines = error "unimplimented" -- TODO +filterPresent lines = filter (\l -> FilePresent == status l) $ compactLog lines {- Compacts a set of logs, returning a subset that contains the current - status. -} diff --git a/git-annex.hs b/git-annex.hs index 0f274e674..8944b50f5 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -7,5 +7,6 @@ import GitRepo main = do repo <- repoTop gitPrep repo + l <- readLog "demo.log" writeLog "demo2.log" $ compactLog l -- cgit v1.2.3 From 80ce5f90db1de10a5fa42583efcb7390cf185662 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 13:47:04 -0400 Subject: update --- Backend.hs | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ BackendFile.hs | 17 +++++++++++++++++ BackendUrl.hs | 17 +++++++++++++++++ GitRepo.hs | 14 ++++++++------ git-annex.hs | 6 ++++++ 5 files changed, 106 insertions(+), 6 deletions(-) create mode 100644 Backend.hs create mode 100644 BackendFile.hs create mode 100644 BackendUrl.hs diff --git a/Backend.hs b/Backend.hs new file mode 100644 index 000000000..cb91325c6 --- /dev/null +++ b/Backend.hs @@ -0,0 +1,58 @@ +{- git-annex key/value storage backends + - + - git-annex uses a key/value abstraction layer to allow files contents to be + - stored in different ways. In theory, any key/value storage system could be + - used to store the file contents, and git-annex would then retrieve them + - as needed and put them in `.git/annex/`. + - + - When a file is annexed, a key is generated from its content and/or metadata. + - This key can later be used to retrieve the file's content (its value). This + - key generation must be stable for a given file content, name, and size. + - + - The mapping from filename to its key is stored in the .git-annex directory, + - in a file named `$filename.$backend` + - + - Multiple pluggable backends are supported, and more than one can be used + - to store different files' contents in a given repository. + - -} + +module Backend where + +import GitRepo +import System.Directory + +data Backend = Backend { + name :: String, -- name of this backend + keyvalue :: FilePath -> Maybe String, -- maps from key to value + retrievekey :: IO String -> IO (Bool) -- retrieves value given key +} + +{- Name of state file that holds the key for an annexed file, + - using a given backend. -} +backendFile :: Backend -> GitRepo -> FilePath -> String +backendFile backend repo file = gitStateDir repo ++ + (gitRelative repo file) ++ "." ++ (name backend) + +{- Looks up the backend used for an already annexed file. -} +lookupBackend :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Backend) +lookupBackend [] repo file = return Nothing +lookupBackend (b:bs) repo file = do + present <- checkBackend b repo file + if present + then + return $ Just b + else + lookupBackend bs repo file + +{- Checks if a file is available via a given backend. -} +checkBackend :: Backend -> GitRepo -> FilePath -> IO (Bool) +checkBackend backend repo file = doesFileExist $ backendFile backend repo file + +{- Attempts to retrieve an annexed file from one of the backends. -} +retrieveFile :: [Backend] -> GitRepo -> FilePath -> IO (Bool) +retrieveFile backends repo file = do + result <- lookupBackend backends repo file + case (result) of + Nothing -> return False + Just b -> (retrievekey b) key + where key = readFile (backendFile b repo file) diff --git a/BackendFile.hs b/BackendFile.hs new file mode 100644 index 000000000..b1a3be58a --- /dev/null +++ b/BackendFile.hs @@ -0,0 +1,17 @@ +{- git-annex "file" backend + - -} + +module BackendFile (backend) where + +import Backend + +backend = Backend { + name = "file", + keyvalue = keyValue, + retrievekey = copyFile +} + +-- direct mapping from filename to key +keyValue k = Just $ id k + +copyFile f = error "unimplemented" diff --git a/BackendUrl.hs b/BackendUrl.hs new file mode 100644 index 000000000..f95c53bbf --- /dev/null +++ b/BackendUrl.hs @@ -0,0 +1,17 @@ +{- git-annex "url" backend + - -} + +module BackendUrl (backend) where + +import Backend + +backend = Backend { + name = "url", + keyvalue = keyValue, + retrievekey = downloadUrl +} + +-- cannot generate url from filename +keyValue k = Nothing + +downloadUrl k = error "unimplemented" diff --git a/GitRepo.hs b/GitRepo.hs index 140fb628a..8974d9db6 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -8,14 +8,16 @@ import System.Path import Data.String.Utils import Utility +type GitRepo = FilePath + {- Long-term state is stored in files inside the .git-annex directory - in the git repository. -} stateLoc = ".git-annex" -gitStateDir :: String -> String +gitStateDir :: GitRepo -> FilePath gitStateDir repo = repo ++ "/" ++ stateLoc ++ "/" {- Path to a repository's gitattributes file. -} -gitAttributes :: FilePath -> IO String +gitAttributes :: GitRepo -> IO String gitAttributes repo = do bare <- isBareRepo repo if (bare) @@ -25,7 +27,7 @@ gitAttributes repo = do {- Path to a repository's .git directory. - (For a bare repository, that is the root of the repository.) - TODO: support GIT_DIR -} -gitDir :: FilePath -> IO String +gitDir :: GitRepo -> IO String gitDir repo = do bare <- isBareRepo repo if (bare) @@ -35,7 +37,7 @@ gitDir repo = do {- Given a relative or absolute filename, calculates the name to use - relative to a git repository directory (which must be absolute). - This is the same form displayed and used by git. -} -gitRelative :: FilePath -> String -> String +gitRelative :: GitRepo -> String -> String gitRelative repo file = drop (length absrepo) absfile where -- normalize both repo and file, so that repo @@ -48,7 +50,7 @@ gitRelative repo file = drop (length absrepo) absfile Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo {- Sets up a git repo for git-annex. May be called repeatedly. -} -gitPrep :: FilePath -> IO () +gitPrep :: GitRepo -> IO () gitPrep repo = do -- configure git to use union merge driver on state files let attrLine = stateLoc ++ "/* merge=union" @@ -66,7 +68,7 @@ gitPrep repo = do {- Finds the top of the current git repository, which may be in a parent - directory. -} -repoTop :: IO String +repoTop :: IO GitRepo repoTop = do cwd <- getCurrentDirectory top <- seekUp cwd isRepoTop diff --git a/git-annex.hs b/git-annex.hs index 8944b50f5..77faea2b7 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -3,6 +3,12 @@ import LocationLog import GitRepo +import Backend + +-- When adding a new backend, import it here and add it to the backends list. +import qualified BackendFile +import qualified BackendUrl +backends = [BackendFile.backend, BackendUrl.backend] main = do repo <- repoTop -- cgit v1.2.3 From f4d2a05e86df464790fb183148717e7ac7f49cda Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 15:04:07 -0400 Subject: got annexing working --- Annex.hs | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) create mode 100644 Annex.hs diff --git a/Annex.hs b/Annex.hs new file mode 100644 index 000000000..7d89c882a --- /dev/null +++ b/Annex.hs @@ -0,0 +1,36 @@ +{- git-annex + -} + +module Annex where + +import Backend +import System.Posix.Files +import System.Directory +import GitRepo +import Utility + +{- An annexed file's content is stored in .git/annex/. -} +annexedFileLocation repo file = do + dir <- gitDir repo + return $ dir ++ "/annex/" ++ (gitRelative repo file) + +{- Annexes a file, storing it in a backend, and then moving it into + - the annex directory and setting up the symlink pointing to its + - content. -} +annexFile :: [Backend] -> GitRepo -> FilePath -> IO () +annexFile backends repo file = do + alreadyannexed <- lookupBackend backends repo file + case (alreadyannexed) of + Just _ -> error $ "already annexed " ++ file + Nothing -> do + stored <- storeFile backends repo file + if (not stored) + then error $ "no backend could store " ++ file + else symlink + where + symlink = do + dest <- annexedFileLocation repo file + createDirectoryIfMissing True (parentDir dest) + renameFile file dest + createSymbolicLink dest file + gitAdd repo file -- cgit v1.2.3 From cc235192353561a374c431485c6c3834659e0fa6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 15:04:18 -0400 Subject: update --- Backend.hs | 55 +++++++++++++++++++++++++++++++++++++++++-------------- BackendFile.hs | 15 +++++++++++---- BackendUrl.hs | 15 +++++++++++---- GitRepo.hs | 11 +++++++++-- LocationLog.hs | 12 ++++++------ git-annex.hs | 1 + 6 files changed, 79 insertions(+), 30 deletions(-) diff --git a/Backend.hs b/Backend.hs index cb91325c6..c55634a68 100644 --- a/Backend.hs +++ b/Backend.hs @@ -18,24 +18,60 @@ module Backend where -import GitRepo import System.Directory +import GitRepo +import Utility + +type Key = String data Backend = Backend { - name :: String, -- name of this backend - keyvalue :: FilePath -> Maybe String, -- maps from key to value - retrievekey :: IO String -> IO (Bool) -- retrieves value given key + -- name of this backend + name :: String, + -- converts a filename to a key + getKey :: FilePath -> IO (Maybe Key), + -- stores a file's contents to a key + storeFileKey :: FilePath -> Key -> IO (Bool), + -- retrieves a key's contents to a file + retrieveKeyFile :: IO Key -> FilePath -> IO (Bool) } +instance Show Backend where + show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" + {- Name of state file that holds the key for an annexed file, - using a given backend. -} backendFile :: Backend -> GitRepo -> FilePath -> String backendFile backend repo file = gitStateDir repo ++ (gitRelative repo file) ++ "." ++ (name backend) +{- Attempts to Stores a file in one of the backends. -} +storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Bool) +storeFile [] _ _ = return False +storeFile (b:bs) repo file = do + try <- (getKey b) (gitRelative repo file) + case (try) of + Nothing -> storeFile bs repo file + Just key -> do + (storeFileKey b) file key + createDirectoryIfMissing True (parentDir backendfile) + writeFile backendfile key + return True + where backendfile = backendFile b repo file + +{- Attempts to retrieve an file from one of the backends, saving it to + - a specified location. -} +retrieveFile :: [Backend] -> GitRepo -> FilePath -> FilePath -> IO (Bool) +retrieveFile backends repo file dest = do + result <- lookupBackend backends repo file + case (result) of + Nothing -> return False + Just b -> (retrieveKeyFile b) key dest + where + key = readFile (backendFile b repo file) + {- Looks up the backend used for an already annexed file. -} lookupBackend :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Backend) -lookupBackend [] repo file = return Nothing +lookupBackend [] _ _ = return Nothing lookupBackend (b:bs) repo file = do present <- checkBackend b repo file if present @@ -47,12 +83,3 @@ lookupBackend (b:bs) repo file = do {- Checks if a file is available via a given backend. -} checkBackend :: Backend -> GitRepo -> FilePath -> IO (Bool) checkBackend backend repo file = doesFileExist $ backendFile backend repo file - -{- Attempts to retrieve an annexed file from one of the backends. -} -retrieveFile :: [Backend] -> GitRepo -> FilePath -> IO (Bool) -retrieveFile backends repo file = do - result <- lookupBackend backends repo file - case (result) of - Nothing -> return False - Just b -> (retrievekey b) key - where key = readFile (backendFile b repo file) diff --git a/BackendFile.hs b/BackendFile.hs index b1a3be58a..324a4d8cd 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -7,11 +7,18 @@ import Backend backend = Backend { name = "file", - keyvalue = keyValue, - retrievekey = copyFile + getKey = keyValue, + storeFileKey = moveToAnnex, + retrieveKeyFile = copyFromOtherRepo } -- direct mapping from filename to key -keyValue k = Just $ id k +keyValue :: FilePath -> IO (Maybe Key) +keyValue k = return $ Just $ id k + +moveToAnnex :: FilePath -> Key -> IO (Bool) +moveToAnnex file key = return False + +copyFromOtherRepo :: IO Key -> FilePath -> IO (Bool) +copyFromOtherRepo key file = return False -copyFile f = error "unimplemented" diff --git a/BackendUrl.hs b/BackendUrl.hs index f95c53bbf..9b4c83d61 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -7,11 +7,18 @@ import Backend backend = Backend { name = "url", - keyvalue = keyValue, - retrievekey = downloadUrl + getKey = keyValue, + storeFileKey = dummyStore, + retrieveKeyFile = downloadUrl } -- cannot generate url from filename -keyValue k = Nothing +keyValue :: FilePath -> IO (Maybe Key) +keyValue k = return Nothing -downloadUrl k = error "unimplemented" +-- cannot store to urls +dummyStore :: FilePath -> Key -> IO (Bool) +dummyStore file url = return False + +downloadUrl :: IO Key -> FilePath -> IO (Bool) +downloadUrl url file = error "unimplemented" diff --git a/GitRepo.hs b/GitRepo.hs index 8974d9db6..690782f0d 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -57,15 +57,22 @@ gitPrep repo = do attributes <- gitAttributes repo exists <- doesFileExist attributes if (not exists) - then writeFile attributes $ attrLine ++ "\n" + then do + writeFile attributes $ attrLine ++ "\n" + gitAdd repo attributes else do content <- readFile attributes if (all (/= attrLine) (lines content)) then do appendFile attributes $ attrLine ++ "\n" - -- TODO check attributes file into git? + gitAdd repo attributes else return () +{- Stages a changed file in git's index. -} +gitAdd repo file = do + -- TODO + return () + {- Finds the top of the current git repository, which may be in a parent - directory. -} repoTop :: IO GitRepo diff --git a/LocationLog.hs b/LocationLog.hs index f9421cd9a..32af82461 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -84,6 +84,7 @@ appendLog file line = do createDirectoryIfMissing True (parentDir file) withFileLocked file AppendMode $ \h -> hPutStrLn h $ show line + -- TODO git add log {- Writes a set of lines to a log file -} writeLog :: FilePath -> [LogLine] -> IO () @@ -99,17 +100,16 @@ logNow status repo = do return $ LogLine now status repo {- Returns the filename of the log file for a given annexed file. -} -logFile :: FilePath -> IO String -logFile annexedFile = do - repo <- repoTop +logFile :: GitRepo -> FilePath -> IO String +logFile repo annexedFile = do return $ (gitStateDir repo) ++ (gitRelative repo annexedFile) ++ ".log" {- Returns a list of repositories that, according to the log, have - the content of a file -} -fileLocations :: FilePath -> IO [String] -fileLocations file = do - log <- logFile file +fileLocations :: GitRepo -> FilePath -> IO [String] +fileLocations thisrepo file = do + log <- logFile thisrepo file lines <- readLog log return $ map repo (filterPresent lines) diff --git a/git-annex.hs b/git-annex.hs index 77faea2b7..556e0607e 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -4,6 +4,7 @@ import LocationLog import GitRepo import Backend +import Annex -- When adding a new backend, import it here and add it to the backends list. import qualified BackendFile -- cgit v1.2.3 From 4631927a5c7b14605725f1c6f272fee19d8b4318 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 15:21:17 -0400 Subject: fix storing files in .git/annex by key --- Annex.hs | 19 +++++++++---------- Backend.hs | 24 ++++++++++++++++-------- 2 files changed, 25 insertions(+), 18 deletions(-) diff --git a/Annex.hs b/Annex.hs index 7d89c882a..bd9ce92a4 100644 --- a/Annex.hs +++ b/Annex.hs @@ -9,14 +9,13 @@ import System.Directory import GitRepo import Utility -{- An annexed file's content is stored in .git/annex/. -} -annexedFileLocation repo file = do +{- An annexed file's content is stored somewhere under .git/annex/ -} +annexLoc repo key = do dir <- gitDir repo - return $ dir ++ "/annex/" ++ (gitRelative repo file) + return $ dir ++ "/annex/" ++ key {- Annexes a file, storing it in a backend, and then moving it into - - the annex directory and setting up the symlink pointing to its - - content. -} + - the annex directory and setting up the symlink pointing to its content. -} annexFile :: [Backend] -> GitRepo -> FilePath -> IO () annexFile backends repo file = do alreadyannexed <- lookupBackend backends repo file @@ -24,12 +23,12 @@ annexFile backends repo file = do Just _ -> error $ "already annexed " ++ file Nothing -> do stored <- storeFile backends repo file - if (not stored) - then error $ "no backend could store " ++ file - else symlink + case (stored) of + Nothing -> error $ "no backend could store " ++ file + Just key -> symlink key where - symlink = do - dest <- annexedFileLocation repo file + symlink key = do + dest <- annexLoc repo key createDirectoryIfMissing True (parentDir dest) renameFile file dest createSymbolicLink dest file diff --git a/Backend.hs b/Backend.hs index c55634a68..d6b433989 100644 --- a/Backend.hs +++ b/Backend.hs @@ -44,21 +44,29 @@ backendFile :: Backend -> GitRepo -> FilePath -> String backendFile backend repo file = gitStateDir repo ++ (gitRelative repo file) ++ "." ++ (name backend) -{- Attempts to Stores a file in one of the backends. -} -storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Bool) -storeFile [] _ _ = return False +{- Attempts to store a file in one of the backends, and returns + - its key. -} +storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key) +storeFile [] _ _ = return Nothing storeFile (b:bs) repo file = do try <- (getKey b) (gitRelative repo file) case (try) of - Nothing -> storeFile bs repo file + Nothing -> nextbackend Just key -> do - (storeFileKey b) file key + stored <- (storeFileKey b) file key + if (not stored) + then nextbackend + else do + bookkeeping key + return $ Just key + where + nextbackend = storeFile bs repo file + backendfile = backendFile b repo file + bookkeeping key = do createDirectoryIfMissing True (parentDir backendfile) writeFile backendfile key - return True - where backendfile = backendFile b repo file -{- Attempts to retrieve an file from one of the backends, saving it to +{- Attempts to retrieve an file from one of the backends, saving it to - a specified location. -} retrieveFile :: [Backend] -> GitRepo -> FilePath -> FilePath -> IO (Bool) retrieveFile backends repo file dest = do -- cgit v1.2.3 From eb577ee37ff1d631aa3580a235b9954043d0fb27 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 15:27:49 -0400 Subject: stub checksum backend --- BackendChecksum.hs | 18 ++++++++++++++++++ BackendFile.hs | 1 - git-annex.hs | 3 ++- 3 files changed, 20 insertions(+), 2 deletions(-) create mode 100644 BackendChecksum.hs diff --git a/BackendChecksum.hs b/BackendChecksum.hs new file mode 100644 index 000000000..267f8099c --- /dev/null +++ b/BackendChecksum.hs @@ -0,0 +1,18 @@ +{- git-annex "checksum" backend + - -} + +module BackendChecksum (backend) where + +import Backend +import qualified BackendFile +import Data.Digest.Pure.SHA + +-- based on BackendFile just with a different key type +backend = BackendFile.backend { + name = "checksum", + getKey = keyValue +} + +-- +keyValue :: FilePath -> IO (Maybe Key) +keyValue k = error "unimplemented" -- TODO diff --git a/BackendFile.hs b/BackendFile.hs index 324a4d8cd..dd6ff595a 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -21,4 +21,3 @@ moveToAnnex file key = return False copyFromOtherRepo :: IO Key -> FilePath -> IO (Bool) copyFromOtherRepo key file = return False - diff --git a/git-annex.hs b/git-annex.hs index 556e0607e..cce49050b 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -8,8 +8,9 @@ import Annex -- When adding a new backend, import it here and add it to the backends list. import qualified BackendFile +import qualified BackendChecksum import qualified BackendUrl -backends = [BackendFile.backend, BackendUrl.backend] +backends = [BackendFile.backend, BackendChecksum.backend, BackendUrl.backend] main = do repo <- repoTop -- cgit v1.2.3 From 7880dc16fef81bb6a8812c6b4e9578a6ae2b2879 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 15:41:35 -0400 Subject: update --- Backend.hs | 8 ++++---- BackendChecksum.hs | 7 ++++--- BackendFile.hs | 16 ++++++++++------ BackendUrl.hs | 11 ++++++----- 4 files changed, 24 insertions(+), 18 deletions(-) diff --git a/Backend.hs b/Backend.hs index d6b433989..40279866f 100644 --- a/Backend.hs +++ b/Backend.hs @@ -28,9 +28,9 @@ data Backend = Backend { -- name of this backend name :: String, -- converts a filename to a key - getKey :: FilePath -> IO (Maybe Key), + getKey :: GitRepo -> FilePath -> IO (Maybe Key), -- stores a file's contents to a key - storeFileKey :: FilePath -> Key -> IO (Bool), + storeFileKey :: GitRepo -> FilePath -> Key -> IO (Bool), -- retrieves a key's contents to a file retrieveKeyFile :: IO Key -> FilePath -> IO (Bool) } @@ -49,11 +49,11 @@ backendFile backend repo file = gitStateDir repo ++ storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key) storeFile [] _ _ = return Nothing storeFile (b:bs) repo file = do - try <- (getKey b) (gitRelative repo file) + try <- (getKey b) repo (gitRelative repo file) case (try) of Nothing -> nextbackend Just key -> do - stored <- (storeFileKey b) file key + stored <- (storeFileKey b) repo file key if (not stored) then nextbackend else do diff --git a/BackendChecksum.hs b/BackendChecksum.hs index 267f8099c..7b8d2c281 100644 --- a/BackendChecksum.hs +++ b/BackendChecksum.hs @@ -4,6 +4,7 @@ module BackendChecksum (backend) where import Backend +import GitRepo import qualified BackendFile import Data.Digest.Pure.SHA @@ -13,6 +14,6 @@ backend = BackendFile.backend { getKey = keyValue } --- -keyValue :: FilePath -> IO (Maybe Key) -keyValue k = error "unimplemented" -- TODO +-- checksum the file to get its key +keyValue :: GitRepo -> FilePath -> IO (Maybe Key) +keyValue k = error "checksum keyValue unimplemented" -- TODO diff --git a/BackendFile.hs b/BackendFile.hs index dd6ff595a..6caf30f65 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -4,20 +4,24 @@ module BackendFile (backend) where import Backend +import GitRepo backend = Backend { name = "file", getKey = keyValue, - storeFileKey = moveToAnnex, + storeFileKey = dummyStore, retrieveKeyFile = copyFromOtherRepo } -- direct mapping from filename to key -keyValue :: FilePath -> IO (Maybe Key) -keyValue k = return $ Just $ id k +keyValue :: GitRepo -> FilePath -> IO (Maybe Key) +keyValue repo file = return $ Just file -moveToAnnex :: FilePath -> Key -> IO (Bool) -moveToAnnex file key = return False +-- This backend does not really do any independant data storage, +-- it relies on the file contents in .git/annex/ in this repo, +-- and other accessible repos. So storing a file is a no-op. +dummyStore :: GitRepo -> FilePath -> Key -> IO (Bool) +dummyStore repo file key = return True copyFromOtherRepo :: IO Key -> FilePath -> IO (Bool) -copyFromOtherRepo key file = return False +copyFromOtherRepo key file = error "copyFromOtherRepo unimplemented" -- TODO diff --git a/BackendUrl.hs b/BackendUrl.hs index 9b4c83d61..1aa5224b5 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -4,6 +4,7 @@ module BackendUrl (backend) where import Backend +import GitRepo backend = Backend { name = "url", @@ -13,12 +14,12 @@ backend = Backend { } -- cannot generate url from filename -keyValue :: FilePath -> IO (Maybe Key) -keyValue k = return Nothing +keyValue :: GitRepo -> FilePath -> IO (Maybe Key) +keyValue repo file = return Nothing -- cannot store to urls -dummyStore :: FilePath -> Key -> IO (Bool) -dummyStore file url = return False +dummyStore :: GitRepo -> FilePath -> Key -> IO (Bool) +dummyStore repo file url = return False downloadUrl :: IO Key -> FilePath -> IO (Bool) -downloadUrl url file = error "unimplemented" +downloadUrl url file = error "downloadUrl unimplemented" -- cgit v1.2.3 From dce9c2e0804d2c94f46dcac8c9884766bb22dcc7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 15:54:02 -0400 Subject: convert GitRepo to struct with constructor --- Annex.hs | 30 ++++++++++++++++++++++------- Backend.hs | 1 + BackendFile.hs | 8 +++++--- GitRepo.hs | 61 +++++++++++++++++++++------------------------------------- LocationLog.hs | 1 + Locations.hs | 18 +++++++++++++++++ git-annex.hs | 2 +- 7 files changed, 71 insertions(+), 50 deletions(-) create mode 100644 Locations.hs diff --git a/Annex.hs b/Annex.hs index bd9ce92a4..f23358bf6 100644 --- a/Annex.hs +++ b/Annex.hs @@ -3,16 +3,12 @@ module Annex where -import Backend import System.Posix.Files import System.Directory import GitRepo import Utility - -{- An annexed file's content is stored somewhere under .git/annex/ -} -annexLoc repo key = do - dir <- gitDir repo - return $ dir ++ "/annex/" ++ key +import Locations +import Backend {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} @@ -28,8 +24,28 @@ annexFile backends repo file = do Just key -> symlink key where symlink key = do - dest <- annexLoc repo key + dest <- annexDir repo key createDirectoryIfMissing True (parentDir dest) renameFile file dest createSymbolicLink dest file gitAdd repo file + +{- Sets up a git repo for git-annex. May be called repeatedly. -} +gitPrep :: GitRepo -> IO () +gitPrep repo = do + -- configure git to use union merge driver on state files + let attrLine = stateLoc ++ "/* merge=union" + attributes <- gitAttributes repo + exists <- doesFileExist attributes + if (not exists) + then do + writeFile attributes $ attrLine ++ "\n" + gitAdd repo attributes + else do + content <- readFile attributes + if (all (/= attrLine) (lines content)) + then do + appendFile attributes $ attrLine ++ "\n" + gitAdd repo attributes + else return () + diff --git a/Backend.hs b/Backend.hs index 40279866f..e01f12239 100644 --- a/Backend.hs +++ b/Backend.hs @@ -19,6 +19,7 @@ module Backend where import System.Directory +import Locations import GitRepo import Utility diff --git a/BackendFile.hs b/BackendFile.hs index 6caf30f65..92f708696 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -17,11 +17,13 @@ backend = Backend { keyValue :: GitRepo -> FilePath -> IO (Maybe Key) keyValue repo file = return $ Just file --- This backend does not really do any independant data storage, --- it relies on the file contents in .git/annex/ in this repo, --- and other accessible repos. So storing a file is a no-op. +{- This backend does not really do any independant data storage, + - it relies on the file contents in .git/annex/ in this repo, + - and other accessible repos. So storing a file is a no-op. -} dummyStore :: GitRepo -> FilePath -> Key -> IO (Bool) dummyStore repo file key = return True +{- Try to find a copy of the file in one of the other repos, + - and copy it over to this one. -} copyFromOtherRepo :: IO Key -> FilePath -> IO (Bool) copyFromOtherRepo key file = error "copyFromOtherRepo unimplemented" -- TODO diff --git a/GitRepo.hs b/GitRepo.hs index 690782f0d..fda83f7d8 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -8,79 +8,62 @@ import System.Path import Data.String.Utils import Utility -type GitRepo = FilePath +data GitRepo = GitRepo { + top :: FilePath, + remotes :: [GitRepo] +} deriving (Eq, Show, Read) -{- Long-term state is stored in files inside the .git-annex directory - - in the git repository. -} -stateLoc = ".git-annex" -gitStateDir :: GitRepo -> FilePath -gitStateDir repo = repo ++ "/" ++ stateLoc ++ "/" +{- GitRepo constructor -} +gitRepo :: FilePath -> IO GitRepo +gitRepo dir = do + -- TOOD query repo for configuration settings; other repositories; etc + return GitRepo { top = dir, remotes = [] } {- Path to a repository's gitattributes file. -} gitAttributes :: GitRepo -> IO String gitAttributes repo = do - bare <- isBareRepo repo + bare <- isBareRepo (top repo) if (bare) - then return $ repo ++ "/info/.gitattributes" - else return $ repo ++ "/.gitattributes" + then return $ (top repo) ++ "/info/.gitattributes" + else return $ (top repo) ++ "/.gitattributes" {- Path to a repository's .git directory. - (For a bare repository, that is the root of the repository.) - TODO: support GIT_DIR -} gitDir :: GitRepo -> IO String gitDir repo = do - bare <- isBareRepo repo + bare <- isBareRepo (top repo) if (bare) - then return $ repo - else return $ repo ++ "/.git" + then return $ (top repo) + else return $ (top repo) ++ "/.git" {- Given a relative or absolute filename, calculates the name to use - - relative to a git repository directory (which must be absolute). + - to refer to the file relative to a git repository directory. - This is the same form displayed and used by git. -} gitRelative :: GitRepo -> String -> String gitRelative repo file = drop (length absrepo) absfile where -- normalize both repo and file, so that repo -- will be substring of file - absrepo = case (absNormPath "/" repo) of + absrepo = case (absNormPath "/" (top repo)) of Just f -> f ++ "/" - Nothing -> error $ "bad repo" ++ repo + Nothing -> error $ "bad repo" ++ (top repo) absfile = case (secureAbsNormPath absrepo file) of Just f -> f Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo -{- Sets up a git repo for git-annex. May be called repeatedly. -} -gitPrep :: GitRepo -> IO () -gitPrep repo = do - -- configure git to use union merge driver on state files - let attrLine = stateLoc ++ "/* merge=union" - attributes <- gitAttributes repo - exists <- doesFileExist attributes - if (not exists) - then do - writeFile attributes $ attrLine ++ "\n" - gitAdd repo attributes - else do - content <- readFile attributes - if (all (/= attrLine) (lines content)) - then do - appendFile attributes $ attrLine ++ "\n" - gitAdd repo attributes - else return () - {- Stages a changed file in git's index. -} gitAdd repo file = do -- TODO return () -{- Finds the top of the current git repository, which may be in a parent - - directory. -} -repoTop :: IO GitRepo -repoTop = do +{- Finds the current git repository, which may be in a parent directory. -} +currentRepo :: IO GitRepo +currentRepo = do cwd <- getCurrentDirectory top <- seekUp cwd isRepoTop case top of - (Just dir) -> return dir + (Just dir) -> gitRepo dir Nothing -> error "Not in a git repository." seekUp :: String -> (String -> IO Bool) -> IO (Maybe String) diff --git a/LocationLog.hs b/LocationLog.hs index 32af82461..73e9f1c6d 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -25,6 +25,7 @@ import System.Directory import Data.Char import GitRepo import Utility +import Locations data LogStatus = FilePresent | FileMissing | Undefined deriving (Eq) diff --git a/Locations.hs b/Locations.hs new file mode 100644 index 000000000..7273797ef --- /dev/null +++ b/Locations.hs @@ -0,0 +1,18 @@ +{- git-annex file locations + -} + +module Locations where + +import GitRepo + +{- An annexed file's content is stored somewhere under .git/annex/ -} +annexDir :: GitRepo -> String -> IO FilePath +annexDir repo key = do + dir <- gitDir repo + return $ dir ++ "/annex/" ++ key + +{- Long-term state is stored in files inside the .git-annex directory + - in the git repository. -} +stateLoc = ".git-annex" +gitStateDir :: GitRepo -> FilePath +gitStateDir repo = (top repo) ++ "/" ++ stateLoc ++ "/" diff --git a/git-annex.hs b/git-annex.hs index cce49050b..f8c67b1fd 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -13,7 +13,7 @@ import qualified BackendUrl backends = [BackendFile.backend, BackendChecksum.backend, BackendUrl.backend] main = do - repo <- repoTop + repo <- currentRepo gitPrep repo l <- readLog "demo.log" -- cgit v1.2.3 From e5514e0cb0809848645814e8c1f67cd89cb16c4f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 18:05:37 -0400 Subject: update --- Annex.hs | 1 + Backend.hs | 14 +------------- BackendChecksum.hs | 3 +-- BackendFile.hs | 3 +-- BackendList.hs | 14 ++++++++++++++ BackendUrl.hs | 3 +-- CmdLine.hs | 41 +++++++++++++++++++++++++++++++++++++++++ GitRepo.hs | 13 +++++++------ LocationLog.hs | 1 + Locations.hs | 3 ++- Types.hs | 24 ++++++++++++++++++++++++ git-annex.hs | 17 +++++++---------- 12 files changed, 101 insertions(+), 36 deletions(-) create mode 100644 BackendList.hs create mode 100644 CmdLine.hs create mode 100644 Types.hs diff --git a/Annex.hs b/Annex.hs index f23358bf6..bddff1e13 100644 --- a/Annex.hs +++ b/Annex.hs @@ -8,6 +8,7 @@ import System.Directory import GitRepo import Utility import Locations +import Types import Backend {- Annexes a file, storing it in a backend, and then moving it into diff --git a/Backend.hs b/Backend.hs index e01f12239..93ceee234 100644 --- a/Backend.hs +++ b/Backend.hs @@ -22,19 +22,7 @@ import System.Directory import Locations import GitRepo import Utility - -type Key = String - -data Backend = Backend { - -- name of this backend - name :: String, - -- converts a filename to a key - getKey :: GitRepo -> FilePath -> IO (Maybe Key), - -- stores a file's contents to a key - storeFileKey :: GitRepo -> FilePath -> Key -> IO (Bool), - -- retrieves a key's contents to a file - retrieveKeyFile :: IO Key -> FilePath -> IO (Bool) -} +import Types instance Show Backend where show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" diff --git a/BackendChecksum.hs b/BackendChecksum.hs index 7b8d2c281..18ff0cb57 100644 --- a/BackendChecksum.hs +++ b/BackendChecksum.hs @@ -3,8 +3,7 @@ module BackendChecksum (backend) where -import Backend -import GitRepo +import Types import qualified BackendFile import Data.Digest.Pure.SHA diff --git a/BackendFile.hs b/BackendFile.hs index 92f708696..deb4bce7e 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -3,8 +3,7 @@ module BackendFile (backend) where -import Backend -import GitRepo +import Types backend = Backend { name = "file", diff --git a/BackendList.hs b/BackendList.hs new file mode 100644 index 000000000..c744949b6 --- /dev/null +++ b/BackendList.hs @@ -0,0 +1,14 @@ +{- git-annex backend list + - -} + +module BackendList where + +-- When adding a new backend, import it here and add it to the list. +import qualified BackendFile +import qualified BackendChecksum +import qualified BackendUrl +supportedBackends = + [ BackendFile.backend + , BackendChecksum.backend + , BackendUrl.backend + ] diff --git a/BackendUrl.hs b/BackendUrl.hs index 1aa5224b5..2bc34434b 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -3,8 +3,7 @@ module BackendUrl (backend) where -import Backend -import GitRepo +import Types backend = Backend { name = "url", diff --git a/CmdLine.hs b/CmdLine.hs new file mode 100644 index 000000000..79bd55cd9 --- /dev/null +++ b/CmdLine.hs @@ -0,0 +1,41 @@ +{- git-annex command line + - + - TODO: This is very rough and stupid; I would like to use + - System.Console.CmdArgs.Implicit but it is not yet packaged in Debian. + -} + +module CmdLine where + +import System.Console.GetOpt +import Types +import Annex + +data Flag = Add FilePath | Push String | Pull String | + Want FilePath | Get (Maybe FilePath) | Drop FilePath + deriving Show + +options :: [OptDescr Flag] +options = + [ Option ['a'] ["add"] (ReqArg Add "FILE") "add file to annex" + , Option ['p'] ["push"] (ReqArg Push "REPO") "push annex to repo" + , Option ['P'] ["pull"] (ReqArg Pull "REPO") "pull annex from repo" + , Option ['w'] ["want"] (ReqArg Want "FILE") "request file contents" + , Option ['g'] ["get"] (OptArg Get "FILE") "transfer file contents" + , Option ['d'] ["drop"] (ReqArg Drop "FILE") "indicate file content not needed" + ] + +argvToFlags argv = do + case getOpt Permute options argv of + -- no options? add listed files + ([],p,[] ) -> return $ map (\f -> Add f) p + -- all options parsed, return flags + (o,[],[] ) -> return o + -- error case + (_,n,errs) -> ioError (userError (concat errs ++ usageInfo header options)) + where header = "Usage: git-annex [option] file" + +dispatch :: Flag -> [Backend] -> GitRepo -> IO () +dispatch flag backends repo = do + case (flag) of + Add f -> annexFile backends repo f + _ -> error "not implemented" diff --git a/GitRepo.hs b/GitRepo.hs index fda83f7d8..a0909d5ec 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -7,17 +7,18 @@ import System.Directory import System.Path import Data.String.Utils import Utility - -data GitRepo = GitRepo { - top :: FilePath, - remotes :: [GitRepo] -} deriving (Eq, Show, Read) +import Types +import BackendList {- GitRepo constructor -} gitRepo :: FilePath -> IO GitRepo gitRepo dir = do -- TOOD query repo for configuration settings; other repositories; etc - return GitRepo { top = dir, remotes = [] } + return GitRepo { + top = dir, + remotes = [], + backends = supportedBackends + } {- Path to a repository's gitattributes file. -} gitAttributes :: GitRepo -> IO String diff --git a/LocationLog.hs b/LocationLog.hs index 73e9f1c6d..a5e9a2679 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -26,6 +26,7 @@ import Data.Char import GitRepo import Utility import Locations +import Types data LogStatus = FilePresent | FileMissing | Undefined deriving (Eq) diff --git a/Locations.hs b/Locations.hs index 7273797ef..50f94a727 100644 --- a/Locations.hs +++ b/Locations.hs @@ -3,10 +3,11 @@ module Locations where +import Types import GitRepo {- An annexed file's content is stored somewhere under .git/annex/ -} -annexDir :: GitRepo -> String -> IO FilePath +annexDir :: GitRepo -> Key -> IO FilePath annexDir repo key = do dir <- gitDir repo return $ dir ++ "/annex/" ++ key diff --git a/Types.hs b/Types.hs new file mode 100644 index 000000000..2308b6fde --- /dev/null +++ b/Types.hs @@ -0,0 +1,24 @@ +{- git-annex data types + - -} + +module Types where + +type Key = String + +data Backend = Backend { + -- name of this backend + name :: String, + -- converts a filename to a key + getKey :: GitRepo -> FilePath -> IO (Maybe Key), + -- stores a file's contents to a key + storeFileKey :: GitRepo -> FilePath -> Key -> IO (Bool), + -- retrieves a key's contents to a file + retrieveKeyFile :: IO Key -> FilePath -> IO (Bool) +} + +data GitRepo = GitRepo { + top :: FilePath, + remotes :: [GitRepo], + backends :: [Backend] +} + diff --git a/git-annex.hs b/git-annex.hs index f8c67b1fd..590a7c051 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -1,20 +1,17 @@ {- git-annex main program - -} -import LocationLog +import System.Environment import GitRepo -import Backend +import CmdLine import Annex - --- When adding a new backend, import it here and add it to the backends list. -import qualified BackendFile -import qualified BackendChecksum -import qualified BackendUrl -backends = [BackendFile.backend, BackendChecksum.backend, BackendUrl.backend] +import BackendList main = do + args <- getArgs + flags <- argvToFlags args + repo <- currentRepo gitPrep repo - l <- readLog "demo.log" - writeLog "demo2.log" $ compactLog l + mapM (\f -> dispatch f supportedBackends repo) flags -- cgit v1.2.3 From 026adce5a01381e9a802747f2ddf4ca5635468c9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 18:25:31 -0400 Subject: update --- Annex.hs | 18 ++++++++++++------ CmdLine.hs | 6 +++--- GitRepo.hs | 4 +--- Types.hs | 11 +++++++++-- git-annex.hs | 5 ++--- 5 files changed, 27 insertions(+), 17 deletions(-) diff --git a/Annex.hs b/Annex.hs index bddff1e13..bd3cade58 100644 --- a/Annex.hs +++ b/Annex.hs @@ -10,26 +10,32 @@ import Utility import Locations import Types import Backend +import BackendList + +startAnnex :: IO State +startAnnex = do + r <- currentRepo + return State { repo = r, backends = supportedBackends } {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} -annexFile :: [Backend] -> GitRepo -> FilePath -> IO () -annexFile backends repo file = do - alreadyannexed <- lookupBackend backends repo file +annexFile :: State -> FilePath -> IO () +annexFile state file = do + alreadyannexed <- lookupBackend (backends state) (repo state) file case (alreadyannexed) of Just _ -> error $ "already annexed " ++ file Nothing -> do - stored <- storeFile backends repo file + stored <- storeFile (backends state) (repo state) file case (stored) of Nothing -> error $ "no backend could store " ++ file Just key -> symlink key where symlink key = do - dest <- annexDir repo key + dest <- annexDir (repo state) key createDirectoryIfMissing True (parentDir dest) renameFile file dest createSymbolicLink dest file - gitAdd repo file + gitAdd (repo state) file {- Sets up a git repo for git-annex. May be called repeatedly. -} gitPrep :: GitRepo -> IO () diff --git a/CmdLine.hs b/CmdLine.hs index 79bd55cd9..d848ee8f9 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -34,8 +34,8 @@ argvToFlags argv = do (_,n,errs) -> ioError (userError (concat errs ++ usageInfo header options)) where header = "Usage: git-annex [option] file" -dispatch :: Flag -> [Backend] -> GitRepo -> IO () -dispatch flag backends repo = do +dispatch :: Flag -> State -> IO () +dispatch flag state = do case (flag) of - Add f -> annexFile backends repo f + Add f -> annexFile state f _ -> error "not implemented" diff --git a/GitRepo.hs b/GitRepo.hs index a0909d5ec..06da2ff88 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -8,7 +8,6 @@ import System.Path import Data.String.Utils import Utility import Types -import BackendList {- GitRepo constructor -} gitRepo :: FilePath -> IO GitRepo @@ -16,8 +15,7 @@ gitRepo dir = do -- TOOD query repo for configuration settings; other repositories; etc return GitRepo { top = dir, - remotes = [], - backends = supportedBackends + remotes = [] } {- Path to a repository's gitattributes file. -} diff --git a/Types.hs b/Types.hs index 2308b6fde..cab4b2016 100644 --- a/Types.hs +++ b/Types.hs @@ -3,8 +3,10 @@ module Types where +-- annexed filenames are mapped into keys type Key = String +-- this structure represents a key/value backend data Backend = Backend { -- name of this backend name :: String, @@ -16,9 +18,14 @@ data Backend = Backend { retrieveKeyFile :: IO Key -> FilePath -> IO (Bool) } +-- a git repository data GitRepo = GitRepo { top :: FilePath, - remotes :: [GitRepo], - backends :: [Backend] + remotes :: [GitRepo] } +-- git-annex's runtime state +data State = State { + repo :: GitRepo, + backends :: [Backend] +} diff --git a/git-annex.hs b/git-annex.hs index 590a7c051..2c9b1315f 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -11,7 +11,6 @@ main = do args <- getArgs flags <- argvToFlags args - repo <- currentRepo - gitPrep repo + state <- startAnnex - mapM (\f -> dispatch f supportedBackends repo) flags + mapM (\f -> dispatch f state) flags -- cgit v1.2.3 From 586266e444f72808101a055323887fe08ae7fce3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 19:00:08 -0400 Subject: robustness --- Annex.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/Annex.hs b/Annex.hs index bd3cade58..402c767da 100644 --- a/Annex.hs +++ b/Annex.hs @@ -1,4 +1,4 @@ -{- git-annex +{- git-annex toplevel code -} module Annex where @@ -12,15 +12,21 @@ import Types import Backend import BackendList +{- On startup, examine the git repo, prepare it, and record state for + - later. -} startAnnex :: IO State startAnnex = do r <- currentRepo + gitPrep r + -- TODO query git repo for configuration return State { repo = r, backends = supportedBackends } {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () annexFile state file = do + checkExists file + checkLegal file alreadyannexed <- lookupBackend (backends state) (repo state) file case (alreadyannexed) of Just _ -> error $ "already annexed " ++ file @@ -36,6 +42,16 @@ annexFile state file = do renameFile file dest createSymbolicLink dest file gitAdd (repo state) file + checkExists file = do + exists <- doesFileExist file + case (exists) of + False -> error $ "does not exist: " ++ file + True -> return () + checkLegal file = do + s <- getFileStatus file + case (not (isSymbolicLink s) && not (isRegularFile s)) of + False -> error $ "not a regular file: " ++ file + True -> return () {- Sets up a git repo for git-annex. May be called repeatedly. -} gitPrep :: GitRepo -> IO () -- cgit v1.2.3 From 93d2dc0d6878ccb1067376d2a03193c222429d3e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 19:14:32 -0400 Subject: cache whether a repo is bare --- GitRepo.hs | 9 +++++---- Types.hs | 1 + 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index 06da2ff88..ef76fb976 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -12,17 +12,19 @@ import Types {- GitRepo constructor -} gitRepo :: FilePath -> IO GitRepo gitRepo dir = do + b <- isBareRepo dir + -- TOOD query repo for configuration settings; other repositories; etc return GitRepo { top = dir, + bare = b, remotes = [] } {- Path to a repository's gitattributes file. -} gitAttributes :: GitRepo -> IO String gitAttributes repo = do - bare <- isBareRepo (top repo) - if (bare) + if (bare repo) then return $ (top repo) ++ "/info/.gitattributes" else return $ (top repo) ++ "/.gitattributes" @@ -31,8 +33,7 @@ gitAttributes repo = do - TODO: support GIT_DIR -} gitDir :: GitRepo -> IO String gitDir repo = do - bare <- isBareRepo (top repo) - if (bare) + if (bare repo) then return $ (top repo) else return $ (top repo) ++ "/.git" diff --git a/Types.hs b/Types.hs index cab4b2016..e1f598f0f 100644 --- a/Types.hs +++ b/Types.hs @@ -21,6 +21,7 @@ data Backend = Backend { -- a git repository data GitRepo = GitRepo { top :: FilePath, + bare :: Bool, remotes :: [GitRepo] } -- cgit v1.2.3 From 344f13394fe5b12cbdd5eeb99bb63892c7096bfd Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 19:53:31 -0400 Subject: update --- Annex.hs | 30 +++++++++++++++++++++++------- Backend.hs | 23 +++++++++++++++++++---- BackendFile.hs | 10 +++++++--- BackendUrl.hs | 11 +++++++---- CmdLine.hs | 6 ++++-- Types.hs | 6 ++++-- git-annex.mdwn | 1 + 7 files changed, 65 insertions(+), 22 deletions(-) diff --git a/Annex.hs b/Annex.hs index 402c767da..964532f3f 100644 --- a/Annex.hs +++ b/Annex.hs @@ -44,14 +44,30 @@ annexFile state file = do gitAdd (repo state) file checkExists file = do exists <- doesFileExist file - case (exists) of - False -> error $ "does not exist: " ++ file - True -> return () + if (not exists) + then error $ "does not exist: " ++ file + else return () checkLegal file = do - s <- getFileStatus file - case (not (isSymbolicLink s) && not (isRegularFile s)) of - False -> error $ "not a regular file: " ++ file - True -> return () + s <- getSymbolicLinkStatus file + if ((isSymbolicLink s) || (not $ isRegularFile s)) + then error $ "not a regular file: " ++ file + else return () + +{- Inverse of annexFile. -} +unannexFile :: State -> FilePath -> IO () +unannexFile state file = do + alreadyannexed <- lookupBackend (backends state) (repo state) file + case (alreadyannexed) of + Nothing -> error $ "not annexed " ++ file + Just _ -> do + mkey <- dropFile (backends state) (repo state) file + case (mkey) of + Nothing -> return () + Just key -> do + src <- annexDir (repo state) key + removeFile file + renameFile src file + return () {- Sets up a git repo for git-annex. May be called repeatedly. -} gitPrep :: GitRepo -> IO () diff --git a/Backend.hs b/Backend.hs index 93ceee234..5ddd3aac6 100644 --- a/Backend.hs +++ b/Backend.hs @@ -57,14 +57,29 @@ storeFile (b:bs) repo file = do {- Attempts to retrieve an file from one of the backends, saving it to - a specified location. -} -retrieveFile :: [Backend] -> GitRepo -> FilePath -> FilePath -> IO (Bool) +retrieveFile :: [Backend] -> GitRepo -> FilePath -> FilePath -> IO Bool retrieveFile backends repo file dest = do result <- lookupBackend backends repo file case (result) of Nothing -> return False - Just b -> (retrieveKeyFile b) key dest - where - key = readFile (backendFile b repo file) + Just b -> do + key <- lookupKey b repo file + (retrieveKeyFile b) key dest + +{- Drops the key for a file from the backend that has it. -} +dropFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key) +dropFile backends repo file = do + result <- lookupBackend backends repo file + case (result) of + Nothing -> return Nothing + Just b -> do + key <- lookupKey b repo file + (removeKey b) key + return $ Just key + +{- Looks up the key a backend uses for an already annexed file. -} +lookupKey :: Backend -> GitRepo -> FilePath -> IO Key +lookupKey backend repo file = readFile (backendFile backend repo file) {- Looks up the backend used for an already annexed file. -} lookupBackend :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Backend) diff --git a/BackendFile.hs b/BackendFile.hs index deb4bce7e..de60803c3 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -9,7 +9,8 @@ backend = Backend { name = "file", getKey = keyValue, storeFileKey = dummyStore, - retrieveKeyFile = copyFromOtherRepo + retrieveKeyFile = copyFromOtherRepo, + removeKey = dummyRemove } -- direct mapping from filename to key @@ -18,11 +19,14 @@ keyValue repo file = return $ Just file {- This backend does not really do any independant data storage, - it relies on the file contents in .git/annex/ in this repo, - - and other accessible repos. So storing a file is a no-op. -} + - and other accessible repos. So storing or removing a key is + - a no-op. -} dummyStore :: GitRepo -> FilePath -> Key -> IO (Bool) dummyStore repo file key = return True +dummyRemove :: Key -> IO Bool +dummyRemove url = return False {- Try to find a copy of the file in one of the other repos, - and copy it over to this one. -} -copyFromOtherRepo :: IO Key -> FilePath -> IO (Bool) +copyFromOtherRepo :: Key -> FilePath -> IO (Bool) copyFromOtherRepo key file = error "copyFromOtherRepo unimplemented" -- TODO diff --git a/BackendUrl.hs b/BackendUrl.hs index 2bc34434b..ddeab9e04 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -9,16 +9,19 @@ backend = Backend { name = "url", getKey = keyValue, storeFileKey = dummyStore, - retrieveKeyFile = downloadUrl + retrieveKeyFile = downloadUrl, + removeKey = dummyRemove } -- cannot generate url from filename keyValue :: GitRepo -> FilePath -> IO (Maybe Key) keyValue repo file = return Nothing --- cannot store to urls -dummyStore :: GitRepo -> FilePath -> Key -> IO (Bool) +-- cannot change urls +dummyStore :: GitRepo -> FilePath -> Key -> IO Bool dummyStore repo file url = return False +dummyRemove :: Key -> IO Bool +dummyRemove url = return False -downloadUrl :: IO Key -> FilePath -> IO (Bool) +downloadUrl :: Key -> FilePath -> IO Bool downloadUrl url file = error "downloadUrl unimplemented" diff --git a/CmdLine.hs b/CmdLine.hs index d848ee8f9..3709f836b 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -10,8 +10,8 @@ import System.Console.GetOpt import Types import Annex -data Flag = Add FilePath | Push String | Pull String | - Want FilePath | Get (Maybe FilePath) | Drop FilePath +data Flag = Add FilePath | Push String | Pull String | Want FilePath | + Get (Maybe FilePath) | Drop FilePath | Unannex FilePath deriving Show options :: [OptDescr Flag] @@ -22,6 +22,7 @@ options = , Option ['w'] ["want"] (ReqArg Want "FILE") "request file contents" , Option ['g'] ["get"] (OptArg Get "FILE") "transfer file contents" , Option ['d'] ["drop"] (ReqArg Drop "FILE") "indicate file content not needed" + , Option ['u'] ["unannex"] (ReqArg Unannex "FILE") "undo --add" ] argvToFlags argv = do @@ -38,4 +39,5 @@ dispatch :: Flag -> State -> IO () dispatch flag state = do case (flag) of Add f -> annexFile state f + Unannex f -> unannexFile state f _ -> error "not implemented" diff --git a/Types.hs b/Types.hs index e1f598f0f..6e3727e25 100644 --- a/Types.hs +++ b/Types.hs @@ -13,9 +13,11 @@ data Backend = Backend { -- converts a filename to a key getKey :: GitRepo -> FilePath -> IO (Maybe Key), -- stores a file's contents to a key - storeFileKey :: GitRepo -> FilePath -> Key -> IO (Bool), + storeFileKey :: GitRepo -> FilePath -> Key -> IO Bool, -- retrieves a key's contents to a file - retrieveKeyFile :: IO Key -> FilePath -> IO (Bool) + retrieveKeyFile :: Key -> FilePath -> IO Bool, + -- removes a key + removeKey :: Key -> IO Bool } -- a git repository diff --git a/git-annex.mdwn b/git-annex.mdwn index bc3550398..2996a90b5 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -36,6 +36,7 @@ Enough broad picture, here's how it actually looks: downloaded. * `git annex --drop $file` indicates that you no longer want the file's content to be available in this repository. +* `git annex --unannex $file` undoes a `git annex --add`. * `git annex $file` is a shorthand for either --add or --get. If the file is already known, it does --get, otherwise it does --add. -- cgit v1.2.3 From 200bc6fdb84658593bfb02f34f984531b6710d26 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 21:00:42 -0400 Subject: better option handling multiple-file support for all modes --- Annex.hs | 12 +++--------- CmdLine.hs | 45 +++++++++++++++++++++++---------------------- git-annex.hs | 29 +++++++++++++++++++++++++---- 3 files changed, 51 insertions(+), 35 deletions(-) diff --git a/Annex.hs b/Annex.hs index 964532f3f..ee94a9809 100644 --- a/Annex.hs +++ b/Annex.hs @@ -25,15 +25,14 @@ startAnnex = do - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () annexFile state file = do - checkExists file - checkLegal file alreadyannexed <- lookupBackend (backends state) (repo state) file case (alreadyannexed) of - Just _ -> error $ "already annexed " ++ file + Just _ -> error $ "already annexed: " ++ file Nothing -> do + checkLegal file stored <- storeFile (backends state) (repo state) file case (stored) of - Nothing -> error $ "no backend could store " ++ file + Nothing -> error $ "no backend could store: " ++ file Just key -> symlink key where symlink key = do @@ -42,11 +41,6 @@ annexFile state file = do renameFile file dest createSymbolicLink dest file gitAdd (repo state) file - checkExists file = do - exists <- doesFileExist file - if (not exists) - then error $ "does not exist: " ++ file - else return () checkLegal file = do s <- getSymbolicLinkStatus file if ((isSymbolicLink s) || (not $ isRegularFile s)) diff --git a/CmdLine.hs b/CmdLine.hs index 3709f836b..c956f29a5 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -10,34 +10,35 @@ import System.Console.GetOpt import Types import Annex -data Flag = Add FilePath | Push String | Pull String | Want FilePath | - Get (Maybe FilePath) | Drop FilePath | Unannex FilePath +data Mode = Add | Push | Pull | Want | Get | Drop | Unannex deriving Show -options :: [OptDescr Flag] +options :: [OptDescr Mode] options = - [ Option ['a'] ["add"] (ReqArg Add "FILE") "add file to annex" - , Option ['p'] ["push"] (ReqArg Push "REPO") "push annex to repo" - , Option ['P'] ["pull"] (ReqArg Pull "REPO") "pull annex from repo" - , Option ['w'] ["want"] (ReqArg Want "FILE") "request file contents" - , Option ['g'] ["get"] (OptArg Get "FILE") "transfer file contents" - , Option ['d'] ["drop"] (ReqArg Drop "FILE") "indicate file content not needed" - , Option ['u'] ["unannex"] (ReqArg Unannex "FILE") "undo --add" + [ Option ['a'] ["add"] (NoArg Add) "add files to annex" + , Option ['p'] ["push"] (NoArg Push) "push annex to repos" + , Option ['P'] ["pull"] (NoArg Pull) "pull annex from repos" + , Option ['w'] ["want"] (NoArg Want) "request file contents" + , Option ['g'] ["get"] (NoArg Get) "transfer file contents" + , Option ['d'] ["drop"] (NoArg Drop) "indicate file contents not needed" + , Option ['u'] ["unannex"] (NoArg Unannex) "undo --add" ] -argvToFlags argv = do +argvToMode argv = do case getOpt Permute options argv of - -- no options? add listed files - ([],p,[] ) -> return $ map (\f -> Add f) p - -- all options parsed, return flags - (o,[],[] ) -> return o + -- default mode is Add + ([],files,[]) -> return (Add, files) + -- one mode is normal case + (m:[],files,[]) -> return (m, files) + -- multiple modes is an error + (ms,files,[]) -> ioError (userError ("only one mode should be specified\n" ++ usageInfo header options)) -- error case - (_,n,errs) -> ioError (userError (concat errs ++ usageInfo header options)) - where header = "Usage: git-annex [option] file" + (_,files,errs) -> ioError (userError (concat errs ++ usageInfo header options)) + where header = "Usage: git-annex [mode] file" -dispatch :: Flag -> State -> IO () -dispatch flag state = do - case (flag) of - Add f -> annexFile state f - Unannex f -> unannexFile state f +dispatch :: State -> Mode -> FilePath -> IO () +dispatch state mode file = do + case (mode) of + Add -> annexFile state file + Unannex -> unannexFile state file _ -> error "not implemented" diff --git a/git-annex.hs b/git-annex.hs index 2c9b1315f..22fbe60ca 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -1,16 +1,37 @@ {- git-annex main program - -} +import System.IO import System.Environment -import GitRepo +import Control.Exception import CmdLine import Annex -import BackendList main = do args <- getArgs - flags <- argvToFlags args + (mode, files) <- argvToMode args state <- startAnnex - mapM (\f -> dispatch f state) flags + tryRun 0 $ map (\f -> dispatch state mode f) files + +{- Tries to run a series of actions, not stopping if some error out, + - and propigating an overall error status at the end. -} +tryRun errflag [] = do + if (errflag > 0) + then error "unsuccessful" + else return () +tryRun errflag (a:as) = do + result <- try (a)::IO (Either SomeException ()) + case (result) of + Left err -> do + showErr err + tryRun 1 as + Right _ -> tryRun errflag as + +{- Exception pretty-printing. -} +showErr :: SomeException -> IO () +showErr e = do + let err = show e + hPutStrLn stderr $ "git-annex: " ++ err + return () -- cgit v1.2.3 From dc5e8853f3b0857f2023df6cb23e57bf42b5b858 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 21:04:25 -0400 Subject: missed a file --- Backend.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Backend.hs b/Backend.hs index 5ddd3aac6..eb4a948c4 100644 --- a/Backend.hs +++ b/Backend.hs @@ -75,6 +75,7 @@ dropFile backends repo file = do Just b -> do key <- lookupKey b repo file (removeKey b) key + removeFile $ backendFile b repo file return $ Just key {- Looks up the key a backend uses for an already annexed file. -} -- cgit v1.2.3 From c5d7ca0a5a2c6837d394e23d1a18a1005ee6f1b6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 22:20:52 -0400 Subject: use Data.Time instead of Data.DateTime The latter has shady rounding. The new module is a bit harder to use, but worth it, it adds subsecond timestamps too. --- Annex.hs | 1 + LocationLog.hs | 50 ++++++++++++++++++++++++++++---------------------- demo.log | 12 ++++++------ 3 files changed, 35 insertions(+), 28 deletions(-) diff --git a/Annex.hs b/Annex.hs index ee94a9809..ad94758c5 100644 --- a/Annex.hs +++ b/Annex.hs @@ -11,6 +11,7 @@ import Locations import Types import Backend import BackendList +import LocationLog {- On startup, examine the git repo, prepare it, and record state for - later. -} diff --git a/LocationLog.hs b/LocationLog.hs index a5e9a2679..195596bda 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -18,7 +18,9 @@ module LocationLog where -import Data.DateTime +import Data.Time.Clock.POSIX +import Data.Time +import System.Locale import qualified Data.Map as Map import System.IO import System.Directory @@ -28,6 +30,12 @@ import Utility import Locations import Types +data LogLine = LogLine { + date :: POSIXTime, + status :: LogStatus, + reponame :: String +} deriving (Eq) + data LogStatus = FilePresent | FileMissing | Undefined deriving (Eq) @@ -41,29 +49,30 @@ instance Read LogStatus where readsPrec _ "0" = [(FileMissing, "")] readsPrec _ _ = [(Undefined, "")] -data LogLine = LogLine { - date :: DateTime, - status :: LogStatus, - repo :: String -} deriving (Eq) - instance Show LogLine where - show (LogLine date status repo) = unwords - [(show (toSeconds date)), (show status), repo] + show (LogLine date status reponame) = unwords + [(show date), (show status), reponame] instance Read LogLine where -- This parser is robust in that even unparsable log lines are -- read without an exception being thrown. -- Such lines have a status of Undefined. readsPrec _ string = - if (length w >= 3 && all isDigit date) - then [((LogLine (fromSeconds $ read date) status repo), "")] - else [((LogLine (fromSeconds 0) Undefined ""), "")] + if (length w >= 3) + then case (pdate) of + Just v -> good v + Nothing -> undefined + else undefined where w = words string date = w !! 0 status = read $ w !! 1 - repo = unwords $ drop 2 w + reponame = unwords $ drop 2 w + pdate = (parseTime defaultTimeLocale "%s%Qs" date) :: Maybe UTCTime + + good v = ret $ LogLine (utcTimeToPOSIXSeconds v) status reponame + undefined = ret $ LogLine (0) Undefined "" + ret v = [(v, "")] {- Reads a log file. - Note that the LogLines returned may be in any order. -} @@ -97,9 +106,9 @@ writeLog file lines = do {- Generates a new LogLine with the current date. -} logNow :: LogStatus -> String -> IO LogLine -logNow status repo = do - now <- getCurrentTime - return $ LogLine now status repo +logNow status reponame = do + now <- getPOSIXTime + return $ LogLine now status reponame {- Returns the filename of the log file for a given annexed file. -} logFile :: GitRepo -> FilePath -> IO String @@ -113,7 +122,7 @@ fileLocations :: GitRepo -> FilePath -> IO [String] fileLocations thisrepo file = do log <- logFile thisrepo file lines <- readLog log - return $ map repo (filterPresent lines) + return $ map reponame (filterPresent lines) {- Filters the list of LogLines to find ones where the file - is (or should still be) present. -} @@ -131,12 +140,9 @@ compactLog' map (l:ls) = compactLog' (mapLog map l) ls - information about a repo than the other logs in the map -} mapLog map log = if (better) - then Map.insert (repo log) log map + then Map.insert (reponame log) log map else map where - better = case (Map.lookup (repo log) map) of - -- <= used because two log entries could - -- have the same timestamp; if so the one that - -- is seen last should win. + better = case (Map.lookup (reponame log) map) of Just l -> (date l <= date log) Nothing -> True diff --git a/demo.log b/demo.log index 7a4263056..bdecb7d40 100644 --- a/demo.log +++ b/demo.log @@ -1,11 +1,11 @@ -1286654242 1 repo -1286652724 0 foo -1286656282 1 foo -1286656282 0 repo -1286656281 0 foo +1286654242s 1 repo +1286652724s 0 foo +1286656282s 1 foo +1286656282s 0 repo +1286656281s 0 foo # some garbage, should be ignored a a a a 1 a -1 a a -1286652724 1 foo +1286652724.0001s 1 foo -- cgit v1.2.3 From 2bd3eea0318fe52452fa7077fe94ae3f224ae9c5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 00:19:38 -0400 Subject: add git config lookups for annex.name, annex.backends, etc --- Annex.hs | 33 +++++++++++++++++++++++++++------ BackendList.hs | 18 ++++++++++++++++++ GitRepo.hs | 16 +++++++++++++--- Types.hs | 11 ++++++++--- git-annex.mdwn | 13 +++++++++---- 5 files changed, 75 insertions(+), 16 deletions(-) diff --git a/Annex.hs b/Annex.hs index ad94758c5..882ed2761 100644 --- a/Annex.hs +++ b/Annex.hs @@ -18,20 +18,38 @@ import LocationLog startAnnex :: IO State startAnnex = do r <- currentRepo + config <- getConfig r gitPrep r - -- TODO query git repo for configuration - return State { repo = r, backends = supportedBackends } + return State { + repo = r, + gitconfig = config + } + +{- Query the git repo for relevant configuration settings. -} +getConfig :: GitRepo -> IO GitConfig +getConfig repo = do + -- a name can be configured, if none is, use the repository path + name <- gitConfigGet "annex.name" (top repo) + -- default number of copies to keep of file contents is 1 + numcopies <- gitConfigGet "annex.numcopies" "1" + backends <- gitConfigGet "annex.backends" "" + + return GitConfig { + annex_name = name, + annex_numcopies = read numcopies, + annex_backends = parseBackendList backends + } {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () annexFile state file = do - alreadyannexed <- lookupBackend (backends state) (repo state) file + alreadyannexed <- lookupBackend backends (repo state) file case (alreadyannexed) of Just _ -> error $ "already annexed: " ++ file Nothing -> do checkLegal file - stored <- storeFile (backends state) (repo state) file + stored <- storeFile (annex_backends $ gitconfig state) (repo state) file case (stored) of Nothing -> error $ "no backend could store: " ++ file Just key -> symlink key @@ -47,15 +65,16 @@ annexFile state file = do if ((isSymbolicLink s) || (not $ isRegularFile s)) then error $ "not a regular file: " ++ file else return () + backends = annex_backends $ gitconfig state {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () unannexFile state file = do - alreadyannexed <- lookupBackend (backends state) (repo state) file + alreadyannexed <- lookupBackend backends (repo state) file case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file Just _ -> do - mkey <- dropFile (backends state) (repo state) file + mkey <- dropFile backends (repo state) file case (mkey) of Nothing -> return () Just key -> do @@ -63,6 +82,8 @@ unannexFile state file = do removeFile file renameFile src file return () + where + backends = annex_backends $ gitconfig state {- Sets up a git repo for git-annex. May be called repeatedly. -} gitPrep :: GitRepo -> IO () diff --git a/BackendList.hs b/BackendList.hs index c744949b6..77e4bd817 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -4,6 +4,7 @@ module BackendList where -- When adding a new backend, import it here and add it to the list. +import Types import qualified BackendFile import qualified BackendChecksum import qualified BackendUrl @@ -12,3 +13,20 @@ supportedBackends = , BackendChecksum.backend , BackendUrl.backend ] + +{- Parses a string with a list of backend names into + - a list of Backend objects. If the list is empty, + - defaults to supportedBackends. -} +parseBackendList :: String -> [Backend] +parseBackendList s = + if (length s == 0) + then supportedBackends + else map (lookupBackendName) $ words s + +{- Looks up a supported backed by name. -} +lookupBackendName :: String -> Backend +lookupBackendName s = + if ((length matches) /= 1) + then error $ "unknown backend " ++ s + else matches !! 0 + where matches = filter (\b -> s == name b) supportedBackends diff --git a/GitRepo.hs b/GitRepo.hs index ef76fb976..3a8a8110d 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -5,7 +5,10 @@ module GitRepo where import Directory import System.Directory import System.Path +import System.Cmd.Utils +import System.IO import Data.String.Utils +import Control.Exception import Utility import Types @@ -14,11 +17,9 @@ gitRepo :: FilePath -> IO GitRepo gitRepo dir = do b <- isBareRepo dir - -- TOOD query repo for configuration settings; other repositories; etc return GitRepo { top = dir, - bare = b, - remotes = [] + bare = b } {- Path to a repository's gitattributes file. -} @@ -53,10 +54,19 @@ gitRelative repo file = drop (length absrepo) absfile Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo {- Stages a changed file in git's index. -} +gitAdd :: GitRepo -> FilePath -> IO () gitAdd repo file = do -- TODO return () +{- Queries git-config. -} +gitConfigGet :: String -> String -> IO String +gitConfigGet name defaultValue = + handle ((\_ -> return defaultValue)::SomeException -> IO String) $ + pOpen ReadFromPipe "git" ["config", "--get", name] $ \h -> do + ret <- hGetLine h + return ret + {- Finds the current git repository, which may be in a parent directory. -} currentRepo :: IO GitRepo currentRepo = do diff --git a/Types.hs b/Types.hs index 6e3727e25..5c5a428d5 100644 --- a/Types.hs +++ b/Types.hs @@ -23,12 +23,17 @@ data Backend = Backend { -- a git repository data GitRepo = GitRepo { top :: FilePath, - bare :: Bool, - remotes :: [GitRepo] + bare :: Bool } -- git-annex's runtime state data State = State { repo :: GitRepo, - backends :: [Backend] + gitconfig :: GitConfig +} + +data GitConfig = GitConfig { + annex_name :: String, + annex_numcopies :: Int, + annex_backends :: [Backend] } diff --git a/git-annex.mdwn b/git-annex.mdwn index 2996a90b5..6bfdd57c7 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -124,8 +124,9 @@ so the lines may be in arbitrary order, but it will never conflict.) ## configuration * `annex.numcopies` -- number of copies of files to keep -* `annex.backend` -- name of the default key/value backend to use to - store new files +* `annex.backends` -- space-separated list of names of + the key/value backends to use. The first listed is used to store + new files. * `annex.name` -- allows specifying a unique name for this repository. If not specified, the name is derived from its directory's location and the hostname. When a repository is on removable media it is useful to give @@ -145,11 +146,15 @@ If the symlink to annexed content is relative, moving it to a subdir will break it. But it it's absolute, moving the git repo (or mounting its drive elsewhere) will break it. Either: -* Use relative links and need `git annex mv` to move (or post-commit +* Use relative links and need `git annex --mv` to move (or post-commit hook that caches moves and updates links). * Use absolute links and need `git annex fixlinks` when location changes; note that would also mean that git would see the symlink targets changed - and want to commit the change. + and want to commit the change. And, other clones of the repo would + diverge and there would be conflicts on the symlink text. Ugh. + +Hard links are not an option, because git would then happily commit the +file content. Amoung other reasons.. ### free space determination -- cgit v1.2.3 From 779ebba96153e712803c8284a0502d7080c609bf Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 00:22:50 -0400 Subject: adjust merge config *.log will merge, but foo.$backend files will not --- Annex.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Annex.hs b/Annex.hs index 882ed2761..e3956cbf2 100644 --- a/Annex.hs +++ b/Annex.hs @@ -89,7 +89,7 @@ unannexFile state file = do gitPrep :: GitRepo -> IO () gitPrep repo = do -- configure git to use union merge driver on state files - let attrLine = stateLoc ++ "/* merge=union" + let attrLine = stateLoc ++ "/*.log merge=union" attributes <- gitAttributes repo exists <- doesFileExist attributes if (not exists) -- cgit v1.2.3 From ecf19abf76d449d2e69d89518566a7cce899708d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 00:23:49 -0400 Subject: foo --- Locations.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Locations.hs b/Locations.hs index 50f94a727..b25e99197 100644 --- a/Locations.hs +++ b/Locations.hs @@ -12,8 +12,8 @@ annexDir repo key = do dir <- gitDir repo return $ dir ++ "/annex/" ++ key -{- Long-term state is stored in files inside the .git-annex directory - - in the git repository. -} +{- Long-term, cross-repo state is stored in files inside the .git-annex + - directory, in the git repository. -} stateLoc = ".git-annex" gitStateDir :: GitRepo -> FilePath gitStateDir repo = (top repo) ++ "/" ++ stateLoc ++ "/" -- cgit v1.2.3 From de3dafae80f45af8db56dc95e11863f049cf3cb2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 16:35:28 -0400 Subject: update --- TODO | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 TODO diff --git a/TODO b/TODO new file mode 100644 index 000000000..ea930f803 --- /dev/null +++ b/TODO @@ -0,0 +1,9 @@ +* bug when annexing files in a subdir of a git repo +* how to handle git mv file? + +* query remotes for their annex.name settings + +* hook up LocationLog +* --push/--pull/--get/--want/--drop + +* finish BackendUrl and BackendChecksum -- cgit v1.2.3 From af82586adff96f18fe768e432f501c647401262f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 17:19:55 -0400 Subject: split up Types --- Annex.hs | 19 ++++++++++++++++++- Backend.hs | 18 +++++++++++++++++- BackendChecksum.hs | 3 ++- BackendFile.hs | 3 ++- BackendList.hs | 3 ++- BackendUrl.hs | 3 ++- CmdLine.hs | 1 - GitRepo.hs | 7 ++++++- LocationLog.hs | 1 - Locations.hs | 7 ------- Types.hs | 39 --------------------------------------- 11 files changed, 49 insertions(+), 55 deletions(-) delete mode 100644 Types.hs diff --git a/Annex.hs b/Annex.hs index e3956cbf2..cedc478a4 100644 --- a/Annex.hs +++ b/Annex.hs @@ -8,11 +8,28 @@ import System.Directory import GitRepo import Utility import Locations -import Types import Backend import BackendList import LocationLog +-- git-annex's runtime state +data State = State { + repo :: GitRepo, + gitconfig :: GitConfig +} + +data GitConfig = GitConfig { + annex_name :: String, + annex_numcopies :: Int, + annex_backends :: [Backend] +} + +{- An annexed file's content is stored somewhere under .git/annex/ -} +annexDir :: GitRepo -> Key -> IO FilePath +annexDir repo key = do + dir <- gitDir repo + return $ dir ++ "/annex/" ++ key + {- On startup, examine the git repo, prepare it, and record state for - later. -} startAnnex :: IO State diff --git a/Backend.hs b/Backend.hs index eb4a948c4..fb7d5666f 100644 --- a/Backend.hs +++ b/Backend.hs @@ -22,7 +22,23 @@ import System.Directory import Locations import GitRepo import Utility -import Types + +-- annexed filenames are mapped into keys +type Key = FilePath + +-- this structure represents a key/value backend +data Backend = Backend { + -- name of this backend + name :: String, + -- converts a filename to a key + getKey :: GitRepo -> FilePath -> IO (Maybe Key), + -- stores a file's contents to a key + storeFileKey :: GitRepo -> FilePath -> Key -> IO Bool, + -- retrieves a key's contents to a file + retrieveKeyFile :: Key -> FilePath -> IO Bool, + -- removes a key + removeKey :: Key -> IO Bool +} instance Show Backend where show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" diff --git a/BackendChecksum.hs b/BackendChecksum.hs index 18ff0cb57..e262962ca 100644 --- a/BackendChecksum.hs +++ b/BackendChecksum.hs @@ -3,9 +3,10 @@ module BackendChecksum (backend) where -import Types import qualified BackendFile import Data.Digest.Pure.SHA +import Backend +import GitRepo -- based on BackendFile just with a different key type backend = BackendFile.backend { diff --git a/BackendFile.hs b/BackendFile.hs index de60803c3..831f80417 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -3,7 +3,8 @@ module BackendFile (backend) where -import Types +import Backend +import GitRepo backend = Backend { name = "file", diff --git a/BackendList.hs b/BackendList.hs index 77e4bd817..c3a1b13a1 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -3,8 +3,9 @@ module BackendList where +import Backend + -- When adding a new backend, import it here and add it to the list. -import Types import qualified BackendFile import qualified BackendChecksum import qualified BackendUrl diff --git a/BackendUrl.hs b/BackendUrl.hs index ddeab9e04..f08f0bdb4 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -3,7 +3,8 @@ module BackendUrl (backend) where -import Types +import Backend +import GitRepo backend = Backend { name = "url", diff --git a/CmdLine.hs b/CmdLine.hs index c956f29a5..53707cd71 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -7,7 +7,6 @@ module CmdLine where import System.Console.GetOpt -import Types import Annex data Mode = Add | Push | Pull | Want | Get | Drop | Unannex diff --git a/GitRepo.hs b/GitRepo.hs index 3a8a8110d..c26f752ef 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -10,7 +10,12 @@ import System.IO import Data.String.Utils import Control.Exception import Utility -import Types + +-- a git repository +data GitRepo = GitRepo { + top :: FilePath, + bare :: Bool +} {- GitRepo constructor -} gitRepo :: FilePath -> IO GitRepo diff --git a/LocationLog.hs b/LocationLog.hs index 195596bda..8e6b56fe8 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -28,7 +28,6 @@ import Data.Char import GitRepo import Utility import Locations -import Types data LogLine = LogLine { date :: POSIXTime, diff --git a/Locations.hs b/Locations.hs index b25e99197..22a0db8e2 100644 --- a/Locations.hs +++ b/Locations.hs @@ -3,15 +3,8 @@ module Locations where -import Types import GitRepo -{- An annexed file's content is stored somewhere under .git/annex/ -} -annexDir :: GitRepo -> Key -> IO FilePath -annexDir repo key = do - dir <- gitDir repo - return $ dir ++ "/annex/" ++ key - {- Long-term, cross-repo state is stored in files inside the .git-annex - directory, in the git repository. -} stateLoc = ".git-annex" diff --git a/Types.hs b/Types.hs deleted file mode 100644 index 5c5a428d5..000000000 --- a/Types.hs +++ /dev/null @@ -1,39 +0,0 @@ -{- git-annex data types - - -} - -module Types where - --- annexed filenames are mapped into keys -type Key = String - --- this structure represents a key/value backend -data Backend = Backend { - -- name of this backend - name :: String, - -- converts a filename to a key - getKey :: GitRepo -> FilePath -> IO (Maybe Key), - -- stores a file's contents to a key - storeFileKey :: GitRepo -> FilePath -> Key -> IO Bool, - -- retrieves a key's contents to a file - retrieveKeyFile :: Key -> FilePath -> IO Bool, - -- removes a key - removeKey :: Key -> IO Bool -} - --- a git repository -data GitRepo = GitRepo { - top :: FilePath, - bare :: Bool -} - --- git-annex's runtime state -data State = State { - repo :: GitRepo, - gitconfig :: GitConfig -} - -data GitConfig = GitConfig { - annex_name :: String, - annex_numcopies :: Int, - annex_backends :: [Backend] -} -- cgit v1.2.3 From ebc3fbe9ae2c5cc52332c77a92697c2517ce8263 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 17:52:46 -0400 Subject: explicit exports --- Annex.hs | 11 ++++++++--- Backend.hs | 29 ++++++++--------------------- BackendChecksum.hs | 2 +- BackendFile.hs | 2 +- BackendList.hs | 8 ++++++-- BackendUrl.hs | 2 +- CmdLine.hs | 5 ++++- GitRepo.hs | 22 +++++++++++++++++----- LocationLog.hs | 3 ++- Locations.hs | 7 +++++-- Utility.hs | 6 +++++- 11 files changed, 58 insertions(+), 39 deletions(-) diff --git a/Annex.hs b/Annex.hs index cedc478a4..8660febd5 100644 --- a/Annex.hs +++ b/Annex.hs @@ -1,7 +1,12 @@ {- git-annex toplevel code -} -module Annex where +module Annex ( + State, + startAnnex, + annexFile, + unannexFile +) where import System.Posix.Files import System.Directory @@ -34,7 +39,7 @@ annexDir repo key = do - later. -} startAnnex :: IO State startAnnex = do - r <- currentRepo + r <- gitRepoCurrent config <- getConfig r gitPrep r return State { @@ -46,7 +51,7 @@ startAnnex = do getConfig :: GitRepo -> IO GitConfig getConfig repo = do -- a name can be configured, if none is, use the repository path - name <- gitConfigGet "annex.name" (top repo) + name <- gitConfigGet "annex.name" (gitRepoTop repo) -- default number of copies to keep of file contents is 1 numcopies <- gitConfigGet "annex.numcopies" "1" backends <- gitConfigGet "annex.backends" "" diff --git a/Backend.hs b/Backend.hs index fb7d5666f..2d3ea42d6 100644 --- a/Backend.hs +++ b/Backend.hs @@ -16,32 +16,19 @@ - to store different files' contents in a given repository. - -} -module Backend where +module Backend ( + Key, + Backend, -- note only data type is exported, not destructors + lookupBackend, + storeFile, + dropFile +) where import System.Directory import Locations import GitRepo import Utility - --- annexed filenames are mapped into keys -type Key = FilePath - --- this structure represents a key/value backend -data Backend = Backend { - -- name of this backend - name :: String, - -- converts a filename to a key - getKey :: GitRepo -> FilePath -> IO (Maybe Key), - -- stores a file's contents to a key - storeFileKey :: GitRepo -> FilePath -> Key -> IO Bool, - -- retrieves a key's contents to a file - retrieveKeyFile :: Key -> FilePath -> IO Bool, - -- removes a key - removeKey :: Key -> IO Bool -} - -instance Show Backend where - show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" +import BackendType {- Name of state file that holds the key for an annexed file, - using a given backend. -} diff --git a/BackendChecksum.hs b/BackendChecksum.hs index e262962ca..e80dbe793 100644 --- a/BackendChecksum.hs +++ b/BackendChecksum.hs @@ -5,7 +5,7 @@ module BackendChecksum (backend) where import qualified BackendFile import Data.Digest.Pure.SHA -import Backend +import BackendType import GitRepo -- based on BackendFile just with a different key type diff --git a/BackendFile.hs b/BackendFile.hs index 831f80417..ae53f460f 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -3,7 +3,7 @@ module BackendFile (backend) where -import Backend +import BackendType import GitRepo backend = Backend { diff --git a/BackendList.hs b/BackendList.hs index c3a1b13a1..f733a44be 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -1,9 +1,13 @@ {- git-annex backend list - -} -module BackendList where +module BackendList ( + supportedBackends, + parseBackendList, + lookupBackendName +) where -import Backend +import BackendType -- When adding a new backend, import it here and add it to the list. import qualified BackendFile diff --git a/BackendUrl.hs b/BackendUrl.hs index f08f0bdb4..4ba1dbadb 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -3,7 +3,7 @@ module BackendUrl (backend) where -import Backend +import BackendType import GitRepo backend = Backend { diff --git a/CmdLine.hs b/CmdLine.hs index 53707cd71..cc8708889 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -4,7 +4,10 @@ - System.Console.CmdArgs.Implicit but it is not yet packaged in Debian. -} -module CmdLine where +module CmdLine ( + argvToMode, + dispatch +) where import System.Console.GetOpt import Annex diff --git a/GitRepo.hs b/GitRepo.hs index c26f752ef..d01ba642b 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -1,6 +1,15 @@ {- git repository handling -} -module GitRepo where +module GitRepo ( + GitRepo, + gitRepoCurrent, + gitRepoTop, + gitDir, + gitRelative, + gitConfigGet, + gitAdd, + gitAttributes +) where import Directory import System.Directory @@ -13,7 +22,7 @@ import Utility -- a git repository data GitRepo = GitRepo { - top :: FilePath, + gitRepoTop :: FilePath, bare :: Bool } @@ -23,10 +32,13 @@ gitRepo dir = do b <- isBareRepo dir return GitRepo { - top = dir, + gitRepoTop = dir, bare = b } +{- Short name used in here for top of repo. -} +top = gitRepoTop + {- Path to a repository's gitattributes file. -} gitAttributes :: GitRepo -> IO String gitAttributes repo = do @@ -73,8 +85,8 @@ gitConfigGet name defaultValue = return ret {- Finds the current git repository, which may be in a parent directory. -} -currentRepo :: IO GitRepo -currentRepo = do +gitRepoCurrent :: IO GitRepo +gitRepoCurrent = do cwd <- getCurrentDirectory top <- seekUp cwd isRepoTop case top of diff --git a/LocationLog.hs b/LocationLog.hs index 8e6b56fe8..31d454f10 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -16,7 +16,8 @@ - so the lines may be in arbitrary order, but it will never conflict. -} -module LocationLog where +module LocationLog ( +) where import Data.Time.Clock.POSIX import Data.Time diff --git a/Locations.hs b/Locations.hs index 22a0db8e2..31bb3d9de 100644 --- a/Locations.hs +++ b/Locations.hs @@ -1,7 +1,10 @@ {- git-annex file locations -} -module Locations where +module Locations ( + gitStateDir, + stateLoc +) where import GitRepo @@ -9,4 +12,4 @@ import GitRepo - directory, in the git repository. -} stateLoc = ".git-annex" gitStateDir :: GitRepo -> FilePath -gitStateDir repo = (top repo) ++ "/" ++ stateLoc ++ "/" +gitStateDir repo = (gitRepoTop repo) ++ "/" ++ stateLoc ++ "/" diff --git a/Utility.hs b/Utility.hs index d1eb247d3..dea53967f 100644 --- a/Utility.hs +++ b/Utility.hs @@ -1,7 +1,11 @@ {- git-annex utility functions -} -module Utility where +module Utility ( + withFileLocked, + hGetContentsStrict, + parentDir +) where import System.IO import System.Posix.IO -- cgit v1.2.3 From 104fe9132af2553a29631b1cd38cc79169e9d9f2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 18:15:05 -0400 Subject: cleanup --- Annex.hs | 47 +++++++++++++++++++++++++---------------------- 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/Annex.hs b/Annex.hs index 8660febd5..972cb3e0f 100644 --- a/Annex.hs +++ b/Annex.hs @@ -20,10 +20,10 @@ import LocationLog -- git-annex's runtime state data State = State { repo :: GitRepo, - gitconfig :: GitConfig + config :: Config } -data GitConfig = GitConfig { +data Config = Config { annex_name :: String, annex_numcopies :: Int, annex_backends :: [Backend] @@ -40,26 +40,11 @@ annexDir repo key = do startAnnex :: IO State startAnnex = do r <- gitRepoCurrent - config <- getConfig r + config <- queryConfig r gitPrep r return State { repo = r, - gitconfig = config - } - -{- Query the git repo for relevant configuration settings. -} -getConfig :: GitRepo -> IO GitConfig -getConfig repo = do - -- a name can be configured, if none is, use the repository path - name <- gitConfigGet "annex.name" (gitRepoTop repo) - -- default number of copies to keep of file contents is 1 - numcopies <- gitConfigGet "annex.numcopies" "1" - backends <- gitConfigGet "annex.backends" "" - - return GitConfig { - annex_name = name, - annex_numcopies = read numcopies, - annex_backends = parseBackendList backends + config = config } {- Annexes a file, storing it in a backend, and then moving it into @@ -71,7 +56,7 @@ annexFile state file = do Just _ -> error $ "already annexed: " ++ file Nothing -> do checkLegal file - stored <- storeFile (annex_backends $ gitconfig state) (repo state) file + stored <- storeFile backends (repo state) file case (stored) of Nothing -> error $ "no backend could store: " ++ file Just key -> symlink key @@ -87,7 +72,7 @@ annexFile state file = do if ((isSymbolicLink s) || (not $ isRegularFile s)) then error $ "not a regular file: " ++ file else return () - backends = annex_backends $ gitconfig state + backends = getConfig state annex_backends {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () @@ -105,7 +90,22 @@ unannexFile state file = do renameFile src file return () where - backends = annex_backends $ gitconfig state + backends = getConfig state annex_backends + +{- Query the git repo for relevant configuration settings. -} +queryConfig :: GitRepo -> IO Config +queryConfig repo = do + -- a name can be configured, if none is, use the repository path + name <- gitConfigGet "annex.name" (gitRepoTop repo) + -- default number of copies to keep of file contents is 1 + numcopies <- gitConfigGet "annex.numcopies" "1" + backends <- gitConfigGet "annex.backends" "" + + return Config { + annex_name = name, + annex_numcopies = read numcopies, + annex_backends = parseBackendList backends + } {- Sets up a git repo for git-annex. May be called repeatedly. -} gitPrep :: GitRepo -> IO () @@ -126,3 +126,6 @@ gitPrep repo = do gitAdd repo attributes else return () +{- Looks up a key in a State's Config -} +getConfig :: State -> (Config -> b) -> b +getConfig state key = key $ config state -- cgit v1.2.3 From f516b820caa702ee76c85b005fef285b8372c4da Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 18:15:14 -0400 Subject: add --- BackendType.hs | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) create mode 100644 BackendType.hs diff --git a/BackendType.hs b/BackendType.hs new file mode 100644 index 000000000..3bc822f32 --- /dev/null +++ b/BackendType.hs @@ -0,0 +1,31 @@ +{- git-annex backend data types + - -} + +module BackendType ( + -- the entire types are exported, for use in backend implementations + Key(..), + Backend(..) +) where + +import GitRepo + +-- annexed filenames are mapped into keys +type Key = FilePath + +-- this structure represents a key/value backend +data Backend = Backend { + -- name of this backend + name :: String, + -- converts a filename to a key + getKey :: GitRepo -> FilePath -> IO (Maybe Key), + -- stores a file's contents to a key + storeFileKey :: GitRepo -> FilePath -> Key -> IO Bool, + -- retrieves a key's contents to a file + retrieveKeyFile :: Key -> FilePath -> IO Bool, + -- removes a key + removeKey :: Key -> IO Bool +} + +instance Show Backend where + show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" + -- cgit v1.2.3 From 8f99409518d343ded6a1355b4366bd21ee4cf66d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 18:31:41 -0400 Subject: simpler exception handling --- GitRepo.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index d01ba642b..de54f6dca 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -16,8 +16,8 @@ import System.Directory import System.Path import System.Cmd.Utils import System.IO +import System.IO.Error import Data.String.Utils -import Control.Exception import Utility -- a git repository @@ -79,7 +79,7 @@ gitAdd repo file = do {- Queries git-config. -} gitConfigGet :: String -> String -> IO String gitConfigGet name defaultValue = - handle ((\_ -> return defaultValue)::SomeException -> IO String) $ + flip catch (\_ -> return defaultValue) $ pOpen ReadFromPipe "git" ["config", "--get", name] $ \h -> do ret <- hGetLine h return ret -- cgit v1.2.3 From 530f16b980bbfe70b49d5112ad9c48a9754e69c5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 18:39:09 -0400 Subject: better result summary --- git-annex.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/git-annex.hs b/git-annex.hs index 22fbe60ca..ec80359b6 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -13,21 +13,21 @@ main = do state <- startAnnex - tryRun 0 $ map (\f -> dispatch state mode f) files + tryRun 0 0 $ map (\f -> dispatch state mode f) files {- Tries to run a series of actions, not stopping if some error out, - and propigating an overall error status at the end. -} -tryRun errflag [] = do - if (errflag > 0) - then error "unsuccessful" +tryRun errnum oknum [] = do + if (errnum > 0) + then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " succeeded" else return () -tryRun errflag (a:as) = do +tryRun errnum oknum (a:as) = do result <- try (a)::IO (Either SomeException ()) case (result) of Left err -> do showErr err - tryRun 1 as - Right _ -> tryRun errflag as + tryRun (errnum + 1) oknum as + Right _ -> tryRun errnum (oknum + 1) as {- Exception pretty-printing. -} showErr :: SomeException -> IO () -- cgit v1.2.3 From f6306bc301af7db3da7afa6e095014de37e2bce3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 18:39:36 -0400 Subject: wording --- git-annex.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/git-annex.hs b/git-annex.hs index ec80359b6..7bcd4de22 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -19,7 +19,7 @@ main = do - and propigating an overall error status at the end. -} tryRun errnum oknum [] = do if (errnum > 0) - then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " succeeded" + then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok" else return () tryRun errnum oknum (a:as) = do result <- try (a)::IO (Either SomeException ()) -- cgit v1.2.3 From cd1e39b127e96298685906e455ff186312d08029 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 23:22:38 -0400 Subject: moved config reading into GitRepo --- Annex.hs | 52 ++++++++---------------------------- GitRepo.hs | 89 +++++++++++++++++++++++++++++++++++++++++++++----------------- 2 files changed, 76 insertions(+), 65 deletions(-) diff --git a/Annex.hs b/Annex.hs index 972cb3e0f..abb7bff6e 100644 --- a/Annex.hs +++ b/Annex.hs @@ -20,49 +20,41 @@ import LocationLog -- git-annex's runtime state data State = State { repo :: GitRepo, - config :: Config -} - -data Config = Config { - annex_name :: String, - annex_numcopies :: Int, - annex_backends :: [Backend] + backends :: [Backend] } {- An annexed file's content is stored somewhere under .git/annex/ -} -annexDir :: GitRepo -> Key -> IO FilePath -annexDir repo key = do - dir <- gitDir repo - return $ dir ++ "/annex/" ++ key +annexDir :: GitRepo -> Key -> FilePath +annexDir repo key = gitDir repo ++ "/annex/" ++ key {- On startup, examine the git repo, prepare it, and record state for - later. -} startAnnex :: IO State startAnnex = do r <- gitRepoCurrent - config <- queryConfig r gitPrep r + return State { repo = r, - config = config + backends = parseBackendList $ gitConfig r "annex.backends" "" } {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () annexFile state file = do - alreadyannexed <- lookupBackend backends (repo state) file + alreadyannexed <- lookupBackend (backends state) (repo state) file case (alreadyannexed) of Just _ -> error $ "already annexed: " ++ file Nothing -> do checkLegal file - stored <- storeFile backends (repo state) file + stored <- storeFile (backends state) (repo state) file case (stored) of Nothing -> error $ "no backend could store: " ++ file Just key -> symlink key where symlink key = do - dest <- annexDir (repo state) key + let dest = annexDir (repo state) key createDirectoryIfMissing True (parentDir dest) renameFile file dest createSymbolicLink dest file @@ -72,40 +64,22 @@ annexFile state file = do if ((isSymbolicLink s) || (not $ isRegularFile s)) then error $ "not a regular file: " ++ file else return () - backends = getConfig state annex_backends {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () unannexFile state file = do - alreadyannexed <- lookupBackend backends (repo state) file + alreadyannexed <- lookupBackend (backends state) (repo state) file case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file Just _ -> do - mkey <- dropFile backends (repo state) file + mkey <- dropFile (backends state) (repo state) file case (mkey) of Nothing -> return () Just key -> do - src <- annexDir (repo state) key + let src = annexDir (repo state) key removeFile file renameFile src file return () - where - backends = getConfig state annex_backends - -{- Query the git repo for relevant configuration settings. -} -queryConfig :: GitRepo -> IO Config -queryConfig repo = do - -- a name can be configured, if none is, use the repository path - name <- gitConfigGet "annex.name" (gitRepoTop repo) - -- default number of copies to keep of file contents is 1 - numcopies <- gitConfigGet "annex.numcopies" "1" - backends <- gitConfigGet "annex.backends" "" - - return Config { - annex_name = name, - annex_numcopies = read numcopies, - annex_backends = parseBackendList backends - } {- Sets up a git repo for git-annex. May be called repeatedly. -} gitPrep :: GitRepo -> IO () @@ -125,7 +99,3 @@ gitPrep repo = do appendFile attributes $ attrLine ++ "\n" gitAdd repo attributes else return () - -{- Looks up a key in a State's Config -} -getConfig :: State -> (Config -> b) -> b -getConfig state key = key $ config state diff --git a/GitRepo.hs b/GitRepo.hs index de54f6dca..7ae6584dd 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -1,4 +1,9 @@ -{- git repository handling -} +{- git repository handling + - + - This is written to be completely independant of git-annex and should be + - suitable for other uses. + - + - -} module GitRepo ( GitRepo, @@ -6,38 +11,46 @@ module GitRepo ( gitRepoTop, gitDir, gitRelative, - gitConfigGet, + gitConfig, gitAdd, gitAttributes ) where import Directory +import System import System.Directory import System.Path import System.Cmd.Utils import System.IO -import System.IO.Error +import System.Posix.Process import Data.String.Utils +import Data.Map as Map (fromList, empty, lookup, Map) import Utility -- a git repository data GitRepo = GitRepo { - gitRepoTop :: FilePath, - bare :: Bool -} + top :: FilePath, + bare :: Bool, + config :: Map String String +} deriving (Show, Read, Eq) {- GitRepo constructor -} gitRepo :: FilePath -> IO GitRepo gitRepo dir = do b <- isBareRepo dir - return GitRepo { - gitRepoTop = dir, - bare = b + let r = GitRepo { + top = dir, + bare = b, + config = Map.empty } + r' <- gitConfigRead r -{- Short name used in here for top of repo. -} -top = gitRepoTop + return r' + +{- Field accessor. -} +gitRepoTop :: GitRepo -> FilePath +gitRepoTop repo = top repo {- Path to a repository's gitattributes file. -} gitAttributes :: GitRepo -> IO String @@ -49,11 +62,11 @@ gitAttributes repo = do {- Path to a repository's .git directory. - (For a bare repository, that is the root of the repository.) - TODO: support GIT_DIR -} -gitDir :: GitRepo -> IO String -gitDir repo = do +gitDir :: GitRepo -> String +gitDir repo = if (bare repo) - then return $ (top repo) - else return $ (top repo) ++ "/.git" + then top repo + else top repo ++ "/.git" {- Given a relative or absolute filename, calculates the name to use - to refer to the file relative to a git repository directory. @@ -72,17 +85,45 @@ gitRelative repo file = drop (length absrepo) absfile {- Stages a changed file in git's index. -} gitAdd :: GitRepo -> FilePath -> IO () -gitAdd repo file = do - -- TODO +gitAdd repo file = runGit repo ["add", file] + +{- Constructs a git command line operating on the specified repo. -} +gitCommandLine :: GitRepo -> [String] -> [String] +gitCommandLine repo params = + -- force use of specified repo via --git-dir and --work-tree + ["--git-dir="++(gitDir repo), "--work-tree="++(top repo)] ++ params + +{- Runs git in the specified repo. -} +runGit :: GitRepo -> [String] -> IO () +runGit repo params = do + r <- executeFile "git" True (gitCommandLine repo params) Nothing return () -{- Queries git-config. -} -gitConfigGet :: String -> String -> IO String -gitConfigGet name defaultValue = - flip catch (\_ -> return defaultValue) $ - pOpen ReadFromPipe "git" ["config", "--get", name] $ \h -> do - ret <- hGetLine h - return ret +{- Runs a git subcommand and returns its output. -} +gitPipeRead :: GitRepo -> [String] -> IO String +gitPipeRead repo params = + pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do + ret <- hGetContentsStrict h + return ret + +{- Runs git config and populates a repo with its settings. -} +gitConfigRead :: GitRepo -> IO GitRepo +gitConfigRead repo = do + c <- gitPipeRead repo ["config", "--list"] + return repo { config = Map.fromList $ parse c } + where + parse s = map ( \l -> (key l, val l) ) $ lines s + keyval l = split sep l :: [String] + key l = (keyval l) !! 0 + val l = join sep $ drop 1 $ keyval l + sep = "=" + +{- Returns a single git config setting, or a default value if not set. -} +gitConfig :: GitRepo -> String -> String -> String +gitConfig repo key defaultValue = + case (Map.lookup key $ config repo) of + Just value -> value + Nothing -> defaultValue {- Finds the current git repository, which may be in a parent directory. -} gitRepoCurrent :: IO GitRepo -- cgit v1.2.3 From 16b551726d9d846a51656b7b1d4736a3b1b438f4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 23:27:48 -0400 Subject: minor --- GitRepo.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index 7ae6584dd..2f9084ff7 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -112,10 +112,11 @@ gitConfigRead repo = do c <- gitPipeRead repo ["config", "--list"] return repo { config = Map.fromList $ parse c } where - parse s = map ( \l -> (key l, val l) ) $ lines s - keyval l = split sep l :: [String] + parse s = map pair $ lines s + pair l = (key l, val l) key l = (keyval l) !! 0 val l = join sep $ drop 1 $ keyval l + keyval l = split sep l :: [String] sep = "=" {- Returns a single git config setting, or a default value if not set. -} -- cgit v1.2.3 From 107074d6623a687d046615a5034af10be7ff1756 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Oct 2010 23:41:12 -0400 Subject: fiddle --- GitRepo.hs | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index 2f9084ff7..2a97e6070 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -7,6 +7,7 @@ module GitRepo ( GitRepo, + gitRepoFromPath, gitRepoCurrent, gitRepoTop, gitDir, @@ -35,8 +36,8 @@ data GitRepo = GitRepo { } deriving (Show, Read, Eq) {- GitRepo constructor -} -gitRepo :: FilePath -> IO GitRepo -gitRepo dir = do +gitRepoFromPath :: FilePath -> IO GitRepo +gitRepoFromPath dir = do b <- isBareRepo dir let r = GitRepo { @@ -110,14 +111,17 @@ gitPipeRead repo params = gitConfigRead :: GitRepo -> IO GitRepo gitConfigRead repo = do c <- gitPipeRead repo ["config", "--list"] - return repo { config = Map.fromList $ parse c } - where - parse s = map pair $ lines s - pair l = (key l, val l) - key l = (keyval l) !! 0 - val l = join sep $ drop 1 $ keyval l - keyval l = split sep l :: [String] - sep = "=" + return repo { config = gitConfigParse c } + +{- Parses git config --list output into a config map. -} +gitConfigParse :: String -> Map.Map String String +gitConfigParse s = Map.fromList $ map pair $ lines s + where + pair l = (key l, val l) + key l = (keyval l) !! 0 + val l = join sep $ drop 1 $ keyval l + keyval l = split sep l :: [String] + sep = "=" {- Returns a single git config setting, or a default value if not set. -} gitConfig :: GitRepo -> String -> String -> String @@ -132,7 +136,7 @@ gitRepoCurrent = do cwd <- getCurrentDirectory top <- seekUp cwd isRepoTop case top of - (Just dir) -> gitRepo dir + (Just dir) -> gitRepoFromPath dir Nothing -> error "Not in a git repository." seekUp :: String -> (String -> IO Bool) -> IO (Maybe String) -- cgit v1.2.3 From 92bf408c664e4fa66132a7095e1f856312ce667c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 00:53:42 -0400 Subject: faddle --- Annex.hs | 2 +- GitRepo.hs | 101 +++++++++++++++++++++++++++++++++++++++++------------------ Locations.hs | 4 +-- 3 files changed, 73 insertions(+), 34 deletions(-) diff --git a/Annex.hs b/Annex.hs index abb7bff6e..5a7274ca1 100644 --- a/Annex.hs +++ b/Annex.hs @@ -86,7 +86,7 @@ gitPrep :: GitRepo -> IO () gitPrep repo = do -- configure git to use union merge driver on state files let attrLine = stateLoc ++ "/*.log merge=union" - attributes <- gitAttributes repo + let attributes = gitAttributes repo exists <- doesFileExist attributes if (not exists) then do diff --git a/GitRepo.hs b/GitRepo.hs index 2a97e6070..dc1c52b47 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -7,9 +7,10 @@ module GitRepo ( GitRepo, - gitRepoFromPath, gitRepoCurrent, - gitRepoTop, + gitRepoFromPath, + gitRepoFromUrl, + gitWorkTree, gitDir, gitRelative, gitConfig, @@ -26,21 +27,28 @@ import System.IO import System.Posix.Process import Data.String.Utils import Data.Map as Map (fromList, empty, lookup, Map) +import Network.URI +import Maybe import Utility --- a git repository -data GitRepo = GitRepo { - top :: FilePath, - bare :: Bool, - config :: Map String String -} deriving (Show, Read, Eq) - -{- GitRepo constructor -} +{- A git repository can be local or remote. -} +data GitRepo = + LocalGitRepo { + top :: FilePath, + bare :: Bool, + config :: Map String String + } | RemoteGitRepo { + url :: String, + top :: FilePath, + config :: Map String String + } deriving (Show, Read, Eq) + +{- Local GitRepo constructor. -} gitRepoFromPath :: FilePath -> IO GitRepo gitRepoFromPath dir = do b <- isBareRepo dir - let r = GitRepo { + let r = LocalGitRepo { top = dir, bare = b, config = Map.empty @@ -49,28 +57,49 @@ gitRepoFromPath dir = do return r' -{- Field accessor. -} -gitRepoTop :: GitRepo -> FilePath -gitRepoTop repo = top repo +{- Remote GitRepo constructor. Note that remote repo config is not read. + - Throws exception on invalid url. -} +gitRepoFromUrl :: String -> IO GitRepo +gitRepoFromUrl url = do + return RemoteGitRepo { + url = url, + top = path url, + config = Map.empty + } + where path url = uriPath $ fromJust $ parseURI url + +{- Some code needs to vary between remote and local repos. -} +local repo = case (repo) of + LocalGitRepo {} -> True + RemoteGitRepo {} -> False +remote repo = not $ local repo +assertlocal repo action = + if (local repo) + then action + else error "acting on remote git repo not supported" {- Path to a repository's gitattributes file. -} -gitAttributes :: GitRepo -> IO String -gitAttributes repo = do +gitAttributes :: GitRepo -> String +gitAttributes repo = assertlocal repo $ do if (bare repo) - then return $ (top repo) ++ "/info/.gitattributes" - else return $ (top repo) ++ "/.gitattributes" + then (top repo) ++ "/info/.gitattributes" + else (top repo) ++ "/.gitattributes" {- Path to a repository's .git directory. - (For a bare repository, that is the root of the repository.) - TODO: support GIT_DIR -} gitDir :: GitRepo -> String -gitDir repo = +gitDir repo = assertlocal repo $ if (bare repo) then top repo else top repo ++ "/.git" -{- Given a relative or absolute filename, calculates the name to use - - to refer to the file relative to a git repository directory. +{- Path to a repository's --work-tree. -} +gitWorkTree :: GitRepo -> FilePath +gitWorkTree repo = top repo + +{- Given a relative or absolute filename in a repository, calculates the + - name to use to refer to the file relative to a git repository's top. - This is the same form displayed and used by git. -} gitRelative :: GitRepo -> String -> String gitRelative repo file = drop (length absrepo) absfile @@ -92,26 +121,36 @@ gitAdd repo file = runGit repo ["add", file] gitCommandLine :: GitRepo -> [String] -> [String] gitCommandLine repo params = -- force use of specified repo via --git-dir and --work-tree - ["--git-dir="++(gitDir repo), "--work-tree="++(top repo)] ++ params + if (local repo) + then ["--git-dir="++(gitDir repo), "--work-tree="++(top repo)] ++ params + else error "gitCommandLine not implemented for remote repo" {- Runs git in the specified repo. -} runGit :: GitRepo -> [String] -> IO () -runGit repo params = do - r <- executeFile "git" True (gitCommandLine repo params) Nothing - return () +runGit repo params = + if (local repo) + then do + r <- executeFile "git" True (gitCommandLine repo params) Nothing + return () + else error "runGit not implemented for remote repo" {- Runs a git subcommand and returns its output. -} gitPipeRead :: GitRepo -> [String] -> IO String gitPipeRead repo params = - pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do - ret <- hGetContentsStrict h - return ret + if (local repo) + then pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do + ret <- hGetContentsStrict h + return ret + else error "gitPipeRead not implemented for remote repo" {- Runs git config and populates a repo with its settings. -} gitConfigRead :: GitRepo -> IO GitRepo -gitConfigRead repo = do - c <- gitPipeRead repo ["config", "--list"] - return repo { config = gitConfigParse c } +gitConfigRead repo = + if (local repo) + then do + c <- gitPipeRead repo ["config", "--list"] + return repo { config = gitConfigParse c } + else error "gitConfigRead not implemented for remote repo" {- Parses git config --list output into a config map. -} gitConfigParse :: String -> Map.Map String String diff --git a/Locations.hs b/Locations.hs index 31bb3d9de..300f443f7 100644 --- a/Locations.hs +++ b/Locations.hs @@ -9,7 +9,7 @@ module Locations ( import GitRepo {- Long-term, cross-repo state is stored in files inside the .git-annex - - directory, in the git repository. -} + - directory, in the git repository's working tree. -} stateLoc = ".git-annex" gitStateDir :: GitRepo -> FilePath -gitStateDir repo = (gitRepoTop repo) ++ "/" ++ stateLoc ++ "/" +gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/" -- cgit v1.2.3 From eea55856e9db85884a7fb28ce1b408fdbc05f90f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 01:35:32 -0400 Subject: remotes lookup --- GitRepo.hs | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index dc1c52b47..fb3ddbaf8 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -26,7 +26,7 @@ import System.Cmd.Utils import System.IO import System.Posix.Process import Data.String.Utils -import Data.Map as Map (fromList, empty, lookup, Map) +import Data.Map as Map hiding (map, split) import Network.URI import Maybe import Utility @@ -61,14 +61,15 @@ gitRepoFromPath dir = do - Throws exception on invalid url. -} gitRepoFromUrl :: String -> IO GitRepo gitRepoFromUrl url = do - return RemoteGitRepo { + return $ RemoteGitRepo { url = url, top = path url, config = Map.empty } where path url = uriPath $ fromJust $ parseURI url -{- Some code needs to vary between remote and local repos. -} +{- Some code needs to vary between remote and local repos, these functions + - help with that. -} local repo = case (repo) of LocalGitRepo {} -> True RemoteGitRepo {} -> False @@ -165,9 +166,19 @@ gitConfigParse s = Map.fromList $ map pair $ lines s {- Returns a single git config setting, or a default value if not set. -} gitConfig :: GitRepo -> String -> String -> String gitConfig repo key defaultValue = - case (Map.lookup key $ config repo) of - Just value -> value - Nothing -> defaultValue + Map.findWithDefault key defaultValue (config repo) + +{- Returns a list of a repo's configured remotes. -} +gitConfigRemotes :: GitRepo -> IO [GitRepo] +gitConfigRemotes repo = mapM construct remotes + where + remotes = elems $ filter $ config repo + filter = filterWithKey (\k _ -> isremote k) + isremote k = (startswith "remote." k) && (endswith ".url" k) + construct r = + if (isURI r) + then gitRepoFromUrl r + else gitRepoFromPath r {- Finds the current git repository, which may be in a parent directory. -} gitRepoCurrent :: IO GitRepo -- cgit v1.2.3 From c8002bd91b03b66c195014ecaa9111c50fa5e716 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 02:00:29 -0400 Subject: update --- GitRepo.hs | 4 +++- TODO | 34 +++++++++++++++++++++++++++++++++- git-annex.mdwn | 24 +++++++++++++++--------- 3 files changed, 51 insertions(+), 11 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index fb3ddbaf8..27fc0632c 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -31,7 +31,9 @@ import Network.URI import Maybe import Utility -{- A git repository can be local or remote. -} +{- A git repository can be on local disk or remote. Not to be confused + - with a git repo's configured remotes, some of which may be on local + - disk. -} data GitRepo = LocalGitRepo { top :: FilePath, diff --git a/TODO b/TODO index ea930f803..b08784ec2 100644 --- a/TODO +++ b/TODO @@ -1,7 +1,39 @@ * bug when annexing files in a subdir of a git repo * how to handle git mv file? -* query remotes for their annex.name settings +* query remotes for their annex.name settings, or figure out a different + solution to nameing problem? + + - querying network remotes all the time will be slow. local caching in + .git/config? + - having a git annex name and a git remote name that are distinct + will be confusing + - but git remote names are repo-local, I want a global name + - really, I don't want a name at all, I want a per-repo UUID + + So, each repo has a UUID, stored in annex.uuid. + + And also, the last seen UUID for each remote is listed: + + remote.origin.annex-uuid=d3d2474c-d5c3-11df-80a9-002170d25c55 + + Then when it need to find a repo by UUID, it can see if a known remote + has it -- and then query the remote to confirm the repo there still has + that UUID (a different repo may have been mounted there). + + Failing that, it can force a refresh of all uuids, updating .git/config, + and check again. + + - Only downside for this is that if I put a repo on a usb disk, + and it is disconnected and I have no remote for it, + git-annex will have to say: + + "You asked for a file that is only present on a git repo with + UUID d3d2474c-d5c3-11df-80a9-002170d25c55 -- and I don't know + where it is." + + To solve that, let .git-annex/uuid.map map between uuids and descriptions, + like "d3d2474c-d5c3-11df-80a9-002170d25c55 SATA drive labeled '* arch-2'" * hook up LocationLog * --push/--pull/--get/--want/--drop diff --git a/git-annex.mdwn b/git-annex.mdwn index 6bfdd57c7..1348886f2 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -79,7 +79,7 @@ git-annex information that should be propigated between repositories. Data is stored here in files that are arranged to avoid conflicts in most cases. A conflict could occur if a file with the same name but different -content was added to multiple clones. +content was added to multiple repositories. ## key/value storage @@ -117,26 +117,32 @@ you indicate you --want a file, git-annex will tell you which repositories have the file's content. Location tracking information is stored in `.git-annex/$filename.log`. -Repositories record their name and the date when they --get or --drop +Repositories record their UUID and the date when they --get or --drop a file's content. (Git is configured to use a union merge for this file, so the lines may be in arbitrary order, but it will never conflict.) +The optional file `.git-annex/uuid.map` can be created to add a description +to a UUID. If git-annex needs a file from a repository and it cannot find +the repository amoung the remotes, it will use the description from this +file when asking for the repository to be made available. The file format +is a UUID, a space, and the rest of the line is its description. For +example: + + UUID d3d2474c-d5c3-11df-80a9-002170d25c55 USB drive in red enclosure + ## configuration -* `annex.numcopies` -- number of copies of files to keep +* `annex.uuid` -- a unique UUID for this repository +* `annex.numcopies` -- number of copies of files to keep (default: 1) * `annex.backends` -- space-separated list of names of the key/value backends to use. The first listed is used to store - new files. -* `annex.name` -- allows specifying a unique name for this repository. - If not specified, the name is derived from its directory's location and - the hostname. When a repository is on removable media it is useful to give - it a more stable name. Typically the name of a repository is the same - name configured as a git remote to allow pulling from that repository. + new files. (default: file, checksum, url) * `remote..annex-cost` -- When determining which repository to transfer annexed files from or to, ones with lower costs are preferred. The default cost is 50. Note that other factors may be configured when pushing files to repositories, in particular, whether the repository is on a filesystem with sufficient free space. +* `remote..annex-uuid` -- git-annex caches UUIDs of remotes here ## issues -- cgit v1.2.3 From 97b31a525e31abf1db95154d09c7efa368d3f59c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 02:05:33 -0400 Subject: foo --- git-annex.mdwn | 1 + 1 file changed, 1 insertion(+) diff --git a/git-annex.mdwn b/git-annex.mdwn index 1348886f2..9dd2d44ef 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -129,6 +129,7 @@ is a UUID, a space, and the rest of the line is its description. For example: UUID d3d2474c-d5c3-11df-80a9-002170d25c55 USB drive in red enclosure + UUID 60cf39c8-d5c6-11df-aa8b-93fda39008d6 my colocated server ## configuration -- cgit v1.2.3 From 8f069bd2875022cfceb0c50cb9a5667a9bae88d8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 02:40:09 -0400 Subject: tweak --- Annex.hs | 2 +- GitRepo.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/Annex.hs b/Annex.hs index 5a7274ca1..3461a92cd 100644 --- a/Annex.hs +++ b/Annex.hs @@ -31,7 +31,7 @@ annexDir repo key = gitDir repo ++ "/annex/" ++ key - later. -} startAnnex :: IO State startAnnex = do - r <- gitRepoCurrent + r <- gitRepoFromCwd gitPrep r return State { diff --git a/GitRepo.hs b/GitRepo.hs index 27fc0632c..643b725e6 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -7,7 +7,7 @@ module GitRepo ( GitRepo, - gitRepoCurrent, + gitRepoFromCwd, gitRepoFromPath, gitRepoFromUrl, gitWorkTree, @@ -183,8 +183,8 @@ gitConfigRemotes repo = mapM construct remotes else gitRepoFromPath r {- Finds the current git repository, which may be in a parent directory. -} -gitRepoCurrent :: IO GitRepo -gitRepoCurrent = do +gitRepoFromCwd :: IO GitRepo +gitRepoFromCwd = do cwd <- getCurrentDirectory top <- seekUp cwd isRepoTop case top of -- cgit v1.2.3 From b430f55b80e0c4efba352817d8eecded586d0726 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 02:51:44 -0400 Subject: tweak --- GitRepo.hs | 44 ++++++++++++++++++++------------------------ 1 file changed, 20 insertions(+), 24 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index 643b725e6..241dd4009 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -15,6 +15,7 @@ module GitRepo ( gitRelative, gitConfig, gitAdd, + gitRm, gitAttributes ) where @@ -79,7 +80,8 @@ remote repo = not $ local repo assertlocal repo action = if (local repo) then action - else error "acting on remote git repo not supported" + else error $ "acting on remote git repo " ++ (url repo) ++ + " not supported" {- Path to a repository's gitattributes file. -} gitAttributes :: GitRepo -> String @@ -116,44 +118,38 @@ gitRelative repo file = drop (length absrepo) absfile Just f -> f Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo -{- Stages a changed file in git's index. -} +{- Stages a changed/new file in git's index. -} gitAdd :: GitRepo -> FilePath -> IO () gitAdd repo file = runGit repo ["add", file] +{- Removes a file. -} +gitRm :: GitRepo -> FilePath -> IO () +gitRm repo file = runGit repo ["rm", file] + {- Constructs a git command line operating on the specified repo. -} gitCommandLine :: GitRepo -> [String] -> [String] -gitCommandLine repo params = +gitCommandLine repo params = assertlocal repo $ -- force use of specified repo via --git-dir and --work-tree - if (local repo) - then ["--git-dir="++(gitDir repo), "--work-tree="++(top repo)] ++ params - else error "gitCommandLine not implemented for remote repo" + ["--git-dir="++(gitDir repo), "--work-tree="++(top repo)] ++ params {- Runs git in the specified repo. -} runGit :: GitRepo -> [String] -> IO () -runGit repo params = - if (local repo) - then do - r <- executeFile "git" True (gitCommandLine repo params) Nothing - return () - else error "runGit not implemented for remote repo" +runGit repo params = assertlocal repo $ do + r <- executeFile "git" True (gitCommandLine repo params) Nothing + return () {- Runs a git subcommand and returns its output. -} gitPipeRead :: GitRepo -> [String] -> IO String -gitPipeRead repo params = - if (local repo) - then pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do - ret <- hGetContentsStrict h - return ret - else error "gitPipeRead not implemented for remote repo" +gitPipeRead repo params = assertlocal repo $ do + pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do + ret <- hGetContentsStrict h + return ret {- Runs git config and populates a repo with its settings. -} gitConfigRead :: GitRepo -> IO GitRepo -gitConfigRead repo = - if (local repo) - then do - c <- gitPipeRead repo ["config", "--list"] - return repo { config = gitConfigParse c } - else error "gitConfigRead not implemented for remote repo" +gitConfigRead repo = assertlocal repo $ do + c <- gitPipeRead repo ["config", "--list"] + return repo { config = gitConfigParse c } {- Parses git config --list output into a config map. -} gitConfigParse :: String -> Map.Map String String -- cgit v1.2.3 From 10b7c405fa427b5657d2336974a7e0a19ed098ff Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 12:23:34 -0400 Subject: better git repo querying and bare repo detection --- GitRepo.hs | 67 +++++++++++++++++++++++++++++++++++--------------------------- 1 file changed, 38 insertions(+), 29 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index 241dd4009..21b37519b 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -38,7 +38,6 @@ import Utility data GitRepo = LocalGitRepo { top :: FilePath, - bare :: Bool, config :: Map String String } | RemoteGitRepo { url :: String, @@ -46,24 +45,20 @@ data GitRepo = config :: Map String String } deriving (Show, Read, Eq) -{- Local GitRepo constructor. -} -gitRepoFromPath :: FilePath -> IO GitRepo -gitRepoFromPath dir = do - b <- isBareRepo dir - +{- Local GitRepo constructor. Can optionally query the repo for its config. -} +gitRepoFromPath :: FilePath -> Bool -> IO GitRepo +gitRepoFromPath dir query = do let r = LocalGitRepo { top = dir, - bare = b, config = Map.empty } - r' <- gitConfigRead r + if (query) + then gitConfigRead r + else return r - return r' - -{- Remote GitRepo constructor. Note that remote repo config is not read. - - Throws exception on invalid url. -} -gitRepoFromUrl :: String -> IO GitRepo -gitRepoFromUrl url = do +{- Remote GitRepo constructor. Throws exception on invalid url. -} +gitRepoFromUrl :: String -> Bool -> IO GitRepo +gitRepoFromUrl url query = do return $ RemoteGitRepo { url = url, top = path url, @@ -71,8 +66,11 @@ gitRepoFromUrl url = do } where path url = uriPath $ fromJust $ parseURI url -{- Some code needs to vary between remote and local repos, these functions - - help with that. -} +{- User-visible description of a git repo by path or url -} +describe repo = if (local repo) then top repo else url repo + +{- Some code needs to vary between remote and local repos, or bare and + - non-bare, these functions help with that. -} local repo = case (repo) of LocalGitRepo {} -> True RemoteGitRepo {} -> False @@ -80,8 +78,16 @@ remote repo = not $ local repo assertlocal repo action = if (local repo) then action - else error $ "acting on remote git repo " ++ (url repo) ++ + else error $ "acting on remote git repo " ++ (describe repo) ++ " not supported" +bare :: GitRepo -> Bool +bare repo = + if (member b (config repo)) + then ("true" == fromJust (Map.lookup b (config repo))) + else error $ "it is not known if git repo " ++ (describe repo) ++ + " is a bare repository; config not read" + where + b = "core.bare" {- Path to a repository's gitattributes file. -} gitAttributes :: GitRepo -> String @@ -130,7 +136,11 @@ gitRm repo file = runGit repo ["rm", file] gitCommandLine :: GitRepo -> [String] -> [String] gitCommandLine repo params = assertlocal repo $ -- force use of specified repo via --git-dir and --work-tree - ["--git-dir="++(gitDir repo), "--work-tree="++(top repo)] ++ params + -- gitDir cannot be used for --git-dir because the config may + -- not have been read (and gitConfigRead relies on this function). + -- So this relies on git doing the right thing when told that + -- --git-dir is the top of a work tree. + ["--git-dir="++(top repo), "--work-tree="++(top repo)] ++ params {- Runs git in the specified repo. -} runGit :: GitRepo -> [String] -> IO () @@ -175,8 +185,8 @@ gitConfigRemotes repo = mapM construct remotes isremote k = (startswith "remote." k) && (endswith ".url" k) construct r = if (isURI r) - then gitRepoFromUrl r - else gitRepoFromPath r + then gitRepoFromUrl r False + else gitRepoFromPath r False {- Finds the current git repository, which may be in a parent directory. -} gitRepoFromCwd :: IO GitRepo @@ -184,7 +194,7 @@ gitRepoFromCwd = do cwd <- getCurrentDirectory top <- seekUp cwd isRepoTop case top of - (Just dir) -> gitRepoFromPath dir + (Just dir) -> gitRepoFromPath dir True Nothing -> error "Not in a git repository." seekUp :: String -> (String -> IO Bool) -> IO (Maybe String) @@ -200,11 +210,10 @@ isRepoTop dir = do r <- isGitRepo dir b <- isBareRepo dir return (r || b) - -isGitRepo dir = gitSignature dir ".git" ".git/config" -isBareRepo dir = gitSignature dir "objects" "config" - -gitSignature dir subdir file = do - s <- (doesDirectoryExist (dir ++ "/" ++ subdir)) - f <- (doesFileExist (dir ++ "/" ++ file)) - return (s && f) + where + isGitRepo dir = gitSignature dir ".git" ".git/config" + isBareRepo dir = gitSignature dir "objects" "config" + gitSignature dir subdir file = do + s <- (doesDirectoryExist (dir ++ "/" ++ subdir)) + f <- (doesFileExist (dir ++ "/" ++ file)) + return (s && f) -- cgit v1.2.3 From 8a3ea4edcbf1cc7059d5382ca84d0033cd9152c6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 12:31:19 -0400 Subject: typo --- GitRepo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GitRepo.hs b/GitRepo.hs index 21b37519b..f3c959bec 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -174,7 +174,7 @@ gitConfigParse s = Map.fromList $ map pair $ lines s {- Returns a single git config setting, or a default value if not set. -} gitConfig :: GitRepo -> String -> String -> String gitConfig repo key defaultValue = - Map.findWithDefault key defaultValue (config repo) + Map.findWithDefault defaultValue key (config repo) {- Returns a list of a repo's configured remotes. -} gitConfigRemotes :: GitRepo -> IO [GitRepo] -- cgit v1.2.3 From e4bc7e599a799d758c4d948dce65a7fa05dd50cb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 12:35:05 -0400 Subject: revert bad change I was wrong about git-config's level of smarts --- GitRepo.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index f3c959bec..565780311 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -136,11 +136,7 @@ gitRm repo file = runGit repo ["rm", file] gitCommandLine :: GitRepo -> [String] -> [String] gitCommandLine repo params = assertlocal repo $ -- force use of specified repo via --git-dir and --work-tree - -- gitDir cannot be used for --git-dir because the config may - -- not have been read (and gitConfigRead relies on this function). - -- So this relies on git doing the right thing when told that - -- --git-dir is the top of a work tree. - ["--git-dir="++(top repo), "--work-tree="++(top repo)] ++ params + ["--git-dir="++(gitDir repo), "--work-tree="++(top repo)] ++ params {- Runs git in the specified repo. -} runGit :: GitRepo -> [String] -> IO () -- cgit v1.2.3 From 31b24348d25f5aec7ff521b7452fab6833a1d051 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 12:47:11 -0400 Subject: new git config read method --- GitRepo.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index 565780311..c87bd355e 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -22,9 +22,11 @@ module GitRepo ( import Directory import System import System.Directory +import System.Posix.Directory import System.Path import System.Cmd.Utils import System.IO +import IO (bracket_) import System.Posix.Process import Data.String.Utils import Data.Map as Map hiding (map, split) @@ -151,11 +153,17 @@ gitPipeRead repo params = assertlocal repo $ do ret <- hGetContentsStrict h return ret -{- Runs git config and populates a repo with its settings. -} +{- Runs git config and populates a repo with its config. -} gitConfigRead :: GitRepo -> IO GitRepo gitConfigRead repo = assertlocal repo $ do - c <- gitPipeRead repo ["config", "--list"] - return repo { config = gitConfigParse c } + {- Cannot use gitPipeRead because it relies on the config having + been already read. Instead, chdir to the repo. -} + cwd <- getCurrentDirectory + bracket_ (changeWorkingDirectory (top repo)) + (\_ -> changeWorkingDirectory cwd) $ do + pOpen ReadFromPipe "git" ["config", "--list"] $ \h -> do + val <- hGetContentsStrict h + return repo { config = gitConfigParse val } {- Parses git config --list output into a config map. -} gitConfigParse :: String -> Map.Map String String -- cgit v1.2.3 From ea5d7fe07a5c40349e66848fc9cd06a9f748b724 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 13:02:41 -0400 Subject: add uuid --- .gitattributes | 1 + Annex.hs | 15 +++++++++++++++ GitRepo.hs | 9 +++++---- 3 files changed, 21 insertions(+), 4 deletions(-) create mode 100644 .gitattributes diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 000000000..b98b07d7d --- /dev/null +++ b/.gitattributes @@ -0,0 +1 @@ +.git-annex/*.log merge=union diff --git a/Annex.hs b/Annex.hs index 3461a92cd..5adc73996 100644 --- a/Annex.hs +++ b/Annex.hs @@ -10,6 +10,8 @@ module Annex ( import System.Posix.Files import System.Directory +import System.Cmd.Utils +import System.IO import GitRepo import Utility import Locations @@ -84,6 +86,13 @@ unannexFile state file = do {- Sets up a git repo for git-annex. May be called repeatedly. -} gitPrep :: GitRepo -> IO () gitPrep repo = do + -- Make sure that the repo has an annex.uuid setting. + if ("" == gitConfig repo "annex.uuid" "") + then do + uuid <- genUUID + gitRun repo ["config", "annex.uuid", uuid] + else return () + -- configure git to use union merge driver on state files let attrLine = stateLoc ++ "/*.log merge=union" let attributes = gitAttributes repo @@ -99,3 +108,9 @@ gitPrep repo = do appendFile attributes $ attrLine ++ "\n" gitAdd repo attributes else return () + +{- Generates a UUID. There is a library for this, but it's not packaged, + - so use the command line tool. -} +genUUID :: IO String +genUUID = do + pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h diff --git a/GitRepo.hs b/GitRepo.hs index c87bd355e..b166e3281 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -16,6 +16,7 @@ module GitRepo ( gitConfig, gitAdd, gitRm, + gitRun, gitAttributes ) where @@ -128,11 +129,11 @@ gitRelative repo file = drop (length absrepo) absfile {- Stages a changed/new file in git's index. -} gitAdd :: GitRepo -> FilePath -> IO () -gitAdd repo file = runGit repo ["add", file] +gitAdd repo file = gitRun repo ["add", file] {- Removes a file. -} gitRm :: GitRepo -> FilePath -> IO () -gitRm repo file = runGit repo ["rm", file] +gitRm repo file = gitRun repo ["rm", file] {- Constructs a git command line operating on the specified repo. -} gitCommandLine :: GitRepo -> [String] -> [String] @@ -141,8 +142,8 @@ gitCommandLine repo params = assertlocal repo $ ["--git-dir="++(gitDir repo), "--work-tree="++(top repo)] ++ params {- Runs git in the specified repo. -} -runGit :: GitRepo -> [String] -> IO () -runGit repo params = assertlocal repo $ do +gitRun :: GitRepo -> [String] -> IO () +gitRun repo params = assertlocal repo $ do r <- executeFile "git" True (gitCommandLine repo params) Nothing return () -- cgit v1.2.3 From dc1d5e68317b85043c8c30a82f53f78b0a9a9f51 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 13:10:07 -0400 Subject: update --- Annex.hs | 16 ++-------------- TODO | 34 +--------------------------------- UUID.hs | 36 ++++++++++++++++++++++++++++++++++++ 3 files changed, 39 insertions(+), 47 deletions(-) create mode 100644 UUID.hs diff --git a/Annex.hs b/Annex.hs index 5adc73996..31897479d 100644 --- a/Annex.hs +++ b/Annex.hs @@ -10,13 +10,12 @@ module Annex ( import System.Posix.Files import System.Directory -import System.Cmd.Utils -import System.IO import GitRepo import Utility import Locations import Backend import BackendList +import UUID import LocationLog -- git-annex's runtime state @@ -86,12 +85,7 @@ unannexFile state file = do {- Sets up a git repo for git-annex. May be called repeatedly. -} gitPrep :: GitRepo -> IO () gitPrep repo = do - -- Make sure that the repo has an annex.uuid setting. - if ("" == gitConfig repo "annex.uuid" "") - then do - uuid <- genUUID - gitRun repo ["config", "annex.uuid", uuid] - else return () + prepUUID repo -- configure git to use union merge driver on state files let attrLine = stateLoc ++ "/*.log merge=union" @@ -108,9 +102,3 @@ gitPrep repo = do appendFile attributes $ attrLine ++ "\n" gitAdd repo attributes else return () - -{- Generates a UUID. There is a library for this, but it's not packaged, - - so use the command line tool. -} -genUUID :: IO String -genUUID = do - pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h diff --git a/TODO b/TODO index b08784ec2..c951eb3f1 100644 --- a/TODO +++ b/TODO @@ -1,39 +1,7 @@ * bug when annexing files in a subdir of a git repo * how to handle git mv file? -* query remotes for their annex.name settings, or figure out a different - solution to nameing problem? - - - querying network remotes all the time will be slow. local caching in - .git/config? - - having a git annex name and a git remote name that are distinct - will be confusing - - but git remote names are repo-local, I want a global name - - really, I don't want a name at all, I want a per-repo UUID - - So, each repo has a UUID, stored in annex.uuid. - - And also, the last seen UUID for each remote is listed: - - remote.origin.annex-uuid=d3d2474c-d5c3-11df-80a9-002170d25c55 - - Then when it need to find a repo by UUID, it can see if a known remote - has it -- and then query the remote to confirm the repo there still has - that UUID (a different repo may have been mounted there). - - Failing that, it can force a refresh of all uuids, updating .git/config, - and check again. - - - Only downside for this is that if I put a repo on a usb disk, - and it is disconnected and I have no remote for it, - git-annex will have to say: - - "You asked for a file that is only present on a git repo with - UUID d3d2474c-d5c3-11df-80a9-002170d25c55 -- and I don't know - where it is." - - To solve that, let .git-annex/uuid.map map between uuids and descriptions, - like "d3d2474c-d5c3-11df-80a9-002170d25c55 SATA drive labeled '* arch-2'" +* query remotes for their annex.uuid settings * hook up LocationLog * --push/--pull/--get/--want/--drop diff --git a/UUID.hs b/UUID.hs new file mode 100644 index 000000000..a0e078482 --- /dev/null +++ b/UUID.hs @@ -0,0 +1,36 @@ +{- git-annex uuids + - + - Each git repository used by git-annex has an annex.uuid setting that + - uniquely identifies that repository. + - + -} + +module UUID ( + getUUID, + prepUUID, + genUUID +) where + +import System.Cmd.Utils +import System.IO +import GitRepo + +configkey="annex.uuid" + +{- Generates a UUID. There is a library for this, but it's not packaged, + - so use the command line tool. -} +genUUID :: IO String +genUUID = do + pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h + +getUUID :: GitRepo -> String +getUUID repo = gitConfig repo "annex.uuid" "" + +{- Make sure that the repo has an annex.uuid setting. -} +prepUUID :: GitRepo -> IO () +prepUUID repo = + if ("" == getUUID repo) + then do + uuid <- genUUID + gitRun repo ["config", configkey, uuid] + else return () -- cgit v1.2.3 From 4fbdb197d524720d1ea77795b33cb5d24152bce9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 13:12:47 -0400 Subject: correctness --- Annex.hs | 9 ++++----- GitRepo.hs | 1 + UUID.hs | 6 ++++-- 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/Annex.hs b/Annex.hs index 31897479d..ed3e4e33a 100644 --- a/Annex.hs +++ b/Annex.hs @@ -33,11 +33,12 @@ annexDir repo key = gitDir repo ++ "/annex/" ++ key startAnnex :: IO State startAnnex = do r <- gitRepoFromCwd - gitPrep r + r' <- prepUUID r + gitPrep r' return State { - repo = r, - backends = parseBackendList $ gitConfig r "annex.backends" "" + repo = r', + backends = parseBackendList $ gitConfig r' "annex.backends" "" } {- Annexes a file, storing it in a backend, and then moving it into @@ -85,8 +86,6 @@ unannexFile state file = do {- Sets up a git repo for git-annex. May be called repeatedly. -} gitPrep :: GitRepo -> IO () gitPrep repo = do - prepUUID repo - -- configure git to use union merge driver on state files let attrLine = stateLoc ++ "/*.log merge=union" let attributes = gitAttributes repo diff --git a/GitRepo.hs b/GitRepo.hs index b166e3281..9a919128e 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -14,6 +14,7 @@ module GitRepo ( gitDir, gitRelative, gitConfig, + gitConfigRead, gitAdd, gitRm, gitRun, diff --git a/UUID.hs b/UUID.hs index a0e078482..0b795b8c1 100644 --- a/UUID.hs +++ b/UUID.hs @@ -23,14 +23,16 @@ genUUID :: IO String genUUID = do pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h +{- Looks up a repo's UUID -} getUUID :: GitRepo -> String getUUID repo = gitConfig repo "annex.uuid" "" {- Make sure that the repo has an annex.uuid setting. -} -prepUUID :: GitRepo -> IO () +prepUUID :: GitRepo -> IO GitRepo prepUUID repo = if ("" == getUUID repo) then do uuid <- genUUID gitRun repo ["config", configkey, uuid] - else return () + gitConfigRead repo -- return new repo with updated config + else return repo -- cgit v1.2.3 From e53900a54597437818d785aa6b1683b3b49d2afb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 15:44:54 -0400 Subject: stub --- Annex.hs | 33 ++++++++++++++++++++++++++++++++- CmdLine.hs | 12 ++++++++---- UUID.hs | 3 ++- 3 files changed, 42 insertions(+), 6 deletions(-) diff --git a/Annex.hs b/Annex.hs index ed3e4e33a..af2569719 100644 --- a/Annex.hs +++ b/Annex.hs @@ -5,7 +5,12 @@ module Annex ( State, startAnnex, annexFile, - unannexFile + unannexFile, + annexGetFile, + annexWantFile, + annexDropFile, + annexPushRepo, + annexPullRepo ) where import System.Posix.Files @@ -83,6 +88,32 @@ unannexFile state file = do renameFile src file return () +{- Transfers the file from a remote. -} +annexGetFile :: State -> FilePath -> IO () +annexGetFile state file = do + alreadyannexed <- lookupBackend (backends state) (repo state) file + case (alreadyannexed) of + Nothing -> error $ "not annexed " ++ file + Just _ -> do error "not implemented" -- TODO + -- 1. find remote with file + -- 2. copy file from remote + +{- Indicates a file is wanted. -} +annexWantFile :: State -> FilePath -> IO () +annexWantFile state file = do error "not implemented" -- TODO + +{- Indicates a file is now wanted. -} +annexDropFile :: State -> FilePath -> IO () +annexDropFile state file = do error "not implemented" -- TODO + +{- Pushes all files to a remote repository. -} +annexPushRepo :: State -> String -> IO () +annexPushRepo state reponame = do error "not implemented" -- TODO + +{- Pulls all files from a remote repository. -} +annexPullRepo :: State -> String -> IO () +annexPullRepo state reponame = do error "not implemented" -- TODO + {- Sets up a git repo for git-annex. May be called repeatedly. -} gitPrep :: GitRepo -> IO () gitPrep repo = do diff --git a/CmdLine.hs b/CmdLine.hs index cc8708889..60ba81d30 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -39,8 +39,12 @@ argvToMode argv = do where header = "Usage: git-annex [mode] file" dispatch :: State -> Mode -> FilePath -> IO () -dispatch state mode file = do +dispatch state mode item = do case (mode) of - Add -> annexFile state file - Unannex -> unannexFile state file - _ -> error "not implemented" + Add -> annexFile state item + Push -> annexPushRepo state item + Pull -> annexPullRepo state item + Want -> annexWantFile state item + Get -> annexGetFile state item + Drop -> annexDropFile state item + Unannex -> unannexFile state item diff --git a/UUID.hs b/UUID.hs index 0b795b8c1..40c2330ee 100644 --- a/UUID.hs +++ b/UUID.hs @@ -34,5 +34,6 @@ prepUUID repo = then do uuid <- genUUID gitRun repo ["config", configkey, uuid] - gitConfigRead repo -- return new repo with updated config + -- return new repo with updated config + gitConfigRead repo else return repo -- cgit v1.2.3 From d257bad93c4ae6f8e6ef6a9c848e63d0f46eb225 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 15:48:00 -0400 Subject: uuid type --- Annex.hs | 2 +- UUID.hs | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/Annex.hs b/Annex.hs index af2569719..f695985e1 100644 --- a/Annex.hs +++ b/Annex.hs @@ -102,7 +102,7 @@ annexGetFile state file = do annexWantFile :: State -> FilePath -> IO () annexWantFile state file = do error "not implemented" -- TODO -{- Indicates a file is now wanted. -} +{- Indicates a file is not wanted. -} annexDropFile :: State -> FilePath -> IO () annexDropFile state file = do error "not implemented" -- TODO diff --git a/UUID.hs b/UUID.hs index 40c2330ee..4364e2070 100644 --- a/UUID.hs +++ b/UUID.hs @@ -15,16 +15,18 @@ import System.Cmd.Utils import System.IO import GitRepo +type UUID = String + configkey="annex.uuid" {- Generates a UUID. There is a library for this, but it's not packaged, - so use the command line tool. -} -genUUID :: IO String +genUUID :: IO UUID genUUID = do pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h {- Looks up a repo's UUID -} -getUUID :: GitRepo -> String +getUUID :: GitRepo -> UUID getUUID repo = gitConfig repo "annex.uuid" "" {- Make sure that the repo has an annex.uuid setting. -} -- cgit v1.2.3 From 759f146d0fd5857cbbb796367c3dd8c695550b46 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 15:52:18 -0400 Subject: update --- Annex.hs | 7 +------ Types.hs | 14 ++++++++++++++ 2 files changed, 15 insertions(+), 6 deletions(-) create mode 100644 Types.hs diff --git a/Annex.hs b/Annex.hs index f695985e1..830f61919 100644 --- a/Annex.hs +++ b/Annex.hs @@ -22,12 +22,7 @@ import Backend import BackendList import UUID import LocationLog - --- git-annex's runtime state -data State = State { - repo :: GitRepo, - backends :: [Backend] -} +import Types {- An annexed file's content is stored somewhere under .git/annex/ -} annexDir :: GitRepo -> Key -> FilePath diff --git a/Types.hs b/Types.hs new file mode 100644 index 000000000..df9588027 --- /dev/null +++ b/Types.hs @@ -0,0 +1,14 @@ +{- git-annex core data types -} + +module Types ( + State(..) +) where + +import BackendType +import GitRepo + +-- git-annex's runtime state +data State = State { + repo :: GitRepo, + backends :: [Backend] +} -- cgit v1.2.3 From 2ac47a3a59b2b9b8980b4a9d3277bcb653bcb026 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 16:06:10 -0400 Subject: thread State thru to backends --- Annex.hs | 10 +++++----- Backend.hs | 55 +++++++++++++++++++++++++++--------------------------- BackendChecksum.hs | 4 ++-- BackendFile.hs | 10 +++++----- BackendList.hs | 2 +- BackendType.hs | 31 ------------------------------ BackendUrl.hs | 7 +++---- Types.hs | 25 +++++++++++++++++++++++-- 8 files changed, 67 insertions(+), 77 deletions(-) delete mode 100644 BackendType.hs diff --git a/Annex.hs b/Annex.hs index 830f61919..78d990eac 100644 --- a/Annex.hs +++ b/Annex.hs @@ -45,12 +45,12 @@ startAnnex = do - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () annexFile state file = do - alreadyannexed <- lookupBackend (backends state) (repo state) file + alreadyannexed <- lookupBackend (backends state) state file case (alreadyannexed) of Just _ -> error $ "already annexed: " ++ file Nothing -> do checkLegal file - stored <- storeFile (backends state) (repo state) file + stored <- storeFile (backends state) state file case (stored) of Nothing -> error $ "no backend could store: " ++ file Just key -> symlink key @@ -70,11 +70,11 @@ annexFile state file = do {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () unannexFile state file = do - alreadyannexed <- lookupBackend (backends state) (repo state) file + alreadyannexed <- lookupBackend (backends state) state file case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file Just _ -> do - mkey <- dropFile (backends state) (repo state) file + mkey <- dropFile (backends state) state file case (mkey) of Nothing -> return () Just key -> do @@ -86,7 +86,7 @@ unannexFile state file = do {- Transfers the file from a remote. -} annexGetFile :: State -> FilePath -> IO () annexGetFile state file = do - alreadyannexed <- lookupBackend (backends state) (repo state) file + alreadyannexed <- lookupBackend (backends state) state file case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file Just _ -> do error "not implemented" -- TODO diff --git a/Backend.hs b/Backend.hs index 2d3ea42d6..ddfd8b19d 100644 --- a/Backend.hs +++ b/Backend.hs @@ -28,74 +28,75 @@ import System.Directory import Locations import GitRepo import Utility -import BackendType +import Types {- Name of state file that holds the key for an annexed file, - using a given backend. -} -backendFile :: Backend -> GitRepo -> FilePath -> String -backendFile backend repo file = gitStateDir repo ++ - (gitRelative repo file) ++ "." ++ (name backend) +backendFile :: Backend -> State -> FilePath -> String +backendFile backend state file = + gitStateDir (repo state) ++ (gitRelative (repo state) file) ++ + "." ++ (name backend) {- Attempts to store a file in one of the backends, and returns - its key. -} -storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key) +storeFile :: [Backend] -> State -> FilePath -> IO (Maybe Key) storeFile [] _ _ = return Nothing -storeFile (b:bs) repo file = do - try <- (getKey b) repo (gitRelative repo file) +storeFile (b:bs) state file = do + try <- (getKey b) state (gitRelative (repo state) file) case (try) of Nothing -> nextbackend Just key -> do - stored <- (storeFileKey b) repo file key + stored <- (storeFileKey b) state file key if (not stored) then nextbackend else do bookkeeping key return $ Just key where - nextbackend = storeFile bs repo file - backendfile = backendFile b repo file + nextbackend = storeFile bs state file + backendfile = backendFile b state file bookkeeping key = do createDirectoryIfMissing True (parentDir backendfile) writeFile backendfile key {- Attempts to retrieve an file from one of the backends, saving it to - a specified location. -} -retrieveFile :: [Backend] -> GitRepo -> FilePath -> FilePath -> IO Bool -retrieveFile backends repo file dest = do - result <- lookupBackend backends repo file +retrieveFile :: [Backend] -> State -> FilePath -> FilePath -> IO Bool +retrieveFile backends state file dest = do + result <- lookupBackend backends state file case (result) of Nothing -> return False Just b -> do - key <- lookupKey b repo file + key <- lookupKey b state file (retrieveKeyFile b) key dest {- Drops the key for a file from the backend that has it. -} -dropFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key) -dropFile backends repo file = do - result <- lookupBackend backends repo file +dropFile :: [Backend] -> State -> FilePath -> IO (Maybe Key) +dropFile backends state file = do + result <- lookupBackend backends state file case (result) of Nothing -> return Nothing Just b -> do - key <- lookupKey b repo file + key <- lookupKey b state file (removeKey b) key - removeFile $ backendFile b repo file + removeFile $ backendFile b state file return $ Just key {- Looks up the key a backend uses for an already annexed file. -} -lookupKey :: Backend -> GitRepo -> FilePath -> IO Key -lookupKey backend repo file = readFile (backendFile backend repo file) +lookupKey :: Backend -> State -> FilePath -> IO Key +lookupKey backend state file = readFile (backendFile backend state file) {- Looks up the backend used for an already annexed file. -} -lookupBackend :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Backend) +lookupBackend :: [Backend] -> State -> FilePath -> IO (Maybe Backend) lookupBackend [] _ _ = return Nothing -lookupBackend (b:bs) repo file = do - present <- checkBackend b repo file +lookupBackend (b:bs) state file = do + present <- checkBackend b state file if present then return $ Just b else - lookupBackend bs repo file + lookupBackend bs state file {- Checks if a file is available via a given backend. -} -checkBackend :: Backend -> GitRepo -> FilePath -> IO (Bool) -checkBackend backend repo file = doesFileExist $ backendFile backend repo file +checkBackend :: Backend -> State -> FilePath -> IO (Bool) +checkBackend backend state file = doesFileExist $ backendFile backend state file diff --git a/BackendChecksum.hs b/BackendChecksum.hs index e80dbe793..72b4744e3 100644 --- a/BackendChecksum.hs +++ b/BackendChecksum.hs @@ -5,7 +5,7 @@ module BackendChecksum (backend) where import qualified BackendFile import Data.Digest.Pure.SHA -import BackendType +import Types import GitRepo -- based on BackendFile just with a different key type @@ -15,5 +15,5 @@ backend = BackendFile.backend { } -- checksum the file to get its key -keyValue :: GitRepo -> FilePath -> IO (Maybe Key) +keyValue :: State -> FilePath -> IO (Maybe Key) keyValue k = error "checksum keyValue unimplemented" -- TODO diff --git a/BackendFile.hs b/BackendFile.hs index ae53f460f..33c2985bc 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -3,7 +3,7 @@ module BackendFile (backend) where -import BackendType +import Types import GitRepo backend = Backend { @@ -15,15 +15,15 @@ backend = Backend { } -- direct mapping from filename to key -keyValue :: GitRepo -> FilePath -> IO (Maybe Key) -keyValue repo file = return $ Just file +keyValue :: State -> FilePath -> IO (Maybe Key) +keyValue state file = return $ Just file {- This backend does not really do any independant data storage, - it relies on the file contents in .git/annex/ in this repo, - and other accessible repos. So storing or removing a key is - a no-op. -} -dummyStore :: GitRepo -> FilePath -> Key -> IO (Bool) -dummyStore repo file key = return True +dummyStore :: State -> FilePath -> Key -> IO (Bool) +dummyStore state file key = return True dummyRemove :: Key -> IO Bool dummyRemove url = return False diff --git a/BackendList.hs b/BackendList.hs index f733a44be..104444dc2 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -7,7 +7,7 @@ module BackendList ( lookupBackendName ) where -import BackendType +import Types -- When adding a new backend, import it here and add it to the list. import qualified BackendFile diff --git a/BackendType.hs b/BackendType.hs deleted file mode 100644 index 3bc822f32..000000000 --- a/BackendType.hs +++ /dev/null @@ -1,31 +0,0 @@ -{- git-annex backend data types - - -} - -module BackendType ( - -- the entire types are exported, for use in backend implementations - Key(..), - Backend(..) -) where - -import GitRepo - --- annexed filenames are mapped into keys -type Key = FilePath - --- this structure represents a key/value backend -data Backend = Backend { - -- name of this backend - name :: String, - -- converts a filename to a key - getKey :: GitRepo -> FilePath -> IO (Maybe Key), - -- stores a file's contents to a key - storeFileKey :: GitRepo -> FilePath -> Key -> IO Bool, - -- retrieves a key's contents to a file - retrieveKeyFile :: Key -> FilePath -> IO Bool, - -- removes a key - removeKey :: Key -> IO Bool -} - -instance Show Backend where - show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" - diff --git a/BackendUrl.hs b/BackendUrl.hs index 4ba1dbadb..aad647744 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -3,8 +3,7 @@ module BackendUrl (backend) where -import BackendType -import GitRepo +import Types backend = Backend { name = "url", @@ -15,11 +14,11 @@ backend = Backend { } -- cannot generate url from filename -keyValue :: GitRepo -> FilePath -> IO (Maybe Key) +keyValue :: State -> FilePath -> IO (Maybe Key) keyValue repo file = return Nothing -- cannot change urls -dummyStore :: GitRepo -> FilePath -> Key -> IO Bool +dummyStore :: State -> FilePath -> Key -> IO Bool dummyStore repo file url = return False dummyRemove :: Key -> IO Bool dummyRemove url = return False diff --git a/Types.hs b/Types.hs index df9588027..de6bff9ff 100644 --- a/Types.hs +++ b/Types.hs @@ -1,14 +1,35 @@ {- git-annex core data types -} module Types ( - State(..) + State(..), + Key(..), + Backend(..) ) where -import BackendType import GitRepo -- git-annex's runtime state data State = State { repo :: GitRepo, backends :: [Backend] +} deriving (Show) + +-- annexed filenames are mapped into keys +type Key = FilePath + +-- this structure represents a key/value backend +data Backend = Backend { + -- name of this backend + name :: String, + -- converts a filename to a key + getKey :: State -> FilePath -> IO (Maybe Key), + -- stores a file's contents to a key + storeFileKey :: State -> FilePath -> Key -> IO Bool, + -- retrieves a key's contents to a file + retrieveKeyFile :: Key -> FilePath -> IO Bool, + -- removes a key + removeKey :: Key -> IO Bool } + +instance Show Backend where + show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" -- cgit v1.2.3 From 20acda0423b1a00eae64296835679887ca79ea2f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 16:10:15 -0400 Subject: more state --- Backend.hs | 4 ++-- BackendChecksum.hs | 1 - BackendFile.hs | 9 ++++----- BackendUrl.hs | 8 ++++---- Types.hs | 4 ++-- 5 files changed, 12 insertions(+), 14 deletions(-) diff --git a/Backend.hs b/Backend.hs index ddfd8b19d..622d558e3 100644 --- a/Backend.hs +++ b/Backend.hs @@ -68,7 +68,7 @@ retrieveFile backends state file dest = do Nothing -> return False Just b -> do key <- lookupKey b state file - (retrieveKeyFile b) key dest + (retrieveKeyFile b) state key dest {- Drops the key for a file from the backend that has it. -} dropFile :: [Backend] -> State -> FilePath -> IO (Maybe Key) @@ -78,7 +78,7 @@ dropFile backends state file = do Nothing -> return Nothing Just b -> do key <- lookupKey b state file - (removeKey b) key + (removeKey b) state key removeFile $ backendFile b state file return $ Just key diff --git a/BackendChecksum.hs b/BackendChecksum.hs index 72b4744e3..efa224412 100644 --- a/BackendChecksum.hs +++ b/BackendChecksum.hs @@ -6,7 +6,6 @@ module BackendChecksum (backend) where import qualified BackendFile import Data.Digest.Pure.SHA import Types -import GitRepo -- based on BackendFile just with a different key type backend = BackendFile.backend { diff --git a/BackendFile.hs b/BackendFile.hs index 33c2985bc..c59cbcbaa 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -4,7 +4,6 @@ module BackendFile (backend) where import Types -import GitRepo backend = Backend { name = "file", @@ -24,10 +23,10 @@ keyValue state file = return $ Just file - a no-op. -} dummyStore :: State -> FilePath -> Key -> IO (Bool) dummyStore state file key = return True -dummyRemove :: Key -> IO Bool -dummyRemove url = return False +dummyRemove :: State -> Key -> IO Bool +dummyRemove state url = return False {- Try to find a copy of the file in one of the other repos, - and copy it over to this one. -} -copyFromOtherRepo :: Key -> FilePath -> IO (Bool) -copyFromOtherRepo key file = error "copyFromOtherRepo unimplemented" -- TODO +copyFromOtherRepo :: State -> Key -> FilePath -> IO (Bool) +copyFromOtherRepo state key file = error "copyFromOtherRepo unimplemented" -- TODO diff --git a/BackendUrl.hs b/BackendUrl.hs index aad647744..71503c5c1 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -20,8 +20,8 @@ keyValue repo file = return Nothing -- cannot change urls dummyStore :: State -> FilePath -> Key -> IO Bool dummyStore repo file url = return False -dummyRemove :: Key -> IO Bool -dummyRemove url = return False +dummyRemove :: State -> Key -> IO Bool +dummyRemove state url = return False -downloadUrl :: Key -> FilePath -> IO Bool -downloadUrl url file = error "downloadUrl unimplemented" +downloadUrl :: State -> Key -> FilePath -> IO Bool +downloadUrl state url file = error "downloadUrl unimplemented" diff --git a/Types.hs b/Types.hs index de6bff9ff..26ba2a904 100644 --- a/Types.hs +++ b/Types.hs @@ -26,9 +26,9 @@ data Backend = Backend { -- stores a file's contents to a key storeFileKey :: State -> FilePath -> Key -> IO Bool, -- retrieves a key's contents to a file - retrieveKeyFile :: Key -> FilePath -> IO Bool, + retrieveKeyFile :: State -> Key -> FilePath -> IO Bool, -- removes a key - removeKey :: Key -> IO Bool + removeKey :: State -> Key -> IO Bool } instance Show Backend where -- cgit v1.2.3 From 603e01e96ce8d76f4b689b4503c3f4528c39957f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 16:20:41 -0400 Subject: simplify some function signatures using state --- Annex.hs | 11 +++++------ Backend.hs | 44 ++++++++++++++++++++++---------------------- CmdLine.hs | 1 + 3 files changed, 28 insertions(+), 28 deletions(-) diff --git a/Annex.hs b/Annex.hs index 78d990eac..1752cabff 100644 --- a/Annex.hs +++ b/Annex.hs @@ -2,7 +2,6 @@ -} module Annex ( - State, startAnnex, annexFile, unannexFile, @@ -45,12 +44,12 @@ startAnnex = do - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () annexFile state file = do - alreadyannexed <- lookupBackend (backends state) state file + alreadyannexed <- lookupBackend state file case (alreadyannexed) of Just _ -> error $ "already annexed: " ++ file Nothing -> do checkLegal file - stored <- storeFile (backends state) state file + stored <- storeFile state file case (stored) of Nothing -> error $ "no backend could store: " ++ file Just key -> symlink key @@ -70,11 +69,11 @@ annexFile state file = do {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () unannexFile state file = do - alreadyannexed <- lookupBackend (backends state) state file + alreadyannexed <- lookupBackend state file case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file Just _ -> do - mkey <- dropFile (backends state) state file + mkey <- dropFile state file case (mkey) of Nothing -> return () Just key -> do @@ -86,7 +85,7 @@ unannexFile state file = do {- Transfers the file from a remote. -} annexGetFile :: State -> FilePath -> IO () annexGetFile state file = do - alreadyannexed <- lookupBackend (backends state) state file + alreadyannexed <- lookupBackend state file case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file Just _ -> do error "not implemented" -- TODO diff --git a/Backend.hs b/Backend.hs index 622d558e3..2e5275ba6 100644 --- a/Backend.hs +++ b/Backend.hs @@ -17,8 +17,6 @@ - -} module Backend ( - Key, - Backend, -- note only data type is exported, not destructors lookupBackend, storeFile, dropFile @@ -32,16 +30,17 @@ import Types {- Name of state file that holds the key for an annexed file, - using a given backend. -} -backendFile :: Backend -> State -> FilePath -> String -backendFile backend state file = +backendFile :: State -> Backend -> FilePath -> String +backendFile state backend file = gitStateDir (repo state) ++ (gitRelative (repo state) file) ++ "." ++ (name backend) {- Attempts to store a file in one of the backends, and returns - its key. -} -storeFile :: [Backend] -> State -> FilePath -> IO (Maybe Key) -storeFile [] _ _ = return Nothing -storeFile (b:bs) state file = do +storeFile :: State -> FilePath -> IO (Maybe Key) +storeFile state file = storeFile' (backends state) state file +storeFile' [] _ _ = return Nothing +storeFile' (b:bs) state file = do try <- (getKey b) state (gitRelative (repo state) file) case (try) of Nothing -> nextbackend @@ -53,17 +52,17 @@ storeFile (b:bs) state file = do bookkeeping key return $ Just key where - nextbackend = storeFile bs state file - backendfile = backendFile b state file + nextbackend = storeFile' bs state file + backendfile = backendFile state b file bookkeeping key = do createDirectoryIfMissing True (parentDir backendfile) writeFile backendfile key {- Attempts to retrieve an file from one of the backends, saving it to - a specified location. -} -retrieveFile :: [Backend] -> State -> FilePath -> FilePath -> IO Bool -retrieveFile backends state file dest = do - result <- lookupBackend backends state file +retrieveFile :: State -> FilePath -> FilePath -> IO Bool +retrieveFile state file dest = do + result <- lookupBackend state file case (result) of Nothing -> return False Just b -> do @@ -71,32 +70,33 @@ retrieveFile backends state file dest = do (retrieveKeyFile b) state key dest {- Drops the key for a file from the backend that has it. -} -dropFile :: [Backend] -> State -> FilePath -> IO (Maybe Key) -dropFile backends state file = do - result <- lookupBackend backends state file +dropFile :: State -> FilePath -> IO (Maybe Key) +dropFile state file = do + result <- lookupBackend state file case (result) of Nothing -> return Nothing Just b -> do key <- lookupKey b state file (removeKey b) state key - removeFile $ backendFile b state file + removeFile $ backendFile state b file return $ Just key {- Looks up the key a backend uses for an already annexed file. -} lookupKey :: Backend -> State -> FilePath -> IO Key -lookupKey backend state file = readFile (backendFile backend state file) +lookupKey backend state file = readFile (backendFile state backend file) {- Looks up the backend used for an already annexed file. -} -lookupBackend :: [Backend] -> State -> FilePath -> IO (Maybe Backend) -lookupBackend [] _ _ = return Nothing -lookupBackend (b:bs) state file = do +lookupBackend :: State -> FilePath -> IO (Maybe Backend) +lookupBackend state file = lookupBackend' (backends state) state file +lookupBackend' [] _ _ = return Nothing +lookupBackend' (b:bs) state file = do present <- checkBackend b state file if present then return $ Just b else - lookupBackend bs state file + lookupBackend' bs state file {- Checks if a file is available via a given backend. -} checkBackend :: Backend -> State -> FilePath -> IO (Bool) -checkBackend backend state file = doesFileExist $ backendFile backend state file +checkBackend backend state file = doesFileExist $ backendFile state backend file diff --git a/CmdLine.hs b/CmdLine.hs index 60ba81d30..9da2b6493 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -10,6 +10,7 @@ module CmdLine ( ) where import System.Console.GetOpt +import Types import Annex data Mode = Add | Push | Pull | Want | Get | Drop | Unannex -- cgit v1.2.3 From 570899ed0c16121705ad5db1cb7aa96181a306a5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 16:39:10 -0400 Subject: handle newlines on keys --- Backend.hs | 43 +++++++++++++++++++++++++++---------------- 1 file changed, 27 insertions(+), 16 deletions(-) diff --git a/Backend.hs b/Backend.hs index 2e5275ba6..fab82a093 100644 --- a/Backend.hs +++ b/Backend.hs @@ -23,18 +23,12 @@ module Backend ( ) where import System.Directory +import Data.String.Utils import Locations import GitRepo import Utility import Types -{- 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) - {- Attempts to store a file in one of the backends, and returns - its key. -} storeFile :: State -> FilePath -> IO (Maybe Key) @@ -49,14 +43,10 @@ storeFile' (b:bs) state file = do if (not stored) then nextbackend else do - bookkeeping key + recordKey state b file key return $ Just key where nextbackend = storeFile' bs state file - backendfile = backendFile state b file - bookkeeping key = do - createDirectoryIfMissing True (parentDir backendfile) - writeFile backendfile key {- Attempts to retrieve an file from one of the backends, saving it to - a specified location. -} @@ -81,10 +71,6 @@ dropFile state file = do removeFile $ backendFile state b file return $ Just key -{- Looks up the key a backend uses for an already annexed file. -} -lookupKey :: Backend -> State -> FilePath -> IO Key -lookupKey backend state file = readFile (backendFile state backend file) - {- Looks up the backend used for an already annexed file. -} lookupBackend :: State -> FilePath -> IO (Maybe Backend) lookupBackend state file = lookupBackend' (backends state) state file @@ -97,6 +83,31 @@ 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 + +{- Looks up the key a backend uses for an already annexed file. -} +lookupKey :: Backend -> State -> FilePath -> IO Key +lookupKey backend state file = do + k <- readFile (backendFile state backend file) + return $ chomp k + where + chomp s = if (endswith s "\n") + then (reverse . (drop 1) . reverse) s + else s + +{- Records the key a backend uses for an annexed file. -} +recordKey :: State -> Backend -> FilePath -> Key -> IO () +recordKey state backend file key = do + createDirectoryIfMissing True (parentDir record) + writeFile record $ key ++ "\n" + where + record = backendFile state backend file -- cgit v1.2.3 From 921313bcc706f054c33c3eb923c47955710cd0a3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 16:40:17 -0400 Subject: consistency --- Backend.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Backend.hs b/Backend.hs index fab82a093..f03f098cf 100644 --- a/Backend.hs +++ b/Backend.hs @@ -56,7 +56,7 @@ retrieveFile state file dest = do case (result) of Nothing -> return False Just b -> do - key <- lookupKey b state file + key <- lookupKey state b file (retrieveKeyFile b) state key dest {- Drops the key for a file from the backend that has it. -} @@ -66,7 +66,7 @@ dropFile state file = do case (result) of Nothing -> return Nothing Just b -> do - key <- lookupKey b state file + key <- lookupKey state b file (removeKey b) state key removeFile $ backendFile state b file return $ Just key @@ -95,8 +95,8 @@ checkBackend :: Backend -> State -> FilePath -> IO (Bool) checkBackend backend state file = doesFileExist $ backendFile state backend file {- Looks up the key a backend uses for an already annexed file. -} -lookupKey :: Backend -> State -> FilePath -> IO Key -lookupKey backend state file = do +lookupKey :: State -> Backend -> FilePath -> IO Key +lookupKey state backend file = do k <- readFile (backendFile state backend file) return $ chomp k where -- cgit v1.2.3 From cad916d92695c7c04d3cdacbcd333a2dcd109d53 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 16:52:01 -0400 Subject: hookup annexgetfile --- Annex.hs | 19 ++++++++++++------- Backend.hs | 2 ++ 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/Annex.hs b/Annex.hs index 1752cabff..7ac9932f1 100644 --- a/Annex.hs +++ b/Annex.hs @@ -24,8 +24,8 @@ import LocationLog import Types {- An annexed file's content is stored somewhere under .git/annex/ -} -annexDir :: GitRepo -> Key -> FilePath -annexDir repo key = gitDir repo ++ "/annex/" ++ key +annexLocation :: GitRepo -> Key -> FilePath +annexLocation repo key = gitDir repo ++ "/annex/" ++ key {- On startup, examine the git repo, prepare it, and record state for - later. -} @@ -55,7 +55,7 @@ annexFile state file = do Just key -> symlink key where symlink key = do - let dest = annexDir (repo state) key + let dest = annexLocation (repo state) key createDirectoryIfMissing True (parentDir dest) renameFile file dest createSymbolicLink dest file @@ -77,7 +77,7 @@ unannexFile state file = do case (mkey) of Nothing -> return () Just key -> do - let src = annexDir (repo state) key + let src = annexLocation (repo state) key removeFile file renameFile src file return () @@ -88,9 +88,14 @@ annexGetFile state file = do alreadyannexed <- lookupBackend state file case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file - Just _ -> do error "not implemented" -- TODO - -- 1. find remote with file - -- 2. copy file from remote + Just backend -> do + key <- lookupKey state backend file + let dest = annexLocation (repo state) key + createDirectoryIfMissing True (parentDir dest) + success <- retrieveFile state file dest + if (success) + then return () + else error $ "failed to get " ++ file {- Indicates a file is wanted. -} annexWantFile :: State -> FilePath -> IO () diff --git a/Backend.hs b/Backend.hs index f03f098cf..9d1b0cdbe 100644 --- a/Backend.hs +++ b/Backend.hs @@ -19,6 +19,8 @@ module Backend ( lookupBackend, storeFile, + retrieveFile, + lookupKey, dropFile ) where -- cgit v1.2.3 From a36c39ad0af168259948a360087d2ff05df2857e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 17:26:34 -0400 Subject: getting files via http working! --- Annex.hs | 10 ++++++++-- Backend.hs | 2 +- BackendUrl.hs | 11 +++++++++-- 3 files changed, 18 insertions(+), 5 deletions(-) diff --git a/Annex.hs b/Annex.hs index 7ac9932f1..68379cf20 100644 --- a/Annex.hs +++ b/Annex.hs @@ -14,6 +14,7 @@ module Annex ( import System.Posix.Files import System.Directory +import Data.String.Utils import GitRepo import Utility import Locations @@ -23,9 +24,14 @@ import UUID import LocationLog import Types -{- An annexed file's content is stored somewhere under .git/annex/ -} +{- 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 :: GitRepo -> Key -> FilePath -annexLocation repo key = gitDir repo ++ "/annex/" ++ key +annexLocation repo key = gitDir repo ++ "/annex/" ++ (transform key) + where transform s = replace "/" "%" $ replace "%" "%%" s {- On startup, examine the git repo, prepare it, and record state for - later. -} diff --git a/Backend.hs b/Backend.hs index 9d1b0cdbe..a16dfab6a 100644 --- a/Backend.hs +++ b/Backend.hs @@ -102,7 +102,7 @@ lookupKey state backend file = do k <- readFile (backendFile state backend file) return $ chomp k where - chomp s = if (endswith s "\n") + chomp s = if (endswith "\n" s) then (reverse . (drop 1) . reverse) s else s diff --git a/BackendUrl.hs b/BackendUrl.hs index 71503c5c1..ca44a5c37 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -3,6 +3,8 @@ module BackendUrl (backend) where +import System.Posix.Process +import IO import Types backend = Backend { @@ -17,11 +19,16 @@ backend = Backend { keyValue :: State -> FilePath -> IO (Maybe Key) keyValue repo file = return Nothing --- cannot change urls +-- cannot change url contents dummyStore :: State -> FilePath -> Key -> IO Bool dummyStore repo file url = return False dummyRemove :: State -> Key -> IO Bool dummyRemove state url = return False downloadUrl :: State -> Key -> FilePath -> IO Bool -downloadUrl state url file = error "downloadUrl unimplemented" +downloadUrl state url file = do + putStrLn $ "download: " ++ url + result <- try $ executeFile "curl" True ["-o", file, url] Nothing + case (result) of + Left _ -> return False + Right _ -> return True -- cgit v1.2.3 From 0561ea1b2873962199aca5ba6529254aa5b2632b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 17:43:54 -0400 Subject: oops, wrong system --- BackendUrl.hs | 4 ++-- GitRepo.hs | 4 ++-- TODO | 2 ++ 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/BackendUrl.hs b/BackendUrl.hs index ca44a5c37..f18c800e9 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -3,7 +3,7 @@ module BackendUrl (backend) where -import System.Posix.Process +import System.Cmd import IO import Types @@ -28,7 +28,7 @@ dummyRemove state url = return False downloadUrl :: State -> Key -> FilePath -> IO Bool downloadUrl state url file = do putStrLn $ "download: " ++ url - result <- try $ executeFile "curl" True ["-o", file, url] Nothing + result <- try $ rawSystem "curl" ["-o", file, url] case (result) of Left _ -> return False Right _ -> return True diff --git a/GitRepo.hs b/GitRepo.hs index 9a919128e..068b2569c 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -26,10 +26,10 @@ import System import System.Directory import System.Posix.Directory import System.Path +import System.Cmd import System.Cmd.Utils import System.IO import IO (bracket_) -import System.Posix.Process import Data.String.Utils import Data.Map as Map hiding (map, split) import Network.URI @@ -145,7 +145,7 @@ gitCommandLine repo params = assertlocal repo $ {- Runs git in the specified repo. -} gitRun :: GitRepo -> [String] -> IO () gitRun repo params = assertlocal repo $ do - r <- executeFile "git" True (gitCommandLine repo params) Nothing + r <- rawSystem "git" (gitCommandLine repo params) return () {- Runs a git subcommand and returns its output. -} diff --git a/TODO b/TODO index c951eb3f1..ad0389f85 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,7 @@ * bug when annexing files in a subdir of a git repo * how to handle git mv file? +* if curl fails to download, git-annex crashes and does not complete + further actions.. exception seems to somehow not get caught * query remotes for their annex.uuid settings -- cgit v1.2.3 From 3d2b44ffe58ddc2f235f71cb548ba4a43b6fe641 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 17:51:41 -0400 Subject: better progress --- BackendUrl.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/BackendUrl.hs b/BackendUrl.hs index f18c800e9..3f0846885 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -28,7 +28,7 @@ dummyRemove state url = return False downloadUrl :: State -> Key -> FilePath -> IO Bool downloadUrl state url file = do putStrLn $ "download: " ++ url - result <- try $ rawSystem "curl" ["-o", file, url] + result <- try $ rawSystem "curl" ["-#", "-o", file, url] case (result) of Left _ -> return False Right _ -> return True -- cgit v1.2.3 From 10992b90c97e8c6abfd26da3d6cb50011b4230b6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 17:56:29 -0400 Subject: avoid redownload --- Annex.hs | 26 +++++++++++++++++--------- TODO | 2 -- 2 files changed, 17 insertions(+), 11 deletions(-) diff --git a/Annex.hs b/Annex.hs index 68379cf20..725009fd2 100644 --- a/Annex.hs +++ b/Annex.hs @@ -29,10 +29,14 @@ import Types - 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 :: GitRepo -> Key -> FilePath -annexLocation repo key = gitDir repo ++ "/annex/" ++ (transform key) +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 + {- On startup, examine the git repo, prepare it, and record state for - later. -} startAnnex :: IO State @@ -61,7 +65,7 @@ annexFile state file = do Just key -> symlink key where symlink key = do - let dest = annexLocation (repo state) key + let dest = annexLocation state key createDirectoryIfMissing True (parentDir dest) renameFile file dest createSymbolicLink dest file @@ -83,7 +87,7 @@ unannexFile state file = do case (mkey) of Nothing -> return () Just key -> do - let src = annexLocation (repo state) key + let src = annexLocation state key removeFile file renameFile src file return () @@ -96,12 +100,16 @@ annexGetFile state file = do Nothing -> error $ "not annexed " ++ file Just backend -> do key <- lookupKey state backend file - let dest = annexLocation (repo state) key - createDirectoryIfMissing True (parentDir dest) - success <- retrieveFile state file dest - if (success) + inannex <- inAnnex state key + if (inannex) then return () - else error $ "failed to get " ++ file + else do + let dest = annexLocation state key + createDirectoryIfMissing True (parentDir dest) + success <- retrieveFile state file dest + if (success) + then return () + else error $ "failed to get " ++ file {- Indicates a file is wanted. -} annexWantFile :: State -> FilePath -> IO () diff --git a/TODO b/TODO index ad0389f85..c951eb3f1 100644 --- a/TODO +++ b/TODO @@ -1,7 +1,5 @@ * bug when annexing files in a subdir of a git repo * how to handle git mv file? -* if curl fails to download, git-annex crashes and does not complete - further actions.. exception seems to somehow not get caught * query remotes for their annex.uuid settings -- cgit v1.2.3 From f1eb4fef99aa553899256f3542e5bf30523e3512 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 17:57:23 -0400 Subject: todo --- TODO | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/TODO b/TODO index c951eb3f1..36ec65c2f 100644 --- a/TODO +++ b/TODO @@ -1,9 +1,11 @@ * bug when annexing files in a subdir of a git repo * how to handle git mv file? +* implement retrieval for backendfile + * query remotes for their annex.uuid settings * hook up LocationLog -* --push/--pull/--get/--want/--drop +* --push/--pull/--want/--drop * finish BackendUrl and BackendChecksum -- cgit v1.2.3 From b882fe8410f33b2c8b170e6a60b55d156e336d47 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 18:06:34 -0400 Subject: locationlog will use uuids --- BackendFile.hs | 7 ++++++- LocationLog.hs | 25 +++++++++++++------------ UUID.hs | 1 + 3 files changed, 20 insertions(+), 13 deletions(-) diff --git a/BackendFile.hs b/BackendFile.hs index c59cbcbaa..43ca2191c 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -29,4 +29,9 @@ dummyRemove state url = return False {- Try to find a copy of the file in one of the other repos, - and copy it over to this one. -} copyFromOtherRepo :: State -> Key -> FilePath -> IO (Bool) -copyFromOtherRepo state key file = error "copyFromOtherRepo unimplemented" -- TODO +copyFromOtherRepo state key file = + -- 1. get ordered list of remotes (local repos, then remote repos) + -- 2. read locationlog for file + -- 3. filter remotes list to ones that have file + -- 4. attempt to transfer from each remote until success + error "copyFromOtherRepo unimplemented" -- TODO diff --git a/LocationLog.hs b/LocationLog.hs index 31d454f10..2cd84db1f 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -6,10 +6,10 @@ - repositories have the file's content. - - Location tracking information is stored in `.git-annex/filename.log`. - - Repositories record their name and the date when they --get or --drop + - Repositories record their UUID and the date when they --get or --drop - a file's content. - - - A line of the log will look like: "date N reponame" + - A line of the log will look like: "date N UUID" - Where N=1 when the repo has the file, and 0 otherwise. - - Git is configured to use a union merge for this file, @@ -28,12 +28,13 @@ import System.Directory import Data.Char import GitRepo import Utility +import UUID import Locations data LogLine = LogLine { date :: POSIXTime, status :: LogStatus, - reponame :: String + uuid :: UUID } deriving (Eq) data LogStatus = FilePresent | FileMissing | Undefined @@ -50,8 +51,8 @@ instance Read LogStatus where readsPrec _ _ = [(Undefined, "")] instance Show LogLine where - show (LogLine date status reponame) = unwords - [(show date), (show status), reponame] + show (LogLine date status uuid) = unwords + [(show date), (show status), uuid] instance Read LogLine where -- This parser is robust in that even unparsable log lines are @@ -67,10 +68,10 @@ instance Read LogLine where w = words string date = w !! 0 status = read $ w !! 1 - reponame = unwords $ drop 2 w + uuid = unwords $ drop 2 w pdate = (parseTime defaultTimeLocale "%s%Qs" date) :: Maybe UTCTime - good v = ret $ LogLine (utcTimeToPOSIXSeconds v) status reponame + good v = ret $ LogLine (utcTimeToPOSIXSeconds v) status uuid undefined = ret $ LogLine (0) Undefined "" ret v = [(v, "")] @@ -106,9 +107,9 @@ writeLog file lines = do {- Generates a new LogLine with the current date. -} logNow :: LogStatus -> String -> IO LogLine -logNow status reponame = do +logNow status uuid = do now <- getPOSIXTime - return $ LogLine now status reponame + return $ LogLine now status uuid {- Returns the filename of the log file for a given annexed file. -} logFile :: GitRepo -> FilePath -> IO String @@ -122,7 +123,7 @@ fileLocations :: GitRepo -> FilePath -> IO [String] fileLocations thisrepo file = do log <- logFile thisrepo file lines <- readLog log - return $ map reponame (filterPresent lines) + return $ map uuid (filterPresent lines) {- Filters the list of LogLines to find ones where the file - is (or should still be) present. -} @@ -140,9 +141,9 @@ compactLog' map (l:ls) = compactLog' (mapLog map l) ls - information about a repo than the other logs in the map -} mapLog map log = if (better) - then Map.insert (reponame log) log map + then Map.insert (uuid log) log map else map where - better = case (Map.lookup (reponame log) map) of + better = case (Map.lookup (uuid log) map) of Just l -> (date l <= date log) Nothing -> True diff --git a/UUID.hs b/UUID.hs index 4364e2070..e2b624d69 100644 --- a/UUID.hs +++ b/UUID.hs @@ -6,6 +6,7 @@ -} module UUID ( + UUID, getUUID, prepUUID, genUUID -- cgit v1.2.3 From 3b89924f53cd88c0b5c21767dfd03b65d9d32f09 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 18:25:41 -0400 Subject: record annexed files in log --- Annex.hs | 1 + LocationLog.hs | 32 ++++++++++++++++++++++++-------- 2 files changed, 25 insertions(+), 8 deletions(-) diff --git a/Annex.hs b/Annex.hs index 725009fd2..29cd7b0fd 100644 --- a/Annex.hs +++ b/Annex.hs @@ -68,6 +68,7 @@ annexFile state file = 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 checkLegal file = do diff --git a/LocationLog.hs b/LocationLog.hs index 2cd84db1f..d3dd07a4e 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -17,6 +17,8 @@ -} module LocationLog ( + LogStatus(..), + logChange ) where import Data.Time.Clock.POSIX @@ -75,6 +77,22 @@ instance Read LogLine where 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 <- 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 + where + logfile = logFile repo file + {- Reads a log file. - Note that the LogLines returned may be in any order. -} readLog :: FilePath -> IO [LogLine] @@ -106,23 +124,21 @@ writeLog file lines = do hPutStr h $ unlines $ map show lines {- Generates a new LogLine with the current date. -} -logNow :: LogStatus -> String -> IO LogLine +logNow :: LogStatus -> UUID -> IO LogLine 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 -> IO String -logFile repo annexedFile = do - return $ (gitStateDir repo) ++ +logFile :: GitRepo -> FilePath -> String +logFile repo annexedFile = (gitStateDir repo) ++ (gitRelative repo annexedFile) ++ ".log" -{- Returns a list of repositories that, according to the log, have +{- Returns a list of repository UUIDs that, according to the log, have - the content of a file -} -fileLocations :: GitRepo -> FilePath -> IO [String] +fileLocations :: GitRepo -> FilePath -> IO [UUID] fileLocations thisrepo file = do - log <- logFile thisrepo file - lines <- readLog log + lines <- readLog $ logFile thisrepo file return $ map uuid (filterPresent lines) {- Filters the list of LogLines to find ones where the file -- cgit v1.2.3 From 476f66abb99ad2baa18b699c26ac9ee7250eca76 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 18:31:02 -0400 Subject: now that a uuid is used, don't need to rejoin --- LocationLog.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LocationLog.hs b/LocationLog.hs index d3dd07a4e..da702d650 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -70,7 +70,7 @@ instance Read LogLine where w = words string date = w !! 0 status = read $ w !! 1 - uuid = unwords $ drop 2 w + uuid = w !! 3 pdate = (parseTime defaultTimeLocale "%s%Qs" date) :: Maybe UTCTime good v = ret $ LogLine (utcTimeToPOSIXSeconds v) status uuid -- cgit v1.2.3 From b7858ada038084c8455cdf9d3598382308dc52b3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 20:04:36 -0400 Subject: bugfixes --- Annex.hs | 51 +++++++++++++++++++++++++++++----------------- Backend.hs | 20 ++++++------------ GitRepo.hs | 10 --------- LocationLog.hs | 64 +++++++++++++++++++++++++++------------------------------- Locations.hs | 25 ++++++++++++++++++++++- Types.hs | 1 + 6 files changed, 93 insertions(+), 78 deletions(-) diff --git a/Annex.hs b/Annex.hs index 29cd7b0fd..b8e70e6c8 100644 --- a/Annex.hs +++ b/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] diff --git a/Backend.hs b/Backend.hs index a16dfab6a..d7bde241a 100644 --- a/Backend.hs +++ b/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) diff --git a/GitRepo.hs b/GitRepo.hs index 068b2569c..fcaae1253 100644 --- a/GitRepo.hs +++ b/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 $ diff --git a/LocationLog.hs b/LocationLog.hs index da702d650..2eab4815e 100644 --- a/LocationLog.hs +++ b/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. -} diff --git a/Locations.hs b/Locations.hs index 300f443f7..59f9df727 100644 --- a/Locations.hs +++ b/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) diff --git a/Types.hs b/Types.hs index 26ba2a904..73492dfc3 100644 --- a/Types.hs +++ b/Types.hs @@ -6,6 +6,7 @@ module Types ( Backend(..) ) where +import Data.String.Utils import GitRepo -- git-annex's runtime state -- cgit v1.2.3 From 490eb66be40d4e9e6a5e4d89f67610e073e7574f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 20:20:59 -0400 Subject: update --- Backend.hs | 3 --- Locations.hs | 7 ++++--- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/Backend.hs b/Backend.hs index d7bde241a..525a52bee 100644 --- a/Backend.hs +++ b/Backend.hs @@ -9,9 +9,6 @@ - This key can later be used to retrieve the file's content (its value). This - key generation must be stable for a given file content, name, and size. - - - The mapping from filename to its key is stored in the .git-annex directory, - - in a file named `$filename.$backend` - - - Multiple pluggable backends are supported, and more than one can be used - to store different files' contents in a given repository. - -} diff --git a/Locations.hs b/Locations.hs index 59f9df727..925aa39e5 100644 --- a/Locations.hs +++ b/Locations.hs @@ -30,9 +30,10 @@ keyFile key = replace "/" "%" $ replace "%" "%%" 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. -} +{- The mapping from filename to its key is stored in the .git-annex directory, + - in a file named `key/$filename.$backend` -} backendFile :: State -> Backend -> FilePath -> String backendFile state backend file = - gitStateDir (repo state) ++ (gitRelative (repo state) file) ++ + gitStateDir (repo state) ++ "key/" ++ + (gitRelative (repo state) file) ++ "." ++ (name backend) -- cgit v1.2.3 From d029c48d0ae5485329b4e8757b45f320bb8bfea9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 20:26:02 -0400 Subject: docs --- git-annex.mdwn | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/git-annex.mdwn b/git-annex.mdwn index 9dd2d44ef..84030bfca 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -36,7 +36,9 @@ Enough broad picture, here's how it actually looks: downloaded. * `git annex --drop $file` indicates that you no longer want the file's content to be available in this repository. -* `git annex --unannex $file` undoes a `git annex --add`. +* `git annex --unannex $file` undoes a `git annex --add`. But use `--drop` + if you're just done with a file; only use `--unannex` if you + accidentially added a file. * `git annex $file` is a shorthand for either --add or --get. If the file is already known, it does --get, otherwise it does --add. @@ -74,12 +76,12 @@ only copies of a file. ## the .git-annex directory -The `.git-annex` directory at the top of the repository, is used to store +The `.git-annex` directory at the top of the repository is used to store git-annex information that should be propigated between repositories. Data is stored here in files that are arranged to avoid conflicts in most cases. A conflict could occur if a file with the same name but different -content was added to multiple repositories. +content was added to different repositories. ## key/value storage @@ -93,7 +95,7 @@ This key can later be used to retrieve the file's content (its value). This key generation must be stable for a given file content, name, and size. The mapping from filename to its key is stored in the .git-annex directory, -in a file named `$filename.$backend` +in a file named `key/$filename.$backend` Multiple pluggable backends are supported, and more than one can be used to store different files' contents in a given repository. @@ -116,7 +118,7 @@ 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. -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. (Git is configured to use a union merge for this file, so the lines may be in arbitrary order, but it will never conflict.) @@ -140,10 +142,12 @@ example: new files. (default: file, checksum, url) * `remote..annex-cost` -- When determining which repository to transfer annexed files from or to, ones with lower costs are preferred. - The default cost is 50. Note that other factors may be configured - when pushing files to repositories, in particular, whether the repository - is on a filesystem with sufficient free space. -* `remote..annex-uuid` -- git-annex caches UUIDs of remotes here + The default cost is 100 for local repositories, and 200 for remote + repositories. Note that other factors may be configured when pushing + files to repositories, in particular, whether the repository is on + a filesystem with sufficient free space. +* `remote..annex-uuid` -- git-annex caches UUIDs of repositories + here. ## issues -- cgit v1.2.3 From fe612bac0361b42af2cdff590797e929cebbb53d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 12 Oct 2010 20:35:20 -0400 Subject: thought --- git-annex.mdwn | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/git-annex.mdwn b/git-annex.mdwn index 84030bfca..3a8db6dcf 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -180,3 +180,11 @@ remote, to check local disk space. When git-rm removed a file, it should get dropped too. Of course, it may not be dropped right away, depending on number of copies available. + +### branching + +The use of `.git-annex` to store state means that if a repo has branches +and the user switched between them, git-annex will see different state in +the different branches. Whether that is a bug or a feature may depend on +point of view -- call it Too Be Determined. An alternative would be to +store data directly in the git repo as `pristine-tar` does. -- cgit v1.2.3 From 9926fe5c8a1479f734c0a5b68c7c4e6ddfc2f8cf Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 00:21:34 -0400 Subject: bugfix in escaping --- Locations.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Locations.hs b/Locations.hs index 925aa39e5..c12b9fadc 100644 --- a/Locations.hs +++ b/Locations.hs @@ -19,11 +19,11 @@ 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. +{- Converts a key into a filename fragment. - 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 +keyFile key = replace "/" "&s" $ replace "&" "&a" key {- An annexed file's content is stored somewhere under .git/annex/, - based on the key. -} -- cgit v1.2.3 From 208bba8d3062133733d27a5db521013e3a2ead57 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 00:42:46 -0400 Subject: got rid of the .git-annex/key.backend files --- Annex.hs | 24 +++++++++++------------- Backend.hs | 46 ++++++++++++++++++---------------------------- Locations.hs | 22 ++++++++-------------- TODO | 7 +++++++ git-annex.mdwn | 18 ++++++++---------- 5 files changed, 52 insertions(+), 65 deletions(-) diff --git a/Annex.hs b/Annex.hs index b8e70e6c8..82efd543d 100644 --- a/Annex.hs +++ b/Annex.hs @@ -25,8 +25,8 @@ import LocationLog import Types {- Checks if a given key is currently present in the annexLocation -} -inAnnex :: State -> Key -> IO Bool -inAnnex state key = doesFileExist $ annexLocation state key +inAnnex :: State -> Backend -> Key -> IO Bool +inAnnex state backend key = doesFileExist $ annexLocation state backend key {- On startup, examine the git repo, prepare it, and record state for - later. -} @@ -56,15 +56,14 @@ annexFile state file = do Just (key, backend) -> setup key backend where setup key backend = do - let dest = annexLocation state key + let dest = annexLocation state backend key createDirectoryIfMissing True (parentDir dest) renameFile file dest createSymbolicLink dest file - gitRun (repo state) ["add", file, bfile] + gitRun (repo state) ["add", file] gitRun (repo state) ["commit", "-m", - ("git-annex annexed " ++ file), file, bfile] + ("git-annex annexed " ++ file), file] logStatus state key ValuePresent - where bfile = backendFile state backend file checkLegal file = do s <- getSymbolicLinkStatus file if ((isSymbolicLink s) || (not $ isRegularFile s)) @@ -82,16 +81,15 @@ unannexFile state file = do case (mkey) of Nothing -> return () Just (key, backend) -> do - let src = annexLocation state key + let src = annexLocation state backend key removeFile file - gitRun (repo state) ["rm", file, bfile] + gitRun (repo state) ["rm", file] gitRun (repo state) ["commit", "-m", ("git-annex unannexed " ++ file), - file, bfile] + file] renameFile src file logStatus state key ValueMissing return () - where bfile = backendFile state backend file {- Transfers the file from a remote. -} annexGetFile :: State -> FilePath -> IO () @@ -100,12 +98,12 @@ annexGetFile state file = do case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file Just backend -> do - key <- lookupKey state backend file - inannex <- inAnnex state key + key <- fileKey file + inannex <- inAnnex state backend key if (inannex) then return () else do - let dest = annexLocation state key + let dest = annexLocation state backend key createDirectoryIfMissing True (parentDir dest) success <- retrieveFile state file dest if (success) diff --git a/Backend.hs b/Backend.hs index 525a52bee..68d70feec 100644 --- a/Backend.hs +++ b/Backend.hs @@ -17,12 +17,14 @@ module Backend ( lookupBackend, storeFile, retrieveFile, - lookupKey, + fileKey, dropFile ) where import System.Directory +import System.FilePath import Data.String.Utils +import System.Posix.Files import Locations import GitRepo import Utility @@ -41,7 +43,6 @@ storeFile' (b:bs) state file = do if (not stored) then nextbackend else do - recordKey state b file key return $ Just (key, b) where nextbackend = storeFile' bs state file @@ -53,9 +54,9 @@ retrieveFile state file dest = do result <- lookupBackend state file case (result) of Nothing -> return False - Just b -> do - key <- lookupKey state b file - (retrieveKeyFile b) state key dest + Just backend -> do + key <- fileKey file + (retrieveKeyFile backend) state key dest {- Drops the key for a file from the backend that has it. -} dropFile :: State -> FilePath -> IO (Maybe (Key, Backend)) @@ -63,11 +64,10 @@ dropFile state file = do result <- lookupBackend state file case (result) of Nothing -> return Nothing - Just b -> do - key <- lookupKey state b file - (removeKey b) state key - removeFile $ backendFile state b file - return $ Just (key, b) + Just backend -> do + key <- fileKey file + (removeKey backend) state key + return $ Just (key, backend) {- Looks up the backend used for an already annexed file. -} lookupBackend :: State -> FilePath -> IO (Maybe Backend) @@ -83,22 +83,12 @@ lookupBackend' (b:bs) state file = do {- 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 +checkBackend backend state file = + doesFileExist $ annexLocation state backend file -{- Looks up the key a backend uses for an already annexed file. -} -lookupKey :: State -> Backend -> FilePath -> IO Key -lookupKey state backend file = do - k <- readFile (backendFile state backend file) - return $ chomp k - where - chomp s = if (endswith "\n" s) - then (reverse . (drop 1) . reverse) s - else s - -{- Records the key used for an annexed file. -} -recordKey :: State -> Backend -> FilePath -> Key -> IO () -recordKey state backend file key = do - createDirectoryIfMissing True (parentDir record) - writeFile record $ key ++ "\n" - where - record = backendFile state backend file +{- Looks up the key corresponding to an annexed file, + - by examining what the file symlinks to. -} +fileKey :: FilePath -> IO Key +fileKey file = do + l <- readSymbolicLink (file) + return $ takeFileName $ l diff --git a/Locations.hs b/Locations.hs index c12b9fadc..b859fd2f2 100644 --- a/Locations.hs +++ b/Locations.hs @@ -5,8 +5,7 @@ module Locations ( gitStateDir, stateLoc, keyFile, - annexLocation, - backendFile + annexLocation ) where import Data.String.Utils @@ -25,15 +24,10 @@ gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/" keyFile :: Key -> FilePath keyFile key = replace "/" "&s" $ replace "&" "&a" 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) - -{- The mapping from filename to its key is stored in the .git-annex directory, - - in a file named `key/$filename.$backend` -} -backendFile :: State -> Backend -> FilePath -> String -backendFile state backend file = - gitStateDir (repo state) ++ "key/" ++ - (gitRelative (repo state) file) ++ - "." ++ (name backend) +{- An annexed file's content is stored in + - .git/annex// ; this allows deriving the key and backend + - by looking at the symlink to it. -} +annexLocation :: State -> Backend -> Key -> FilePath +annexLocation state backend key = + gitDir (repo state) ++ "/annex/" ++ (name backend) ++ + "/" ++ (keyFile key) diff --git a/TODO b/TODO index 36ec65c2f..392ec4990 100644 --- a/TODO +++ b/TODO @@ -1,6 +1,13 @@ * bug when annexing files in a subdir of a git repo * how to handle git mv file? +* if the annexed files were in .git/annex//key, and + files in the repo symlink to that, the .git-annex/key/. + would be redundant, and not needed + + -- no separate merge problem with it + -- want to add an url? `ln -s .git/annex//http:%%kitenet.net%foo myfile` + * implement retrieval for backendfile * query remotes for their annex.uuid settings diff --git a/git-annex.mdwn b/git-annex.mdwn index 3a8db6dcf..dd0b3bc07 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -91,11 +91,9 @@ used to store the file contents, and git-annex would then retrieve them as needed and put them in `.git/annex/`. When a file is annexed, a key is generated from its content and/or metadata. -This key can later be used to retrieve the file's content (its value). This -key generation must be stable for a given file content, name, and size. - -The mapping from filename to its key is stored in the .git-annex directory, -in a file named `key/$filename.$backend` +The file checked into git symlinks to the key. This key can later be used +to retrieve the file's content (its value). This key generation must be +stable for a given file content, name, and size. Multiple pluggable backends are supported, and more than one can be used to store different files' contents in a given repository. @@ -183,8 +181,8 @@ not be dropped right away, depending on number of copies available. ### branching -The use of `.git-annex` to store state means that if a repo has branches -and the user switched between them, git-annex will see different state in -the different branches. Whether that is a bug or a feature may depend on -point of view -- call it Too Be Determined. An alternative would be to -store data directly in the git repo as `pristine-tar` does. +The use of `.git-annex` to store logs means that if a repo has branches +and the user switched between them, git-annex will see different logs in +the different branches, and so may miss info about what remotes have which +files (though it can re-learn). An alternative would be to +store the log data directly in the git repo as `pristine-tar` does. -- cgit v1.2.3 From 14d7b2ac13318ba513bbab4f08b98434741f0e12 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 00:45:09 -0400 Subject: update --- Annex.hs | 6 +++--- demo.log | 11 ----------- git-annex.mdwn | 4 ---- 3 files changed, 3 insertions(+), 18 deletions(-) delete mode 100644 demo.log diff --git a/Annex.hs b/Annex.hs index 82efd543d..e5eb1894f 100644 --- a/Annex.hs +++ b/Annex.hs @@ -34,7 +34,7 @@ startAnnex :: IO State startAnnex = do r <- gitRepoFromCwd r' <- prepUUID r - gitPrep r' + gitSetup r' return State { repo = r', @@ -129,8 +129,8 @@ annexPullRepo :: State -> String -> IO () annexPullRepo state reponame = do error "not implemented" -- TODO {- Sets up a git repo for git-annex. May be called repeatedly. -} -gitPrep :: GitRepo -> IO () -gitPrep repo = do +gitSetup :: GitRepo -> IO () +gitSetup repo = do -- configure git to use union merge driver on state files exists <- doesFileExist attributes if (not exists) diff --git a/demo.log b/demo.log deleted file mode 100644 index bdecb7d40..000000000 --- a/demo.log +++ /dev/null @@ -1,11 +0,0 @@ -1286654242s 1 repo -1286652724s 0 foo -1286656282s 1 foo -1286656282s 0 repo -1286656281s 0 foo -# some garbage, should be ignored -a a a - -a 1 a --1 a a -1286652724.0001s 1 foo diff --git a/git-annex.mdwn b/git-annex.mdwn index dd0b3bc07..6852ed008 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -79,10 +79,6 @@ only copies of a file. The `.git-annex` directory at the top of the repository is used to store git-annex information that should be propigated between repositories. -Data is stored here in files that are arranged to avoid conflicts in most -cases. A conflict could occur if a file with the same name but different -content was added to different repositories. - ## key/value storage git-annex uses a key/value abstraction layer to allow files contents to be -- cgit v1.2.3 From 67ae9d7fa109503e4b798e2b7703282b92ce3deb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 00:58:59 -0400 Subject: relative symlink to annexed file --- Annex.hs | 2 +- GitRepo.hs | 10 ++++------ Locations.hs | 9 +++++++-- 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/Annex.hs b/Annex.hs index e5eb1894f..1c369be92 100644 --- a/Annex.hs +++ b/Annex.hs @@ -59,7 +59,7 @@ annexFile state file = do let dest = annexLocation state backend key createDirectoryIfMissing True (parentDir dest) renameFile file dest - createSymbolicLink dest file + createSymbolicLink (annexLocationRelative state backend key) file gitRun (repo state) ["add", file] gitRun (repo state) ["commit", "-m", ("git-annex annexed " ++ file), file] diff --git a/GitRepo.hs b/GitRepo.hs index fcaae1253..f0686ff20 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -98,14 +98,12 @@ gitAttributes repo = assertlocal repo $ do then (top repo) ++ "/info/.gitattributes" else (top repo) ++ "/.gitattributes" -{- Path to a repository's .git directory. - - (For a bare repository, that is the root of the repository.) - - TODO: support GIT_DIR -} +{- Path to a repository's .git directory, relative to its topdir. -} gitDir :: GitRepo -> String gitDir repo = assertlocal repo $ if (bare repo) - then top repo - else top repo ++ "/.git" + then "" + else ".git" {- Path to a repository's --work-tree. -} gitWorkTree :: GitRepo -> FilePath @@ -130,7 +128,7 @@ gitRelative repo file = drop (length absrepo) absfile gitCommandLine :: GitRepo -> [String] -> [String] gitCommandLine repo params = assertlocal repo $ -- force use of specified repo via --git-dir and --work-tree - ["--git-dir="++(gitDir repo), "--work-tree="++(top repo)] ++ params + ["--git-dir="++(top repo)++"/"++(gitDir repo), "--work-tree="++(top repo)] ++ params {- Runs git in the specified repo. -} gitRun :: GitRepo -> [String] -> IO () diff --git a/Locations.hs b/Locations.hs index b859fd2f2..faf29235f 100644 --- a/Locations.hs +++ b/Locations.hs @@ -5,7 +5,8 @@ module Locations ( gitStateDir, stateLoc, keyFile, - annexLocation + annexLocation, + annexLocationRelative ) where import Data.String.Utils @@ -28,6 +29,10 @@ keyFile key = replace "/" "&s" $ replace "&" "&a" key - .git/annex// ; this allows deriving the key and backend - by looking at the symlink to it. -} annexLocation :: State -> Backend -> Key -> FilePath -annexLocation state backend key = +annexLocation state backend key = + (gitWorkTree $ repo state) ++ "/" ++ + (annexLocationRelative state backend key) +annexLocationRelative :: State -> Backend -> Key -> FilePath +annexLocationRelative state backend key = gitDir (repo state) ++ "/annex/" ++ (name backend) ++ "/" ++ (keyFile key) -- cgit v1.2.3 From 16cd682290b065fee59575b077525d20713e4b4b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 01:04:06 -0400 Subject: better key to file mapping --- Locations.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/Locations.hs b/Locations.hs index faf29235f..6aba0ed1a 100644 --- a/Locations.hs +++ b/Locations.hs @@ -20,10 +20,17 @@ gitStateDir :: GitRepo -> FilePath gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/" {- Converts a key into a filename fragment. - - Just escape "/" in the key name, to keep a flat - - tree of files and avoid issues with files ending with "/" etc. -} + - + - Escape "/" in the key name, to keep a flat tree of files and avoid + - issues with keys containing "/../" or ending with "/" etc. + - + - "/" is escaped to "%" because it's short and rarely used, and resembles + - a slash + - "%" is escaped to "&s", and "&" to "&a"; this ensures that the mapping + - is one to one. + - -} keyFile :: Key -> FilePath -keyFile key = replace "/" "&s" $ replace "&" "&a" key +keyFile key = replace "/" "%" $ replace "%" "%s" $ replace "&" "&a" key {- An annexed file's content is stored in - .git/annex// ; this allows deriving the key and backend @@ -32,6 +39,7 @@ annexLocation :: State -> Backend -> Key -> FilePath annexLocation state backend key = (gitWorkTree $ repo state) ++ "/" ++ (annexLocationRelative state backend key) + annexLocationRelative :: State -> Backend -> Key -> FilePath annexLocationRelative state backend key = gitDir (repo state) ++ "/annex/" ++ (name backend) ++ -- cgit v1.2.3 From 3e65384f06400e06f78173d64b13da07c5d024d7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 01:36:20 -0400 Subject: fix relative symlink 2 --- Annex.hs | 22 ++++++++++++++++------ Locations.hs | 3 ++- 2 files changed, 18 insertions(+), 7 deletions(-) diff --git a/Annex.hs b/Annex.hs index 1c369be92..1ad9569f9 100644 --- a/Annex.hs +++ b/Annex.hs @@ -55,20 +55,30 @@ annexFile state file = do Nothing -> error $ "no backend could store: " ++ file Just (key, backend) -> setup key backend where + checkLegal file = do + s <- getSymbolicLinkStatus file + if ((isSymbolicLink s) || (not $ isRegularFile s)) + then error $ "not a regular file: " ++ file + else return () setup key backend = do let dest = annexLocation state backend key + let reldest = annexLocationRelative state backend key createDirectoryIfMissing True (parentDir dest) renameFile file dest - createSymbolicLink (annexLocationRelative state backend key) file + createSymbolicLink ((linkTarget file) ++ reldest) file gitRun (repo state) ["add", file] gitRun (repo state) ["commit", "-m", ("git-annex annexed " ++ file), file] logStatus state key ValuePresent - checkLegal file = do - s <- getSymbolicLinkStatus file - if ((isSymbolicLink s) || (not $ isRegularFile s)) - then error $ "not a regular file: " ++ file - else return () + linkTarget file = + -- relies on file being relative to the top of the + -- git repo; just replace each subdirectory with ".." + if (subdirs > 0) + then (join "/" $ take subdirs $ repeat "..") ++ "/" + else "" + where + subdirs = (length $ split "/" file) - 1 + {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () diff --git a/Locations.hs b/Locations.hs index 6aba0ed1a..72f4c451f 100644 --- a/Locations.hs +++ b/Locations.hs @@ -40,7 +40,8 @@ annexLocation state backend key = (gitWorkTree $ repo state) ++ "/" ++ (annexLocationRelative state backend key) +{- Annexed file's location relative to the gitWorkTree -} annexLocationRelative :: State -> Backend -> Key -> FilePath -annexLocationRelative state backend key = +annexLocationRelative state backend key = gitDir (repo state) ++ "/annex/" ++ (name backend) ++ "/" ++ (keyFile key) -- cgit v1.2.3 From 3a18b6d2ae95f8b536640f2438437d1d0a99082e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 01:42:39 -0400 Subject: bugfix --- Annex.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Annex.hs b/Annex.hs index 1ad9569f9..dd6912d85 100644 --- a/Annex.hs +++ b/Annex.hs @@ -91,7 +91,7 @@ unannexFile state file = do case (mkey) of Nothing -> return () Just (key, backend) -> do - let src = annexLocation state backend key + let src = annexLocation state backend file removeFile file gitRun (repo state) ["rm", file] gitRun (repo state) ["commit", "-m", -- cgit v1.2.3 From 4ecebfb218e58fb85a8e4484af93b5178a8046e7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 01:43:24 -0400 Subject: bugfx --- Annex.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Annex.hs b/Annex.hs index dd6912d85..63cf0d2fb 100644 --- a/Annex.hs +++ b/Annex.hs @@ -97,6 +97,9 @@ unannexFile state file = do gitRun (repo state) ["commit", "-m", ("git-annex unannexed " ++ file), file] + -- git rm deletes empty directories; + -- put them back + createDirectoryIfMissing True (parentDir file) renameFile src file logStatus state key ValueMissing return () -- cgit v1.2.3 From 77d052af3c527b3ebe349329305d80c9c5a2bf36 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 01:49:21 -0400 Subject: fix parentDir to work for relative too --- Utility.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Utility.hs b/Utility.hs index dea53967f..349dd9355 100644 --- a/Utility.hs +++ b/Utility.hs @@ -34,7 +34,8 @@ hGetContentsStrict h = hGetContents h >>= \s -> length s `seq` return s parentDir :: String -> String parentDir dir = if length dirs > 0 - then "/" ++ (join "/" $ take ((length dirs) - 1) dirs) + then absolute ++ (join "/" $ take ((length dirs) - 1) dirs) else "" where dirs = filter (\x -> length x > 0) $ split "/" dir + absolute = if ((dir !! 0) == '/') then "/" else "" -- cgit v1.2.3 From 3f2ce326fac36cef36a2ab9667d20d921ab91a6e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 01:53:16 -0400 Subject: update --- TODO | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/TODO b/TODO index 392ec4990..0bba79f10 100644 --- a/TODO +++ b/TODO @@ -1,12 +1,5 @@ -* bug when annexing files in a subdir of a git repo -* how to handle git mv file? - -* if the annexed files were in .git/annex//key, and - files in the repo symlink to that, the .git-annex/key/. - would be redundant, and not needed - - -- no separate merge problem with it - -- want to add an url? `ln -s .git/annex//http:%%kitenet.net%foo myfile` +* bug when annexing files while in a subdir of a git repo +* bug when specifying full path to files when annexing * implement retrieval for backendfile @@ -15,4 +8,6 @@ * hook up LocationLog * --push/--pull/--want/--drop -* finish BackendUrl and BackendChecksum +* how to handle git mv file? + +* finish BackendChecksum -- cgit v1.2.3 From 490a3a828cbb5a4046178b36fc0f9fe0696d0e9d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 01:55:44 -0400 Subject: update --- TODO | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/TODO b/TODO index 0bba79f10..a0f7c8b5f 100644 --- a/TODO +++ b/TODO @@ -1,11 +1,10 @@ * bug when annexing files while in a subdir of a git repo -* bug when specifying full path to files when annexing +* bug when specifying absolute path to files when annexing * implement retrieval for backendfile * query remotes for their annex.uuid settings -* hook up LocationLog * --push/--pull/--want/--drop * how to handle git mv file? -- cgit v1.2.3 From d1071bd1fe879abb3ebb229f9347f7855a697b8c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 02:31:24 -0400 Subject: autobugfixing! Converted Key to a real data type and caught all the places where I used an unconverted filename as a key. Had to loose some sanity checks around whether something is already annexed, but I guess I can add those back other ways. --- Annex.hs | 21 +++++++++++++-------- Backend.hs | 54 ++++++++++++++++++++++++++++++------------------------ BackendFile.hs | 5 +++-- BackendUrl.hs | 4 ++-- Locations.hs | 2 +- Types.hs | 6 +++++- 6 files changed, 54 insertions(+), 38 deletions(-) diff --git a/Annex.hs b/Annex.hs index 63cf0d2fb..8a7b8d860 100644 --- a/Annex.hs +++ b/Annex.hs @@ -45,7 +45,8 @@ startAnnex = do - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () annexFile state file = do - alreadyannexed <- lookupBackend state file + -- TODO check if already annexed + let alreadyannexed = Nothing case (alreadyannexed) of Just _ -> error $ "already annexed: " ++ file Nothing -> do @@ -83,15 +84,17 @@ annexFile state file = do {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () unannexFile state file = do - alreadyannexed <- lookupBackend state file + -- TODO check if already annexed + let alreadyannexed = Just 1 case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file Just _ -> do - mkey <- dropFile state file - case (mkey) of + key <- fileKey file + dropped <- dropFile state key + case (dropped) of Nothing -> return () Just (key, backend) -> do - let src = annexLocation state backend file + let src = annexLocation state backend key removeFile file gitRun (repo state) ["rm", file] gitRun (repo state) ["commit", "-m", @@ -107,18 +110,20 @@ unannexFile state file = do {- Transfers the file from a remote. -} annexGetFile :: State -> FilePath -> IO () annexGetFile state file = do - alreadyannexed <- lookupBackend state file + -- TODO check if already annexed + let alreadyannexed = Just 1 case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file - Just backend -> do + Just _ -> do key <- fileKey file + backend <- fileBackend file inannex <- inAnnex state backend key if (inannex) then return () else do let dest = annexLocation state backend key createDirectoryIfMissing True (parentDir dest) - success <- retrieveFile state file dest + success <- retrieveFile state key dest if (success) then do logStatus state key ValuePresent diff --git a/Backend.hs b/Backend.hs index 68d70feec..dbb0064a5 100644 --- a/Backend.hs +++ b/Backend.hs @@ -16,15 +16,17 @@ module Backend ( lookupBackend, storeFile, + dropFile, retrieveFile, fileKey, - dropFile + fileBackend ) where import System.Directory import System.FilePath import Data.String.Utils import System.Posix.Files +import BackendList import Locations import GitRepo import Utility @@ -47,48 +49,52 @@ storeFile' (b:bs) state file = do where nextbackend = storeFile' bs state file -{- Attempts to retrieve an file from one of the backends, saving it to +{- Attempts to retrieve an key from one of the backends, saving it to - a specified location. -} -retrieveFile :: State -> FilePath -> FilePath -> IO Bool -retrieveFile state file dest = do - result <- lookupBackend state file +retrieveFile :: State -> Key -> FilePath -> IO Bool +retrieveFile state key dest = do + result <- lookupBackend state key case (result) of Nothing -> return False - Just backend -> do - key <- fileKey file - (retrieveKeyFile backend) state key dest + Just backend -> (retrieveKeyFile backend) state key dest -{- Drops the key for a file from the backend that has it. -} -dropFile :: State -> FilePath -> IO (Maybe (Key, Backend)) -dropFile state file = do - result <- lookupBackend state file +{- Drops a key from the backend that has it. -} +dropFile :: State -> Key -> IO (Maybe (Key, Backend)) +dropFile state key = do + result <- lookupBackend state key case (result) of Nothing -> return Nothing Just backend -> do - key <- fileKey file (removeKey backend) state key return $ Just (key, backend) -{- Looks up the backend used for an already annexed file. -} -lookupBackend :: State -> FilePath -> IO (Maybe Backend) -lookupBackend state file = lookupBackend' (backends state) state file +{- Looks up the backend that has a key. -} +lookupBackend :: State -> Key -> IO (Maybe Backend) +lookupBackend state key = lookupBackend' (backends state) state key lookupBackend' [] _ _ = return Nothing -lookupBackend' (b:bs) state file = do - present <- checkBackend b state file +lookupBackend' (b:bs) state key = do + present <- checkBackend b state key if present then return $ Just b else - lookupBackend' bs state file + lookupBackend' bs state key -{- Checks if a file is available via a given backend. -} -checkBackend :: Backend -> State -> FilePath -> IO (Bool) -checkBackend backend state file = - doesFileExist $ annexLocation state backend file +{- Checks if a key is available via a given backend. -} +checkBackend :: Backend -> State -> Key -> IO (Bool) +checkBackend backend state key = + doesFileExist $ annexLocation state backend key {- Looks up the key corresponding to an annexed file, - by examining what the file symlinks to. -} fileKey :: FilePath -> IO Key fileKey file = do l <- readSymbolicLink (file) - return $ takeFileName $ l + return $ Key $ takeFileName $ l + +{- Looks up the backend corresponding to an annexed file, + - by examining what the file symlinks to. -} +fileBackend :: FilePath -> IO Backend +fileBackend file = do + l <- readSymbolicLink (file) + return $ lookupBackendName $ takeFileName $ parentDir $ l diff --git a/BackendFile.hs b/BackendFile.hs index 43ca2191c..15b23536b 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -15,12 +15,13 @@ backend = Backend { -- direct mapping from filename to key keyValue :: State -> FilePath -> IO (Maybe Key) -keyValue state file = return $ Just file +keyValue state file = return $ Just $ Key file {- This backend does not really do any independant data storage, - it relies on the file contents in .git/annex/ in this repo, - and other accessible repos. So storing or removing a key is - - a no-op. -} + - a no-op. TODO until support is added for git annex --push otherrepo, + - then these could implement that.. -} dummyStore :: State -> FilePath -> Key -> IO (Bool) dummyStore state file key = return True dummyRemove :: State -> Key -> IO Bool diff --git a/BackendUrl.hs b/BackendUrl.hs index 3f0846885..5b586497c 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -27,8 +27,8 @@ dummyRemove state url = return False downloadUrl :: State -> Key -> FilePath -> IO Bool downloadUrl state url file = do - putStrLn $ "download: " ++ url - result <- try $ rawSystem "curl" ["-#", "-o", file, url] + putStrLn $ "download: " ++ (show url) + result <- try $ rawSystem "curl" ["-#", "-o", file, (show url)] case (result) of Left _ -> return False Right _ -> return True diff --git a/Locations.hs b/Locations.hs index 72f4c451f..a99ad6ec4 100644 --- a/Locations.hs +++ b/Locations.hs @@ -30,7 +30,7 @@ gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/" - is one to one. - -} keyFile :: Key -> FilePath -keyFile key = replace "/" "%" $ replace "%" "%s" $ replace "&" "&a" key +keyFile key = replace "/" "%" $ replace "%" "%s" $ replace "&" "&a" $ show key {- An annexed file's content is stored in - .git/annex// ; this allows deriving the key and backend diff --git a/Types.hs b/Types.hs index 73492dfc3..9b0bb00fd 100644 --- a/Types.hs +++ b/Types.hs @@ -16,7 +16,11 @@ data State = State { } deriving (Show) -- annexed filenames are mapped into keys -type Key = FilePath +data Key = Key String deriving (Eq) + +-- show a key to convert it to a string +instance Show Key where + show (Key v) = v -- this structure represents a key/value backend data Backend = Backend { -- cgit v1.2.3 From 4b801b265afa94b1219a1abb6e52e08e0790582a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 03:20:05 -0400 Subject: error handling --- Annex.hs | 34 +++++++++++++------------------ Backend.hs | 67 +++++++++++++++++++------------------------------------------- 2 files changed, 34 insertions(+), 67 deletions(-) diff --git a/Annex.hs b/Annex.hs index 8a7b8d860..30ec0843a 100644 --- a/Annex.hs +++ b/Annex.hs @@ -45,10 +45,9 @@ startAnnex = do - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () annexFile state file = do - -- TODO check if already annexed - let alreadyannexed = Nothing - case (alreadyannexed) of - Just _ -> error $ "already annexed: " ++ file + r <- lookupFile file + case (r) of + Just _ -> error $ "already annexed " ++ file Nothing -> do checkLegal file stored <- storeFile state file @@ -84,16 +83,14 @@ annexFile state file = do {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () unannexFile state file = do - -- TODO check if already annexed - let alreadyannexed = Just 1 - case (alreadyannexed) of + r <- lookupFile file + case (r) of Nothing -> error $ "not annexed " ++ file - Just _ -> do - key <- fileKey file - dropped <- dropFile state key - case (dropped) of - Nothing -> return () - Just (key, backend) -> do + Just (key, backend) -> do + dropped <- dropFile state backend key + if (not dropped) + then error $ "backend refused to drop " ++ file + else do let src = annexLocation state backend key removeFile file gitRun (repo state) ["rm", file] @@ -110,20 +107,17 @@ unannexFile state file = do {- Transfers the file from a remote. -} annexGetFile :: State -> FilePath -> IO () annexGetFile state file = do - -- TODO check if already annexed - let alreadyannexed = Just 1 - case (alreadyannexed) of + r <- lookupFile file + case (r) of Nothing -> error $ "not annexed " ++ file - Just _ -> do - key <- fileKey file - backend <- fileBackend file + Just (key, backend) -> do inannex <- inAnnex state backend key if (inannex) then return () else do let dest = annexLocation state backend key createDirectoryIfMissing True (parentDir dest) - success <- retrieveFile state key dest + success <- retrieveFile state backend key dest if (success) then do logStatus state key ValuePresent diff --git a/Backend.hs b/Backend.hs index dbb0064a5..2697f43d4 100644 --- a/Backend.hs +++ b/Backend.hs @@ -14,14 +14,13 @@ - -} module Backend ( - lookupBackend, storeFile, dropFile, retrieveFile, - fileKey, - fileBackend + lookupFile ) where +import Control.Exception import System.Directory import System.FilePath import Data.String.Utils @@ -51,50 +50,24 @@ storeFile' (b:bs) state file = do {- Attempts to retrieve an key from one of the backends, saving it to - a specified location. -} -retrieveFile :: State -> Key -> FilePath -> IO Bool -retrieveFile state key dest = do - result <- lookupBackend state key - case (result) of - Nothing -> return False - Just backend -> (retrieveKeyFile backend) state key dest - -{- Drops a key from the backend that has it. -} -dropFile :: State -> Key -> IO (Maybe (Key, Backend)) -dropFile state key = do - result <- lookupBackend state key - case (result) of - Nothing -> return Nothing - Just backend -> do - (removeKey backend) state key - return $ Just (key, backend) - -{- Looks up the backend that has a key. -} -lookupBackend :: State -> Key -> IO (Maybe Backend) -lookupBackend state key = lookupBackend' (backends state) state key -lookupBackend' [] _ _ = return Nothing -lookupBackend' (b:bs) state key = do - present <- checkBackend b state key - if present - then - return $ Just b - else - lookupBackend' bs state key +retrieveFile :: State -> Backend -> Key -> FilePath -> IO Bool +retrieveFile state backend key dest = (retrieveKeyFile backend) state key dest -{- Checks if a key is available via a given backend. -} -checkBackend :: Backend -> State -> Key -> IO (Bool) -checkBackend backend state key = - doesFileExist $ annexLocation state backend key +{- Drops a key from a backend. -} +dropFile :: State -> Backend -> Key -> IO Bool +dropFile state backend key = (removeKey backend) state key -{- Looks up the key corresponding to an annexed file, +{- Looks up the key and backend corresponding to an annexed file, - by examining what the file symlinks to. -} -fileKey :: FilePath -> IO Key -fileKey file = do - l <- readSymbolicLink (file) - return $ Key $ takeFileName $ l - -{- Looks up the backend corresponding to an annexed file, - - by examining what the file symlinks to. -} -fileBackend :: FilePath -> IO Backend -fileBackend file = do - l <- readSymbolicLink (file) - return $ lookupBackendName $ takeFileName $ parentDir $ l +lookupFile :: FilePath -> IO (Maybe (Key, Backend)) +lookupFile file = do + result <- try (lookup)::IO (Either SomeException (Maybe (Key, Backend))) + case (result) of + Left err -> return Nothing + Right succ -> return succ + where + lookup = do + l <- readSymbolicLink file + return $ Just (k l, b l) + k l = Key $ takeFileName $ l + b l = lookupBackendName $ takeFileName $ parentDir $ l -- cgit v1.2.3 From cc5cf0093ea1aacc4c5460dfdd4d35f2963687bd Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 03:30:51 -0400 Subject: cleanup --- Annex.hs | 64 +++++++++++++++++++++++++++++++++------------------------------- 1 file changed, 33 insertions(+), 31 deletions(-) diff --git a/Annex.hs b/Annex.hs index 30ec0843a..7cee3c4cb 100644 --- a/Annex.hs +++ b/Annex.hs @@ -41,20 +41,24 @@ startAnnex = do backends = parseBackendList $ gitConfig r' "annex.backends" "" } +inBackend file yes no = do + r <- lookupFile file + case (r) of + Just v -> yes v + Nothing -> no +notinBackend file yes no = inBackend file no yes + {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () -annexFile state file = do - r <- lookupFile file - case (r) of - Just _ -> error $ "already annexed " ++ file - Nothing -> do - checkLegal file - stored <- storeFile state file - case (stored) of - Nothing -> error $ "no backend could store: " ++ file - Just (key, backend) -> setup key backend +annexFile state file = inBackend file err $ do + checkLegal file + stored <- storeFile state file + case (stored) of + Nothing -> error $ "no backend could store: " ++ file + Just (key, backend) -> setup key backend where + err = error $ "already annexed " ++ file checkLegal file = do s <- getSymbolicLinkStatus file if ((isSymbolicLink s) || (not $ isRegularFile s)) @@ -82,27 +86,25 @@ annexFile state file = do {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () -unannexFile state file = do - r <- lookupFile file - case (r) of - Nothing -> error $ "not annexed " ++ file - Just (key, backend) -> do - dropped <- dropFile state backend key - if (not dropped) - then error $ "backend refused to drop " ++ file - else do - let src = annexLocation state backend key - removeFile file - gitRun (repo state) ["rm", file] - gitRun (repo state) ["commit", "-m", - ("git-annex unannexed " ++ file), - file] - -- git rm deletes empty directories; - -- put them back - createDirectoryIfMissing True (parentDir file) - renameFile src file - logStatus state key ValueMissing - return () +unannexFile state file = notinBackend file err $ \(key, backend) -> do + dropped <- dropFile state backend key + if (not dropped) + then error $ "backend refused to drop " ++ file + else cleanup key backend + where + err = error $ "not annexed " ++ file + cleanup key backend = do + let src = annexLocation state backend key + removeFile file + gitRun (repo state) ["rm", file] + gitRun (repo state) ["commit", "-m", + ("git-annex unannexed " ++ file), file] + -- git rm deletes empty directories; + -- put them back + createDirectoryIfMissing True (parentDir file) + renameFile src file + logStatus state key ValueMissing + return () {- Transfers the file from a remote. -} annexGetFile :: State -> FilePath -> IO () -- cgit v1.2.3 From 99b2029236248f6b4ce68e126b70fa0855fac37f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 03:41:12 -0400 Subject: key conversion back from file bugfixes --- Annex.hs | 6 ++---- Backend.hs | 2 +- Locations.hs | 31 ++++++++++++++++++------------- 3 files changed, 21 insertions(+), 18 deletions(-) diff --git a/Annex.hs b/Annex.hs index 7cee3c4cb..936e62502 100644 --- a/Annex.hs +++ b/Annex.hs @@ -87,10 +87,8 @@ annexFile state file = inBackend file err $ do {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () unannexFile state file = notinBackend file err $ \(key, backend) -> do - dropped <- dropFile state backend key - if (not dropped) - then error $ "backend refused to drop " ++ file - else cleanup key backend + dropFile state backend key + cleanup key backend where err = error $ "not annexed " ++ file cleanup key backend = do diff --git a/Backend.hs b/Backend.hs index 2697f43d4..bc7eb206f 100644 --- a/Backend.hs +++ b/Backend.hs @@ -69,5 +69,5 @@ lookupFile file = do lookup = do l <- readSymbolicLink file return $ Just (k l, b l) - k l = Key $ takeFileName $ l + k l = fileKey $ takeFileName $ l b l = lookupBackendName $ takeFileName $ parentDir $ l diff --git a/Locations.hs b/Locations.hs index a99ad6ec4..304ca060e 100644 --- a/Locations.hs +++ b/Locations.hs @@ -5,6 +5,7 @@ module Locations ( gitStateDir, stateLoc, keyFile, + fileKey, annexLocation, annexLocationRelative ) where @@ -19,19 +20,6 @@ stateLoc = ".git-annex" gitStateDir :: GitRepo -> FilePath gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/" -{- Converts a key into a filename fragment. - - - - Escape "/" in the key name, to keep a flat tree of files and avoid - - issues with keys containing "/../" or ending with "/" etc. - - - - "/" is escaped to "%" because it's short and rarely used, and resembles - - a slash - - "%" is escaped to "&s", and "&" to "&a"; this ensures that the mapping - - is one to one. - - -} -keyFile :: Key -> FilePath -keyFile key = replace "/" "%" $ replace "%" "%s" $ replace "&" "&a" $ show key - {- An annexed file's content is stored in - .git/annex// ; this allows deriving the key and backend - by looking at the symlink to it. -} @@ -45,3 +33,20 @@ annexLocationRelative :: State -> Backend -> Key -> FilePath annexLocationRelative state backend key = gitDir (repo state) ++ "/annex/" ++ (name backend) ++ "/" ++ (keyFile key) + +{- Converts a key into a filename fragment. + - + - Escape "/" in the key name, to keep a flat tree of files and avoid + - issues with keys containing "/../" or ending with "/" etc. + - + - "/" is escaped to "%" because it's short and rarely used, and resembles + - a slash + - "%" is escaped to "&s", and "&" to "&a"; this ensures that the mapping + - is one to one. + - -} +keyFile :: Key -> FilePath +keyFile key = replace "/" "%" $ replace "%" "&s" $ replace "&" "&a" $ show key + +{- Reverses keyFile -} +fileKey :: FilePath -> Key +fileKey file = Key $ replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file -- cgit v1.2.3 From ff998a9a677ba4a4af9e4bd45a651653421760cb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 03:46:40 -0400 Subject: cleanup2 --- Annex.hs | 58 +++++++++++++++++++++++++++------------------------------- 1 file changed, 27 insertions(+), 31 deletions(-) diff --git a/Annex.hs b/Annex.hs index 936e62502..eb57e2d57 100644 --- a/Annex.hs +++ b/Annex.hs @@ -65,6 +65,7 @@ annexFile state file = inBackend file err $ do then error $ "not a regular file: " ++ file else return () setup key backend = do + logStatus state key ValuePresent let dest = annexLocation state backend key let reldest = annexLocationRelative state backend key createDirectoryIfMissing True (parentDir dest) @@ -73,7 +74,6 @@ annexFile state file = inBackend file err $ do gitRun (repo state) ["add", file] gitRun (repo state) ["commit", "-m", ("git-annex annexed " ++ file), file] - logStatus state key ValuePresent linkTarget file = -- relies on file being relative to the top of the -- git repo; just replace each subdirectory with ".." @@ -88,41 +88,37 @@ annexFile state file = inBackend file err $ do unannexFile :: State -> FilePath -> IO () unannexFile state file = notinBackend file err $ \(key, backend) -> do dropFile state backend key - cleanup key backend + logStatus state key ValueMissing + let src = annexLocation state backend key + removeFile file + gitRun (repo state) ["rm", file] + gitRun (repo state) ["commit", "-m", + ("git-annex unannexed " ++ file), file] + -- git rm deletes empty directories; + -- put them back + createDirectoryIfMissing True (parentDir file) + renameFile src file + return () where err = error $ "not annexed " ++ file - cleanup key backend = do - let src = annexLocation state backend key - removeFile file - gitRun (repo state) ["rm", file] - gitRun (repo state) ["commit", "-m", - ("git-annex unannexed " ++ file), file] - -- git rm deletes empty directories; - -- put them back - createDirectoryIfMissing True (parentDir file) - renameFile src file - logStatus state key ValueMissing - return () {- Transfers the file from a remote. -} annexGetFile :: State -> FilePath -> IO () -annexGetFile state file = do - r <- lookupFile file - case (r) of - Nothing -> error $ "not annexed " ++ file - Just (key, backend) -> do - inannex <- inAnnex state backend key - if (inannex) - then return () - else do - let dest = annexLocation state backend key - createDirectoryIfMissing True (parentDir dest) - success <- retrieveFile state backend key dest - if (success) - then do - logStatus state key ValuePresent - return () - else error $ "failed to get " ++ file +annexGetFile state file = notinBackend file err $ \(key, backend) -> do + inannex <- inAnnex state backend key + if (inannex) + then return () + else do + let dest = annexLocation state backend key + createDirectoryIfMissing True (parentDir dest) + success <- retrieveFile state backend key dest + if (success) + then do + logStatus state key ValuePresent + return () + else error $ "failed to get " ++ file + where + err = error $ "not annexed " ++ file {- Indicates a file is wanted. -} annexWantFile :: State -> FilePath -> IO () -- cgit v1.2.3 From 1dbf36bf9a951b7a92770ea0b57bc79c8b465795 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 03:51:55 -0400 Subject: cleanup3 --- Annex.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Annex.hs b/Annex.hs index eb57e2d57..012e90199 100644 --- a/Annex.hs +++ b/Annex.hs @@ -24,10 +24,6 @@ import UUID import LocationLog import Types -{- Checks if a given key is currently present in the annexLocation -} -inAnnex :: State -> Backend -> Key -> IO Bool -inAnnex state backend key = doesFileExist $ annexLocation state backend key - {- On startup, examine the git repo, prepare it, and record state for - later. -} startAnnex :: IO State @@ -89,7 +85,6 @@ unannexFile :: State -> FilePath -> IO () unannexFile state file = notinBackend file err $ \(key, backend) -> do dropFile state backend key logStatus state key ValueMissing - let src = annexLocation state backend key removeFile file gitRun (repo state) ["rm", file] gitRun (repo state) ["commit", "-m", @@ -97,12 +92,13 @@ unannexFile state file = notinBackend file err $ \(key, backend) -> do -- git rm deletes empty directories; -- put them back createDirectoryIfMissing True (parentDir file) + let src = annexLocation state backend key renameFile src file return () where err = error $ "not annexed " ++ file -{- Transfers the file from a remote. -} +{- Gets an annexed file from one of the backends. -} annexGetFile :: State -> FilePath -> IO () annexGetFile state file = notinBackend file err $ \(key, backend) -> do inannex <- inAnnex state backend key @@ -165,3 +161,7 @@ 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] + +{- Checks if a given key is currently present in the annexLocation -} +inAnnex :: State -> Backend -> Key -> IO Bool +inAnnex state backend key = doesFileExist $ annexLocation state backend key -- cgit v1.2.3 From 794d44cf1daf073f05d1a27b2a02c47db37c443a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 14:01:17 -0400 Subject: add remoteName --- GitRepo.hs | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index f0686ff20..489c9cf75 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -40,11 +40,14 @@ import Utility data GitRepo = LocalGitRepo { top :: FilePath, - config :: Map String String + config :: Map String String, + -- remoteName holds the name used for this repo in remotes + remoteName :: Maybe String } | RemoteGitRepo { url :: String, top :: FilePath, - config :: Map String String + config :: Map String String, + remoteName :: Maybe String } deriving (Show, Read, Eq) {- Local GitRepo constructor. Can optionally query the repo for its config. -} @@ -52,7 +55,8 @@ gitRepoFromPath :: FilePath -> Bool -> IO GitRepo gitRepoFromPath dir query = do let r = LocalGitRepo { top = dir, - config = Map.empty + config = Map.empty, + remoteName = Nothing } if (query) then gitConfigRead r @@ -64,7 +68,8 @@ gitRepoFromUrl url query = do return $ RemoteGitRepo { url = url, top = path url, - config = Map.empty + config = Map.empty, + remoteName = Nothing } where path url = uriPath $ fromJust $ parseURI url @@ -174,13 +179,15 @@ gitConfig repo key defaultValue = gitConfigRemotes :: GitRepo -> IO [GitRepo] gitConfigRemotes repo = mapM construct remotes where - remotes = elems $ filter $ config repo + remotes = toList $ filter $ config repo filter = filterWithKey (\k _ -> isremote k) isremote k = (startswith "remote." k) && (endswith ".url" k) - construct r = - if (isURI r) - then gitRepoFromUrl r False - else gitRepoFromPath r False + remotename k = (split "." k) !! 1 + construct (k,v) = do + r <- if (isURI v) + then gitRepoFromUrl v False + else gitRepoFromPath v False + return r { remoteName = Just $ remotename k } {- Finds the current git repository, which may be in a parent directory. -} gitRepoFromCwd :: IO GitRepo -- cgit v1.2.3 From 771a6b36e1527571b9a38baacbee6e864f44172a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 14:40:56 -0400 Subject: cost ordering --- Annex.hs | 25 +++++++++++++++++++++++++ GitRepo.hs | 21 ++++++++++++++++----- 2 files changed, 41 insertions(+), 5 deletions(-) diff --git a/Annex.hs b/Annex.hs index 012e90199..bd57514ea 100644 --- a/Annex.hs +++ b/Annex.hs @@ -9,12 +9,14 @@ module Annex ( annexWantFile, annexDropFile, annexPushRepo, + repoCost, annexPullRepo ) where import System.Posix.Files import System.Directory import Data.String.Utils +import List import GitRepo import Utility import Locations @@ -165,3 +167,26 @@ logStatus state key status = do {- Checks if a given key is currently present in the annexLocation -} inAnnex :: State -> Backend -> Key -> IO Bool inAnnex state backend key = doesFileExist $ annexLocation state backend key + +{- Orders a list of git repos by cost. -} +reposByCost :: State -> [GitRepo] -> [GitRepo] +reposByCost state l = + fst $ unzip $ sortBy (\(r1, c1) (r2, c2) -> compare c1 c2) $ costpairs l + where + costpairs l = map (\r -> (r, repoCost state r)) l + +{- Calculates cost for a repo. + - + - The default cost is 100 for local repositories, and 200 for remote + - repositories; it can also be configured by remote..annex-cost + -} +repoCost :: State -> GitRepo -> Int +repoCost state r = + if ((length $ config state r) > 0) + then read $ config state r + else if (gitRepoIsLocal r) + then 100 + else 200 + where + config state r = gitConfig (repo state) (configkey r) "" + configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-cost" diff --git a/GitRepo.hs b/GitRepo.hs index 489c9cf75..c4a55863d 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -10,13 +10,17 @@ module GitRepo ( gitRepoFromCwd, gitRepoFromPath, gitRepoFromUrl, + gitRepoIsLocal, + gitRepoIsRemote, + gitConfigRemotes, gitWorkTree, gitDir, gitRelative, gitConfig, gitConfigRead, gitRun, - gitAttributes + gitAttributes, + gitRepoRemoteName ) where import Directory @@ -74,16 +78,23 @@ gitRepoFromUrl url query = do where path url = uriPath $ fromJust $ parseURI url {- User-visible description of a git repo by path or url -} -describe repo = if (local repo) then top repo else url repo +describe repo = if (gitRepoIsLocal repo) then top repo else url repo + +{- Returns the name of the remote that corresponds to the repo, if + - it is a remote. Otherwise, "" -} +gitRepoRemoteName r = + if (isJust $ remoteName r) + then fromJust $ remoteName r + else "" {- Some code needs to vary between remote and local repos, or bare and - non-bare, these functions help with that. -} -local repo = case (repo) of +gitRepoIsLocal repo = case (repo) of LocalGitRepo {} -> True RemoteGitRepo {} -> False -remote repo = not $ local repo +gitRepoIsRemote repo = not $ gitRepoIsLocal repo assertlocal repo action = - if (local repo) + if (gitRepoIsLocal repo) then action else error $ "acting on remote git repo " ++ (describe repo) ++ " not supported" -- cgit v1.2.3 From 77055f5ff82d2712f599ba77e03d5d2cc022ff65 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 14:51:09 -0400 Subject: move some stuff out of IO --- Annex.hs | 11 ++++++++--- GitRepo.hs | 32 ++++++++++++++------------------ 2 files changed, 22 insertions(+), 21 deletions(-) diff --git a/Annex.hs b/Annex.hs index bd57514ea..e06bd84bc 100644 --- a/Annex.hs +++ b/Annex.hs @@ -9,7 +9,7 @@ module Annex ( annexWantFile, annexDropFile, annexPushRepo, - repoCost, + annexRemotes, annexPullRepo ) where @@ -31,8 +31,9 @@ import Types startAnnex :: IO State startAnnex = do r <- gitRepoFromCwd - r' <- prepUUID r - gitSetup r' + r' <- gitConfigRead r + r'' <- prepUUID r' + gitSetup r'' return State { repo = r', @@ -168,6 +169,10 @@ logStatus state key status = do inAnnex :: State -> Backend -> Key -> IO Bool inAnnex state backend key = doesFileExist $ annexLocation state backend key +{- Ordered list of remotes for the annex. -} +annexRemotes :: State -> [GitRepo] +annexRemotes state = reposByCost state $ gitConfigRemotes (repo state) + {- Orders a list of git repos by cost. -} reposByCost :: State -> [GitRepo] -> [GitRepo] reposByCost state l = diff --git a/GitRepo.hs b/GitRepo.hs index c4a55863d..06e244d6b 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -54,22 +54,19 @@ data GitRepo = remoteName :: Maybe String } deriving (Show, Read, Eq) -{- Local GitRepo constructor. Can optionally query the repo for its config. -} -gitRepoFromPath :: FilePath -> Bool -> IO GitRepo -gitRepoFromPath dir query = do - let r = LocalGitRepo { +{- Local GitRepo constructor. -} +gitRepoFromPath :: FilePath -> GitRepo +gitRepoFromPath dir = + LocalGitRepo { top = dir, config = Map.empty, remoteName = Nothing } - if (query) - then gitConfigRead r - else return r {- Remote GitRepo constructor. Throws exception on invalid url. -} -gitRepoFromUrl :: String -> Bool -> IO GitRepo -gitRepoFromUrl url query = do - return $ RemoteGitRepo { +gitRepoFromUrl :: String -> GitRepo +gitRepoFromUrl url = + RemoteGitRepo { url = url, top = path url, config = Map.empty, @@ -187,18 +184,17 @@ gitConfig repo key defaultValue = Map.findWithDefault defaultValue key (config repo) {- Returns a list of a repo's configured remotes. -} -gitConfigRemotes :: GitRepo -> IO [GitRepo] -gitConfigRemotes repo = mapM construct remotes +gitConfigRemotes :: GitRepo -> [GitRepo] +gitConfigRemotes repo = map construct remotes where remotes = toList $ filter $ config repo filter = filterWithKey (\k _ -> isremote k) isremote k = (startswith "remote." k) && (endswith ".url" k) remotename k = (split "." k) !! 1 - construct (k,v) = do - r <- if (isURI v) - then gitRepoFromUrl v False - else gitRepoFromPath v False - return r { remoteName = Just $ remotename k } + construct (k,v) = (gen v) { remoteName = Just $ remotename k } + gen v = if (isURI v) + then gitRepoFromUrl v + else gitRepoFromPath v {- Finds the current git repository, which may be in a parent directory. -} gitRepoFromCwd :: IO GitRepo @@ -206,7 +202,7 @@ gitRepoFromCwd = do cwd <- getCurrentDirectory top <- seekUp cwd isRepoTop case top of - (Just dir) -> gitRepoFromPath dir True + (Just dir) -> return $ gitRepoFromPath dir Nothing -> error "Not in a git repository." seekUp :: String -> (String -> IO Bool) -> IO (Maybe String) -- cgit v1.2.3 From e28ff5bdaf7ce56c0c928904ff883c1e2cd093de Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 15:55:18 -0400 Subject: almost able to get files from remotes now! --- Annex.hs | 30 +----------------------------- BackendFile.hs | 36 +++++++++++++++++++++++++++--------- GitRepo.hs | 14 ++++++++++---- LocationLog.hs | 3 ++- Remotes.hs | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ UUID.hs | 31 ++++++++++++++++++++++++++----- 6 files changed, 116 insertions(+), 48 deletions(-) create mode 100644 Remotes.hs diff --git a/Annex.hs b/Annex.hs index e06bd84bc..834c26115 100644 --- a/Annex.hs +++ b/Annex.hs @@ -9,7 +9,6 @@ module Annex ( annexWantFile, annexDropFile, annexPushRepo, - annexRemotes, annexPullRepo ) where @@ -161,37 +160,10 @@ gitSetup repo = do {- Updates the LocationLog when a key's presence changes. -} logStatus state key status = do - f <- logChange (repo state) key (getUUID (repo state)) status + f <- logChange (repo state) key (getUUID state (repo state)) status gitRun (repo state) ["add", f] gitRun (repo state) ["commit", "-m", "git-annex log update", f] {- Checks if a given key is currently present in the annexLocation -} inAnnex :: State -> Backend -> Key -> IO Bool inAnnex state backend key = doesFileExist $ annexLocation state backend key - -{- Ordered list of remotes for the annex. -} -annexRemotes :: State -> [GitRepo] -annexRemotes state = reposByCost state $ gitConfigRemotes (repo state) - -{- Orders a list of git repos by cost. -} -reposByCost :: State -> [GitRepo] -> [GitRepo] -reposByCost state l = - fst $ unzip $ sortBy (\(r1, c1) (r2, c2) -> compare c1 c2) $ costpairs l - where - costpairs l = map (\r -> (r, repoCost state r)) l - -{- Calculates cost for a repo. - - - - The default cost is 100 for local repositories, and 200 for remote - - repositories; it can also be configured by remote..annex-cost - -} -repoCost :: State -> GitRepo -> Int -repoCost state r = - if ((length $ config state r) > 0) - then read $ config state r - else if (gitRepoIsLocal r) - then 100 - else 200 - where - config state r = gitConfig (repo state) (configkey r) "" - configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-cost" diff --git a/BackendFile.hs b/BackendFile.hs index 15b23536b..d4d137e53 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -4,12 +4,16 @@ module BackendFile (backend) where import Types +import LocationLog +import Locations +import Remotes +import GitRepo backend = Backend { name = "file", getKey = keyValue, storeFileKey = dummyStore, - retrieveKeyFile = copyFromOtherRepo, + retrieveKeyFile = copyKeyFile, removeKey = dummyRemove } @@ -27,12 +31,26 @@ dummyStore state file key = return True dummyRemove :: State -> Key -> IO Bool dummyRemove state url = return False -{- Try to find a copy of the file in one of the other repos, +{- Try to find a copy of the file in one of the remotes, - and copy it over to this one. -} -copyFromOtherRepo :: State -> Key -> FilePath -> IO (Bool) -copyFromOtherRepo state key file = - -- 1. get ordered list of remotes (local repos, then remote repos) - -- 2. read locationlog for file - -- 3. filter remotes list to ones that have file - -- 4. attempt to transfer from each remote until success - error "copyFromOtherRepo unimplemented" -- TODO +copyKeyFile :: State -> Key -> FilePath -> IO (Bool) +copyKeyFile state key file = do + remotes <- remotesWithKey state key + if (0 == length remotes) + then error $ "no known remotes have: " ++ (keyFile key) ++ "\n" ++ + "(Perhaps you need to git remote add a repository?)" + else trycopy remotes remotes + where + trycopy full [] = error $ "unable to get: " ++ (keyFile key) ++ "\n" ++ + "To get that file, need access to one of these remotes: " ++ + (remotesList full) + trycopy full (r:rs) = do + ok <- copyFromRemote r key file + if (ok) + then return True + else trycopy full rs + +{- Tries to copy a file from a remote. -} +copyFromRemote :: GitRepo -> Key -> FilePath -> IO (Bool) +copyFromRemote r key file = do + return False -- TODO diff --git a/GitRepo.hs b/GitRepo.hs index 06e244d6b..e1f086b69 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -13,6 +13,7 @@ module GitRepo ( gitRepoIsLocal, gitRepoIsRemote, gitConfigRemotes, + gitRepoDescribe, gitWorkTree, gitDir, gitRelative, @@ -74,8 +75,13 @@ gitRepoFromUrl url = } where path url = uriPath $ fromJust $ parseURI url -{- User-visible description of a git repo by path or url -} -describe repo = if (gitRepoIsLocal repo) then top repo else url repo +{- User-visible description of a git repo. -} +gitRepoDescribe repo = + if (isJust $ remoteName repo) + then fromJust $ remoteName repo + else if (gitRepoIsLocal repo) + then top repo + else url repo {- Returns the name of the remote that corresponds to the repo, if - it is a remote. Otherwise, "" -} @@ -93,13 +99,13 @@ gitRepoIsRemote repo = not $ gitRepoIsLocal repo assertlocal repo action = if (gitRepoIsLocal repo) then action - else error $ "acting on remote git repo " ++ (describe repo) ++ + else error $ "acting on remote git repo " ++ (gitRepoDescribe repo) ++ " not supported" bare :: GitRepo -> Bool bare repo = if (member b (config repo)) then ("true" == fromJust (Map.lookup b (config repo))) - else error $ "it is not known if git repo " ++ (describe repo) ++ + else error $ "it is not known if git repo " ++ (gitRepoDescribe repo) ++ " is a bare repository; config not read" where b = "core.bare" diff --git a/LocationLog.hs b/LocationLog.hs index 2eab4815e..28ac46b90 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -18,7 +18,8 @@ module LocationLog ( LogStatus(..), - logChange + logChange, + keyLocations ) where import Data.Time.Clock.POSIX diff --git a/Remotes.hs b/Remotes.hs new file mode 100644 index 000000000..ae709a3c2 --- /dev/null +++ b/Remotes.hs @@ -0,0 +1,50 @@ +{- git-annex remote repositories -} + +module Remotes ( + remotesList, + remotesWithKey +) where + +import Types +import GitRepo +import LocationLog +import Data.String.Utils +import UUID +import List + +{- Human visible list of remotes. -} +remotesList :: [GitRepo] -> String +remotesList remotes = join " " $ map gitRepoDescribe remotes + +{- Cost ordered list of remotes that the LocationLog indicate may have a key. -} +remotesWithKey :: State -> Key -> IO [GitRepo] +remotesWithKey state key = do + uuids <- keyLocations (repo state) key + return $ reposByUUID state (remotesByCost state) uuids + +{- Cost Ordered list of remotes. -} +remotesByCost :: State -> [GitRepo] +remotesByCost state = reposByCost state $ gitConfigRemotes (repo state) + +{- Orders a list of git repos by cost. -} +reposByCost :: State -> [GitRepo] -> [GitRepo] +reposByCost state l = + fst $ unzip $ sortBy (\(r1, c1) (r2, c2) -> compare c1 c2) $ costpairs l + where + costpairs l = map (\r -> (r, repoCost state r)) l + +{- Calculates cost for a repo. + - + - The default cost is 100 for local repositories, and 200 for remote + - repositories; it can also be configured by remote..annex-cost + -} +repoCost :: State -> GitRepo -> Int +repoCost state r = + if ((length $ config state r) > 0) + then read $ config state r + else if (gitRepoIsLocal r) + then 100 + else 200 + where + config state r = gitConfig (repo state) (configkey r) "" + configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-cost" diff --git a/UUID.hs b/UUID.hs index e2b624d69..b4c4c0cc0 100644 --- a/UUID.hs +++ b/UUID.hs @@ -9,12 +9,16 @@ module UUID ( UUID, getUUID, prepUUID, - genUUID + genUUID, + reposByUUID ) where +import Maybe +import List import System.Cmd.Utils import System.IO import GitRepo +import Types type UUID = String @@ -26,17 +30,34 @@ genUUID :: IO UUID genUUID = do pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h -{- Looks up a repo's UUID -} -getUUID :: GitRepo -> UUID -getUUID repo = gitConfig repo "annex.uuid" "" +{- Looks up a repo's UUID. May return "" if none is known. + - + - UUIDs of remotes are cached in git config, using keys named + - remote..annex-uuid + - + - -} +getUUID :: State -> GitRepo -> UUID +getUUID s r = + if ("" /= getUUID' r) + then getUUID' r + else cached s r + where + cached s r = gitConfig (repo s) (configkey r) "" + configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-uuid" +getUUID' r = gitConfig r "annex.uuid" "" {- Make sure that the repo has an annex.uuid setting. -} prepUUID :: GitRepo -> IO GitRepo prepUUID repo = - if ("" == getUUID repo) + if ("" == getUUID' repo) then do uuid <- genUUID gitRun repo ["config", configkey, uuid] -- return new repo with updated config gitConfigRead repo else return repo + +{- Filters a list of repos to ones that have listed UUIDs. -} +reposByUUID :: State -> [GitRepo] -> [UUID] -> [GitRepo] +reposByUUID state repos uuids = + filter (\r -> isJust $ elemIndex (getUUID state r) uuids) repos -- cgit v1.2.3 From f87c5ed9496f50646d9f5e8be540f8bc059db242 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 16:21:50 -0400 Subject: copying almost working --- Annex.hs | 10 +++++----- BackendFile.hs | 35 ++++++++++++++++++++++++++++------- Locations.hs | 20 ++++++++++---------- git-annex.hs | 3 +-- 4 files changed, 44 insertions(+), 24 deletions(-) diff --git a/Annex.hs b/Annex.hs index 834c26115..8489c2ca6 100644 --- a/Annex.hs +++ b/Annex.hs @@ -64,8 +64,8 @@ annexFile state file = inBackend file err $ do else return () setup key backend = do logStatus state key ValuePresent - let dest = annexLocation state backend key - let reldest = annexLocationRelative state backend key + let dest = annexLocation (repo state) backend key + let reldest = annexLocationRelative (repo state) backend key createDirectoryIfMissing True (parentDir dest) renameFile file dest createSymbolicLink ((linkTarget file) ++ reldest) file @@ -94,7 +94,7 @@ unannexFile state file = notinBackend file err $ \(key, backend) -> do -- git rm deletes empty directories; -- put them back createDirectoryIfMissing True (parentDir file) - let src = annexLocation state backend key + let src = annexLocation (repo state) backend key renameFile src file return () where @@ -107,7 +107,7 @@ annexGetFile state file = notinBackend file err $ \(key, backend) -> do if (inannex) then return () else do - let dest = annexLocation state backend key + let dest = annexLocation (repo state) backend key createDirectoryIfMissing True (parentDir dest) success <- retrieveFile state backend key dest if (success) @@ -166,4 +166,4 @@ logStatus state key status = do {- Checks if a given key is currently present in the annexLocation -} inAnnex :: State -> Backend -> Key -> IO Bool -inAnnex state backend key = doesFileExist $ annexLocation state backend key +inAnnex state backend key = doesFileExist $ annexLocation (repo state) backend key diff --git a/BackendFile.hs b/BackendFile.hs index d4d137e53..adb8da8bd 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -3,6 +3,9 @@ module BackendFile (backend) where +import System.IO +import System.Cmd +import Control.Exception import Types import LocationLog import Locations @@ -45,12 +48,30 @@ copyKeyFile state key file = do "To get that file, need access to one of these remotes: " ++ (remotesList full) trycopy full (r:rs) = do - ok <- copyFromRemote r key file - if (ok) - then return True - else trycopy full rs + putStrLn "trying a remote" + result <- try (copyFromRemote r key file)::IO (Either SomeException ()) + case (result) of + Left err -> do + showerr err r + trycopy full rs + Right succ -> return True + showerr err r = do + hPutStrLn stderr $ "git-annex: copy from " ++ + (gitRepoDescribe r ) ++ " failed: " ++ + (show err) -{- Tries to copy a file from a remote. -} -copyFromRemote :: GitRepo -> Key -> FilePath -> IO (Bool) +{- Tries to copy a file from a remote, exception on error. -} +copyFromRemote :: GitRepo -> Key -> FilePath -> IO () copyFromRemote r key file = do - return False -- TODO + r <- if (gitRepoIsLocal r) + then getlocal + else getremote + return () + where + getlocal = do + putStrLn $ "get: " ++ location + rawSystem "cp" ["-a", location, file] + getremote = do + putStrLn $ "get: " ++ location + error "get via network not yet implemented!" + location = annexLocation r backend key diff --git a/Locations.hs b/Locations.hs index 304ca060e..d6d7d4248 100644 --- a/Locations.hs +++ b/Locations.hs @@ -21,18 +21,18 @@ gitStateDir :: GitRepo -> FilePath gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/" {- An annexed file's content is stored in - - .git/annex// ; this allows deriving the key and backend - - by looking at the symlink to it. -} -annexLocation :: State -> Backend -> Key -> FilePath -annexLocation state backend key = - (gitWorkTree $ repo state) ++ "/" ++ - (annexLocationRelative state backend key) + - /path/to/repo/.git/annex// + - + - (That allows deriving the key and backend by looking at the symlink to it.) + -} +annexLocation :: GitRepo -> Backend -> Key -> FilePath +annexLocation r backend key = + (gitWorkTree r) ++ "/" ++ (annexLocationRelative r backend key) {- Annexed file's location relative to the gitWorkTree -} -annexLocationRelative :: State -> Backend -> Key -> FilePath -annexLocationRelative state backend key = - gitDir (repo state) ++ "/annex/" ++ (name backend) ++ - "/" ++ (keyFile key) +annexLocationRelative :: GitRepo -> Backend -> Key -> FilePath +annexLocationRelative r backend key = + gitDir r ++ "/annex/" ++ (name backend) ++ "/" ++ (keyFile key) {- Converts a key into a filename fragment. - diff --git a/git-annex.hs b/git-annex.hs index 7bcd4de22..7785e4f2d 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -32,6 +32,5 @@ tryRun errnum oknum (a:as) = do {- Exception pretty-printing. -} showErr :: SomeException -> IO () showErr e = do - let err = show e - hPutStrLn stderr $ "git-annex: " ++ err + hPutStrLn stderr $ "git-annex: " ++ (show e) return () -- cgit v1.2.3 From e5c1db355f5fa31af14ed8474aee89872b934f1a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 16:32:16 -0400 Subject: it works!! --- BackendFile.hs | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/BackendFile.hs b/BackendFile.hs index adb8da8bd..a31cbfeb1 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -48,30 +48,31 @@ copyKeyFile state key file = do "To get that file, need access to one of these remotes: " ++ (remotesList full) trycopy full (r:rs) = do - putStrLn "trying a remote" result <- try (copyFromRemote r key file)::IO (Either SomeException ()) case (result) of Left err -> do - showerr err r + hPutStrLn stderr (show err) trycopy full rs Right succ -> return True - showerr err r = do - hPutStrLn stderr $ "git-annex: copy from " ++ - (gitRepoDescribe r ) ++ " failed: " ++ - (show err) {- Tries to copy a file from a remote, exception on error. -} copyFromRemote :: GitRepo -> Key -> FilePath -> IO () copyFromRemote r key file = do - r <- if (gitRepoIsLocal r) - then getlocal - else getremote + putStrLn $ "copy from " ++ (gitRepoDescribe r ) ++ " " ++ file + + -- annexLocation needs the git config read for the remote first. + -- FIXME: Having this here means git-config is run repeatedly when + -- copying a series of files; need to use state monad to avoid + -- this. + r' <- gitConfigRead r + + _ <- if (gitRepoIsLocal r') + then getlocal r' + else getremote r' return () where - getlocal = do - putStrLn $ "get: " ++ location - rawSystem "cp" ["-a", location, file] - getremote = do - putStrLn $ "get: " ++ location + getlocal r = do + rawSystem "cp" ["-a", location r, file] + getremote r = do error "get via network not yet implemented!" - location = annexLocation r backend key + location r = annexLocation r backend key -- cgit v1.2.3 From b1607485168e851f69fe3a5b74d73f3c36edf886 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 21:28:47 -0400 Subject: use a state monad enormous reworking --- Annex.hs | 138 ++++++++++++++++++++++++++++++----------------------- Backend.hs | 25 ++++++---- BackendChecksum.hs | 2 +- BackendFile.hs | 21 ++++---- BackendUrl.hs | 21 ++++---- CmdLine.hs | 21 ++++---- Remotes.hs | 44 ++++++++++------- TODO | 4 +- Types.hs | 51 +++++++++++++++++--- UUID.hs | 50 +++++++++++-------- git-annex.hs | 31 +++++++----- 11 files changed, 251 insertions(+), 157 deletions(-) diff --git a/Annex.hs b/Annex.hs index 8489c2ca6..f3c8f533a 100644 --- a/Annex.hs +++ b/Annex.hs @@ -12,6 +12,7 @@ module Annex ( annexPullRepo ) where +import Control.Monad.State (liftIO) import System.Posix.Files import System.Directory import Data.String.Utils @@ -25,22 +26,27 @@ import UUID import LocationLog import Types -{- On startup, examine the git repo, prepare it, and record state for - - later. -} -startAnnex :: IO State +{- Create and returns an Annex state object. + - Examines and prepares the git repo. + -} +startAnnex :: IO AnnexState startAnnex = do - r <- gitRepoFromCwd - r' <- gitConfigRead r - r'' <- prepUUID r' - gitSetup r'' - - return State { - repo = r', - backends = parseBackendList $ gitConfig r' "annex.backends" "" - } + g <- gitRepoFromCwd + let s = makeAnnexState g + (_,s') <- runAnnexState s (prep g) + return s' + where + prep g = do + -- setup git and read its config; update state + liftIO $ gitSetup g + g' <- liftIO $ gitConfigRead g + gitAnnexChange g' + backendsAnnexChange $ parseBackendList $ + gitConfig g' "annex.backends" "" + prepUUID inBackend file yes no = do - r <- lookupFile file + r <- liftIO $ lookupFile file case (r) of Just v -> yes v Nothing -> no @@ -48,13 +54,16 @@ notinBackend file yes no = inBackend file no yes {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} -annexFile :: State -> FilePath -> IO () -annexFile state file = inBackend file err $ do - checkLegal file - stored <- storeFile state file +annexFile :: FilePath -> Annex () +annexFile file = inBackend file err $ do + liftIO $ checkLegal file + stored <- storeFile file + g <- gitAnnex case (stored) of Nothing -> error $ "no backend could store: " ++ file - Just (key, backend) -> setup key backend + Just (key, backend) -> do + logStatus key ValuePresent + liftIO $ setup g key backend where err = error $ "already annexed " ++ file checkLegal file = do @@ -62,15 +71,14 @@ annexFile state file = inBackend file err $ do if ((isSymbolicLink s) || (not $ isRegularFile s)) then error $ "not a regular file: " ++ file else return () - setup key backend = do - logStatus state key ValuePresent - let dest = annexLocation (repo state) backend key - let reldest = annexLocationRelative (repo state) backend key + setup g key backend = do + let dest = annexLocation g backend key + let reldest = annexLocationRelative g backend key createDirectoryIfMissing True (parentDir dest) renameFile file dest createSymbolicLink ((linkTarget file) ++ reldest) file - gitRun (repo state) ["add", file] - gitRun (repo state) ["commit", "-m", + gitRun g ["add", file] + gitRun g ["commit", "-m", ("git-annex annexed " ++ file), file] linkTarget file = -- relies on file being relative to the top of the @@ -83,56 +91,60 @@ annexFile state file = inBackend file err $ do {- Inverse of annexFile. -} -unannexFile :: State -> FilePath -> IO () -unannexFile state file = notinBackend file err $ \(key, backend) -> do - dropFile state backend key - logStatus state key ValueMissing - removeFile file - gitRun (repo state) ["rm", file] - gitRun (repo state) ["commit", "-m", - ("git-annex unannexed " ++ file), file] - -- git rm deletes empty directories; - -- put them back - createDirectoryIfMissing True (parentDir file) - let src = annexLocation (repo state) backend key - renameFile src file - return () +unannexFile :: FilePath -> Annex () +unannexFile file = notinBackend file err $ \(key, backend) -> do + dropFile backend key + logStatus key ValueMissing + g <- gitAnnex + let src = annexLocation g backend key + liftIO $ moveout g src where err = error $ "not annexed " ++ file + moveout g src = do + removeFile file + gitRun g ["rm", file] + gitRun g ["commit", "-m", + ("git-annex unannexed " ++ file), file] + -- git rm deletes empty directories; + -- put them back + createDirectoryIfMissing True (parentDir file) + renameFile src file + return () {- Gets an annexed file from one of the backends. -} -annexGetFile :: State -> FilePath -> IO () -annexGetFile state file = notinBackend file err $ \(key, backend) -> do - inannex <- inAnnex state backend key +annexGetFile :: FilePath -> Annex () +annexGetFile file = notinBackend file err $ \(key, backend) -> do + inannex <- inAnnex backend key if (inannex) then return () else do - let dest = annexLocation (repo state) backend key - createDirectoryIfMissing True (parentDir dest) - success <- retrieveFile state backend key dest + g <- gitAnnex + let dest = annexLocation g backend key + liftIO $ createDirectoryIfMissing True (parentDir dest) + success <- retrieveFile backend key dest if (success) then do - logStatus state key ValuePresent + logStatus key ValuePresent return () else error $ "failed to get " ++ file where err = error $ "not annexed " ++ file {- Indicates a file is wanted. -} -annexWantFile :: State -> FilePath -> IO () -annexWantFile state file = do error "not implemented" -- TODO +annexWantFile :: FilePath -> Annex () +annexWantFile file = do error "not implemented" -- TODO {- Indicates a file is not wanted. -} -annexDropFile :: State -> FilePath -> IO () -annexDropFile state file = do error "not implemented" -- TODO +annexDropFile :: FilePath -> Annex () +annexDropFile file = do error "not implemented" -- TODO {- Pushes all files to a remote repository. -} -annexPushRepo :: State -> String -> IO () -annexPushRepo state reponame = do error "not implemented" -- TODO +annexPushRepo :: String -> Annex () +annexPushRepo reponame = do error "not implemented" -- TODO {- Pulls all files from a remote repository. -} -annexPullRepo :: State -> String -> IO () -annexPullRepo state reponame = do error "not implemented" -- TODO +annexPullRepo :: String -> Annex () +annexPullRepo reponame = do error "not implemented" -- TODO {- Sets up a git repo for git-annex. May be called repeatedly. -} gitSetup :: GitRepo -> IO () @@ -159,11 +171,19 @@ gitSetup repo = do attributes] {- Updates the LocationLog when a key's presence changes. -} -logStatus state key status = do - f <- logChange (repo state) key (getUUID state (repo state)) status - gitRun (repo state) ["add", f] - gitRun (repo state) ["commit", "-m", "git-annex log update", f] +logStatus :: Key -> LogStatus -> Annex () +logStatus key status = do + g <- gitAnnex + u <- getUUID g + f <- liftIO $ logChange g key u status + liftIO $ commit g f + where + commit g f = do + gitRun g ["add", f] + gitRun g ["commit", "-m", "git-annex log update", f] {- Checks if a given key is currently present in the annexLocation -} -inAnnex :: State -> Backend -> Key -> IO Bool -inAnnex state backend key = doesFileExist $ annexLocation (repo state) backend key +inAnnex :: Backend -> Key -> Annex Bool +inAnnex backend key = do + g <- gitAnnex + liftIO $ doesFileExist $ annexLocation g backend key diff --git a/Backend.hs b/Backend.hs index bc7eb206f..775c4a02f 100644 --- a/Backend.hs +++ b/Backend.hs @@ -20,6 +20,7 @@ module Backend ( lookupFile ) where +import Control.Monad.State import Control.Exception import System.Directory import System.FilePath @@ -32,30 +33,34 @@ import Utility import Types {- 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 :: FilePath -> Annex (Maybe (Key, Backend)) +storeFile file = do + g <- gitAnnex + let relfile = gitRelative g file + b <- backendsAnnex + storeFile' b file relfile storeFile' [] _ _ = return Nothing -storeFile' (b:bs) state file = do - try <- (getKey b) state (gitRelative (repo state) file) +storeFile' (b:bs) file relfile = do + try <- (getKey b) relfile case (try) of Nothing -> nextbackend Just key -> do - stored <- (storeFileKey b) state file key + stored <- (storeFileKey b) file key if (not stored) then nextbackend else do return $ Just (key, b) where - nextbackend = storeFile' bs state file + nextbackend = storeFile' bs file relfile {- Attempts to retrieve an key from one of the backends, saving it to - a specified location. -} -retrieveFile :: State -> Backend -> Key -> FilePath -> IO Bool -retrieveFile state backend key dest = (retrieveKeyFile backend) state key dest +retrieveFile :: Backend -> Key -> FilePath -> Annex Bool +retrieveFile backend key dest = (retrieveKeyFile backend) key dest {- Drops a key from a backend. -} -dropFile :: State -> Backend -> Key -> IO Bool -dropFile state backend key = (removeKey backend) state key +dropFile :: Backend -> Key -> Annex Bool +dropFile backend key = (removeKey backend) key {- Looks up the key and backend corresponding to an annexed file, - by examining what the file symlinks to. -} diff --git a/BackendChecksum.hs b/BackendChecksum.hs index efa224412..c6e68ffed 100644 --- a/BackendChecksum.hs +++ b/BackendChecksum.hs @@ -14,5 +14,5 @@ backend = BackendFile.backend { } -- checksum the file to get its key -keyValue :: State -> FilePath -> IO (Maybe Key) +keyValue :: FilePath -> Annex (Maybe Key) keyValue k = error "checksum keyValue unimplemented" -- TODO diff --git a/BackendFile.hs b/BackendFile.hs index a31cbfeb1..9b82a0b20 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -3,6 +3,7 @@ module BackendFile (backend) where +import Control.Monad.State import System.IO import System.Cmd import Control.Exception @@ -21,28 +22,28 @@ backend = Backend { } -- direct mapping from filename to key -keyValue :: State -> FilePath -> IO (Maybe Key) -keyValue state file = return $ Just $ Key file +keyValue :: FilePath -> Annex (Maybe Key) +keyValue file = return $ Just $ Key file {- This backend does not really do any independant data storage, - it relies on the file contents in .git/annex/ in this repo, - and other accessible repos. So storing or removing a key is - a no-op. TODO until support is added for git annex --push otherrepo, - then these could implement that.. -} -dummyStore :: State -> FilePath -> Key -> IO (Bool) -dummyStore state file key = return True -dummyRemove :: State -> Key -> IO Bool -dummyRemove state url = return False +dummyStore :: FilePath -> Key -> Annex (Bool) +dummyStore file key = return True +dummyRemove :: Key -> Annex Bool +dummyRemove url = return False {- Try to find a copy of the file in one of the remotes, - and copy it over to this one. -} -copyKeyFile :: State -> Key -> FilePath -> IO (Bool) -copyKeyFile state key file = do - remotes <- remotesWithKey state key +copyKeyFile :: Key -> FilePath -> Annex (Bool) +copyKeyFile key file = do + remotes <- remotesWithKey key if (0 == length remotes) then error $ "no known remotes have: " ++ (keyFile key) ++ "\n" ++ "(Perhaps you need to git remote add a repository?)" - else trycopy remotes remotes + else liftIO $ trycopy remotes remotes where trycopy full [] = error $ "unable to get: " ++ (keyFile key) ++ "\n" ++ "To get that file, need access to one of these remotes: " ++ diff --git a/BackendUrl.hs b/BackendUrl.hs index 5b586497c..43b0bc75a 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -3,6 +3,7 @@ module BackendUrl (backend) where +import Control.Monad.State import System.Cmd import IO import Types @@ -16,19 +17,19 @@ backend = Backend { } -- cannot generate url from filename -keyValue :: State -> FilePath -> IO (Maybe Key) -keyValue repo file = return Nothing +keyValue :: FilePath -> Annex (Maybe Key) +keyValue file = return Nothing -- cannot change url contents -dummyStore :: State -> FilePath -> Key -> IO Bool -dummyStore repo file url = return False -dummyRemove :: State -> Key -> IO Bool -dummyRemove state url = return False +dummyStore :: FilePath -> Key -> Annex Bool +dummyStore file url = return False +dummyRemove :: Key -> Annex Bool +dummyRemove url = return False -downloadUrl :: State -> Key -> FilePath -> IO Bool -downloadUrl state url file = do - putStrLn $ "download: " ++ (show url) - result <- try $ rawSystem "curl" ["-#", "-o", file, (show url)] +downloadUrl :: Key -> FilePath -> Annex Bool +downloadUrl url file = do + liftIO $ putStrLn $ "download: " ++ (show url) + result <- liftIO $ try $ rawSystem "curl" ["-#", "-o", file, (show url)] case (result) of Left _ -> return False Right _ -> return True diff --git a/CmdLine.hs b/CmdLine.hs index 9da2b6493..d23508aa2 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -6,7 +6,8 @@ module CmdLine ( argvToMode, - dispatch + dispatch, + Mode ) where import System.Console.GetOpt @@ -39,13 +40,13 @@ argvToMode argv = do (_,files,errs) -> ioError (userError (concat errs ++ usageInfo header options)) where header = "Usage: git-annex [mode] file" -dispatch :: State -> Mode -> FilePath -> IO () -dispatch state mode item = do +dispatch :: Mode -> FilePath -> Annex () +dispatch mode item = do case (mode) of - Add -> annexFile state item - Push -> annexPushRepo state item - Pull -> annexPullRepo state item - Want -> annexWantFile state item - Get -> annexGetFile state item - Drop -> annexDropFile state item - Unannex -> unannexFile state item + Add -> annexFile item + Push -> annexPushRepo item + Pull -> annexPullRepo item + Want -> annexWantFile item + Get -> annexGetFile item + Drop -> annexDropFile item + Unannex -> unannexFile item diff --git a/Remotes.hs b/Remotes.hs index ae709a3c2..399291467 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -5,6 +5,7 @@ module Remotes ( remotesWithKey ) where +import Control.Monad.State (liftIO) import Types import GitRepo import LocationLog @@ -17,34 +18,43 @@ remotesList :: [GitRepo] -> String remotesList remotes = join " " $ map gitRepoDescribe remotes {- Cost ordered list of remotes that the LocationLog indicate may have a key. -} -remotesWithKey :: State -> Key -> IO [GitRepo] -remotesWithKey state key = do - uuids <- keyLocations (repo state) key - return $ reposByUUID state (remotesByCost state) uuids +remotesWithKey :: Key -> Annex [GitRepo] +remotesWithKey key = do + g <- gitAnnex + uuids <- liftIO $ keyLocations g key + remotes <- remotesByCost + reposByUUID remotes uuids {- Cost Ordered list of remotes. -} -remotesByCost :: State -> [GitRepo] -remotesByCost state = reposByCost state $ gitConfigRemotes (repo state) +remotesByCost :: Annex [GitRepo] +remotesByCost = do + g <- gitAnnex + reposByCost $ gitConfigRemotes g {- Orders a list of git repos by cost. -} -reposByCost :: State -> [GitRepo] -> [GitRepo] -reposByCost state l = - fst $ unzip $ sortBy (\(r1, c1) (r2, c2) -> compare c1 c2) $ costpairs l +reposByCost :: [GitRepo] -> Annex [GitRepo] +reposByCost l = do + costpairs <- mapM costpair l + return $ fst $ unzip $ sortBy bycost $ costpairs where - costpairs l = map (\r -> (r, repoCost state r)) l + costpair r = do + cost <- repoCost r + return (r, cost) + bycost (_, c1) (_, c2) = compare c1 c2 {- Calculates cost for a repo. - - The default cost is 100 for local repositories, and 200 for remote - repositories; it can also be configured by remote..annex-cost -} -repoCost :: State -> GitRepo -> Int -repoCost state r = - if ((length $ config state r) > 0) - then read $ config state r +repoCost :: GitRepo -> Annex Int +repoCost r = do + g <- gitAnnex + if ((length $ config g r) > 0) + then return $ read $ config g r else if (gitRepoIsLocal r) - then 100 - else 200 + then return 100 + else return 200 where - config state r = gitConfig (repo state) (configkey r) "" + config g r = gitConfig g (configkey r) "" configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-cost" diff --git a/TODO b/TODO index a0f7c8b5f..ea3f87c11 100644 --- a/TODO +++ b/TODO @@ -1,9 +1,9 @@ * bug when annexing files while in a subdir of a git repo * bug when specifying absolute path to files when annexing -* implement retrieval for backendfile +* state monad -* query remotes for their annex.uuid settings +* query remotes for their annex.uuid settings and cache * --push/--pull/--want/--drop diff --git a/Types.hs b/Types.hs index 9b0bb00fd..15c2ec89f 100644 --- a/Types.hs +++ b/Types.hs @@ -1,20 +1,59 @@ {- git-annex core data types -} module Types ( - State(..), + Annex(..), + makeAnnexState, + runAnnexState, + gitAnnex, + gitAnnexChange, + backendsAnnex, + backendsAnnexChange, + + AnnexState(..), Key(..), Backend(..) ) where +import Control.Monad.State import Data.String.Utils import GitRepo -- git-annex's runtime state -data State = State { +data AnnexState = AnnexState { repo :: GitRepo, backends :: [Backend] } deriving (Show) +-- git-annex's monad +type Annex = StateT AnnexState IO + +-- constructor +makeAnnexState :: GitRepo -> AnnexState +makeAnnexState g = AnnexState { repo = g, backends = [] } + +-- performs an action in the Annex monad +runAnnexState state action = runStateT (action) state + +-- state accessors +gitAnnex :: Annex GitRepo +gitAnnex = do + state <- get + return (repo state) +gitAnnexChange :: GitRepo -> Annex () +gitAnnexChange r = do + state <- get + put state { repo = r } + return () +backendsAnnex :: Annex [Backend] +backendsAnnex = do + state <- get + return (backends state) +backendsAnnexChange :: [Backend] -> Annex () +backendsAnnexChange b = do + state <- get + put state { backends = b } + return () + -- annexed filenames are mapped into keys data Key = Key String deriving (Eq) @@ -27,13 +66,13 @@ data Backend = Backend { -- name of this backend name :: String, -- converts a filename to a key - getKey :: State -> FilePath -> IO (Maybe Key), + getKey :: FilePath -> Annex (Maybe Key), -- stores a file's contents to a key - storeFileKey :: State -> FilePath -> Key -> IO Bool, + storeFileKey :: FilePath -> Key -> Annex Bool, -- retrieves a key's contents to a file - retrieveKeyFile :: State -> Key -> FilePath -> IO Bool, + retrieveKeyFile :: Key -> FilePath -> Annex Bool, -- removes a key - removeKey :: State -> Key -> IO Bool + removeKey :: Key -> Annex Bool } instance Show Backend where diff --git a/UUID.hs b/UUID.hs index b4c4c0cc0..5c9f9179e 100644 --- a/UUID.hs +++ b/UUID.hs @@ -13,6 +13,7 @@ module UUID ( reposByUUID ) where +import Control.Monad.State import Maybe import List import System.Cmd.Utils @@ -26,9 +27,8 @@ configkey="annex.uuid" {- Generates a UUID. There is a library for this, but it's not packaged, - so use the command line tool. -} -genUUID :: IO UUID -genUUID = do - pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h +genUUID :: Annex UUID +genUUID = liftIO $ pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h {- Looks up a repo's UUID. May return "" if none is known. - @@ -36,28 +36,38 @@ genUUID = do - remote..annex-uuid - - -} -getUUID :: State -> GitRepo -> UUID -getUUID s r = - if ("" /= getUUID' r) - then getUUID' r - else cached s r +getUUID :: GitRepo -> Annex UUID +getUUID r = do + if ("" /= configured r) + then return $ configured r + else cached r where - cached s r = gitConfig (repo s) (configkey r) "" + configured r = gitConfig r "annex.uuid" "" + cached r = do + g <- gitAnnex + return $ gitConfig g (configkey r) "" configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-uuid" -getUUID' r = gitConfig r "annex.uuid" "" {- Make sure that the repo has an annex.uuid setting. -} -prepUUID :: GitRepo -> IO GitRepo -prepUUID repo = - if ("" == getUUID' repo) +prepUUID :: Annex () +prepUUID = do + g <- gitAnnex + u <- getUUID g + if ("" == u) then do uuid <- genUUID - gitRun repo ["config", configkey, uuid] - -- return new repo with updated config - gitConfigRead repo - else return repo + liftIO $ gitRun g ["config", configkey, uuid] + -- re-read git config and update the repo's state + u' <- liftIO $ gitConfigRead g + gitAnnexChange u' + return () + else return () {- Filters a list of repos to ones that have listed UUIDs. -} -reposByUUID :: State -> [GitRepo] -> [UUID] -> [GitRepo] -reposByUUID state repos uuids = - filter (\r -> isJust $ elemIndex (getUUID state r) uuids) repos +reposByUUID :: [GitRepo] -> [UUID] -> Annex [GitRepo] +reposByUUID repos uuids = do + filterM match repos + where + match r = do + u <- getUUID r + return $ isJust $ elemIndex u uuids diff --git a/git-annex.hs b/git-annex.hs index 7785e4f2d..935be2f1e 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -1,36 +1,43 @@ {- git-annex main program - -} +import Control.Monad.State import System.IO import System.Environment import Control.Exception import CmdLine +import Types import Annex main = do args <- getArgs - (mode, files) <- argvToMode args - + (mode, params) <- argvToMode args state <- startAnnex + tryRun state mode 0 0 params - tryRun 0 0 $ map (\f -> dispatch state mode f) files - -{- Tries to run a series of actions, not stopping if some error out, - - and propigating an overall error status at the end. -} -tryRun errnum oknum [] = do +{- Processes each param in the list by dispatching the handler function + - for the user-selection operation mode. Catches exceptions, not stopping + - if some error out, and propigates an overall error status at the end. + - + - This runs in the IO monad, not in the Annex monad. It seems that + - exceptions can only be caught in the IO monad, not in a stacked monad; + - or more likely I missed an easy way to do it. So, I have to laboriously + - thread AnnexState through this function. + -} +tryRun :: AnnexState -> Mode -> Int -> Int -> [String] -> IO () +tryRun state mode errnum oknum [] = do if (errnum > 0) then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok" else return () -tryRun errnum oknum (a:as) = do - result <- try (a)::IO (Either SomeException ()) +tryRun state mode errnum oknum (f:fs) = do + result <- try (runAnnexState state (dispatch mode f))::IO (Either SomeException ((), AnnexState)) case (result) of Left err -> do showErr err - tryRun (errnum + 1) oknum as - Right _ -> tryRun errnum (oknum + 1) as + tryRun state mode (errnum + 1) oknum fs + Right (_,state') -> tryRun state' mode errnum (oknum + 1) fs {- Exception pretty-printing. -} -showErr :: SomeException -> IO () showErr e = do hPutStrLn stderr $ "git-annex: " ++ (show e) return () -- cgit v1.2.3 From 89654751daacd9336c114bfc1c88c952dcc4ffe9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 21:35:10 -0400 Subject: bugfix --- Annex.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Annex.hs b/Annex.hs index f3c8f533a..f55a62c4d 100644 --- a/Annex.hs +++ b/Annex.hs @@ -38,9 +38,9 @@ startAnnex = do where prep g = do -- setup git and read its config; update state - liftIO $ gitSetup g g' <- liftIO $ gitConfigRead g gitAnnexChange g' + liftIO $ gitSetup g' backendsAnnexChange $ parseBackendList $ gitConfig g' "annex.backends" "" prepUUID -- cgit v1.2.3 From 912d10e78b725b4d3d4105a0ffe5696c21fc0e10 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 22:59:43 -0400 Subject: implemented remotes config caching --- BackendFile.hs | 30 +++++++++++++----------------- GitRepo.hs | 50 +++++++++++++++++++++++++++++++++++--------------- Remotes.hs | 28 ++++++++++++++++++++++++++-- 3 files changed, 74 insertions(+), 34 deletions(-) diff --git a/BackendFile.hs b/BackendFile.hs index 9b82a0b20..d16f3611b 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -43,16 +43,20 @@ copyKeyFile key file = do if (0 == length remotes) then error $ "no known remotes have: " ++ (keyFile key) ++ "\n" ++ "(Perhaps you need to git remote add a repository?)" - else liftIO $ trycopy remotes remotes + else trycopy remotes remotes where trycopy full [] = error $ "unable to get: " ++ (keyFile key) ++ "\n" ++ "To get that file, need access to one of these remotes: " ++ (remotesList full) trycopy full (r:rs) = do - result <- try (copyFromRemote r key file)::IO (Either SomeException ()) + -- annexLocation needs the git config to have been + -- read for a remote, so do that now, + -- if it hasn't been already + r' <- remoteEnsureGitConfigRead r + result <- liftIO $ (try (copyFromRemote r' key file)::IO (Either SomeException ())) case (result) of Left err -> do - hPutStrLn stderr (show err) + liftIO $ hPutStrLn stderr (show err) trycopy full rs Right succ -> return True @@ -61,19 +65,11 @@ copyFromRemote :: GitRepo -> Key -> FilePath -> IO () copyFromRemote r key file = do putStrLn $ "copy from " ++ (gitRepoDescribe r ) ++ " " ++ file - -- annexLocation needs the git config read for the remote first. - -- FIXME: Having this here means git-config is run repeatedly when - -- copying a series of files; need to use state monad to avoid - -- this. - r' <- gitConfigRead r - - _ <- if (gitRepoIsLocal r') - then getlocal r' - else getremote r' + if (gitRepoIsLocal r) + then getlocal + else getremote return () where - getlocal r = do - rawSystem "cp" ["-a", location r, file] - getremote r = do - error "get via network not yet implemented!" - location r = annexLocation r backend key + getlocal = rawSystem "cp" ["-a", location, file] + getremote = error "get via network not yet implemented!" + location = annexLocation r backend key diff --git a/GitRepo.hs b/GitRepo.hs index e1f086b69..d22218219 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -12,15 +12,17 @@ module GitRepo ( gitRepoFromUrl, gitRepoIsLocal, gitRepoIsRemote, - gitConfigRemotes, gitRepoDescribe, gitWorkTree, gitDir, gitRelative, gitConfig, + gitConfigMap, gitConfigRead, gitRun, gitAttributes, + gitRepoRemotes, + gitRepoRemotesAdd, gitRepoRemoteName ) where @@ -46,12 +48,14 @@ data GitRepo = LocalGitRepo { top :: FilePath, config :: Map String String, + remotes :: [GitRepo], -- remoteName holds the name used for this repo in remotes remoteName :: Maybe String } | RemoteGitRepo { url :: String, top :: FilePath, config :: Map String String, + remotes :: [GitRepo], remoteName :: Maybe String } deriving (Show, Read, Eq) @@ -61,6 +65,7 @@ gitRepoFromPath dir = LocalGitRepo { top = dir, config = Map.empty, + remotes = [], remoteName = Nothing } @@ -71,6 +76,7 @@ gitRepoFromUrl url = url = url, top = path url, config = Map.empty, + remotes = [], remoteName = Nothing } where path url = uriPath $ fromJust $ parseURI url @@ -83,6 +89,15 @@ gitRepoDescribe repo = then top repo else url repo +{- Returns the list of a repo's remotes. -} +gitRepoRemotes :: GitRepo -> [GitRepo] +gitRepoRemotes r = remotes r + +{- Constructs and returns an updated version of a repo with + - different remotes list. -} +gitRepoRemotesAdd :: GitRepo -> [GitRepo] -> GitRepo +gitRepoRemotesAdd repo rs = repo { remotes = rs } + {- Returns the name of the remote that corresponds to the repo, if - it is a remote. Otherwise, "" -} gitRepoRemoteName r = @@ -169,10 +184,24 @@ gitConfigRead repo = assertlocal repo $ do been already read. Instead, chdir to the repo. -} cwd <- getCurrentDirectory bracket_ (changeWorkingDirectory (top repo)) - (\_ -> changeWorkingDirectory cwd) $ do + (\_ -> changeWorkingDirectory cwd) $ pOpen ReadFromPipe "git" ["config", "--list"] $ \h -> do val <- hGetContentsStrict h - return repo { config = gitConfigParse val } + let r = repo { config = gitConfigParse val } + return r { remotes = gitConfigRemotes r } + +{- Calculates a list of a repo's configured remotes, by parsing its config. -} +gitConfigRemotes :: GitRepo -> [GitRepo] +gitConfigRemotes repo = map construct remotes + where + remotes = toList $ filter $ config repo + filter = filterWithKey (\k _ -> isremote k) + isremote k = (startswith "remote." k) && (endswith ".url" k) + remotename k = (split "." k) !! 1 + construct (k,v) = (gen v) { remoteName = Just $ remotename k } + gen v = if (isURI v) + then gitRepoFromUrl v + else gitRepoFromPath v {- Parses git config --list output into a config map. -} gitConfigParse :: String -> Map.Map String String @@ -189,18 +218,9 @@ gitConfig :: GitRepo -> String -> String -> String gitConfig repo key defaultValue = Map.findWithDefault defaultValue key (config repo) -{- Returns a list of a repo's configured remotes. -} -gitConfigRemotes :: GitRepo -> [GitRepo] -gitConfigRemotes repo = map construct remotes - where - remotes = toList $ filter $ config repo - filter = filterWithKey (\k _ -> isremote k) - isremote k = (startswith "remote." k) && (endswith ".url" k) - remotename k = (split "." k) !! 1 - construct (k,v) = (gen v) { remoteName = Just $ remotename k } - gen v = if (isURI v) - then gitRepoFromUrl v - else gitRepoFromPath v +{- Access to raw config Map -} +gitConfigMap :: GitRepo -> Map String String +gitConfigMap repo = config repo {- Finds the current git repository, which may be in a parent directory. -} gitRepoFromCwd :: IO GitRepo diff --git a/Remotes.hs b/Remotes.hs index 399291467..13b87982c 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -2,10 +2,12 @@ module Remotes ( remotesList, - remotesWithKey + remotesWithKey, + remoteEnsureGitConfigRead ) where import Control.Monad.State (liftIO) +import qualified Data.Map as Map import Types import GitRepo import LocationLog @@ -29,7 +31,7 @@ remotesWithKey key = do remotesByCost :: Annex [GitRepo] remotesByCost = do g <- gitAnnex - reposByCost $ gitConfigRemotes g + reposByCost $ gitRepoRemotes g {- Orders a list of git repos by cost. -} reposByCost :: [GitRepo] -> Annex [GitRepo] @@ -58,3 +60,25 @@ repoCost r = do where config g r = gitConfig g (configkey r) "" configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-cost" + +{- The git configs for the git repo's remotes is not read on startup + - because reading it may be expensive. This function ensures that it is + - read for a specified remote, and updates state. It returns the + - updated git repo also. -} +remoteEnsureGitConfigRead :: GitRepo -> Annex GitRepo +remoteEnsureGitConfigRead r = do + if (Map.null $ gitConfigMap r) + then do + r' <- liftIO $ gitConfigRead r + g <- gitAnnex + let l = gitRepoRemotes g + let g' = gitRepoRemotesAdd g $ exchange l r' + gitAnnexChange g' + return r' + else return r + where + exchange [] new = [] + exchange (old:ls) new = + if ((gitRepoRemoteName old) == (gitRepoRemoteName new)) + then new:(exchange ls new) + else old:(exchange ls new) -- cgit v1.2.3 From 64b5167b0f9620bd96cd57b58f0e40be741e5420 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 23:03:01 -0400 Subject: update --- Types.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Types.hs b/Types.hs index 15c2ec89f..ce377dda1 100644 --- a/Types.hs +++ b/Types.hs @@ -1,7 +1,8 @@ {- git-annex core data types -} module Types ( - Annex(..), + Annex, + AnnexState, makeAnnexState, runAnnexState, gitAnnex, @@ -9,7 +10,6 @@ module Types ( backendsAnnex, backendsAnnexChange, - AnnexState(..), Key(..), Backend(..) ) where @@ -34,7 +34,7 @@ makeAnnexState g = AnnexState { repo = g, backends = [] } -- performs an action in the Annex monad runAnnexState state action = runStateT (action) state --- state accessors +-- Annex monad state accessors gitAnnex :: Annex GitRepo gitAnnex = do state <- get -- cgit v1.2.3 From 8ab54401b609f49a603f3ed69bb8493a53f28db8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 23:18:58 -0400 Subject: update --- BackendFile.hs | 5 +---- Remotes.hs | 12 +++++++++--- TODO | 2 -- UUID.hs | 10 +++++++++- 4 files changed, 19 insertions(+), 10 deletions(-) diff --git a/BackendFile.hs b/BackendFile.hs index d16f3611b..e821ac22b 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -40,10 +40,7 @@ dummyRemove url = return False copyKeyFile :: Key -> FilePath -> Annex (Bool) copyKeyFile key file = do remotes <- remotesWithKey key - if (0 == length remotes) - then error $ "no known remotes have: " ++ (keyFile key) ++ "\n" ++ - "(Perhaps you need to git remote add a repository?)" - else trycopy remotes remotes + trycopy remotes remotes where trycopy full [] = error $ "unable to get: " ++ (keyFile key) ++ "\n" ++ "To get that file, need access to one of these remotes: " ++ diff --git a/Remotes.hs b/Remotes.hs index 13b87982c..f3af81f23 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -8,10 +8,11 @@ module Remotes ( import Control.Monad.State (liftIO) import qualified Data.Map as Map +import Data.String.Utils import Types import GitRepo import LocationLog -import Data.String.Utils +import Locations import UUID import List @@ -24,8 +25,13 @@ remotesWithKey :: Key -> Annex [GitRepo] remotesWithKey key = do g <- gitAnnex uuids <- liftIO $ keyLocations g key - remotes <- remotesByCost - reposByUUID remotes uuids + allremotes <- remotesByCost + remotes <- reposByUUID allremotes uuids + if (0 == length remotes) + then error $ "no configured git remotes have: " ++ (keyFile key) ++ "\n" ++ + "It has been seen before in these repositories:\n" ++ + prettyPrintUUIDs uuids + else return remotes {- Cost Ordered list of remotes. -} remotesByCost :: Annex [GitRepo] diff --git a/TODO b/TODO index ea3f87c11..40017c816 100644 --- a/TODO +++ b/TODO @@ -1,8 +1,6 @@ * bug when annexing files while in a subdir of a git repo * bug when specifying absolute path to files when annexing -* state monad - * query remotes for their annex.uuid settings and cache * --push/--pull/--want/--drop diff --git a/UUID.hs b/UUID.hs index 5c9f9179e..af6003bfb 100644 --- a/UUID.hs +++ b/UUID.hs @@ -10,7 +10,8 @@ module UUID ( getUUID, prepUUID, genUUID, - reposByUUID + reposByUUID, + prettyPrintUUIDs ) where import Control.Monad.State @@ -71,3 +72,10 @@ reposByUUID repos uuids = do match r = do u <- getUUID r return $ isJust $ elemIndex u uuids + +{- Pretty-prints a list of UUIDs + - TODO: use lookup file to really show pretty names. -} +prettyPrintUUIDs :: [UUID] -> String +prettyPrintUUIDs uuids = + unwords $ map (\u -> "\tUUID "++u++"\n") uuids + -- cgit v1.2.3 From e47dca162a0ca0144172c9a61a47d1e0b5ad04b7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Oct 2010 23:31:08 -0400 Subject: update --- Locations.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Locations.hs b/Locations.hs index d6d7d4248..68a958192 100644 --- a/Locations.hs +++ b/Locations.hs @@ -47,6 +47,7 @@ annexLocationRelative r backend key = keyFile :: Key -> FilePath keyFile key = replace "/" "%" $ replace "%" "&s" $ replace "&" "&a" $ show key -{- Reverses keyFile -} +{- Reverses keyFile, converting a filename fragment (ie, the basename of + - the symlink target) into a key. -} fileKey :: FilePath -> Key fileKey file = Key $ replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file -- cgit v1.2.3 From eda80e44c5fb399fa4e5625388d6e0f993b0f779 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 02:12:41 -0400 Subject: add module that only exports abstract types --- AbstractTypes.hs | 17 +++++++++++++++++ Annex.hs | 2 +- CmdLine.hs | 2 +- LocationLog.hs | 2 +- Remotes.hs | 2 +- UUID.hs | 2 +- git-annex.hs | 2 +- 7 files changed, 23 insertions(+), 6 deletions(-) create mode 100644 AbstractTypes.hs diff --git a/AbstractTypes.hs b/AbstractTypes.hs new file mode 100644 index 000000000..510a37f0c --- /dev/null +++ b/AbstractTypes.hs @@ -0,0 +1,17 @@ +{- git-annex data types, abstract only -} + +module AbstractTypes ( + Annex, + AnnexState, + makeAnnexState, + runAnnexState, + gitAnnex, + gitAnnexChange, + backendsAnnex, + backendsAnnexChange, + + Key, + Backend +) where + +import Types diff --git a/Annex.hs b/Annex.hs index f55a62c4d..68bf0136a 100644 --- a/Annex.hs +++ b/Annex.hs @@ -24,7 +24,7 @@ import Backend import BackendList import UUID import LocationLog -import Types +import AbstractTypes {- Create and returns an Annex state object. - Examines and prepares the git repo. diff --git a/CmdLine.hs b/CmdLine.hs index d23508aa2..bb908a2e4 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -11,7 +11,7 @@ module CmdLine ( ) where import System.Console.GetOpt -import Types +import AbstractTypes import Annex data Mode = Add | Push | Pull | Want | Get | Drop | Unannex diff --git a/LocationLog.hs b/LocationLog.hs index 28ac46b90..a6d998e0a 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -32,7 +32,7 @@ import Data.Char import GitRepo import Utility import UUID -import Types +import AbstractTypes import Locations data LogLine = LogLine { diff --git a/Remotes.hs b/Remotes.hs index f3af81f23..711cd6c83 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -9,7 +9,7 @@ module Remotes ( import Control.Monad.State (liftIO) import qualified Data.Map as Map import Data.String.Utils -import Types +import AbstractTypes import GitRepo import LocationLog import Locations diff --git a/UUID.hs b/UUID.hs index af6003bfb..f334afdc9 100644 --- a/UUID.hs +++ b/UUID.hs @@ -20,7 +20,7 @@ import List import System.Cmd.Utils import System.IO import GitRepo -import Types +import AbstractTypes type UUID = String diff --git a/git-annex.hs b/git-annex.hs index 935be2f1e..be5168755 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -6,7 +6,7 @@ import System.IO import System.Environment import Control.Exception import CmdLine -import Types +import AbstractTypes import Annex main = do -- cgit v1.2.3 From 48643b68b3ff05399b72f44b8b02ff34d6de046c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 02:36:41 -0400 Subject: convert GitRepo to qualified import --- Annex.hs | 78 ++++++++++++++-------------- Backend.hs | 4 +- BackendFile.hs | 8 +-- CmdLine.hs | 14 ++--- GitRepo.hs | 158 ++++++++++++++++++++++++++++----------------------------- LocationLog.hs | 10 ++-- Locations.hs | 14 ++--- Remotes.hs | 34 ++++++------- Types.hs | 24 +++------ UUID.hs | 16 +++--- git-annex.hs | 2 +- 11 files changed, 173 insertions(+), 189 deletions(-) diff --git a/Annex.hs b/Annex.hs index 68bf0136a..54f9b9dff 100644 --- a/Annex.hs +++ b/Annex.hs @@ -2,14 +2,14 @@ -} module Annex ( - startAnnex, - annexFile, - unannexFile, - annexGetFile, - annexWantFile, - annexDropFile, - annexPushRepo, - annexPullRepo + start, + annexCmd, + unannexCmd, + getCmd, + wantCmd, + dropCmd, + pushCmd, + pullCmd ) where import Control.Monad.State (liftIO) @@ -17,7 +17,7 @@ import System.Posix.Files import System.Directory import Data.String.Utils import List -import GitRepo +import qualified GitRepo as Git import Utility import Locations import Backend @@ -29,20 +29,20 @@ import AbstractTypes {- Create and returns an Annex state object. - Examines and prepares the git repo. -} -startAnnex :: IO AnnexState -startAnnex = do - g <- gitRepoFromCwd +start :: IO AnnexState +start = do + g <- Git.repoFromCwd let s = makeAnnexState g (_,s') <- runAnnexState s (prep g) return s' where prep g = do -- setup git and read its config; update state - g' <- liftIO $ gitConfigRead g + g' <- liftIO $ Git.configRead g gitAnnexChange g' liftIO $ gitSetup g' backendsAnnexChange $ parseBackendList $ - gitConfig g' "annex.backends" "" + Git.configGet g' "annex.backends" "" prepUUID inBackend file yes no = do @@ -54,8 +54,8 @@ notinBackend file yes no = inBackend file no yes {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} -annexFile :: FilePath -> Annex () -annexFile file = inBackend file err $ do +annexCmd :: FilePath -> Annex () +annexCmd file = inBackend file err $ do liftIO $ checkLegal file stored <- storeFile file g <- gitAnnex @@ -77,8 +77,8 @@ annexFile file = inBackend file err $ do createDirectoryIfMissing True (parentDir dest) renameFile file dest createSymbolicLink ((linkTarget file) ++ reldest) file - gitRun g ["add", file] - gitRun g ["commit", "-m", + Git.run g ["add", file] + Git.run g ["commit", "-m", ("git-annex annexed " ++ file), file] linkTarget file = -- relies on file being relative to the top of the @@ -90,9 +90,9 @@ annexFile file = inBackend file err $ do subdirs = (length $ split "/" file) - 1 -{- Inverse of annexFile. -} -unannexFile :: FilePath -> Annex () -unannexFile file = notinBackend file err $ \(key, backend) -> do +{- Inverse of annexCmd. -} +unannexCmd :: FilePath -> Annex () +unannexCmd file = notinBackend file err $ \(key, backend) -> do dropFile backend key logStatus key ValueMissing g <- gitAnnex @@ -102,8 +102,8 @@ unannexFile file = notinBackend file err $ \(key, backend) -> do err = error $ "not annexed " ++ file moveout g src = do removeFile file - gitRun g ["rm", file] - gitRun g ["commit", "-m", + Git.run g ["rm", file] + Git.run g ["commit", "-m", ("git-annex unannexed " ++ file), file] -- git rm deletes empty directories; -- put them back @@ -112,8 +112,8 @@ unannexFile file = notinBackend file err $ \(key, backend) -> do return () {- Gets an annexed file from one of the backends. -} -annexGetFile :: FilePath -> Annex () -annexGetFile file = notinBackend file err $ \(key, backend) -> do +getCmd :: FilePath -> Annex () +getCmd file = notinBackend file err $ \(key, backend) -> do inannex <- inAnnex backend key if (inannex) then return () @@ -131,23 +131,23 @@ annexGetFile file = notinBackend file err $ \(key, backend) -> do err = error $ "not annexed " ++ file {- Indicates a file is wanted. -} -annexWantFile :: FilePath -> Annex () -annexWantFile file = do error "not implemented" -- TODO +wantCmd :: FilePath -> Annex () +wantCmd file = do error "not implemented" -- TODO {- Indicates a file is not wanted. -} -annexDropFile :: FilePath -> Annex () -annexDropFile file = do error "not implemented" -- TODO +dropCmd :: FilePath -> Annex () +dropCmd file = do error "not implemented" -- TODO {- Pushes all files to a remote repository. -} -annexPushRepo :: String -> Annex () -annexPushRepo reponame = do error "not implemented" -- TODO +pushCmd :: String -> Annex () +pushCmd reponame = do error "not implemented" -- TODO {- Pulls all files from a remote repository. -} -annexPullRepo :: String -> Annex () -annexPullRepo reponame = do error "not implemented" -- TODO +pullCmd :: String -> Annex () +pullCmd reponame = do error "not implemented" -- TODO {- Sets up a git repo for git-annex. May be called repeatedly. -} -gitSetup :: GitRepo -> IO () +gitSetup :: Git.Repo -> IO () gitSetup repo = do -- configure git to use union merge driver on state files exists <- doesFileExist attributes @@ -164,10 +164,10 @@ gitSetup repo = do else return () where attrLine = stateLoc ++ "/*.log merge=union" - attributes = gitAttributes repo + attributes = Git.attributes repo commit = do - gitRun repo ["add", attributes] - gitRun repo ["commit", "-m", "git-annex setup", + Git.run repo ["add", attributes] + Git.run repo ["commit", "-m", "git-annex setup", attributes] {- Updates the LocationLog when a key's presence changes. -} @@ -179,8 +179,8 @@ logStatus key status = do liftIO $ commit g f where commit g f = do - gitRun g ["add", f] - gitRun g ["commit", "-m", "git-annex log update", f] + Git.run g ["add", f] + Git.run g ["commit", "-m", "git-annex log update", f] {- Checks if a given key is currently present in the annexLocation -} inAnnex :: Backend -> Key -> Annex Bool diff --git a/Backend.hs b/Backend.hs index 775c4a02f..1bd4efc1e 100644 --- a/Backend.hs +++ b/Backend.hs @@ -28,7 +28,7 @@ import Data.String.Utils import System.Posix.Files import BackendList import Locations -import GitRepo +import qualified GitRepo as Git import Utility import Types @@ -36,7 +36,7 @@ import Types storeFile :: FilePath -> Annex (Maybe (Key, Backend)) storeFile file = do g <- gitAnnex - let relfile = gitRelative g file + let relfile = Git.relative g file b <- backendsAnnex storeFile' b file relfile storeFile' [] _ _ = return Nothing diff --git a/BackendFile.hs b/BackendFile.hs index e821ac22b..6c1dc0623 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -11,7 +11,7 @@ import Types import LocationLog import Locations import Remotes -import GitRepo +import qualified GitRepo as Git backend = Backend { name = "file", @@ -58,11 +58,11 @@ copyKeyFile key file = do Right succ -> return True {- Tries to copy a file from a remote, exception on error. -} -copyFromRemote :: GitRepo -> Key -> FilePath -> IO () +copyFromRemote :: Git.Repo -> Key -> FilePath -> IO () copyFromRemote r key file = do - putStrLn $ "copy from " ++ (gitRepoDescribe r ) ++ " " ++ file + putStrLn $ "copy from " ++ (Git.repoDescribe r ) ++ " " ++ file - if (gitRepoIsLocal r) + if (Git.repoIsLocal r) then getlocal else getremote return () diff --git a/CmdLine.hs b/CmdLine.hs index bb908a2e4..479be7e8b 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -43,10 +43,10 @@ argvToMode argv = do dispatch :: Mode -> FilePath -> Annex () dispatch mode item = do case (mode) of - Add -> annexFile item - Push -> annexPushRepo item - Pull -> annexPullRepo item - Want -> annexWantFile item - Get -> annexGetFile item - Drop -> annexDropFile item - Unannex -> unannexFile item + Add -> annexCmd item + Push -> pushCmd item + Pull -> pullCmd item + Want -> wantCmd item + Get -> getCmd item + Drop -> dropCmd item + Unannex -> unannexCmd item diff --git a/GitRepo.hs b/GitRepo.hs index d22218219..f3bb5427a 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -3,27 +3,27 @@ - This is written to be completely independant of git-annex and should be - suitable for other uses. - - - -} + -} module GitRepo ( - GitRepo, - gitRepoFromCwd, - gitRepoFromPath, - gitRepoFromUrl, - gitRepoIsLocal, - gitRepoIsRemote, - gitRepoDescribe, - gitWorkTree, - gitDir, - gitRelative, - gitConfig, - gitConfigMap, - gitConfigRead, - gitRun, - gitAttributes, - gitRepoRemotes, - gitRepoRemotesAdd, - gitRepoRemoteName + Repo, + repoFromCwd, + repoFromPath, + repoFromUrl, + repoIsLocal, + repoIsRemote, + repoDescribe, + workTree, + dir, + relative, + configGet, + configMap, + configRead, + run, + attributes, + remotes, + remotesAdd, + repoRemoteName ) where import Directory @@ -44,35 +44,35 @@ import Utility {- A git repository can be on local disk or remote. Not to be confused - with a git repo's configured remotes, some of which may be on local - disk. -} -data GitRepo = - LocalGitRepo { +data Repo = + LocalRepo { top :: FilePath, config :: Map String String, - remotes :: [GitRepo], + remotes :: [Repo], -- remoteName holds the name used for this repo in remotes remoteName :: Maybe String - } | RemoteGitRepo { + } | RemoteRepo { url :: String, top :: FilePath, config :: Map String String, - remotes :: [GitRepo], + remotes :: [Repo], remoteName :: Maybe String } deriving (Show, Read, Eq) -{- Local GitRepo constructor. -} -gitRepoFromPath :: FilePath -> GitRepo -gitRepoFromPath dir = - LocalGitRepo { +{- Local Repo constructor. -} +repoFromPath :: FilePath -> Repo +repoFromPath dir = + LocalRepo { top = dir, config = Map.empty, remotes = [], remoteName = Nothing } -{- Remote GitRepo constructor. Throws exception on invalid url. -} -gitRepoFromUrl :: String -> GitRepo -gitRepoFromUrl url = - RemoteGitRepo { +{- Remote Repo constructor. Throws exception on invalid url. -} +repoFromUrl :: String -> Repo +repoFromUrl url = + RemoteRepo { url = url, top = path url, config = Map.empty, @@ -82,72 +82,68 @@ gitRepoFromUrl url = where path url = uriPath $ fromJust $ parseURI url {- User-visible description of a git repo. -} -gitRepoDescribe repo = +repoDescribe repo = if (isJust $ remoteName repo) then fromJust $ remoteName repo - else if (gitRepoIsLocal repo) + else if (repoIsLocal repo) then top repo else url repo -{- Returns the list of a repo's remotes. -} -gitRepoRemotes :: GitRepo -> [GitRepo] -gitRepoRemotes r = remotes r - {- Constructs and returns an updated version of a repo with - different remotes list. -} -gitRepoRemotesAdd :: GitRepo -> [GitRepo] -> GitRepo -gitRepoRemotesAdd repo rs = repo { remotes = rs } +remotesAdd :: Repo -> [Repo] -> Repo +remotesAdd repo rs = repo { remotes = rs } {- Returns the name of the remote that corresponds to the repo, if - it is a remote. Otherwise, "" -} -gitRepoRemoteName r = +repoRemoteName r = if (isJust $ remoteName r) then fromJust $ remoteName r else "" {- Some code needs to vary between remote and local repos, or bare and - non-bare, these functions help with that. -} -gitRepoIsLocal repo = case (repo) of - LocalGitRepo {} -> True - RemoteGitRepo {} -> False -gitRepoIsRemote repo = not $ gitRepoIsLocal repo +repoIsLocal repo = case (repo) of + LocalRepo {} -> True + RemoteRepo {} -> False +repoIsRemote repo = not $ repoIsLocal repo assertlocal repo action = - if (gitRepoIsLocal repo) + if (repoIsLocal repo) then action - else error $ "acting on remote git repo " ++ (gitRepoDescribe repo) ++ + else error $ "acting on remote git repo " ++ (repoDescribe repo) ++ " not supported" -bare :: GitRepo -> Bool +bare :: Repo -> Bool bare repo = if (member b (config repo)) then ("true" == fromJust (Map.lookup b (config repo))) - else error $ "it is not known if git repo " ++ (gitRepoDescribe repo) ++ + else error $ "it is not known if git repo " ++ (repoDescribe repo) ++ " is a bare repository; config not read" where b = "core.bare" {- Path to a repository's gitattributes file. -} -gitAttributes :: GitRepo -> String -gitAttributes repo = assertlocal repo $ do +attributes :: Repo -> String +attributes repo = assertlocal repo $ do if (bare repo) then (top repo) ++ "/info/.gitattributes" else (top repo) ++ "/.gitattributes" {- Path to a repository's .git directory, relative to its topdir. -} -gitDir :: GitRepo -> String -gitDir repo = assertlocal repo $ +dir :: Repo -> String +dir repo = assertlocal repo $ if (bare repo) then "" else ".git" {- Path to a repository's --work-tree. -} -gitWorkTree :: GitRepo -> FilePath -gitWorkTree repo = top repo +workTree :: Repo -> FilePath +workTree repo = top repo {- Given a relative or absolute filename in a repository, calculates the - name to use to refer to the file relative to a git repository's top. - This is the same form displayed and used by git. -} -gitRelative :: GitRepo -> String -> String -gitRelative repo file = drop (length absrepo) absfile +relative :: Repo -> String -> String +relative repo file = drop (length absrepo) absfile where -- normalize both repo and file, so that repo -- will be substring of file @@ -159,27 +155,27 @@ gitRelative repo file = drop (length absrepo) absfile Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo {- Constructs a git command line operating on the specified repo. -} -gitCommandLine :: GitRepo -> [String] -> [String] +gitCommandLine :: Repo -> [String] -> [String] gitCommandLine repo params = assertlocal repo $ -- force use of specified repo via --git-dir and --work-tree - ["--git-dir="++(top repo)++"/"++(gitDir repo), "--work-tree="++(top repo)] ++ params + ["--git-dir="++(top repo)++"/"++(dir repo), "--work-tree="++(top repo)] ++ params {- Runs git in the specified repo. -} -gitRun :: GitRepo -> [String] -> IO () -gitRun repo params = assertlocal repo $ do +run :: Repo -> [String] -> IO () +run repo params = assertlocal repo $ do r <- rawSystem "git" (gitCommandLine repo params) return () {- Runs a git subcommand and returns its output. -} -gitPipeRead :: GitRepo -> [String] -> IO String +gitPipeRead :: Repo -> [String] -> IO String gitPipeRead repo params = assertlocal repo $ do pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do ret <- hGetContentsStrict h return ret {- Runs git config and populates a repo with its config. -} -gitConfigRead :: GitRepo -> IO GitRepo -gitConfigRead repo = assertlocal repo $ do +configRead :: Repo -> IO Repo +configRead repo = assertlocal repo $ do {- Cannot use gitPipeRead because it relies on the config having been already read. Instead, chdir to the repo. -} cwd <- getCurrentDirectory @@ -187,12 +183,12 @@ gitConfigRead repo = assertlocal repo $ do (\_ -> changeWorkingDirectory cwd) $ pOpen ReadFromPipe "git" ["config", "--list"] $ \h -> do val <- hGetContentsStrict h - let r = repo { config = gitConfigParse val } - return r { remotes = gitConfigRemotes r } + let r = repo { config = configParse val } + return r { remotes = configRemotes r } {- Calculates a list of a repo's configured remotes, by parsing its config. -} -gitConfigRemotes :: GitRepo -> [GitRepo] -gitConfigRemotes repo = map construct remotes +configRemotes :: Repo -> [Repo] +configRemotes repo = map construct remotes where remotes = toList $ filter $ config repo filter = filterWithKey (\k _ -> isremote k) @@ -200,12 +196,12 @@ gitConfigRemotes repo = map construct remotes remotename k = (split "." k) !! 1 construct (k,v) = (gen v) { remoteName = Just $ remotename k } gen v = if (isURI v) - then gitRepoFromUrl v - else gitRepoFromPath v + then repoFromUrl v + else repoFromPath v {- Parses git config --list output into a config map. -} -gitConfigParse :: String -> Map.Map String String -gitConfigParse s = Map.fromList $ map pair $ lines s +configParse :: String -> Map.Map String String +configParse s = Map.fromList $ map pair $ lines s where pair l = (key l, val l) key l = (keyval l) !! 0 @@ -214,21 +210,21 @@ gitConfigParse s = Map.fromList $ map pair $ lines s sep = "=" {- Returns a single git config setting, or a default value if not set. -} -gitConfig :: GitRepo -> String -> String -> String -gitConfig repo key defaultValue = +configGet :: Repo -> String -> String -> String +configGet repo key defaultValue = Map.findWithDefault defaultValue key (config repo) {- Access to raw config Map -} -gitConfigMap :: GitRepo -> Map String String -gitConfigMap repo = config repo +configMap :: Repo -> Map String String +configMap repo = config repo {- Finds the current git repository, which may be in a parent directory. -} -gitRepoFromCwd :: IO GitRepo -gitRepoFromCwd = do +repoFromCwd :: IO Repo +repoFromCwd = do cwd <- getCurrentDirectory top <- seekUp cwd isRepoTop case top of - (Just dir) -> return $ gitRepoFromPath dir + (Just dir) -> return $ repoFromPath dir Nothing -> error "Not in a git repository." seekUp :: String -> (String -> IO Bool) -> IO (Maybe String) @@ -241,11 +237,11 @@ seekUp dir want = do d -> seekUp d want isRepoTop dir = do - r <- isGitRepo dir + r <- isRepo dir b <- isBareRepo dir return (r || b) where - isGitRepo dir = gitSignature dir ".git" ".git/config" + isRepo dir = gitSignature dir ".git" ".git/config" isBareRepo dir = gitSignature dir "objects" "config" gitSignature dir subdir file = do s <- (doesDirectoryExist (dir ++ "/" ++ subdir)) diff --git a/LocationLog.hs b/LocationLog.hs index a6d998e0a..7953b345f 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -29,7 +29,7 @@ import qualified Data.Map as Map import System.IO import System.Directory import Data.Char -import GitRepo +import qualified GitRepo as Git import Utility import UUID import AbstractTypes @@ -81,7 +81,7 @@ instance Read LogLine where {- 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 :: Git.Repo -> Key -> UUID -> LogStatus -> IO FilePath logChange repo key uuid status = do log <- logNow status uuid ls <- readLog logfile @@ -127,13 +127,13 @@ logNow status uuid = do return $ LogLine now status uuid {- Returns the filename of the log file for a given key. -} -logFile :: GitRepo -> Key -> String +logFile :: Git.Repo -> Key -> String logFile repo key = - (gitStateDir repo) ++ (gitRelative repo (keyFile key)) ++ ".log" + (gitStateDir repo) ++ (Git.relative repo (keyFile key)) ++ ".log" {- Returns a list of repository UUIDs that, according to the log, have - the value of a key. -} -keyLocations :: GitRepo -> Key -> IO [UUID] +keyLocations :: Git.Repo -> Key -> IO [UUID] keyLocations thisrepo key = do lines <- readLog $ logFile thisrepo key return $ map uuid (filterPresent lines) diff --git a/Locations.hs b/Locations.hs index 68a958192..5d701681c 100644 --- a/Locations.hs +++ b/Locations.hs @@ -12,27 +12,27 @@ module Locations ( import Data.String.Utils import Types -import GitRepo +import qualified GitRepo as Git {- Long-term, cross-repo state is stored in files inside the .git-annex - directory, in the git repository's working tree. -} stateLoc = ".git-annex" -gitStateDir :: GitRepo -> FilePath -gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/" +gitStateDir :: Git.Repo -> FilePath +gitStateDir repo = (Git.workTree repo) ++ "/" ++ stateLoc ++ "/" {- An annexed file's content is stored in - /path/to/repo/.git/annex// - - (That allows deriving the key and backend by looking at the symlink to it.) -} -annexLocation :: GitRepo -> Backend -> Key -> FilePath +annexLocation :: Git.Repo -> Backend -> Key -> FilePath annexLocation r backend key = - (gitWorkTree r) ++ "/" ++ (annexLocationRelative r backend key) + (Git.workTree r) ++ "/" ++ (annexLocationRelative r backend key) {- Annexed file's location relative to the gitWorkTree -} -annexLocationRelative :: GitRepo -> Backend -> Key -> FilePath +annexLocationRelative :: Git.Repo -> Backend -> Key -> FilePath annexLocationRelative r backend key = - gitDir r ++ "/annex/" ++ (name backend) ++ "/" ++ (keyFile key) + Git.dir r ++ "/annex/" ++ (name backend) ++ "/" ++ (keyFile key) {- Converts a key into a filename fragment. - diff --git a/Remotes.hs b/Remotes.hs index 711cd6c83..39404bf19 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -10,18 +10,18 @@ import Control.Monad.State (liftIO) import qualified Data.Map as Map import Data.String.Utils import AbstractTypes -import GitRepo +import qualified GitRepo as Git import LocationLog import Locations import UUID import List {- Human visible list of remotes. -} -remotesList :: [GitRepo] -> String -remotesList remotes = join " " $ map gitRepoDescribe remotes +remotesList :: [Git.Repo] -> String +remotesList remotes = join " " $ map Git.repoDescribe remotes {- Cost ordered list of remotes that the LocationLog indicate may have a key. -} -remotesWithKey :: Key -> Annex [GitRepo] +remotesWithKey :: Key -> Annex [Git.Repo] remotesWithKey key = do g <- gitAnnex uuids <- liftIO $ keyLocations g key @@ -34,13 +34,13 @@ remotesWithKey key = do else return remotes {- Cost Ordered list of remotes. -} -remotesByCost :: Annex [GitRepo] +remotesByCost :: Annex [Git.Repo] remotesByCost = do g <- gitAnnex - reposByCost $ gitRepoRemotes g + reposByCost $ Git.remotes g {- Orders a list of git repos by cost. -} -reposByCost :: [GitRepo] -> Annex [GitRepo] +reposByCost :: [Git.Repo] -> Annex [Git.Repo] reposByCost l = do costpairs <- mapM costpair l return $ fst $ unzip $ sortBy bycost $ costpairs @@ -55,36 +55,36 @@ reposByCost l = do - The default cost is 100 for local repositories, and 200 for remote - repositories; it can also be configured by remote..annex-cost -} -repoCost :: GitRepo -> Annex Int +repoCost :: Git.Repo -> Annex Int repoCost r = do g <- gitAnnex if ((length $ config g r) > 0) then return $ read $ config g r - else if (gitRepoIsLocal r) + else if (Git.repoIsLocal r) then return 100 else return 200 where - config g r = gitConfig g (configkey r) "" - configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-cost" + config g r = Git.configGet g (configkey r) "" + configkey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-cost" {- The git configs for the git repo's remotes is not read on startup - because reading it may be expensive. This function ensures that it is - read for a specified remote, and updates state. It returns the - updated git repo also. -} -remoteEnsureGitConfigRead :: GitRepo -> Annex GitRepo +remoteEnsureGitConfigRead :: Git.Repo -> Annex Git.Repo remoteEnsureGitConfigRead r = do - if (Map.null $ gitConfigMap r) + if (Map.null $ Git.configMap r) then do - r' <- liftIO $ gitConfigRead r + r' <- liftIO $ Git.configRead r g <- gitAnnex - let l = gitRepoRemotes g - let g' = gitRepoRemotesAdd g $ exchange l r' + let l = Git.remotes g + let g' = Git.remotesAdd g $ exchange l r' gitAnnexChange g' return r' else return r where exchange [] new = [] exchange (old:ls) new = - if ((gitRepoRemoteName old) == (gitRepoRemoteName new)) + if ((Git.repoRemoteName old) == (Git.repoRemoteName new)) then new:(exchange ls new) else old:(exchange ls new) diff --git a/Types.hs b/Types.hs index ce377dda1..c9d33affd 100644 --- a/Types.hs +++ b/Types.hs @@ -1,26 +1,14 @@ {- git-annex core data types -} -module Types ( - Annex, - AnnexState, - makeAnnexState, - runAnnexState, - gitAnnex, - gitAnnexChange, - backendsAnnex, - backendsAnnexChange, - - Key(..), - Backend(..) -) where +module Types where import Control.Monad.State import Data.String.Utils -import GitRepo +import qualified GitRepo as Git -- git-annex's runtime state data AnnexState = AnnexState { - repo :: GitRepo, + repo :: Git.Repo, backends :: [Backend] } deriving (Show) @@ -28,18 +16,18 @@ data AnnexState = AnnexState { type Annex = StateT AnnexState IO -- constructor -makeAnnexState :: GitRepo -> AnnexState +makeAnnexState :: Git.Repo -> AnnexState makeAnnexState g = AnnexState { repo = g, backends = [] } -- performs an action in the Annex monad runAnnexState state action = runStateT (action) state -- Annex monad state accessors -gitAnnex :: Annex GitRepo +gitAnnex :: Annex Git.Repo gitAnnex = do state <- get return (repo state) -gitAnnexChange :: GitRepo -> Annex () +gitAnnexChange :: Git.Repo -> Annex () gitAnnexChange r = do state <- get put state { repo = r } diff --git a/UUID.hs b/UUID.hs index f334afdc9..9c8b23a96 100644 --- a/UUID.hs +++ b/UUID.hs @@ -19,7 +19,7 @@ import Maybe import List import System.Cmd.Utils import System.IO -import GitRepo +import qualified GitRepo as Git import AbstractTypes type UUID = String @@ -37,17 +37,17 @@ genUUID = liftIO $ pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h - remote..annex-uuid - - -} -getUUID :: GitRepo -> Annex UUID +getUUID :: Git.Repo -> Annex UUID getUUID r = do if ("" /= configured r) then return $ configured r else cached r where - configured r = gitConfig r "annex.uuid" "" + configured r = Git.configGet r "annex.uuid" "" cached r = do g <- gitAnnex - return $ gitConfig g (configkey r) "" - configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-uuid" + return $ Git.configGet g (configkey r) "" + configkey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid" {- Make sure that the repo has an annex.uuid setting. -} prepUUID :: Annex () @@ -57,15 +57,15 @@ prepUUID = do if ("" == u) then do uuid <- genUUID - liftIO $ gitRun g ["config", configkey, uuid] + liftIO $ Git.run g ["config", configkey, uuid] -- re-read git config and update the repo's state - u' <- liftIO $ gitConfigRead g + u' <- liftIO $ Git.configRead g gitAnnexChange u' return () else return () {- Filters a list of repos to ones that have listed UUIDs. -} -reposByUUID :: [GitRepo] -> [UUID] -> Annex [GitRepo] +reposByUUID :: [Git.Repo] -> [UUID] -> Annex [Git.Repo] reposByUUID repos uuids = do filterM match repos where diff --git a/git-annex.hs b/git-annex.hs index be5168755..2cf1c5305 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -12,7 +12,7 @@ import Annex main = do args <- getArgs (mode, params) <- argvToMode args - state <- startAnnex + state <- start tryRun state mode 0 0 params {- Processes each param in the list by dispatching the handler function -- cgit v1.2.3 From 4c1d8b9689043c18214b1da7d5c145fb0859443d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 02:41:54 -0400 Subject: more namespace cleanup --- Annex.hs | 10 +++++----- BackendFile.hs | 8 ++++---- Remotes.hs | 18 +++++++++--------- 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/Annex.hs b/Annex.hs index 54f9b9dff..c26baabef 100644 --- a/Annex.hs +++ b/Annex.hs @@ -20,7 +20,7 @@ import List import qualified GitRepo as Git import Utility import Locations -import Backend +import qualified Backend import BackendList import UUID import LocationLog @@ -46,7 +46,7 @@ start = do prepUUID inBackend file yes no = do - r <- liftIO $ lookupFile file + r <- liftIO $ Backend.lookupFile file case (r) of Just v -> yes v Nothing -> no @@ -57,7 +57,7 @@ notinBackend file yes no = inBackend file no yes annexCmd :: FilePath -> Annex () annexCmd file = inBackend file err $ do liftIO $ checkLegal file - stored <- storeFile file + stored <- Backend.storeFile file g <- gitAnnex case (stored) of Nothing -> error $ "no backend could store: " ++ file @@ -93,7 +93,7 @@ annexCmd file = inBackend file err $ do {- Inverse of annexCmd. -} unannexCmd :: FilePath -> Annex () unannexCmd file = notinBackend file err $ \(key, backend) -> do - dropFile backend key + Backend.dropFile backend key logStatus key ValueMissing g <- gitAnnex let src = annexLocation g backend key @@ -121,7 +121,7 @@ getCmd file = notinBackend file err $ \(key, backend) -> do g <- gitAnnex let dest = annexLocation g backend key liftIO $ createDirectoryIfMissing True (parentDir dest) - success <- retrieveFile backend key dest + success <- Backend.retrieveFile backend key dest if (success) then do logStatus key ValuePresent diff --git a/BackendFile.hs b/BackendFile.hs index 6c1dc0623..a0396f51d 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -10,7 +10,7 @@ import Control.Exception import Types import LocationLog import Locations -import Remotes +import qualified Remotes import qualified GitRepo as Git backend = Backend { @@ -39,17 +39,17 @@ dummyRemove url = return False - and copy it over to this one. -} copyKeyFile :: Key -> FilePath -> Annex (Bool) copyKeyFile key file = do - remotes <- remotesWithKey key + remotes <- Remotes.withKey key trycopy remotes remotes where trycopy full [] = error $ "unable to get: " ++ (keyFile key) ++ "\n" ++ "To get that file, need access to one of these remotes: " ++ - (remotesList full) + (Remotes.list full) trycopy full (r:rs) = do -- annexLocation needs the git config to have been -- read for a remote, so do that now, -- if it hasn't been already - r' <- remoteEnsureGitConfigRead r + r' <- Remotes.ensureGitConfigRead r result <- liftIO $ (try (copyFromRemote r' key file)::IO (Either SomeException ())) case (result) of Left err -> do diff --git a/Remotes.hs b/Remotes.hs index 39404bf19..918ae2290 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -1,9 +1,9 @@ {- git-annex remote repositories -} module Remotes ( - remotesList, - remotesWithKey, - remoteEnsureGitConfigRead + list, + withKey, + ensureGitConfigRead ) where import Control.Monad.State (liftIO) @@ -17,12 +17,12 @@ import UUID import List {- Human visible list of remotes. -} -remotesList :: [Git.Repo] -> String -remotesList remotes = join " " $ map Git.repoDescribe remotes +list :: [Git.Repo] -> String +list remotes = join " " $ map Git.repoDescribe remotes {- Cost ordered list of remotes that the LocationLog indicate may have a key. -} -remotesWithKey :: Key -> Annex [Git.Repo] -remotesWithKey key = do +withKey :: Key -> Annex [Git.Repo] +withKey key = do g <- gitAnnex uuids <- liftIO $ keyLocations g key allremotes <- remotesByCost @@ -71,8 +71,8 @@ repoCost r = do - because reading it may be expensive. This function ensures that it is - read for a specified remote, and updates state. It returns the - updated git repo also. -} -remoteEnsureGitConfigRead :: Git.Repo -> Annex Git.Repo -remoteEnsureGitConfigRead r = do +ensureGitConfigRead :: Git.Repo -> Annex Git.Repo +ensureGitConfigRead r = do if (Map.null $ Git.configMap r) then do r' <- liftIO $ Git.configRead r -- cgit v1.2.3 From 0b55bd05de7b83a474ea58e9d45676934667f4bd Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 02:52:17 -0400 Subject: more namespace cleanup --- AbstractTypes.hs | 32 +++++++++++++++++++++++++- Backend.hs | 3 ++- BackendChecksum.hs | 2 +- BackendFile.hs | 2 +- BackendList.hs | 2 +- BackendTypes.hs | 44 +++++++++++++++++++++++++++++++++++ BackendUrl.hs | 2 +- Locations.hs | 8 ++++--- Types.hs | 67 ------------------------------------------------------ 9 files changed, 86 insertions(+), 76 deletions(-) create mode 100644 BackendTypes.hs delete mode 100644 Types.hs diff --git a/AbstractTypes.hs b/AbstractTypes.hs index 510a37f0c..935d1de2f 100644 --- a/AbstractTypes.hs +++ b/AbstractTypes.hs @@ -14,4 +14,34 @@ module AbstractTypes ( Backend ) where -import Types +import Control.Monad.State +import qualified GitRepo as Git +import BackendTypes + +-- constructor +makeAnnexState :: Git.Repo -> AnnexState +makeAnnexState g = AnnexState { repo = g, backends = [] } + +-- performs an action in the Annex monad +runAnnexState state action = runStateT (action) state + +-- Annex monad state accessors +gitAnnex :: Annex Git.Repo +gitAnnex = do + state <- get + return (repo state) +gitAnnexChange :: Git.Repo -> Annex () +gitAnnexChange r = do + state <- get + put state { repo = r } + return () +backendsAnnex :: Annex [Backend] +backendsAnnex = do + state <- get + return (backends state) +backendsAnnexChange :: [Backend] -> Annex () +backendsAnnexChange b = do + state <- get + put state { backends = b } + return () + diff --git a/Backend.hs b/Backend.hs index 1bd4efc1e..251e436c7 100644 --- a/Backend.hs +++ b/Backend.hs @@ -30,7 +30,8 @@ import BackendList import Locations import qualified GitRepo as Git import Utility -import Types +import AbstractTypes +import BackendTypes {- Attempts to store a file in one of the backends. -} storeFile :: FilePath -> Annex (Maybe (Key, Backend)) diff --git a/BackendChecksum.hs b/BackendChecksum.hs index c6e68ffed..50ef2ae6f 100644 --- a/BackendChecksum.hs +++ b/BackendChecksum.hs @@ -5,7 +5,7 @@ module BackendChecksum (backend) where import qualified BackendFile import Data.Digest.Pure.SHA -import Types +import BackendTypes -- based on BackendFile just with a different key type backend = BackendFile.backend { diff --git a/BackendFile.hs b/BackendFile.hs index a0396f51d..284daca88 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -7,7 +7,7 @@ import Control.Monad.State import System.IO import System.Cmd import Control.Exception -import Types +import BackendTypes import LocationLog import Locations import qualified Remotes diff --git a/BackendList.hs b/BackendList.hs index 104444dc2..91a2fa7fc 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -7,7 +7,7 @@ module BackendList ( lookupBackendName ) where -import Types +import BackendTypes -- When adding a new backend, import it here and add it to the list. import qualified BackendFile diff --git a/BackendTypes.hs b/BackendTypes.hs new file mode 100644 index 000000000..2ef65f469 --- /dev/null +++ b/BackendTypes.hs @@ -0,0 +1,44 @@ +{- git-annex backend data types + - + - Mostly only backend implementations should need to import this. + -} + +module BackendTypes where + +import Control.Monad.State +import Data.String.Utils +import qualified GitRepo as Git + +-- git-annex's runtime state type doesn't really belong here, +-- but it uses Backend, so has to be here to avoid a depends loop. +data AnnexState = AnnexState { + repo :: Git.Repo, + backends :: [Backend] +} deriving (Show) + +-- git-annex's monad +type Annex = StateT AnnexState IO + +-- annexed filenames are mapped into keys +data Key = Key String deriving (Eq) + +-- show a key to convert it to a string +instance Show Key where + show (Key v) = v + +-- this structure represents a key/value backend +data Backend = Backend { + -- name of this backend + name :: String, + -- converts a filename to a key + getKey :: FilePath -> Annex (Maybe Key), + -- stores a file's contents to a key + storeFileKey :: FilePath -> Key -> Annex Bool, + -- retrieves a key's contents to a file + retrieveKeyFile :: Key -> FilePath -> Annex Bool, + -- removes a key + removeKey :: Key -> Annex Bool +} + +instance Show Backend where + show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" diff --git a/BackendUrl.hs b/BackendUrl.hs index 43b0bc75a..fc0a8ae58 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -6,7 +6,7 @@ module BackendUrl (backend) where import Control.Monad.State import System.Cmd import IO -import Types +import BackendTypes backend = Backend { name = "url", diff --git a/Locations.hs b/Locations.hs index 5d701681c..8c1915b02 100644 --- a/Locations.hs +++ b/Locations.hs @@ -11,7 +11,8 @@ module Locations ( ) where import Data.String.Utils -import Types +import AbstractTypes +import qualified BackendTypes as Backend import qualified GitRepo as Git {- Long-term, cross-repo state is stored in files inside the .git-annex @@ -32,7 +33,7 @@ annexLocation r backend key = {- Annexed file's location relative to the gitWorkTree -} annexLocationRelative :: Git.Repo -> Backend -> Key -> FilePath annexLocationRelative r backend key = - Git.dir r ++ "/annex/" ++ (name backend) ++ "/" ++ (keyFile key) + Git.dir r ++ "/annex/" ++ (Backend.name backend) ++ "/" ++ (keyFile key) {- Converts a key into a filename fragment. - @@ -50,4 +51,5 @@ 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 = Key $ replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file +fileKey file = Backend.Key $ + replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file diff --git a/Types.hs b/Types.hs deleted file mode 100644 index c9d33affd..000000000 --- a/Types.hs +++ /dev/null @@ -1,67 +0,0 @@ -{- git-annex core data types -} - -module Types where - -import Control.Monad.State -import Data.String.Utils -import qualified GitRepo as Git - --- git-annex's runtime state -data AnnexState = AnnexState { - repo :: Git.Repo, - backends :: [Backend] -} deriving (Show) - --- git-annex's monad -type Annex = StateT AnnexState IO - --- constructor -makeAnnexState :: Git.Repo -> AnnexState -makeAnnexState g = AnnexState { repo = g, backends = [] } - --- performs an action in the Annex monad -runAnnexState state action = runStateT (action) state - --- Annex monad state accessors -gitAnnex :: Annex Git.Repo -gitAnnex = do - state <- get - return (repo state) -gitAnnexChange :: Git.Repo -> Annex () -gitAnnexChange r = do - state <- get - put state { repo = r } - return () -backendsAnnex :: Annex [Backend] -backendsAnnex = do - state <- get - return (backends state) -backendsAnnexChange :: [Backend] -> Annex () -backendsAnnexChange b = do - state <- get - put state { backends = b } - return () - --- annexed filenames are mapped into keys -data Key = Key String deriving (Eq) - --- show a key to convert it to a string -instance Show Key where - show (Key v) = v - --- this structure represents a key/value backend -data Backend = Backend { - -- name of this backend - name :: String, - -- converts a filename to a key - getKey :: FilePath -> Annex (Maybe Key), - -- stores a file's contents to a key - storeFileKey :: FilePath -> Key -> Annex Bool, - -- retrieves a key's contents to a file - retrieveKeyFile :: Key -> FilePath -> Annex Bool, - -- removes a key - removeKey :: Key -> Annex Bool -} - -instance Show Backend where - show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" -- cgit v1.2.3 From 6f3572e47f57bbe5cc76b58c8bcdc9c6c455dce0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 03:18:11 -0400 Subject: more reorg, spiffed up state monad --- AbstractTypes.hs | 47 ------------ Annex.hs | 221 ++++++++++--------------------------------------------- Backend.hs | 7 +- CmdLine.hs | 4 +- Commands.hs | 189 +++++++++++++++++++++++++++++++++++++++++++++++ LocationLog.hs | 2 +- Locations.hs | 2 +- Remotes.hs | 13 ++-- Types.hs | 10 +++ UUID.hs | 11 +-- git-annex.hs | 8 +- 11 files changed, 262 insertions(+), 252 deletions(-) delete mode 100644 AbstractTypes.hs create mode 100644 Commands.hs create mode 100644 Types.hs diff --git a/AbstractTypes.hs b/AbstractTypes.hs deleted file mode 100644 index 935d1de2f..000000000 --- a/AbstractTypes.hs +++ /dev/null @@ -1,47 +0,0 @@ -{- git-annex data types, abstract only -} - -module AbstractTypes ( - Annex, - AnnexState, - makeAnnexState, - runAnnexState, - gitAnnex, - gitAnnexChange, - backendsAnnex, - backendsAnnexChange, - - Key, - Backend -) where - -import Control.Monad.State -import qualified GitRepo as Git -import BackendTypes - --- constructor -makeAnnexState :: Git.Repo -> AnnexState -makeAnnexState g = AnnexState { repo = g, backends = [] } - --- performs an action in the Annex monad -runAnnexState state action = runStateT (action) state - --- Annex monad state accessors -gitAnnex :: Annex Git.Repo -gitAnnex = do - state <- get - return (repo state) -gitAnnexChange :: Git.Repo -> Annex () -gitAnnexChange r = do - state <- get - put state { repo = r } - return () -backendsAnnex :: Annex [Backend] -backendsAnnex = do - state <- get - return (backends state) -backendsAnnexChange :: [Backend] -> Annex () -backendsAnnexChange b = do - state <- get - put state { backends = b } - return () - diff --git a/Annex.hs b/Annex.hs index c26baabef..fcd19ba03 100644 --- a/Annex.hs +++ b/Annex.hs @@ -1,189 +1,42 @@ -{- git-annex toplevel code - -} +{- git-annex monad -} module Annex ( - start, - annexCmd, - unannexCmd, - getCmd, - wantCmd, - dropCmd, - pushCmd, - pullCmd + new, + run, + gitRepo, + gitRepoChange, + backends, + backendsChange, ) where -import Control.Monad.State (liftIO) -import System.Posix.Files -import System.Directory -import Data.String.Utils -import List +import Control.Monad.State import qualified GitRepo as Git -import Utility -import Locations -import qualified Backend -import BackendList -import UUID -import LocationLog -import AbstractTypes - -{- Create and returns an Annex state object. - - Examines and prepares the git repo. - -} -start :: IO AnnexState -start = do - g <- Git.repoFromCwd - let s = makeAnnexState g - (_,s') <- runAnnexState s (prep g) - return s' - where - prep g = do - -- setup git and read its config; update state - g' <- liftIO $ Git.configRead g - gitAnnexChange g' - liftIO $ gitSetup g' - backendsAnnexChange $ parseBackendList $ - Git.configGet g' "annex.backends" "" - prepUUID - -inBackend file yes no = do - r <- liftIO $ Backend.lookupFile file - case (r) of - Just v -> yes v - Nothing -> no -notinBackend file yes no = inBackend file no yes - -{- Annexes a file, storing it in a backend, and then moving it into - - the annex directory and setting up the symlink pointing to its content. -} -annexCmd :: FilePath -> Annex () -annexCmd file = inBackend file err $ do - liftIO $ checkLegal file - stored <- Backend.storeFile file - g <- gitAnnex - case (stored) of - Nothing -> error $ "no backend could store: " ++ file - Just (key, backend) -> do - logStatus key ValuePresent - liftIO $ setup g key backend - where - err = error $ "already annexed " ++ file - checkLegal file = do - s <- getSymbolicLinkStatus file - if ((isSymbolicLink s) || (not $ isRegularFile s)) - then error $ "not a regular file: " ++ file - else return () - setup g key backend = do - let dest = annexLocation g backend key - let reldest = annexLocationRelative g backend key - createDirectoryIfMissing True (parentDir dest) - renameFile file dest - createSymbolicLink ((linkTarget file) ++ reldest) file - Git.run g ["add", file] - Git.run g ["commit", "-m", - ("git-annex annexed " ++ file), file] - linkTarget file = - -- relies on file being relative to the top of the - -- git repo; just replace each subdirectory with ".." - if (subdirs > 0) - then (join "/" $ take subdirs $ repeat "..") ++ "/" - else "" - where - subdirs = (length $ split "/" file) - 1 - - -{- Inverse of annexCmd. -} -unannexCmd :: FilePath -> Annex () -unannexCmd file = notinBackend file err $ \(key, backend) -> do - Backend.dropFile backend key - logStatus key ValueMissing - g <- gitAnnex - let src = annexLocation g backend key - liftIO $ moveout g src - where - err = error $ "not annexed " ++ file - moveout g src = do - removeFile file - Git.run g ["rm", file] - Git.run g ["commit", "-m", - ("git-annex unannexed " ++ file), file] - -- git rm deletes empty directories; - -- put them back - createDirectoryIfMissing True (parentDir file) - renameFile src file - return () - -{- Gets an annexed file from one of the backends. -} -getCmd :: FilePath -> Annex () -getCmd file = notinBackend file err $ \(key, backend) -> do - inannex <- inAnnex backend key - if (inannex) - then return () - else do - g <- gitAnnex - let dest = annexLocation g backend key - liftIO $ createDirectoryIfMissing True (parentDir dest) - success <- Backend.retrieveFile backend key dest - if (success) - then do - logStatus key ValuePresent - return () - else error $ "failed to get " ++ file - where - err = error $ "not annexed " ++ file - -{- Indicates a file is wanted. -} -wantCmd :: FilePath -> Annex () -wantCmd file = do error "not implemented" -- TODO - -{- Indicates a file is not wanted. -} -dropCmd :: FilePath -> Annex () -dropCmd file = do error "not implemented" -- TODO - -{- Pushes all files to a remote repository. -} -pushCmd :: String -> Annex () -pushCmd reponame = do error "not implemented" -- TODO - -{- Pulls all files from a remote repository. -} -pullCmd :: String -> Annex () -pullCmd reponame = do error "not implemented" -- TODO - -{- Sets up a git repo for git-annex. May be called repeatedly. -} -gitSetup :: Git.Repo -> IO () -gitSetup repo = do - -- configure git to use union merge driver on state files - exists <- doesFileExist attributes - if (not exists) - then do - writeFile attributes $ attrLine ++ "\n" - commit - else do - content <- readFile attributes - if (all (/= attrLine) (lines content)) - then do - appendFile attributes $ attrLine ++ "\n" - commit - else return () - where - attrLine = stateLoc ++ "/*.log merge=union" - attributes = Git.attributes repo - commit = do - Git.run repo ["add", attributes] - Git.run repo ["commit", "-m", "git-annex setup", - attributes] - -{- Updates the LocationLog when a key's presence changes. -} -logStatus :: Key -> LogStatus -> Annex () -logStatus key status = do - g <- gitAnnex - u <- getUUID g - f <- liftIO $ logChange g key u status - liftIO $ commit g f - where - commit g f = do - Git.run g ["add", f] - Git.run g ["commit", "-m", "git-annex log update", f] - -{- Checks if a given key is currently present in the annexLocation -} -inAnnex :: Backend -> Key -> Annex Bool -inAnnex backend key = do - g <- gitAnnex - liftIO $ doesFileExist $ annexLocation g backend key +import Types +import qualified BackendTypes as Backend + +-- constructor +new :: Git.Repo -> AnnexState +new g = Backend.AnnexState { Backend.repo = g, Backend.backends = [] } + +-- performs an action in the Annex monad +run state action = runStateT (action) state + +-- Annex monad state accessors +gitRepo :: Annex Git.Repo +gitRepo = do + state <- get + return (Backend.repo state) +gitRepoChange :: Git.Repo -> Annex () +gitRepoChange r = do + state <- get + put state { Backend.repo = r } + return () +backends :: Annex [Backend] +backends = do + state <- get + return (Backend.backends state) +backendsChange :: [Backend] -> Annex () +backendsChange b = do + state <- get + put state { Backend.backends = b } + return () diff --git a/Backend.hs b/Backend.hs index 251e436c7..2829fef9d 100644 --- a/Backend.hs +++ b/Backend.hs @@ -29,16 +29,17 @@ import System.Posix.Files import BackendList import Locations import qualified GitRepo as Git +import qualified Annex import Utility -import AbstractTypes +import Types import BackendTypes {- Attempts to store a file in one of the backends. -} storeFile :: FilePath -> Annex (Maybe (Key, Backend)) storeFile file = do - g <- gitAnnex + g <- Annex.gitRepo let relfile = Git.relative g file - b <- backendsAnnex + b <- Annex.backends storeFile' b file relfile storeFile' [] _ _ = return Nothing storeFile' (b:bs) file relfile = do diff --git a/CmdLine.hs b/CmdLine.hs index 479be7e8b..9737e0eb0 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -11,8 +11,8 @@ module CmdLine ( ) where import System.Console.GetOpt -import AbstractTypes -import Annex +import Types +import Commands data Mode = Add | Push | Pull | Want | Get | Drop | Unannex deriving Show diff --git a/Commands.hs b/Commands.hs new file mode 100644 index 000000000..98e65b126 --- /dev/null +++ b/Commands.hs @@ -0,0 +1,189 @@ +{- git-annex subcommands -} + +module Commands ( + start, + annexCmd, + unannexCmd, + getCmd, + wantCmd, + dropCmd, + pushCmd, + pullCmd +) where + +import Control.Monad.State (liftIO) +import System.Posix.Files +import System.Directory +import Data.String.Utils +import List +import qualified GitRepo as Git +import qualified Annex +import Utility +import Locations +import qualified Backend +import BackendList +import UUID +import LocationLog +import Types + +{- Create and returns an Annex state object. + - Examines and prepares the git repo. + -} +start :: IO AnnexState +start = do + g <- Git.repoFromCwd + let s = Annex.new g + (_,s') <- Annex.run s (prep g) + return s' + where + prep g = do + -- setup git and read its config; update state + g' <- liftIO $ Git.configRead g + Annex.gitRepoChange g' + liftIO $ gitSetup g' + Annex.backendsChange $ parseBackendList $ + Git.configGet g' "annex.backends" "" + prepUUID + +inBackend file yes no = do + r <- liftIO $ Backend.lookupFile file + case (r) of + Just v -> yes v + Nothing -> no +notinBackend file yes no = inBackend file no yes + +{- Annexes a file, storing it in a backend, and then moving it into + - the annex directory and setting up the symlink pointing to its content. -} +annexCmd :: FilePath -> Annex () +annexCmd file = inBackend file err $ do + liftIO $ checkLegal file + stored <- Backend.storeFile file + g <- Annex.gitRepo + case (stored) of + Nothing -> error $ "no backend could store: " ++ file + Just (key, backend) -> do + logStatus key ValuePresent + liftIO $ setup g key backend + where + err = error $ "already annexed " ++ file + checkLegal file = do + s <- getSymbolicLinkStatus file + if ((isSymbolicLink s) || (not $ isRegularFile s)) + then error $ "not a regular file: " ++ file + else return () + setup g key backend = do + let dest = annexLocation g backend key + let reldest = annexLocationRelative g backend key + createDirectoryIfMissing True (parentDir dest) + renameFile file dest + createSymbolicLink ((linkTarget file) ++ reldest) file + Git.run g ["add", file] + Git.run g ["commit", "-m", + ("git-annex annexed " ++ file), file] + linkTarget file = + -- relies on file being relative to the top of the + -- git repo; just replace each subdirectory with ".." + if (subdirs > 0) + then (join "/" $ take subdirs $ repeat "..") ++ "/" + else "" + where + subdirs = (length $ split "/" file) - 1 + + +{- Inverse of annexCmd. -} +unannexCmd :: FilePath -> Annex () +unannexCmd file = notinBackend file err $ \(key, backend) -> do + Backend.dropFile backend key + logStatus key ValueMissing + g <- Annex.gitRepo + let src = annexLocation g backend key + liftIO $ moveout g src + where + err = error $ "not annexed " ++ file + moveout g src = do + removeFile file + Git.run g ["rm", file] + Git.run g ["commit", "-m", + ("git-annex unannexed " ++ file), file] + -- git rm deletes empty directories; + -- put them back + createDirectoryIfMissing True (parentDir file) + renameFile src file + return () + +{- Gets an annexed file from one of the backends. -} +getCmd :: FilePath -> Annex () +getCmd file = notinBackend file err $ \(key, backend) -> do + inannex <- inAnnex backend key + if (inannex) + then return () + else do + g <- Annex.gitRepo + let dest = annexLocation g backend key + liftIO $ createDirectoryIfMissing True (parentDir dest) + success <- Backend.retrieveFile backend key dest + if (success) + then do + logStatus key ValuePresent + return () + else error $ "failed to get " ++ file + where + err = error $ "not annexed " ++ file + +{- Indicates a file is wanted. -} +wantCmd :: FilePath -> Annex () +wantCmd file = do error "not implemented" -- TODO + +{- Indicates a file is not wanted. -} +dropCmd :: FilePath -> Annex () +dropCmd file = do error "not implemented" -- TODO + +{- Pushes all files to a remote repository. -} +pushCmd :: String -> Annex () +pushCmd reponame = do error "not implemented" -- TODO + +{- Pulls all files from a remote repository. -} +pullCmd :: String -> Annex () +pullCmd reponame = do error "not implemented" -- TODO + +{- Sets up a git repo for git-annex. May be called repeatedly. -} +gitSetup :: Git.Repo -> IO () +gitSetup repo = do + -- configure git to use union merge driver on state files + exists <- doesFileExist attributes + if (not exists) + then do + writeFile attributes $ attrLine ++ "\n" + commit + else do + content <- readFile attributes + if (all (/= attrLine) (lines content)) + then do + appendFile attributes $ attrLine ++ "\n" + commit + else return () + where + attrLine = stateLoc ++ "/*.log merge=union" + attributes = Git.attributes repo + commit = do + Git.run repo ["add", attributes] + Git.run repo ["commit", "-m", "git-annex setup", + attributes] + +{- Updates the LocationLog when a key's presence changes. -} +logStatus :: Key -> LogStatus -> Annex () +logStatus key status = do + g <- Annex.gitRepo + u <- getUUID g + f <- liftIO $ logChange g key u status + liftIO $ commit g f + where + commit g f = do + Git.run g ["add", f] + Git.run g ["commit", "-m", "git-annex log update", f] + +{- Checks if a given key is currently present in the annexLocation -} +inAnnex :: Backend -> Key -> Annex Bool +inAnnex backend key = do + g <- Annex.gitRepo + liftIO $ doesFileExist $ annexLocation g backend key diff --git a/LocationLog.hs b/LocationLog.hs index 7953b345f..ba9178704 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -32,7 +32,7 @@ import Data.Char import qualified GitRepo as Git import Utility import UUID -import AbstractTypes +import Types import Locations data LogLine = LogLine { diff --git a/Locations.hs b/Locations.hs index 8c1915b02..7b8beb14f 100644 --- a/Locations.hs +++ b/Locations.hs @@ -11,7 +11,7 @@ module Locations ( ) where import Data.String.Utils -import AbstractTypes +import Types import qualified BackendTypes as Backend import qualified GitRepo as Git diff --git a/Remotes.hs b/Remotes.hs index 918ae2290..1802ff28e 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -9,8 +9,9 @@ module Remotes ( import Control.Monad.State (liftIO) import qualified Data.Map as Map import Data.String.Utils -import AbstractTypes +import Types import qualified GitRepo as Git +import qualified Annex import LocationLog import Locations import UUID @@ -23,7 +24,7 @@ list remotes = join " " $ map Git.repoDescribe remotes {- Cost ordered list of remotes that the LocationLog indicate may have a key. -} withKey :: Key -> Annex [Git.Repo] withKey key = do - g <- gitAnnex + g <- Annex.gitRepo uuids <- liftIO $ keyLocations g key allremotes <- remotesByCost remotes <- reposByUUID allremotes uuids @@ -36,7 +37,7 @@ withKey key = do {- Cost Ordered list of remotes. -} remotesByCost :: Annex [Git.Repo] remotesByCost = do - g <- gitAnnex + g <- Annex.gitRepo reposByCost $ Git.remotes g {- Orders a list of git repos by cost. -} @@ -57,7 +58,7 @@ reposByCost l = do -} repoCost :: Git.Repo -> Annex Int repoCost r = do - g <- gitAnnex + g <- Annex.gitRepo if ((length $ config g r) > 0) then return $ read $ config g r else if (Git.repoIsLocal r) @@ -76,10 +77,10 @@ ensureGitConfigRead r = do if (Map.null $ Git.configMap r) then do r' <- liftIO $ Git.configRead r - g <- gitAnnex + g <- Annex.gitRepo let l = Git.remotes g let g' = Git.remotesAdd g $ exchange l r' - gitAnnexChange g' + Annex.gitRepoChange g' return r' else return r where diff --git a/Types.hs b/Types.hs new file mode 100644 index 000000000..4262ed567 --- /dev/null +++ b/Types.hs @@ -0,0 +1,10 @@ +{- git-annex abstract data types -} + +module Types ( + Annex, + AnnexState, + Key, + Backend +) where + +import BackendTypes diff --git a/UUID.hs b/UUID.hs index 9c8b23a96..1c31a343f 100644 --- a/UUID.hs +++ b/UUID.hs @@ -20,7 +20,8 @@ import List import System.Cmd.Utils import System.IO import qualified GitRepo as Git -import AbstractTypes +import Types +import qualified Annex type UUID = String @@ -45,22 +46,22 @@ getUUID r = do where configured r = Git.configGet r "annex.uuid" "" cached r = do - g <- gitAnnex + g <- Annex.gitRepo return $ Git.configGet g (configkey r) "" configkey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid" {- Make sure that the repo has an annex.uuid setting. -} prepUUID :: Annex () prepUUID = do - g <- gitAnnex + g <- Annex.gitRepo u <- getUUID g if ("" == u) then do uuid <- genUUID liftIO $ Git.run g ["config", configkey, uuid] -- re-read git config and update the repo's state - u' <- liftIO $ Git.configRead g - gitAnnexChange u' + g' <- liftIO $ Git.configRead g + Annex.gitRepoChange g' return () else return () diff --git a/git-annex.hs b/git-annex.hs index 2cf1c5305..ce3b2ac42 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -6,8 +6,9 @@ import System.IO import System.Environment import Control.Exception import CmdLine -import AbstractTypes -import Annex +import Types +import Commands +import qualified Annex main = do args <- getArgs @@ -30,7 +31,8 @@ tryRun state mode errnum oknum [] = do then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok" else return () tryRun state mode errnum oknum (f:fs) = do - result <- try (runAnnexState state (dispatch mode f))::IO (Either SomeException ((), AnnexState)) + result <- try + (Annex.run state (dispatch mode f))::IO (Either SomeException ((), AnnexState)) case (result) of Left err -> do showErr err -- cgit v1.2.3 From f407f23a54d9152a382ee8e48629f40e1a72a26f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 03:40:26 -0400 Subject: more refactor --- Commands.hs | 58 +++++----------------------------------- Core.hs | 87 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ git-annex.hs | 41 +++------------------------- 3 files changed, 98 insertions(+), 88 deletions(-) create mode 100644 Core.hs diff --git a/Commands.hs b/Commands.hs index 98e65b126..be61c7c64 100644 --- a/Commands.hs +++ b/Commands.hs @@ -1,7 +1,6 @@ {- git-annex subcommands -} module Commands ( - start, annexCmd, unannexCmd, getCmd, @@ -26,32 +25,6 @@ import UUID import LocationLog import Types -{- Create and returns an Annex state object. - - Examines and prepares the git repo. - -} -start :: IO AnnexState -start = do - g <- Git.repoFromCwd - let s = Annex.new g - (_,s') <- Annex.run s (prep g) - return s' - where - prep g = do - -- setup git and read its config; update state - g' <- liftIO $ Git.configRead g - Annex.gitRepoChange g' - liftIO $ gitSetup g' - Annex.backendsChange $ parseBackendList $ - Git.configGet g' "annex.backends" "" - prepUUID - -inBackend file yes no = do - r <- liftIO $ Backend.lookupFile file - case (r) of - Just v -> yes v - Nothing -> no -notinBackend file yes no = inBackend file no yes - {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} annexCmd :: FilePath -> Annex () @@ -146,30 +119,6 @@ pushCmd reponame = do error "not implemented" -- TODO pullCmd :: String -> Annex () pullCmd reponame = do error "not implemented" -- TODO -{- Sets up a git repo for git-annex. May be called repeatedly. -} -gitSetup :: Git.Repo -> IO () -gitSetup repo = do - -- configure git to use union merge driver on state files - exists <- doesFileExist attributes - if (not exists) - then do - writeFile attributes $ attrLine ++ "\n" - commit - else do - content <- readFile attributes - if (all (/= attrLine) (lines content)) - then do - appendFile attributes $ attrLine ++ "\n" - commit - else return () - where - attrLine = stateLoc ++ "/*.log merge=union" - attributes = Git.attributes repo - commit = do - Git.run repo ["add", attributes] - Git.run repo ["commit", "-m", "git-annex setup", - attributes] - {- Updates the LocationLog when a key's presence changes. -} logStatus :: Key -> LogStatus -> Annex () logStatus key status = do @@ -182,6 +131,13 @@ logStatus key status = do Git.run g ["add", f] Git.run g ["commit", "-m", "git-annex log update", f] +inBackend file yes no = do + r <- liftIO $ Backend.lookupFile file + case (r) of + Just v -> yes v + Nothing -> no +notinBackend file yes no = inBackend file no yes + {- Checks if a given key is currently present in the annexLocation -} inAnnex :: Backend -> Key -> Annex Bool inAnnex backend key = do diff --git a/Core.hs b/Core.hs new file mode 100644 index 000000000..e3d2c6403 --- /dev/null +++ b/Core.hs @@ -0,0 +1,87 @@ +{- git-annex core functions -} + +module Core where + +import System.IO +import System.Directory +import Control.Monad.State (liftIO) +import Control.Exception +import CmdLine +import Types +import BackendList +import Locations +import UUID +import qualified GitRepo as Git +import qualified Annex + +{- Create and returns an Annex state object. + - Examines and prepares the git repo. + -} +start :: IO AnnexState +start = do + g <- Git.repoFromCwd + let s = Annex.new g + (_,s') <- Annex.run s (prep g) + return s' + where + prep g = do + -- setup git and read its config; update state + g' <- liftIO $ Git.configRead g + Annex.gitRepoChange g' + liftIO $ gitSetup g' + Annex.backendsChange $ parseBackendList $ + Git.configGet g' "annex.backends" "" + prepUUID + +{- Processes each param in the list by dispatching the handler function + - for the user-selection operation mode. Catches exceptions, not stopping + - if some error out, and propigates an overall error status at the end. + - + - This runs in the IO monad, not in the Annex monad. It seems that + - exceptions can only be caught in the IO monad, not in a stacked monad; + - or more likely I missed an easy way to do it. So, I have to laboriously + - thread AnnexState through this function. + -} +tryRun :: AnnexState -> Mode -> [String] -> IO () +tryRun state mode params = tryRun' state mode 0 0 params +tryRun' state mode errnum oknum [] = do + if (errnum > 0) + then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok" + else return () +tryRun' state mode errnum oknum (f:fs) = do + result <- try + (Annex.run state (dispatch mode f))::IO (Either SomeException ((), AnnexState)) + case (result) of + Left err -> do + showErr err + tryRun' state mode (errnum + 1) oknum fs + Right (_,state') -> tryRun' state' mode errnum (oknum + 1) fs + +{- Exception pretty-printing. -} +showErr e = do + hPutStrLn stderr $ "git-annex: " ++ (show e) + return () + +{- Sets up a git repo for git-annex. May be called repeatedly. -} +gitSetup :: Git.Repo -> IO () +gitSetup repo = do + -- configure git to use union merge driver on state files + exists <- doesFileExist attributes + if (not exists) + then do + writeFile attributes $ attrLine ++ "\n" + commit + else do + content <- readFile attributes + if (all (/= attrLine) (lines content)) + then do + appendFile attributes $ attrLine ++ "\n" + commit + else return () + where + attrLine = stateLoc ++ "/*.log merge=union" + attributes = Git.attributes repo + commit = do + Git.run repo ["add", attributes] + Git.run repo ["commit", "-m", "git-annex setup", + attributes] diff --git a/git-annex.hs b/git-annex.hs index ce3b2ac42..b326b2b19 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -1,45 +1,12 @@ -{- git-annex main program - - -} +{- git-annex main program -} -import Control.Monad.State -import System.IO import System.Environment -import Control.Exception -import CmdLine -import Types -import Commands import qualified Annex +import Core +import CmdLine main = do args <- getArgs (mode, params) <- argvToMode args state <- start - tryRun state mode 0 0 params - -{- Processes each param in the list by dispatching the handler function - - for the user-selection operation mode. Catches exceptions, not stopping - - if some error out, and propigates an overall error status at the end. - - - - This runs in the IO monad, not in the Annex monad. It seems that - - exceptions can only be caught in the IO monad, not in a stacked monad; - - or more likely I missed an easy way to do it. So, I have to laboriously - - thread AnnexState through this function. - -} -tryRun :: AnnexState -> Mode -> Int -> Int -> [String] -> IO () -tryRun state mode errnum oknum [] = do - if (errnum > 0) - then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok" - else return () -tryRun state mode errnum oknum (f:fs) = do - result <- try - (Annex.run state (dispatch mode f))::IO (Either SomeException ((), AnnexState)) - case (result) of - Left err -> do - showErr err - tryRun state mode (errnum + 1) oknum fs - Right (_,state') -> tryRun state' mode errnum (oknum + 1) fs - -{- Exception pretty-printing. -} -showErr e = do - hPutStrLn stderr $ "git-annex: " ++ (show e) - return () + tryRun state mode params -- cgit v1.2.3 From 50630840ee6802fef9db136505975db40a81920a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 03:46:34 -0400 Subject: build in subdir --- .gitignore | 5 +---- Makefile | 5 +++-- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/.gitignore b/.gitignore index 7dd8869b1..2b3e3aef1 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,2 @@ -*.o -*.hi -*.ho -*.a +build/* git-annex diff --git a/Makefile b/Makefile index 8b7c9d3a0..876407de0 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,8 @@ git-annex: - ghc --make git-annex + mkdir -p build + ghc -odir build -hidir build --make git-annex clean: - rm -f git-annex *.o *.hi *.ho *.a + rm -rf build git-annex .PHONY: git-annex -- cgit v1.2.3 From 7117702fddf521ed4f3675a91cd87119207eba02 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 03:47:06 -0400 Subject: foo --- .gitattributes | 1 - 1 file changed, 1 deletion(-) delete mode 100644 .gitattributes diff --git a/.gitattributes b/.gitattributes deleted file mode 100644 index b98b07d7d..000000000 --- a/.gitattributes +++ /dev/null @@ -1 +0,0 @@ -.git-annex/*.log merge=union -- cgit v1.2.3 From 0f12bd16d829432f7b1c2efbba386262ed36fc27 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 03:50:28 -0400 Subject: subdir --- Backend/Checksum.hs | 18 ++++++++++++++ Backend/File.hs | 72 +++++++++++++++++++++++++++++++++++++++++++++++++++++ Backend/Url.hs | 35 ++++++++++++++++++++++++++ BackendChecksum.hs | 18 -------------- BackendFile.hs | 72 ----------------------------------------------------- BackendList.hs | 12 ++++----- BackendUrl.hs | 35 -------------------------- 7 files changed, 131 insertions(+), 131 deletions(-) create mode 100644 Backend/Checksum.hs create mode 100644 Backend/File.hs create mode 100644 Backend/Url.hs delete mode 100644 BackendChecksum.hs delete mode 100644 BackendFile.hs delete mode 100644 BackendUrl.hs diff --git a/Backend/Checksum.hs b/Backend/Checksum.hs new file mode 100644 index 000000000..bfc789e40 --- /dev/null +++ b/Backend/Checksum.hs @@ -0,0 +1,18 @@ +{- git-annex "checksum" backend + - -} + +module Backend.Checksum (backend) where + +import qualified Backend.File +import Data.Digest.Pure.SHA +import BackendTypes + +-- based on BackendFile just with a different key type +backend = Backend.File.backend { + name = "checksum", + getKey = keyValue +} + +-- checksum the file to get its key +keyValue :: FilePath -> Annex (Maybe Key) +keyValue k = error "checksum keyValue unimplemented" -- TODO diff --git a/Backend/File.hs b/Backend/File.hs new file mode 100644 index 000000000..107ef3851 --- /dev/null +++ b/Backend/File.hs @@ -0,0 +1,72 @@ +{- git-annex "file" backend + - -} + +module Backend.File (backend) where + +import Control.Monad.State +import System.IO +import System.Cmd +import Control.Exception +import BackendTypes +import LocationLog +import Locations +import qualified Remotes +import qualified GitRepo as Git + +backend = Backend { + name = "file", + getKey = keyValue, + storeFileKey = dummyStore, + retrieveKeyFile = copyKeyFile, + removeKey = dummyRemove +} + +-- direct mapping from filename to key +keyValue :: FilePath -> Annex (Maybe Key) +keyValue file = return $ Just $ Key file + +{- This backend does not really do any independant data storage, + - it relies on the file contents in .git/annex/ in this repo, + - and other accessible repos. So storing or removing a key is + - a no-op. TODO until support is added for git annex --push otherrepo, + - then these could implement that.. -} +dummyStore :: FilePath -> Key -> Annex (Bool) +dummyStore file key = return True +dummyRemove :: Key -> Annex Bool +dummyRemove url = return False + +{- Try to find a copy of the file in one of the remotes, + - and copy it over to this one. -} +copyKeyFile :: Key -> FilePath -> Annex (Bool) +copyKeyFile key file = do + remotes <- Remotes.withKey key + trycopy remotes remotes + where + trycopy full [] = error $ "unable to get: " ++ (keyFile key) ++ "\n" ++ + "To get that file, need access to one of these remotes: " ++ + (Remotes.list full) + trycopy full (r:rs) = do + -- annexLocation needs the git config to have been + -- read for a remote, so do that now, + -- if it hasn't been already + r' <- Remotes.ensureGitConfigRead r + result <- liftIO $ (try (copyFromRemote r' key file)::IO (Either SomeException ())) + case (result) of + Left err -> do + liftIO $ hPutStrLn stderr (show err) + trycopy full rs + Right succ -> return True + +{- Tries to copy a file from a remote, exception on error. -} +copyFromRemote :: Git.Repo -> Key -> FilePath -> IO () +copyFromRemote r key file = do + putStrLn $ "copy from " ++ (Git.repoDescribe r ) ++ " " ++ file + + if (Git.repoIsLocal r) + then getlocal + else getremote + return () + where + getlocal = rawSystem "cp" ["-a", location, file] + getremote = error "get via network not yet implemented!" + location = annexLocation r backend key diff --git a/Backend/Url.hs b/Backend/Url.hs new file mode 100644 index 000000000..e4ba58e6d --- /dev/null +++ b/Backend/Url.hs @@ -0,0 +1,35 @@ +{- git-annex "url" backend + - -} + +module Backend.Url (backend) where + +import Control.Monad.State +import System.Cmd +import IO +import BackendTypes + +backend = Backend { + name = "url", + getKey = keyValue, + storeFileKey = dummyStore, + retrieveKeyFile = downloadUrl, + removeKey = dummyRemove +} + +-- cannot generate url from filename +keyValue :: FilePath -> Annex (Maybe Key) +keyValue file = return Nothing + +-- cannot change url contents +dummyStore :: FilePath -> Key -> Annex Bool +dummyStore file url = return False +dummyRemove :: Key -> Annex Bool +dummyRemove url = return False + +downloadUrl :: Key -> FilePath -> Annex Bool +downloadUrl url file = do + liftIO $ putStrLn $ "download: " ++ (show url) + result <- liftIO $ try $ rawSystem "curl" ["-#", "-o", file, (show url)] + case (result) of + Left _ -> return False + Right _ -> return True diff --git a/BackendChecksum.hs b/BackendChecksum.hs deleted file mode 100644 index 50ef2ae6f..000000000 --- a/BackendChecksum.hs +++ /dev/null @@ -1,18 +0,0 @@ -{- git-annex "checksum" backend - - -} - -module BackendChecksum (backend) where - -import qualified BackendFile -import Data.Digest.Pure.SHA -import BackendTypes - --- based on BackendFile just with a different key type -backend = BackendFile.backend { - name = "checksum", - getKey = keyValue -} - --- checksum the file to get its key -keyValue :: FilePath -> Annex (Maybe Key) -keyValue k = error "checksum keyValue unimplemented" -- TODO diff --git a/BackendFile.hs b/BackendFile.hs deleted file mode 100644 index 284daca88..000000000 --- a/BackendFile.hs +++ /dev/null @@ -1,72 +0,0 @@ -{- git-annex "file" backend - - -} - -module BackendFile (backend) where - -import Control.Monad.State -import System.IO -import System.Cmd -import Control.Exception -import BackendTypes -import LocationLog -import Locations -import qualified Remotes -import qualified GitRepo as Git - -backend = Backend { - name = "file", - getKey = keyValue, - storeFileKey = dummyStore, - retrieveKeyFile = copyKeyFile, - removeKey = dummyRemove -} - --- direct mapping from filename to key -keyValue :: FilePath -> Annex (Maybe Key) -keyValue file = return $ Just $ Key file - -{- This backend does not really do any independant data storage, - - it relies on the file contents in .git/annex/ in this repo, - - and other accessible repos. So storing or removing a key is - - a no-op. TODO until support is added for git annex --push otherrepo, - - then these could implement that.. -} -dummyStore :: FilePath -> Key -> Annex (Bool) -dummyStore file key = return True -dummyRemove :: Key -> Annex Bool -dummyRemove url = return False - -{- Try to find a copy of the file in one of the remotes, - - and copy it over to this one. -} -copyKeyFile :: Key -> FilePath -> Annex (Bool) -copyKeyFile key file = do - remotes <- Remotes.withKey key - trycopy remotes remotes - where - trycopy full [] = error $ "unable to get: " ++ (keyFile key) ++ "\n" ++ - "To get that file, need access to one of these remotes: " ++ - (Remotes.list full) - trycopy full (r:rs) = do - -- annexLocation needs the git config to have been - -- read for a remote, so do that now, - -- if it hasn't been already - r' <- Remotes.ensureGitConfigRead r - result <- liftIO $ (try (copyFromRemote r' key file)::IO (Either SomeException ())) - case (result) of - Left err -> do - liftIO $ hPutStrLn stderr (show err) - trycopy full rs - Right succ -> return True - -{- Tries to copy a file from a remote, exception on error. -} -copyFromRemote :: Git.Repo -> Key -> FilePath -> IO () -copyFromRemote r key file = do - putStrLn $ "copy from " ++ (Git.repoDescribe r ) ++ " " ++ file - - if (Git.repoIsLocal r) - then getlocal - else getremote - return () - where - getlocal = rawSystem "cp" ["-a", location, file] - getremote = error "get via network not yet implemented!" - location = annexLocation r backend key diff --git a/BackendList.hs b/BackendList.hs index 91a2fa7fc..e9f926ce2 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -10,13 +10,13 @@ module BackendList ( import BackendTypes -- When adding a new backend, import it here and add it to the list. -import qualified BackendFile -import qualified BackendChecksum -import qualified BackendUrl +import qualified Backend.File +import qualified Backend.Checksum +import qualified Backend.Url supportedBackends = - [ BackendFile.backend - , BackendChecksum.backend - , BackendUrl.backend + [ Backend.File.backend + , Backend.Checksum.backend + , Backend.Url.backend ] {- Parses a string with a list of backend names into diff --git a/BackendUrl.hs b/BackendUrl.hs deleted file mode 100644 index fc0a8ae58..000000000 --- a/BackendUrl.hs +++ /dev/null @@ -1,35 +0,0 @@ -{- git-annex "url" backend - - -} - -module BackendUrl (backend) where - -import Control.Monad.State -import System.Cmd -import IO -import BackendTypes - -backend = Backend { - name = "url", - getKey = keyValue, - storeFileKey = dummyStore, - retrieveKeyFile = downloadUrl, - removeKey = dummyRemove -} - --- cannot generate url from filename -keyValue :: FilePath -> Annex (Maybe Key) -keyValue file = return Nothing - --- cannot change url contents -dummyStore :: FilePath -> Key -> Annex Bool -dummyStore file url = return False -dummyRemove :: Key -> Annex Bool -dummyRemove url = return False - -downloadUrl :: Key -> FilePath -> Annex Bool -downloadUrl url file = do - liftIO $ putStrLn $ "download: " ++ (show url) - result <- liftIO $ try $ rawSystem "curl" ["-#", "-o", file, (show url)] - case (result) of - Left _ -> return False - Right _ -> return True -- cgit v1.2.3 From 282d9853682f457cc6dc8b095b230bd892f0a5f3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 12:36:40 -0400 Subject: default command --- CmdLine.hs | 8 ++++---- Commands.hs | 18 ++++++++++++++---- 2 files changed, 18 insertions(+), 8 deletions(-) diff --git a/CmdLine.hs b/CmdLine.hs index 9737e0eb0..98971a733 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -14,7 +14,7 @@ import System.Console.GetOpt import Types import Commands -data Mode = Add | Push | Pull | Want | Get | Drop | Unannex +data Mode = Default | Add | Push | Pull | Want | Get | Drop | Unannex deriving Show options :: [OptDescr Mode] @@ -30,8 +30,7 @@ options = argvToMode argv = do case getOpt Permute options argv of - -- default mode is Add - ([],files,[]) -> return (Add, files) + ([],files,[]) -> return (Default, files) -- one mode is normal case (m:[],files,[]) -> return (m, files) -- multiple modes is an error @@ -43,7 +42,8 @@ argvToMode argv = do dispatch :: Mode -> FilePath -> Annex () dispatch mode item = do case (mode) of - Add -> annexCmd item + Default -> defaultCmd item + Add -> addCmd item Push -> pushCmd item Pull -> pullCmd item Want -> wantCmd item diff --git a/Commands.hs b/Commands.hs index be61c7c64..b4f57d6fe 100644 --- a/Commands.hs +++ b/Commands.hs @@ -1,7 +1,8 @@ {- git-annex subcommands -} module Commands ( - annexCmd, + defaultCmd, + addCmd, unannexCmd, getCmd, wantCmd, @@ -25,10 +26,19 @@ import UUID import LocationLog import Types +{- Default mode is to annex a file if it is not already, and otherwise + - get its content. -} +defaultCmd :: FilePath -> Annex () +defaultCmd file = do + r <- liftIO $ Backend.lookupFile file + case (r) of + Just v -> getCmd file + Nothing -> addCmd file + {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} -annexCmd :: FilePath -> Annex () -annexCmd file = inBackend file err $ do +addCmd :: FilePath -> Annex () +addCmd file = inBackend file err $ do liftIO $ checkLegal file stored <- Backend.storeFile file g <- Annex.gitRepo @@ -63,7 +73,7 @@ annexCmd file = inBackend file err $ do subdirs = (length $ split "/" file) - 1 -{- Inverse of annexCmd. -} +{- Inverse of addCmd. -} unannexCmd :: FilePath -> Annex () unannexCmd file = notinBackend file err $ \(key, backend) -> do Backend.dropFile backend key -- cgit v1.2.3 From 8df3e2aa0227e426ade1d92f430e02e31bb97ad9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 13:11:42 -0400 Subject: query remotes for uuids (not cached yet) --- Backend/File.hs | 21 +++++++++++++-------- Remotes.hs | 52 ++++++++++++++++++++++++++++++++++++---------------- 2 files changed, 49 insertions(+), 24 deletions(-) diff --git a/Backend/File.hs b/Backend/File.hs index 107ef3851..78e1f5563 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -49,13 +49,16 @@ copyKeyFile key file = do -- annexLocation needs the git config to have been -- read for a remote, so do that now, -- if it hasn't been already - r' <- Remotes.ensureGitConfigRead r - result <- liftIO $ (try (copyFromRemote r' key file)::IO (Either SomeException ())) - case (result) of - Left err -> do - liftIO $ hPutStrLn stderr (show err) - trycopy full rs - Right succ -> return True + result <- Remotes.tryGitConfigRead r + case (result) of + Nothing -> trycopy full rs + Just r' -> do + result <- liftIO $ (try (copyFromRemote r' key file)::IO (Either SomeException ())) + case (result) of + Left err -> do + liftIO $ hPutStrLn stderr (show err) + trycopy full rs + Right succ -> return True {- Tries to copy a file from a remote, exception on error. -} copyFromRemote :: Git.Repo -> Key -> FilePath -> IO () @@ -67,6 +70,8 @@ copyFromRemote r key file = do else getremote return () where - getlocal = rawSystem "cp" ["-a", location, file] + getlocal = do + rawSystem "cp" ["-a", location, file] + putStrLn "cp done" getremote = error "get via network not yet implemented!" location = annexLocation r backend key diff --git a/Remotes.hs b/Remotes.hs index 1802ff28e..ecb0d96e3 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -3,19 +3,21 @@ module Remotes ( list, withKey, - ensureGitConfigRead + tryGitConfigRead ) where import Control.Monad.State (liftIO) +import IO import qualified Data.Map as Map import Data.String.Utils +import List +import Maybe import Types import qualified GitRepo as Git import qualified Annex import LocationLog import Locations import UUID -import List {- Human visible list of remotes. -} list :: [Git.Repo] -> String @@ -27,12 +29,25 @@ withKey key = do g <- Annex.gitRepo uuids <- liftIO $ keyLocations g key allremotes <- remotesByCost + -- this only uses cached data, so may not find new remotes remotes <- reposByUUID allremotes uuids if (0 == length remotes) - then error $ "no configured git remotes have: " ++ (keyFile key) ++ "\n" ++ + then tryharder allremotes uuids + else return remotes + where + tryharder allremotes uuids = do + -- more expensive; check each remote's config + mayberemotes <- mapM tryGitConfigRead allremotes + let allremotes' = catMaybes mayberemotes + remotes' <- reposByUUID allremotes' uuids + if (0 == length remotes') + then err uuids + else return remotes' + err uuids = + error $ "no available git remotes have: " ++ + (keyFile key) ++ "\n" ++ "It has been seen before in these repositories:\n" ++ prettyPrintUUIDs uuids - else return remotes {- Cost Ordered list of remotes. -} remotesByCost :: Annex [Git.Repo] @@ -69,20 +84,25 @@ repoCost r = do configkey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-cost" {- The git configs for the git repo's remotes is not read on startup - - because reading it may be expensive. This function ensures that it is - - read for a specified remote, and updates state. It returns the - - updated git repo also. -} -ensureGitConfigRead :: Git.Repo -> Annex Git.Repo -ensureGitConfigRead r = do + - because reading it may be expensive. This function tries to read the + - config for a specified remote, and updates state. If successful, it + - returns the updated git repo. -} +tryGitConfigRead :: Git.Repo -> Annex (Maybe Git.Repo) +tryGitConfigRead r = do if (Map.null $ Git.configMap r) then do - r' <- liftIO $ Git.configRead r - g <- Annex.gitRepo - let l = Git.remotes g - let g' = Git.remotesAdd g $ exchange l r' - Annex.gitRepoChange g' - return r' - else return r + liftIO $ putStrLn $ "read config for " ++ (show r) + result <- liftIO $ try (Git.configRead r) + case (result) of + Left err -> return Nothing + Right r' -> do + g <- Annex.gitRepo + let l = Git.remotes g + let g' = Git.remotesAdd g $ + exchange l r' + Annex.gitRepoChange g' + return $ Just r' + else return $ Just r where exchange [] new = [] exchange (old:ls) new = -- cgit v1.2.3 From 7c975eab07d842e3d91626871027f803f34c6372 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 13:17:43 -0400 Subject: check rawSystem exit codes --- Backend/File.hs | 8 +++++--- Backend/Url.hs | 10 +++++----- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/Backend/File.hs b/Backend/File.hs index 78e1f5563..2ac12487e 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -6,6 +6,7 @@ module Backend.File (backend) where import Control.Monad.State import System.IO import System.Cmd +import System.Exit import Control.Exception import BackendTypes import LocationLog @@ -68,10 +69,11 @@ copyFromRemote r key file = do if (Git.repoIsLocal r) then getlocal else getremote - return () where getlocal = do - rawSystem "cp" ["-a", location, file] - putStrLn "cp done" + res <-rawSystem "cp" ["-a", location, file] + if (res == ExitSuccess) + then return () + else error "cp failed" getremote = error "get via network not yet implemented!" location = annexLocation r backend key diff --git a/Backend/Url.hs b/Backend/Url.hs index e4ba58e6d..9831c337b 100644 --- a/Backend/Url.hs +++ b/Backend/Url.hs @@ -5,7 +5,7 @@ module Backend.Url (backend) where import Control.Monad.State import System.Cmd -import IO +import System.Exit import BackendTypes backend = Backend { @@ -29,7 +29,7 @@ dummyRemove url = return False downloadUrl :: Key -> FilePath -> Annex Bool downloadUrl url file = do liftIO $ putStrLn $ "download: " ++ (show url) - result <- liftIO $ try $ rawSystem "curl" ["-#", "-o", file, (show url)] - case (result) of - Left _ -> return False - Right _ -> return True + result <- liftIO $ rawSystem "curl" ["-#", "-o", file, (show url)] + if (result == ExitSuccess) + then return True + else return False -- cgit v1.2.3 From f9557d7c5e2aa7ef19a5d589594154a21c7f2caa Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 13:49:45 -0400 Subject: uuid cache done --- Remotes.hs | 1 - TODO | 2 -- UUID.hs | 42 +++++++++++++++++++++++++++++------------- 3 files changed, 29 insertions(+), 16 deletions(-) diff --git a/Remotes.hs b/Remotes.hs index ecb0d96e3..4f4e5a26c 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -91,7 +91,6 @@ tryGitConfigRead :: Git.Repo -> Annex (Maybe Git.Repo) tryGitConfigRead r = do if (Map.null $ Git.configMap r) then do - liftIO $ putStrLn $ "read config for " ++ (show r) result <- liftIO $ try (Git.configRead r) case (result) of Left err -> return Nothing diff --git a/TODO b/TODO index 40017c816..54411185a 100644 --- a/TODO +++ b/TODO @@ -1,8 +1,6 @@ * bug when annexing files while in a subdir of a git repo * bug when specifying absolute path to files when annexing -* query remotes for their annex.uuid settings and cache - * --push/--pull/--want/--drop * how to handle git mv file? diff --git a/UUID.hs b/UUID.hs index 1c31a343f..c77004527 100644 --- a/UUID.hs +++ b/UUID.hs @@ -40,15 +40,25 @@ genUUID = liftIO $ pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h - -} getUUID :: Git.Repo -> Annex UUID getUUID r = do - if ("" /= configured r) - then return $ configured r - else cached r + g <- Annex.gitRepo + let uuid = cached r g + if (uuid /= "") + then return $ uuid + else do + let uuid = uncached r + if (uuid /= "") + then do + updatecache r g uuid + return uuid + else return "" where - configured r = Git.configGet r "annex.uuid" "" - cached r = do - g <- Annex.gitRepo - return $ Git.configGet g (configkey r) "" - configkey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid" + uncached r = Git.configGet r "annex.uuid" "" + cached r g = Git.configGet g (cachekey r) "" + updatecache r g uuid = do + if (g /= r) + then setConfig (cachekey r) uuid + else return () + cachekey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid" {- Make sure that the repo has an annex.uuid setting. -} prepUUID :: Annex () @@ -58,13 +68,19 @@ prepUUID = do if ("" == u) then do uuid <- genUUID - liftIO $ Git.run g ["config", configkey, uuid] - -- re-read git config and update the repo's state - g' <- liftIO $ Git.configRead g - Annex.gitRepoChange g' - return () + setConfig configkey uuid else return () +{- 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 + Annex.gitRepoChange g' + return () + {- Filters a list of repos to ones that have listed UUIDs. -} reposByUUID :: [Git.Repo] -> [UUID] -> Annex [Git.Repo] reposByUUID repos uuids = do -- cgit v1.2.3 From a200761e66f01a271c90ce67482105befca6ef09 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 14:14:19 -0400 Subject: implemented basic --drop --- Backend.hs | 34 +++++++++++++++++----------------- Backend/File.hs | 6 ++++-- Backend/Url.hs | 4 +++- Commands.hs | 24 ++++++++++++++++++++---- Remotes.hs | 7 ++++--- TODO | 2 +- 6 files changed, 49 insertions(+), 28 deletions(-) diff --git a/Backend.hs b/Backend.hs index 2829fef9d..7a8a41a4b 100644 --- a/Backend.hs +++ b/Backend.hs @@ -14,9 +14,9 @@ - -} module Backend ( - storeFile, - dropFile, - retrieveFile, + storeFileKey, + removeKey, + retrieveKeyFile, lookupFile ) where @@ -32,37 +32,37 @@ import qualified GitRepo as Git import qualified Annex import Utility import Types -import BackendTypes +import qualified BackendTypes as B {- Attempts to store a file in one of the backends. -} -storeFile :: FilePath -> Annex (Maybe (Key, Backend)) -storeFile file = do +storeFileKey :: FilePath -> Annex (Maybe (Key, Backend)) +storeFileKey file = do g <- Annex.gitRepo let relfile = Git.relative g file b <- Annex.backends - storeFile' b file relfile -storeFile' [] _ _ = return Nothing -storeFile' (b:bs) file relfile = do - try <- (getKey b) relfile + storeFileKey' b file relfile +storeFileKey' [] _ _ = return Nothing +storeFileKey' (b:bs) file relfile = do + try <- (B.getKey b) relfile case (try) of Nothing -> nextbackend Just key -> do - stored <- (storeFileKey b) file key + stored <- (B.storeFileKey b) file key if (not stored) then nextbackend else do return $ Just (key, b) where - nextbackend = storeFile' bs file relfile + nextbackend = storeFileKey' bs file relfile {- Attempts to retrieve an key from one of the backends, saving it to - a specified location. -} -retrieveFile :: Backend -> Key -> FilePath -> Annex Bool -retrieveFile backend key dest = (retrieveKeyFile backend) key dest +retrieveKeyFile :: Backend -> Key -> FilePath -> Annex Bool +retrieveKeyFile backend key dest = (B.retrieveKeyFile backend) key dest -{- Drops a key from a backend. -} -dropFile :: Backend -> Key -> Annex Bool -dropFile backend key = (removeKey backend) key +{- Removes a key from a backend. -} +removeKey :: Backend -> Key -> Annex Bool +removeKey backend key = (B.removeKey backend) key {- Looks up the key and backend corresponding to an annexed file, - by examining what the file symlinks to. -} diff --git a/Backend/File.hs b/Backend/File.hs index 2ac12487e..311fe820b 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -28,13 +28,15 @@ keyValue file = return $ Just $ Key file {- This backend does not really do any independant data storage, - it relies on the file contents in .git/annex/ in this repo, - - and other accessible repos. So storing or removing a key is + - and other accessible repos. So storing a key is - a no-op. TODO until support is added for git annex --push otherrepo, - then these could implement that.. -} dummyStore :: FilePath -> Key -> Annex (Bool) dummyStore file key = return True + +{- Allow keys to be removed. -} dummyRemove :: Key -> Annex Bool -dummyRemove url = return False +dummyRemove url = return True {- Try to find a copy of the file in one of the remotes, - and copy it over to this one. -} diff --git a/Backend/Url.hs b/Backend/Url.hs index 9831c337b..3d971864a 100644 --- a/Backend/Url.hs +++ b/Backend/Url.hs @@ -23,8 +23,10 @@ keyValue file = return Nothing -- cannot change url contents dummyStore :: FilePath -> Key -> Annex Bool dummyStore file url = return False + +-- allow keys to be removed dummyRemove :: Key -> Annex Bool -dummyRemove url = return False +dummyRemove url = return True downloadUrl :: Key -> FilePath -> Annex Bool downloadUrl url file = do diff --git a/Commands.hs b/Commands.hs index b4f57d6fe..65f6f6efd 100644 --- a/Commands.hs +++ b/Commands.hs @@ -40,7 +40,7 @@ defaultCmd file = do addCmd :: FilePath -> Annex () addCmd file = inBackend file err $ do liftIO $ checkLegal file - stored <- Backend.storeFile file + stored <- Backend.storeFileKey file g <- Annex.gitRepo case (stored) of Nothing -> error $ "no backend could store: " ++ file @@ -76,7 +76,7 @@ addCmd file = inBackend file err $ do {- Inverse of addCmd. -} unannexCmd :: FilePath -> Annex () unannexCmd file = notinBackend file err $ \(key, backend) -> do - Backend.dropFile backend key + Backend.removeKey backend key logStatus key ValueMissing g <- Annex.gitRepo let src = annexLocation g backend key @@ -104,7 +104,7 @@ getCmd file = notinBackend file err $ \(key, backend) -> do g <- Annex.gitRepo let dest = annexLocation g backend key liftIO $ createDirectoryIfMissing True (parentDir dest) - success <- Backend.retrieveFile backend key dest + success <- Backend.retrieveKeyFile backend key dest if (success) then do logStatus key ValuePresent @@ -119,7 +119,23 @@ wantCmd file = do error "not implemented" -- TODO {- Indicates a file is not wanted. -} dropCmd :: FilePath -> Annex () -dropCmd file = do error "not implemented" -- TODO +dropCmd file = notinBackend file err $ \(key, backend) -> do + -- TODO only remove if enough copies are present elsewhere + success <- Backend.removeKey backend key + if (success) + then do + logStatus key ValueMissing + inannex <- inAnnex backend key + if (inannex) + then do + g <- Annex.gitRepo + let loc = annexLocation g backend key + liftIO $ removeFile loc + return () + else return () + else error $ "backend refused to drop " ++ file + where + err = error $ "not annexed " ++ file {- Pushes all files to a remote repository. -} pushCmd :: String -> Annex () diff --git a/Remotes.hs b/Remotes.hs index 4f4e5a26c..f20d51ab3 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -45,9 +45,10 @@ withKey key = do else return remotes' err uuids = error $ "no available git remotes have: " ++ - (keyFile key) ++ "\n" ++ - "It has been seen before in these repositories:\n" ++ - prettyPrintUUIDs uuids + (keyFile key) ++ (uuidlist uuids) + uuidlist [] = "" + uuidlist uuids = "\nIt has been seen before in these repositories:\n" ++ + prettyPrintUUIDs uuids {- Cost Ordered list of remotes. -} remotesByCost :: Annex [Git.Repo] diff --git a/TODO b/TODO index 54411185a..c4ce74e19 100644 --- a/TODO +++ b/TODO @@ -1,7 +1,7 @@ * bug when annexing files while in a subdir of a git repo * bug when specifying absolute path to files when annexing -* --push/--pull/--want/--drop +* --push/--pull/--want * how to handle git mv file? -- cgit v1.2.3 From 65e4f9cc73f4800fd4dcb5503f7a428539e1e959 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 14:22:05 -0400 Subject: update cached uuids if it's noticed they changed --- UUID.hs | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/UUID.hs b/UUID.hs index c77004527..9348c7b43 100644 --- a/UUID.hs +++ b/UUID.hs @@ -41,22 +41,21 @@ genUUID = liftIO $ pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h getUUID :: Git.Repo -> Annex UUID getUUID r = do g <- Annex.gitRepo - let uuid = cached r g - if (uuid /= "") - then return $ uuid - else do - let uuid = uncached r - if (uuid /= "") - then do - updatecache r g uuid - return uuid - else return "" + + let c = cached r g + let u = uncached r + + if (c /= u && u /= "") + then do + updatecache g r u + return u + else return c where uncached r = Git.configGet r "annex.uuid" "" cached r g = Git.configGet g (cachekey r) "" - updatecache r g uuid = do - if (g /= r) - then setConfig (cachekey r) uuid + updatecache g r u = do + if (g /= r) + then setConfig (cachekey r) u else return () cachekey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid" -- cgit v1.2.3 From 90cdc61c7c8d08590e054018c54c542c463be7e9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 14:38:29 -0400 Subject: refactor --- CmdLine.hs | 52 ---------------------------------------------------- Commands.hs | 58 +++++++++++++++++++++++++++++++++++++++++++--------------- Core.hs | 37 ++++++------------------------------- git-annex.hs | 34 +++++++++++++++++++++++++++++++++- git-annex.mdwn | 6 ++++-- 5 files changed, 86 insertions(+), 101 deletions(-) delete mode 100644 CmdLine.hs diff --git a/CmdLine.hs b/CmdLine.hs deleted file mode 100644 index 98971a733..000000000 --- a/CmdLine.hs +++ /dev/null @@ -1,52 +0,0 @@ -{- git-annex command line - - - - TODO: This is very rough and stupid; I would like to use - - System.Console.CmdArgs.Implicit but it is not yet packaged in Debian. - -} - -module CmdLine ( - argvToMode, - dispatch, - Mode -) where - -import System.Console.GetOpt -import Types -import Commands - -data Mode = Default | Add | Push | Pull | Want | Get | Drop | Unannex - deriving Show - -options :: [OptDescr Mode] -options = - [ Option ['a'] ["add"] (NoArg Add) "add files to annex" - , Option ['p'] ["push"] (NoArg Push) "push annex to repos" - , Option ['P'] ["pull"] (NoArg Pull) "pull annex from repos" - , Option ['w'] ["want"] (NoArg Want) "request file contents" - , Option ['g'] ["get"] (NoArg Get) "transfer file contents" - , Option ['d'] ["drop"] (NoArg Drop) "indicate file contents not needed" - , Option ['u'] ["unannex"] (NoArg Unannex) "undo --add" - ] - -argvToMode argv = do - case getOpt Permute options argv of - ([],files,[]) -> return (Default, files) - -- one mode is normal case - (m:[],files,[]) -> return (m, files) - -- multiple modes is an error - (ms,files,[]) -> ioError (userError ("only one mode should be specified\n" ++ usageInfo header options)) - -- error case - (_,files,errs) -> ioError (userError (concat errs ++ usageInfo header options)) - where header = "Usage: git-annex [mode] file" - -dispatch :: Mode -> FilePath -> Annex () -dispatch mode item = do - case (mode) of - Default -> defaultCmd item - Add -> addCmd item - Push -> pushCmd item - Pull -> pullCmd item - Want -> wantCmd item - Get -> getCmd item - Drop -> dropCmd item - Unannex -> unannexCmd item diff --git a/Commands.hs b/Commands.hs index 65f6f6efd..b631664d6 100644 --- a/Commands.hs +++ b/Commands.hs @@ -1,16 +1,12 @@ -{- git-annex subcommands -} +{- git-annex command line -} module Commands ( - defaultCmd, - addCmd, - unannexCmd, - getCmd, - wantCmd, - dropCmd, - pushCmd, - pullCmd + argvToMode, + dispatch, + Mode ) where +import System.Console.GetOpt import Control.Monad.State (liftIO) import System.Posix.Files import System.Directory @@ -25,6 +21,44 @@ import BackendList import UUID import LocationLog import Types +import Core + +data Mode = Default | Add | Push | Pull | Want | Get | Drop | Unannex + deriving Show + +options :: [OptDescr Mode] +options = + [ Option ['a'] ["add"] (NoArg Add) "add files to annex" + , Option ['p'] ["push"] (NoArg Push) "push annex to repos" + , Option ['P'] ["pull"] (NoArg Pull) "pull annex from repos" + , Option ['w'] ["want"] (NoArg Want) "request file contents" + , Option ['g'] ["get"] (NoArg Get) "transfer file contents" + , Option ['d'] ["drop"] (NoArg Drop) "indicate file contents not needed" + , Option ['u'] ["unannex"] (NoArg Unannex) "undo --add" + ] + +argvToMode argv = do + case getOpt Permute options argv of + ([],files,[]) -> return (Default, files) + -- one mode is normal case + (m:[],files,[]) -> return (m, files) + -- multiple modes is an error + (ms,files,[]) -> ioError (userError ("only one mode should be specified\n" ++ usageInfo header options)) + -- error case + (_,files,errs) -> ioError (userError (concat errs ++ usageInfo header options)) + where header = "Usage: git-annex [mode] file" + +dispatch :: Mode -> FilePath -> Annex () +dispatch mode item = do + case (mode) of + Default -> defaultCmd item + Add -> addCmd item + Push -> pushCmd item + Pull -> pullCmd item + Want -> wantCmd item + Get -> getCmd item + Drop -> dropCmd item + Unannex -> unannexCmd item {- Default mode is to annex a file if it is not already, and otherwise - get its content. -} @@ -163,9 +197,3 @@ inBackend file yes no = do Just v -> yes v Nothing -> no notinBackend file yes no = inBackend file no yes - -{- Checks if a given key is currently present in the annexLocation -} -inAnnex :: Backend -> Key -> Annex Bool -inAnnex backend key = do - g <- Annex.gitRepo - liftIO $ doesFileExist $ annexLocation g backend key diff --git a/Core.hs b/Core.hs index e3d2c6403..1eb9da687 100644 --- a/Core.hs +++ b/Core.hs @@ -5,8 +5,6 @@ module Core where import System.IO import System.Directory import Control.Monad.State (liftIO) -import Control.Exception -import CmdLine import Types import BackendList import Locations @@ -33,35 +31,6 @@ start = do Git.configGet g' "annex.backends" "" prepUUID -{- Processes each param in the list by dispatching the handler function - - for the user-selection operation mode. Catches exceptions, not stopping - - if some error out, and propigates an overall error status at the end. - - - - This runs in the IO monad, not in the Annex monad. It seems that - - exceptions can only be caught in the IO monad, not in a stacked monad; - - or more likely I missed an easy way to do it. So, I have to laboriously - - thread AnnexState through this function. - -} -tryRun :: AnnexState -> Mode -> [String] -> IO () -tryRun state mode params = tryRun' state mode 0 0 params -tryRun' state mode errnum oknum [] = do - if (errnum > 0) - then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok" - else return () -tryRun' state mode errnum oknum (f:fs) = do - result <- try - (Annex.run state (dispatch mode f))::IO (Either SomeException ((), AnnexState)) - case (result) of - Left err -> do - showErr err - tryRun' state mode (errnum + 1) oknum fs - Right (_,state') -> tryRun' state' mode errnum (oknum + 1) fs - -{- Exception pretty-printing. -} -showErr e = do - hPutStrLn stderr $ "git-annex: " ++ (show e) - return () - {- Sets up a git repo for git-annex. May be called repeatedly. -} gitSetup :: Git.Repo -> IO () gitSetup repo = do @@ -85,3 +54,9 @@ gitSetup repo = do Git.run repo ["add", attributes] Git.run repo ["commit", "-m", "git-annex setup", attributes] + +{- Checks if a given key is currently present in the annexLocation -} +inAnnex :: Backend -> Key -> Annex Bool +inAnnex backend key = do + g <- Annex.gitRepo + liftIO $ doesFileExist $ annexLocation g backend key diff --git a/git-annex.hs b/git-annex.hs index b326b2b19..a038107e9 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -1,12 +1,44 @@ {- git-annex main program -} +import Control.Exception +import System.IO import System.Environment import qualified Annex +import Types import Core -import CmdLine +import Commands main = do args <- getArgs (mode, params) <- argvToMode args state <- start tryRun state mode params + +{- Processes each param in the list by dispatching the handler function + - for the user-selection operation mode. Catches exceptions, not stopping + - if some error out, and propigates an overall error status at the end. + - + - This runs in the IO monad, not in the Annex monad. It seems that + - exceptions can only be caught in the IO monad, not in a stacked monad; + - or more likely I missed an easy way to do it. So, I have to laboriously + - thread AnnexState through this function. + -} +tryRun :: AnnexState -> Mode -> [String] -> IO () +tryRun state mode params = tryRun' state mode 0 0 params +tryRun' state mode errnum oknum (f:fs) = do + result <- try + (Annex.run state (dispatch mode f))::IO (Either SomeException ((), AnnexState)) + case (result) of + Left err -> do + showErr err + tryRun' state mode (errnum + 1) oknum fs + Right (_,state') -> tryRun' state' mode errnum (oknum + 1) fs +tryRun' state mode errnum oknum [] = do + if (errnum > 0) + then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok" + else return () + +{- Exception pretty-printing. -} +showErr e = do + hPutStrLn stderr $ "git-annex: " ++ (show e) + return () diff --git a/git-annex.mdwn b/git-annex.mdwn index 6852ed008..a7a053907 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -48,9 +48,11 @@ git-annex can be configured to try to keep N copies of a file's content available across all repositories. By default, N is 1 (configured by annex.numcopies). -`git annex --drop` attempts to communicate with all other configured +`git annex --drop` attempts to check all other configured repositories, to check that N copies of the file exist. If enough -repositories cannot be contacted, it will retain the file content. +repositories cannot be verified to have it, it will retain the file content +to avoid data loss. + You can later use `git annex --drop --retry` to retry pending drops. Or you can use `git annex --drop --force $file` to force dropping of file content. -- cgit v1.2.3 From a0c013605699a4b1509ba1b04b4522ac43f033c6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 14:49:19 -0400 Subject: cooler command-line handling --- Commands.hs | 44 +++++++++++++++----------------------------- git-annex.hs | 18 +++++++++--------- 2 files changed, 24 insertions(+), 38 deletions(-) diff --git a/Commands.hs b/Commands.hs index b631664d6..05ea65880 100644 --- a/Commands.hs +++ b/Commands.hs @@ -1,9 +1,7 @@ {- git-annex command line -} module Commands ( - argvToMode, - dispatch, - Mode + argvToActions ) where import System.Console.GetOpt @@ -23,43 +21,31 @@ import LocationLog import Types import Core -data Mode = Default | Add | Push | Pull | Want | Get | Drop | Unannex - deriving Show - -options :: [OptDescr Mode] +options :: [OptDescr (String -> Annex ())] options = - [ Option ['a'] ["add"] (NoArg Add) "add files to annex" - , Option ['p'] ["push"] (NoArg Push) "push annex to repos" - , Option ['P'] ["pull"] (NoArg Pull) "pull annex from repos" - , Option ['w'] ["want"] (NoArg Want) "request file contents" - , Option ['g'] ["get"] (NoArg Get) "transfer file contents" - , Option ['d'] ["drop"] (NoArg Drop) "indicate file contents not needed" - , Option ['u'] ["unannex"] (NoArg Unannex) "undo --add" + [ Option ['a'] ["add"] (NoArg addCmd) "add files to annex" + , Option ['p'] ["push"] (NoArg pushCmd) "push annex to repos" + , Option ['P'] ["pull"] (NoArg pullCmd) "pull annex from repos" + , Option ['w'] ["want"] (NoArg wantCmd) "request file contents" + , Option ['g'] ["get"] (NoArg getCmd) "transfer file contents" + , Option ['d'] ["drop"] (NoArg dropCmd) "indicate file contents not needed" + , Option ['u'] ["unannex"] (NoArg unannexCmd) "undo --add" ] -argvToMode argv = do +{- Parses command line and returns a list of actons to be run in the Annex + - monad. -} +argvToActions :: [String] -> IO [Annex ()] +argvToActions argv = do case getOpt Permute options argv of - ([],files,[]) -> return (Default, files) + ([],files,[]) -> return $ map defaultCmd files -- one mode is normal case - (m:[],files,[]) -> return (m, files) + (m:[],files,[]) -> return $ map m files -- multiple modes is an error (ms,files,[]) -> ioError (userError ("only one mode should be specified\n" ++ usageInfo header options)) -- error case (_,files,errs) -> ioError (userError (concat errs ++ usageInfo header options)) where header = "Usage: git-annex [mode] file" -dispatch :: Mode -> FilePath -> Annex () -dispatch mode item = do - case (mode) of - Default -> defaultCmd item - Add -> addCmd item - Push -> pushCmd item - Pull -> pullCmd item - Want -> wantCmd item - Get -> getCmd item - Drop -> dropCmd item - Unannex -> unannexCmd item - {- Default mode is to annex a file if it is not already, and otherwise - get its content. -} defaultCmd :: FilePath -> Annex () diff --git a/git-annex.hs b/git-annex.hs index a038107e9..77dd29fac 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -10,9 +10,9 @@ import Commands main = do args <- getArgs - (mode, params) <- argvToMode args + actions <- argvToActions args state <- start - tryRun state mode params + tryRun state actions {- Processes each param in the list by dispatching the handler function - for the user-selection operation mode. Catches exceptions, not stopping @@ -23,17 +23,17 @@ main = do - or more likely I missed an easy way to do it. So, I have to laboriously - thread AnnexState through this function. -} -tryRun :: AnnexState -> Mode -> [String] -> IO () -tryRun state mode params = tryRun' state mode 0 0 params -tryRun' state mode errnum oknum (f:fs) = do +tryRun :: AnnexState -> [Annex ()] -> IO () +tryRun state actions = tryRun' state 0 0 actions +tryRun' state errnum oknum (a:as) = do result <- try - (Annex.run state (dispatch mode f))::IO (Either SomeException ((), AnnexState)) + (Annex.run state a)::IO (Either SomeException ((), AnnexState)) case (result) of Left err -> do showErr err - tryRun' state mode (errnum + 1) oknum fs - Right (_,state') -> tryRun' state' mode errnum (oknum + 1) fs -tryRun' state mode errnum oknum [] = do + tryRun' state (errnum + 1) oknum as + Right (_,state') -> tryRun' state' errnum (oknum + 1) as +tryRun' state errnum oknum [] = do if (errnum > 0) then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok" else return () -- cgit v1.2.3 From 1d628ff2380d1bec0c260bc19349c67360fa7a1f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 14:50:46 -0400 Subject: comment --- Commands.hs | 4 +--- git-annex.hs | 3 +-- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/Commands.hs b/Commands.hs index 05ea65880..feb35d1fb 100644 --- a/Commands.hs +++ b/Commands.hs @@ -1,8 +1,6 @@ {- git-annex command line -} -module Commands ( - argvToActions -) where +module Commands (argvToActions) where import System.Console.GetOpt import Control.Monad.State (liftIO) diff --git a/git-annex.hs b/git-annex.hs index 77dd29fac..78e875014 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -14,8 +14,7 @@ main = do state <- start tryRun state actions -{- Processes each param in the list by dispatching the handler function - - for the user-selection operation mode. Catches exceptions, not stopping +{- Runs a list of Annex actions. Catches exceptions, not stopping - if some error out, and propigates an overall error status at the end. - - This runs in the IO monad, not in the Annex monad. It seems that -- cgit v1.2.3 From 40df205881c6bfa180dd37d1a6e67afb3ce3593f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 14:54:56 -0400 Subject: indent --- Commands.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Commands.hs b/Commands.hs index feb35d1fb..730663b0d 100644 --- a/Commands.hs +++ b/Commands.hs @@ -21,12 +21,12 @@ import Core options :: [OptDescr (String -> Annex ())] options = - [ Option ['a'] ["add"] (NoArg addCmd) "add files to annex" - , Option ['p'] ["push"] (NoArg pushCmd) "push annex to repos" - , Option ['P'] ["pull"] (NoArg pullCmd) "pull annex from repos" - , Option ['w'] ["want"] (NoArg wantCmd) "request file contents" - , Option ['g'] ["get"] (NoArg getCmd) "transfer file contents" - , Option ['d'] ["drop"] (NoArg dropCmd) "indicate file contents not needed" + [ Option ['a'] ["add"] (NoArg addCmd) "add files to annex" + , Option ['p'] ["push"] (NoArg pushCmd) "push annex to repos" + , Option ['P'] ["pull"] (NoArg pullCmd) "pull annex from repos" + , Option ['w'] ["want"] (NoArg wantCmd) "request file contents" + , Option ['g'] ["get"] (NoArg getCmd) "transfer file contents" + , Option ['d'] ["drop"] (NoArg dropCmd) "indicate file contents not needed" , Option ['u'] ["unannex"] (NoArg unannexCmd) "undo --add" ] -- cgit v1.2.3 From 4b7e54eddb953ee3ec3ce1734e2748fc3e2f2f9f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 15:05:10 -0400 Subject: tweak docs --- git-annex.mdwn | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/git-annex.mdwn b/git-annex.mdwn index a7a053907..62e4301eb 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -53,10 +53,6 @@ repositories, to check that N copies of the file exist. If enough repositories cannot be verified to have it, it will retain the file content to avoid data loss. -You can later use `git annex --drop --retry` to retry pending drops. -Or you can use `git annex --drop --force $file` to force dropping of -file content. - For example, consider three repositories: Server, Laptop, and USB. Both Server and USB have a copy of a file, and N=1. If on Laptop, you `git annex --get $file`, this will transfer it from either Server or USB (depending on which @@ -66,14 +62,15 @@ Suppose you want to free up space on laptop again, and you --drop the file there. If USB is connected, or Server can be contacted, git-annex can check that it still has a copy of the file, and the content is removed from Laptop. But if USB is currently disconnected, and Server also cannot be -contacted, it can't check that and will retain the file content. +contacted, it can't verify that it is safe to drop the file, and will +refuse to do so. With N=2, in order to drop the file content from Laptop, it would need access to both USB and Server. Note that different repositories can be configured with different values of N. So just because Laptop has N=2, this does not prevent the number of -copies falling to 1, when USB and Server have N=1, and of they have the +copies falling to 1, when USB and Server have N=1, and if they have the only copies of a file. ## the .git-annex directory -- cgit v1.2.3 From 859731ee5b09072d112296a073cb152007d7785a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 15:31:44 -0400 Subject: add hasKey --- Backend/File.hs | 12 +++++++++--- Backend/Url.hs | 9 +++++---- BackendTypes.hs | 4 +++- 3 files changed, 17 insertions(+), 8 deletions(-) diff --git a/Backend/File.hs b/Backend/File.hs index 311fe820b..893850a69 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -13,13 +13,16 @@ import LocationLog import Locations import qualified Remotes import qualified GitRepo as Git +import Utility +import Core backend = Backend { name = "file", getKey = keyValue, storeFileKey = dummyStore, retrieveKeyFile = copyKeyFile, - removeKey = dummyRemove + removeKey = dummyRemove, + hasKey = checkKeyFile } -- direct mapping from filename to key @@ -29,8 +32,7 @@ keyValue file = return $ Just $ Key file {- This backend does not really do any independant data storage, - it relies on the file contents in .git/annex/ in this repo, - and other accessible repos. So storing a key is - - a no-op. TODO until support is added for git annex --push otherrepo, - - then these could implement that.. -} + - a no-op. -} dummyStore :: FilePath -> Key -> Annex (Bool) dummyStore file key = return True @@ -38,6 +40,10 @@ dummyStore file key = return True dummyRemove :: Key -> Annex Bool dummyRemove url = return True +{- Just check if the .git/annex/ file for the key exists. -} +checkKeyFile :: Key -> Annex Bool +checkKeyFile k = inAnnex backend k + {- Try to find a copy of the file in one of the remotes, - and copy it over to this one. -} copyKeyFile :: Key -> FilePath -> Annex (Bool) diff --git a/Backend/Url.hs b/Backend/Url.hs index 3d971864a..325a7e217 100644 --- a/Backend/Url.hs +++ b/Backend/Url.hs @@ -13,7 +13,8 @@ backend = Backend { getKey = keyValue, storeFileKey = dummyStore, retrieveKeyFile = downloadUrl, - removeKey = dummyRemove + removeKey = dummyOk, + hasKey = dummyOk } -- cannot generate url from filename @@ -24,9 +25,9 @@ keyValue file = return Nothing dummyStore :: FilePath -> Key -> Annex Bool dummyStore file url = return False --- allow keys to be removed -dummyRemove :: Key -> Annex Bool -dummyRemove url = return True +-- allow keys to be removed; presumably they can always be downloaded again +dummyOk :: Key -> Annex Bool +dummyOk url = return True downloadUrl :: Key -> FilePath -> Annex Bool downloadUrl url file = do diff --git a/BackendTypes.hs b/BackendTypes.hs index 2ef65f469..e480f725b 100644 --- a/BackendTypes.hs +++ b/BackendTypes.hs @@ -37,7 +37,9 @@ data Backend = Backend { -- retrieves a key's contents to a file retrieveKeyFile :: Key -> FilePath -> Annex Bool, -- removes a key - removeKey :: Key -> Annex Bool + removeKey :: Key -> Annex Bool, + -- checks if a backend is storing the content of a key + hasKey :: Key -> Annex Bool } instance Show Backend where -- cgit v1.2.3 From d4ce0724527fa0155f737b5d3e94e190c27d29dc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 15:58:53 -0400 Subject: break depends cycle --- Backend.hs | 13 +++++++++++++ Backend/File.hs | 1 - Core.hs | 2 -- 3 files changed, 13 insertions(+), 3 deletions(-) diff --git a/Backend.hs b/Backend.hs index 7a8a41a4b..01c7c6823 100644 --- a/Backend.hs +++ b/Backend.hs @@ -33,6 +33,19 @@ import qualified Annex import Utility import Types import qualified BackendTypes as B +import BackendList + +{- List of backends in the order to try them when storing a new key. -} +backendList :: Annex [Backend] +backendList = do + l <- Annex.backends + if (0 < length l) + then return l + else do + g <- Annex.gitRepo + let l = parseBackendList $ Git.configGet g "annex.backends" "" + Annex.backendsChange l + return l {- Attempts to store a file in one of the backends. -} storeFileKey :: FilePath -> Annex (Maybe (Key, Backend)) diff --git a/Backend/File.hs b/Backend/File.hs index 893850a69..92f5932ce 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -14,7 +14,6 @@ import Locations import qualified Remotes import qualified GitRepo as Git import Utility -import Core backend = Backend { name = "file", diff --git a/Core.hs b/Core.hs index 1eb9da687..431c9c9e6 100644 --- a/Core.hs +++ b/Core.hs @@ -27,8 +27,6 @@ start = do g' <- liftIO $ Git.configRead g Annex.gitRepoChange g' liftIO $ gitSetup g' - Annex.backendsChange $ parseBackendList $ - Git.configGet g' "annex.backends" "" prepUUID {- Sets up a git repo for git-annex. May be called repeatedly. -} -- cgit v1.2.3 From aa2f4bd81049e3bcaad6f5f1334864ce14887527 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 16:13:43 -0400 Subject: bug --- Annex.hs | 15 ++++++++++--- Backend.hs | 2 +- Backend/File.hs | 1 + Core.hs | 65 +++++++++++++++++++++++---------------------------------- git-annex.hs | 7 +++++-- 5 files changed, 45 insertions(+), 45 deletions(-) diff --git a/Annex.hs b/Annex.hs index fcd19ba03..9be86c948 100644 --- a/Annex.hs +++ b/Annex.hs @@ -14,9 +14,18 @@ import qualified GitRepo as Git import Types import qualified BackendTypes as Backend --- constructor -new :: Git.Repo -> AnnexState -new g = Backend.AnnexState { Backend.repo = g, Backend.backends = [] } +{- Create and returns an Annex state object for the specified git repo. + -} +new :: Git.Repo -> IO AnnexState +new g = do + let s = Backend.AnnexState { Backend.repo = g, Backend.backends = [] } + (_,s') <- Annex.run s (prep g) + return s' + where + prep g = do + -- read git config and update state + g' <- liftIO $ Git.configRead g + Annex.gitRepoChange g' -- performs an action in the Annex monad run state action = runStateT (action) state diff --git a/Backend.hs b/Backend.hs index 01c7c6823..7a8178a8e 100644 --- a/Backend.hs +++ b/Backend.hs @@ -52,7 +52,7 @@ storeFileKey :: FilePath -> Annex (Maybe (Key, Backend)) storeFileKey file = do g <- Annex.gitRepo let relfile = Git.relative g file - b <- Annex.backends + b <- backendList storeFileKey' b file relfile storeFileKey' [] _ _ = return Nothing storeFileKey' (b:bs) file relfile = do diff --git a/Backend/File.hs b/Backend/File.hs index 92f5932ce..893850a69 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -14,6 +14,7 @@ import Locations import qualified Remotes import qualified GitRepo as Git import Utility +import Core backend = Backend { name = "file", diff --git a/Core.hs b/Core.hs index 431c9c9e6..644bedd00 100644 --- a/Core.hs +++ b/Core.hs @@ -6,52 +6,39 @@ import System.IO import System.Directory import Control.Monad.State (liftIO) import Types -import BackendList import Locations import UUID import qualified GitRepo as Git import qualified Annex - -{- Create and returns an Annex state object. - - Examines and prepares the git repo. - -} -start :: IO AnnexState -start = do - g <- Git.repoFromCwd - let s = Annex.new g - (_,s') <- Annex.run s (prep g) - return s' - where - prep g = do - -- setup git and read its config; update state - g' <- liftIO $ Git.configRead g - Annex.gitRepoChange g' - liftIO $ gitSetup g' - prepUUID - + {- Sets up a git repo for git-annex. May be called repeatedly. -} -gitSetup :: Git.Repo -> IO () -gitSetup repo = do - -- configure git to use union merge driver on state files - exists <- doesFileExist attributes - if (not exists) - then do - writeFile attributes $ attrLine ++ "\n" - commit - else do - content <- readFile attributes - if (all (/= attrLine) (lines content)) +gitSetup :: Annex () +gitSetup = do + g <- Annex.gitRepo + liftIO $ setupattributes g + prepUUID + where + -- configure git to use union merge driver on state files + setupattributes repo = do + exists <- doesFileExist attributes + if (not exists) then do - appendFile attributes $ attrLine ++ "\n" + writeFile attributes $ attrLine ++ "\n" commit - else return () - where - attrLine = stateLoc ++ "/*.log merge=union" - attributes = Git.attributes repo - commit = do - Git.run repo ["add", attributes] - Git.run repo ["commit", "-m", "git-annex setup", - attributes] + else do + content <- readFile attributes + if (all (/= attrLine) (lines content)) + then do + appendFile attributes $ attrLine ++ "\n" + commit + else return () + where + attrLine = stateLoc ++ "/*.log merge=union" + attributes = Git.attributes repo + commit = do + Git.run repo ["add", attributes] + Git.run repo ["commit", "-m", "git-annex setup", + attributes] {- Checks if a given key is currently present in the annexLocation -} inAnnex :: Backend -> Key -> Annex Bool diff --git a/git-annex.hs b/git-annex.hs index 78e875014..f9d9311eb 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -7,12 +7,15 @@ import qualified Annex import Types import Core import Commands +import Annex +import qualified GitRepo as Git main = do args <- getArgs actions <- argvToActions args - state <- start - tryRun state actions + gitrepo <- Git.repoFromCwd + state <- new gitrepo + tryRun state (gitSetup:actions) {- Runs a list of Annex actions. Catches exceptions, not stopping - if some error out, and propigates an overall error status at the end. -- cgit v1.2.3 From 508a3b65ed675c9322940578614f088ea2c74e7f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 17:37:20 -0400 Subject: annex.numcopies works --- Backend.hs | 15 ++++++++++++++- Backend/File.hs | 13 +++++++++++++ Commands.hs | 41 ++++++++++++++++++++++++++++++++++++++++- Remotes.hs | 10 +--------- TODO | 3 +++ 5 files changed, 71 insertions(+), 11 deletions(-) diff --git a/Backend.hs b/Backend.hs index 7a8178a8e..47e42b822 100644 --- a/Backend.hs +++ b/Backend.hs @@ -15,8 +15,9 @@ module Backend ( storeFileKey, - removeKey, retrieveKeyFile, + removeKey, + hasKey, lookupFile ) where @@ -77,6 +78,18 @@ retrieveKeyFile backend key dest = (B.retrieveKeyFile backend) key dest removeKey :: Backend -> Key -> Annex Bool removeKey backend key = (B.removeKey backend) key +{- Checks if any backend has a key. -} +hasKey :: Key -> Annex Bool +hasKey key = do + b <- backendList + hasKey' b key +hasKey' [] key = return False +hasKey' (b:bs) key = do + has <- (B.hasKey b) key + if (has) + then return True + else hasKey' bs key + {- Looks up the key and backend corresponding to an annexed file, - by examining what the file symlinks to. -} lookupFile :: FilePath -> IO (Maybe (Key, Backend)) diff --git a/Backend/File.hs b/Backend/File.hs index 893850a69..def2f3091 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -15,6 +15,8 @@ import qualified Remotes import qualified GitRepo as Git import Utility import Core +import qualified Annex +import UUID backend = Backend { name = "file", @@ -49,6 +51,9 @@ checkKeyFile k = inAnnex backend k copyKeyFile :: Key -> FilePath -> Annex (Bool) copyKeyFile key file = do remotes <- Remotes.withKey key + if (0 == length remotes) + then cantfind + else return () trycopy remotes remotes where trycopy full [] = error $ "unable to get: " ++ (keyFile key) ++ "\n" ++ @@ -68,6 +73,14 @@ copyKeyFile key file = do liftIO $ hPutStrLn stderr (show err) trycopy full rs Right succ -> return True + cantfind = do + g <- Annex.gitRepo + uuids <- liftIO $ keyLocations g key + error $ "no available git remotes have: " ++ + (keyFile key) ++ (uuidlist uuids) + uuidlist [] = "" + uuidlist uuids = "\nIt has been seen before in these repositories:\n" ++ + prettyPrintUUIDs uuids {- Tries to copy a file from a remote, exception on error. -} copyFromRemote :: Git.Repo -> Key -> FilePath -> IO () diff --git a/Commands.hs b/Commands.hs index 730663b0d..6128b76aa 100644 --- a/Commands.hs +++ b/Commands.hs @@ -8,6 +8,7 @@ import System.Posix.Files import System.Directory import Data.String.Utils import List +import IO import qualified GitRepo as Git import qualified Annex import Utility @@ -18,6 +19,7 @@ import UUID import LocationLog import Types import Core +import qualified Remotes options :: [OptDescr (String -> Annex ())] options = @@ -138,7 +140,7 @@ wantCmd file = do error "not implemented" -- TODO {- Indicates a file is not wanted. -} dropCmd :: FilePath -> Annex () dropCmd file = notinBackend file err $ \(key, backend) -> do - -- TODO only remove if enough copies are present elsewhere + requireEnoughCopies key success <- Backend.removeKey backend key if (success) then do @@ -181,3 +183,40 @@ inBackend file yes no = do Just v -> yes v Nothing -> no notinBackend file yes no = inBackend file no yes + +{- Checks remotes to verify that enough copies of a key exist to allow + - for a key to be safely removed (with no data loss), and fails with an + - error if not. -} +requireEnoughCopies :: Key -> Annex () +requireEnoughCopies key = do + g <- Annex.gitRepo + let numcopies = read $ Git.configGet g config "1" + remotes <- Remotes.withKey key + if (numcopies > length remotes) + then error $ "I only know about " ++ (show $ length remotes) ++ + " out of " ++ (show numcopies) ++ + " necessary copies of: " ++ (keyFile key) ++ + unsafe + else findcopies numcopies remotes [] + where + findcopies 0 _ _ = return () -- success, enough copies found + findcopies _ [] bad = die bad + findcopies n (r:rs) bad = do + result <- liftIO $ try $ haskey r + case (result) of + Right True -> findcopies (n-1) rs bad + Left _ -> findcopies n rs (r:bad) + haskey r = do + -- To check if a remote has a key, construct a new + -- Annex monad and query its backend. + a <- Annex.new r + (result, _) <- Annex.run a (Backend.hasKey key) + return result + die bad = + error $ "I failed to find enough other copies of: " ++ + (keyFile key) ++ "\n" ++ + "I was unable to access these remotes: " ++ + (Remotes.list bad) ++ unsafe + unsafe = "\n -- According to the " ++ config ++ + " setting, it is not safe to remove it!" + config = "annex.numcopies" diff --git a/Remotes.hs b/Remotes.hs index f20d51ab3..2fffcffa7 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -40,15 +40,7 @@ withKey key = do mayberemotes <- mapM tryGitConfigRead allremotes let allremotes' = catMaybes mayberemotes remotes' <- reposByUUID allremotes' uuids - if (0 == length remotes') - then err uuids - else return remotes' - err uuids = - error $ "no available git remotes have: " ++ - (keyFile key) ++ (uuidlist uuids) - uuidlist [] = "" - uuidlist uuids = "\nIt has been seen before in these repositories:\n" ++ - prettyPrintUUIDs uuids + return remotes' {- Cost Ordered list of remotes. -} remotesByCost :: Annex [Git.Repo] diff --git a/TODO b/TODO index c4ce74e19..70ace863e 100644 --- a/TODO +++ b/TODO @@ -1,6 +1,9 @@ * bug when annexing files while in a subdir of a git repo * bug when specifying absolute path to files when annexing +* need to include backend name as part of the key, because currently + if two backends have overlapping key spaces, it can confuse things + * --push/--pull/--want * how to handle git mv file? -- cgit v1.2.3 From 467c4b2751921818f86561d85b0927254e48d956 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 17:57:04 -0400 Subject: better shutdown --- Commands.hs | 9 +++------ Core.hs | 57 +++++++++++++++++++++++++++++++++------------------------ git-annex.hs | 14 +++++++------- 3 files changed, 43 insertions(+), 37 deletions(-) diff --git a/Commands.hs b/Commands.hs index 6128b76aa..58d88aa3b 100644 --- a/Commands.hs +++ b/Commands.hs @@ -171,11 +171,7 @@ logStatus key status = do g <- Annex.gitRepo u <- getUUID g f <- liftIO $ logChange g key u status - liftIO $ commit g f - where - commit g f = do - Git.run g ["add", f] - Git.run g ["commit", "-m", "git-annex log update", f] + liftIO $ Git.run g ["add", f] -- committed at shutdown inBackend file yes no = do r <- liftIO $ Backend.lookupFile file @@ -204,7 +200,8 @@ requireEnoughCopies key = do findcopies n (r:rs) bad = do result <- liftIO $ try $ haskey r case (result) of - Right True -> findcopies (n-1) rs bad + Right True -> do + findcopies (n-1) rs bad Left _ -> findcopies n rs (r:bad) haskey r = do -- To check if a remote has a key, construct a new diff --git a/Core.hs b/Core.hs index 644bedd00..5182a6855 100644 --- a/Core.hs +++ b/Core.hs @@ -11,34 +11,43 @@ import UUID import qualified GitRepo as Git import qualified Annex -{- Sets up a git repo for git-annex. May be called repeatedly. -} -gitSetup :: Annex () -gitSetup = do +{- Sets up a git repo for git-annex. -} +setup :: Annex () +setup = do g <- Annex.gitRepo - liftIO $ setupattributes g + liftIO $ gitAttributes g prepUUID - where - -- configure git to use union merge driver on state files - setupattributes repo = do - exists <- doesFileExist attributes - if (not exists) + +{- When git-annex is done, it runs this. -} +shutdown :: Annex () +shutdown = do + g <- Annex.gitRepo + liftIO $ Git.run g ["commit", "-m", + "git-annex log update", ".git-annex"] + +{- configure git to use union merge driver on state files, if it is not + - already -} +gitAttributes :: Git.Repo -> IO () +gitAttributes repo = do + exists <- doesFileExist attributes + if (not exists) + then do + writeFile attributes $ attrLine ++ "\n" + commit + else do + content <- readFile attributes + if (all (/= attrLine) (lines content)) then do - writeFile attributes $ attrLine ++ "\n" + appendFile attributes $ attrLine ++ "\n" commit - else do - content <- readFile attributes - if (all (/= attrLine) (lines content)) - then do - appendFile attributes $ attrLine ++ "\n" - commit - else return () - where - attrLine = stateLoc ++ "/*.log merge=union" - attributes = Git.attributes repo - commit = do - Git.run repo ["add", attributes] - Git.run repo ["commit", "-m", "git-annex setup", - attributes] + else return () + where + attrLine = stateLoc ++ "/*.log merge=union" + attributes = Git.attributes repo + commit = do + Git.run repo ["add", attributes] + Git.run repo ["commit", "-m", "git-annex setup", + attributes] {- Checks if a given key is currently present in the annexLocation -} inAnnex :: Backend -> Key -> Annex Bool diff --git a/git-annex.hs b/git-annex.hs index f9d9311eb..e14739195 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -15,7 +15,7 @@ main = do actions <- argvToActions args gitrepo <- Git.repoFromCwd state <- new gitrepo - tryRun state (gitSetup:actions) + tryRun state $ [setup] ++ actions ++ [shutdown] {- Runs a list of Annex actions. Catches exceptions, not stopping - if some error out, and propigates an overall error status at the end. @@ -26,18 +26,18 @@ main = do - thread AnnexState through this function. -} tryRun :: AnnexState -> [Annex ()] -> IO () -tryRun state actions = tryRun' state 0 0 actions -tryRun' state errnum oknum (a:as) = do +tryRun state actions = tryRun' state 0 actions +tryRun' state errnum (a:as) = do result <- try (Annex.run state a)::IO (Either SomeException ((), AnnexState)) case (result) of Left err -> do showErr err - tryRun' state (errnum + 1) oknum as - Right (_,state') -> tryRun' state' errnum (oknum + 1) as -tryRun' state errnum oknum [] = do + tryRun' state (errnum + 1) as + Right (_,state') -> tryRun' state' errnum as +tryRun' state errnum [] = do if (errnum > 0) - then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok" + then error $ (show errnum) ++ " failed" else return () {- Exception pretty-printing. -} -- cgit v1.2.3 From c4959fee47f168857998dea6d11395158251158d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 18:48:21 -0400 Subject: bugfix --- Commands.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/Commands.hs b/Commands.hs index 58d88aa3b..ce8f00fd6 100644 --- a/Commands.hs +++ b/Commands.hs @@ -200,9 +200,9 @@ requireEnoughCopies key = do findcopies n (r:rs) bad = do result <- liftIO $ try $ haskey r case (result) of - Right True -> do - findcopies (n-1) rs bad - Left _ -> findcopies n rs (r:bad) + Right True -> findcopies (n-1) rs bad + Right False -> findcopies n rs bad + Left _ -> findcopies n rs (r:bad) haskey r = do -- To check if a remote has a key, construct a new -- Annex monad and query its backend. @@ -211,9 +211,11 @@ requireEnoughCopies key = do return result die bad = error $ "I failed to find enough other copies of: " ++ - (keyFile key) ++ "\n" ++ - "I was unable to access these remotes: " ++ - (Remotes.list bad) ++ unsafe + (keyFile key) ++ + (if (0 /= length bad) then listbad bad else "") + ++ unsafe + listbad bad = "\nI was unable to access these remotes: " ++ + (Remotes.list bad) unsafe = "\n -- According to the " ++ config ++ " setting, it is not safe to remove it!" config = "annex.numcopies" -- cgit v1.2.3 From b8ba60428a0b4c077482560757e830e9ba02a823 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 19:36:11 -0400 Subject: changed key to include backend name --- Backend/File.hs | 6 +++--- BackendTypes.hs | 20 +++++++++++++++----- Commands.hs | 18 +++++++++--------- Core.hs | 6 +++--- Locations.hs | 19 ++++++++++--------- 5 files changed, 40 insertions(+), 29 deletions(-) diff --git a/Backend/File.hs b/Backend/File.hs index def2f3091..6267b478a 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -29,7 +29,7 @@ backend = Backend { -- direct mapping from filename to key keyValue :: FilePath -> Annex (Maybe Key) -keyValue file = return $ Just $ Key file +keyValue file = return $ Just $ Key ((name backend), file) {- This backend does not really do any independant data storage, - it relies on the file contents in .git/annex/ in this repo, @@ -44,7 +44,7 @@ dummyRemove url = return True {- Just check if the .git/annex/ file for the key exists. -} checkKeyFile :: Key -> Annex Bool -checkKeyFile k = inAnnex backend k +checkKeyFile k = inAnnex k {- Try to find a copy of the file in one of the remotes, - and copy it over to this one. -} @@ -97,4 +97,4 @@ copyFromRemote r key file = do then return () else error "cp failed" getremote = error "get via network not yet implemented!" - location = annexLocation r backend key + location = annexLocation r key diff --git a/BackendTypes.hs b/BackendTypes.hs index e480f725b..e0f5f7373 100644 --- a/BackendTypes.hs +++ b/BackendTypes.hs @@ -5,7 +5,7 @@ module BackendTypes where -import Control.Monad.State +import Control.Monad.State (StateT) import Data.String.Utils import qualified GitRepo as Git @@ -19,12 +19,22 @@ data AnnexState = AnnexState { -- git-annex's monad type Annex = StateT AnnexState IO --- annexed filenames are mapped into keys -data Key = Key String deriving (Eq) +-- annexed filenames are mapped through a backend into keys +type KeyFrag = String +type BackendName = String +data Key = Key (BackendName, KeyFrag) deriving (Eq) --- show a key to convert it to a string +-- show a key to convert it to a string; the string includes the +-- name of the backend to avoid collisions between key strings instance Show Key where - show (Key v) = v + show (Key (b, k)) = b ++ ":" ++ k + +instance Read Key where + readsPrec _ s = [((Key (b,k)) ,"")] + where + l = split ":" s + b = l !! 0 + k = join ":" $ drop 1 l -- this structure represents a key/value backend data Backend = Backend { diff --git a/Commands.hs b/Commands.hs index ce8f00fd6..7ff33ab02 100644 --- a/Commands.hs +++ b/Commands.hs @@ -66,7 +66,7 @@ addCmd file = inBackend file err $ do Nothing -> error $ "no backend could store: " ++ file Just (key, backend) -> do logStatus key ValuePresent - liftIO $ setup g key backend + liftIO $ setup g key where err = error $ "already annexed " ++ file checkLegal file = do @@ -74,9 +74,9 @@ addCmd file = inBackend file err $ do if ((isSymbolicLink s) || (not $ isRegularFile s)) then error $ "not a regular file: " ++ file else return () - setup g key backend = do - let dest = annexLocation g backend key - let reldest = annexLocationRelative g backend key + setup g key = do + let dest = annexLocation g key + let reldest = annexLocationRelative g key createDirectoryIfMissing True (parentDir dest) renameFile file dest createSymbolicLink ((linkTarget file) ++ reldest) file @@ -99,7 +99,7 @@ unannexCmd file = notinBackend file err $ \(key, backend) -> do Backend.removeKey backend key logStatus key ValueMissing g <- Annex.gitRepo - let src = annexLocation g backend key + let src = annexLocation g key liftIO $ moveout g src where err = error $ "not annexed " ++ file @@ -117,12 +117,12 @@ unannexCmd file = notinBackend file err $ \(key, backend) -> do {- Gets an annexed file from one of the backends. -} getCmd :: FilePath -> Annex () getCmd file = notinBackend file err $ \(key, backend) -> do - inannex <- inAnnex backend key + inannex <- inAnnex key if (inannex) then return () else do g <- Annex.gitRepo - let dest = annexLocation g backend key + let dest = annexLocation g key liftIO $ createDirectoryIfMissing True (parentDir dest) success <- Backend.retrieveKeyFile backend key dest if (success) @@ -145,11 +145,11 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do if (success) then do logStatus key ValueMissing - inannex <- inAnnex backend key + inannex <- inAnnex key if (inannex) then do g <- Annex.gitRepo - let loc = annexLocation g backend key + let loc = annexLocation g key liftIO $ removeFile loc return () else return () diff --git a/Core.hs b/Core.hs index 5182a6855..6f05394bb 100644 --- a/Core.hs +++ b/Core.hs @@ -50,7 +50,7 @@ gitAttributes repo = do attributes] {- Checks if a given key is currently present in the annexLocation -} -inAnnex :: Backend -> Key -> Annex Bool -inAnnex backend key = do +inAnnex :: Key -> Annex Bool +inAnnex key = do g <- Annex.gitRepo - liftIO $ doesFileExist $ annexLocation g backend key + liftIO $ doesFileExist $ annexLocation g key diff --git a/Locations.hs b/Locations.hs index 7b8beb14f..960a8938d 100644 --- a/Locations.hs +++ b/Locations.hs @@ -22,18 +22,19 @@ gitStateDir :: Git.Repo -> FilePath gitStateDir repo = (Git.workTree repo) ++ "/" ++ stateLoc ++ "/" {- An annexed file's content is stored in - - /path/to/repo/.git/annex// + - /path/to/repo/.git/annex/, where is of the form + - - - - (That allows deriving the key and backend by looking at the symlink to it.) + - That allows deriving the key and backend by looking at the symlink to it. -} -annexLocation :: Git.Repo -> Backend -> Key -> FilePath -annexLocation r backend key = - (Git.workTree r) ++ "/" ++ (annexLocationRelative r backend key) +annexLocation :: Git.Repo -> Key -> FilePath +annexLocation r key = + (Git.workTree r) ++ "/" ++ (annexLocationRelative r key) {- Annexed file's location relative to the gitWorkTree -} -annexLocationRelative :: Git.Repo -> Backend -> Key -> FilePath -annexLocationRelative r backend key = - Git.dir r ++ "/annex/" ++ (Backend.name backend) ++ "/" ++ (keyFile key) +annexLocationRelative :: Git.Repo -> Key -> FilePath +annexLocationRelative r key = + Git.dir r ++ "/annex/" ++ (keyFile key) {- Converts a key into a filename fragment. - @@ -51,5 +52,5 @@ 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 = Backend.Key $ +fileKey file = read $ replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file -- cgit v1.2.3 From 4c3ad80f320d3c4cccc3e41e4f2364155bae22a1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 20:05:04 -0400 Subject: bugfix --- Backend.hs | 20 +++++++------------- Backend/Url.hs | 11 +++++++---- BackendList.hs | 2 +- BackendTypes.hs | 8 ++++++++ TODO | 3 --- Types.hs | 4 +++- 6 files changed, 26 insertions(+), 22 deletions(-) diff --git a/Backend.hs b/Backend.hs index 47e42b822..f419831d2 100644 --- a/Backend.hs +++ b/Backend.hs @@ -78,17 +78,9 @@ retrieveKeyFile backend key dest = (B.retrieveKeyFile backend) key dest removeKey :: Backend -> Key -> Annex Bool removeKey backend key = (B.removeKey backend) key -{- Checks if any backend has a key. -} +{- Checks if a backend has its key. -} hasKey :: Key -> Annex Bool -hasKey key = do - b <- backendList - hasKey' b key -hasKey' [] key = return False -hasKey' (b:bs) key = do - has <- (B.hasKey b) key - if (has) - then return True - else hasKey' bs key +hasKey key = (B.hasKey (lookupBackendName $ backendName key)) key {- Looks up the key and backend corresponding to an annexed file, - by examining what the file symlinks to. -} @@ -101,6 +93,8 @@ lookupFile file = do where lookup = do l <- readSymbolicLink file - return $ Just (k l, b l) - k l = fileKey $ takeFileName $ l - b l = lookupBackendName $ takeFileName $ parentDir $ l + return $ Just $ pair $ takeFileName l + pair file = (k, b) + where + k = fileKey file + b = lookupBackendName $ backendName k diff --git a/Backend/Url.hs b/Backend/Url.hs index 325a7e217..e23767208 100644 --- a/Backend/Url.hs +++ b/Backend/Url.hs @@ -3,7 +3,8 @@ module Backend.Url (backend) where -import Control.Monad.State +import Control.Monad.State (liftIO) +import Data.String.Utils import System.Cmd import System.Exit import BackendTypes @@ -30,9 +31,11 @@ dummyOk :: Key -> Annex Bool dummyOk url = return True downloadUrl :: Key -> FilePath -> Annex Bool -downloadUrl url file = do - liftIO $ putStrLn $ "download: " ++ (show url) - result <- liftIO $ rawSystem "curl" ["-#", "-o", file, (show url)] +downloadUrl key file = do + liftIO $ putStrLn $ "download: " ++ url + result <- liftIO $ rawSystem "curl" ["-#", "-o", file, url] if (result == ExitSuccess) then return True else return False + where + url = join ":" $ drop 1 $ split ":" $ show key diff --git a/BackendList.hs b/BackendList.hs index e9f926ce2..b66110905 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -28,7 +28,7 @@ parseBackendList s = then supportedBackends else map (lookupBackendName) $ words s -{- Looks up a supported backed by name. -} +{- Looks up a supported backend by name. -} lookupBackendName :: String -> Backend lookupBackendName s = if ((length matches) /= 1) diff --git a/BackendTypes.hs b/BackendTypes.hs index e0f5f7373..41ff7e506 100644 --- a/BackendTypes.hs +++ b/BackendTypes.hs @@ -36,6 +36,14 @@ instance Read Key where b = l !! 0 k = join ":" $ drop 1 l +-- pulls the backend name out +backendName :: Key -> BackendName +backendName (Key (b,k)) = b + +-- pulls the key fragment out +keyFrag :: Key -> KeyFrag +keyFrag (Key (b,k)) = k + -- this structure represents a key/value backend data Backend = Backend { -- name of this backend diff --git a/TODO b/TODO index 70ace863e..c4ce74e19 100644 --- a/TODO +++ b/TODO @@ -1,9 +1,6 @@ * bug when annexing files while in a subdir of a git repo * bug when specifying absolute path to files when annexing -* need to include backend name as part of the key, because currently - if two backends have overlapping key spaces, it can confuse things - * --push/--pull/--want * how to handle git mv file? diff --git a/Types.hs b/Types.hs index 4262ed567..a0f120db0 100644 --- a/Types.hs +++ b/Types.hs @@ -3,8 +3,10 @@ module Types ( Annex, AnnexState, + Backend, Key, - Backend + backendName, + keyFrag ) where import BackendTypes -- cgit v1.2.3 From 29039fdf97f541a1077c9af65ccbe09dd2ae2b28 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 21:10:59 -0400 Subject: add flags, and change to subcommand style --- Annex.hs | 18 +++++++++++++++++- BackendTypes.hs | 7 ++++++- Commands.hs | 50 +++++++++++++++++++++++++++----------------------- Core.hs | 5 +++-- TODO | 2 ++ Types.hs | 3 ++- git-annex.hs | 4 ++-- 7 files changed, 59 insertions(+), 30 deletions(-) diff --git a/Annex.hs b/Annex.hs index 9be86c948..9e76b9b04 100644 --- a/Annex.hs +++ b/Annex.hs @@ -7,6 +7,9 @@ module Annex ( gitRepoChange, backends, backendsChange, + flagIsSet, + flagsChange, + Flag(..) ) where import Control.Monad.State @@ -18,7 +21,11 @@ import qualified BackendTypes as Backend -} new :: Git.Repo -> IO AnnexState new g = do - let s = Backend.AnnexState { Backend.repo = g, Backend.backends = [] } + let s = Backend.AnnexState { + Backend.repo = g, + Backend.backends = [], + Backend.flags = [] + } (_,s') <- Annex.run s (prep g) return s' where @@ -49,3 +56,12 @@ backendsChange b = do state <- get put state { Backend.backends = b } return () +flagIsSet :: Flag -> Annex Bool +flagIsSet flag = do + state <- get + return $ elem flag $ Backend.flags state +flagsChange :: [Flag] -> Annex () +flagsChange b = do + state <- get + put state { Backend.flags = b } + return () diff --git a/BackendTypes.hs b/BackendTypes.hs index 41ff7e506..1b67ef584 100644 --- a/BackendTypes.hs +++ b/BackendTypes.hs @@ -9,11 +9,16 @@ import Control.Monad.State (StateT) import Data.String.Utils import qualified GitRepo as Git +-- command-line flags +data Flag = Force + deriving (Eq, Read, Show) + -- git-annex's runtime state type doesn't really belong here, -- but it uses Backend, so has to be here to avoid a depends loop. data AnnexState = AnnexState { repo :: Git.Repo, - backends :: [Backend] + backends :: [Backend], + flags :: [Flag] } deriving (Show) -- git-annex's monad diff --git a/Commands.hs b/Commands.hs index 7ff33ab02..a16470fe3 100644 --- a/Commands.hs +++ b/Commands.hs @@ -1,6 +1,6 @@ {- git-annex command line -} -module Commands (argvToActions) where +module Commands (parseCmd) where import System.Console.GetOpt import Control.Monad.State (liftIO) @@ -21,30 +21,34 @@ import Types import Core import qualified Remotes -options :: [OptDescr (String -> Annex ())] -options = - [ Option ['a'] ["add"] (NoArg addCmd) "add files to annex" - , Option ['p'] ["push"] (NoArg pushCmd) "push annex to repos" - , Option ['P'] ["pull"] (NoArg pullCmd) "pull annex from repos" - , Option ['w'] ["want"] (NoArg wantCmd) "request file contents" - , Option ['g'] ["get"] (NoArg getCmd) "transfer file contents" - , Option ['d'] ["drop"] (NoArg dropCmd) "indicate file contents not needed" - , Option ['u'] ["unannex"] (NoArg unannexCmd) "undo --add" - ] - {- Parses command line and returns a list of actons to be run in the Annex - monad. -} -argvToActions :: [String] -> IO [Annex ()] -argvToActions argv = do - case getOpt Permute options argv of - ([],files,[]) -> return $ map defaultCmd files - -- one mode is normal case - (m:[],files,[]) -> return $ map m files - -- multiple modes is an error - (ms,files,[]) -> ioError (userError ("only one mode should be specified\n" ++ usageInfo header options)) - -- error case - (_,files,errs) -> ioError (userError (concat errs ++ usageInfo header options)) - where header = "Usage: git-annex [mode] file" +parseCmd :: [String] -> IO ([Flag], [Annex ()]) +parseCmd argv = do + (flags, nonopts) <- getopt + case (length nonopts) of + 0 -> error header + _ -> do + let c = lookupCmd (nonopts !! 0) + if (0 == length c) + then return $ (flags, map defaultCmd nonopts) + else do + return $ (flags, map (snd $ c !! 0) $ drop 1 nonopts) + where + getopt = case getOpt Permute options argv of + (flags, nonopts, []) -> return (flags, nonopts) + (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) + lookupCmd cmd = filter (\(c, a) -> c == cmd) cmds + cmds = [ ("add", addCmd) + , ("push", pushCmd) + , ("pull", pullCmd) + , ("want", wantCmd) + , ("drop", dropCmd) + , ("unannex", unannexCmd) + ] + header = "Usage: git-annex [" ++ + (join "|" $ map fst cmds) ++ "] file ..." + options = [ Option ['f'] ["force"] (NoArg Force) "" ] {- Default mode is to annex a file if it is not already, and otherwise - get its content. -} diff --git a/Core.hs b/Core.hs index 6f05394bb..765b1e6a7 100644 --- a/Core.hs +++ b/Core.hs @@ -12,8 +12,9 @@ import qualified GitRepo as Git import qualified Annex {- Sets up a git repo for git-annex. -} -setup :: Annex () -setup = do +startup :: [Flag] -> Annex () +startup flags = do + Annex.flagsChange flags g <- Annex.gitRepo liftIO $ gitAttributes g prepUUID diff --git a/TODO b/TODO index c4ce74e19..b800097a0 100644 --- a/TODO +++ b/TODO @@ -3,6 +3,8 @@ * --push/--pull/--want +* recurse on directories + * how to handle git mv file? * finish BackendChecksum diff --git a/Types.hs b/Types.hs index a0f120db0..6bf26d36e 100644 --- a/Types.hs +++ b/Types.hs @@ -6,7 +6,8 @@ module Types ( Backend, Key, backendName, - keyFrag + keyFrag, + Flag(..), ) where import BackendTypes diff --git a/git-annex.hs b/git-annex.hs index e14739195..cd67242af 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -12,10 +12,10 @@ import qualified GitRepo as Git main = do args <- getArgs - actions <- argvToActions args + (flags, actions) <- parseCmd args gitrepo <- Git.repoFromCwd state <- new gitrepo - tryRun state $ [setup] ++ actions ++ [shutdown] + tryRun state $ [startup flags] ++ actions ++ [shutdown] {- Runs a list of Annex actions. Catches exceptions, not stopping - if some error out, and propigates an overall error status at the end. -- cgit v1.2.3 From 1ab3e54ca8e56f8d7b8fd6ad4ceda888e19205f1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 21:12:54 -0400 Subject: docs --- git-annex.mdwn | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/git-annex.mdwn b/git-annex.mdwn index 62e4301eb..70bd66e95 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -13,7 +13,7 @@ associated with annexed files but that benefit from full revision control. Enough broad picture, here's how it actually looks: -* `git annex --add $file` moves the file into `.git/annex/`, and replaces +* `git annex add $file` moves the file into `.git/annex/`, and replaces it with a symlink pointing at the annexed file, and then calls `git add` to version the *symlink*. (If the file has already been annexed, it does nothing.) @@ -24,23 +24,23 @@ Enough broad picture, here's how it actually looks: * If you use normal git push/pull commands, the annexed file contents won't be sent, but the symlinks will be. So different clones of a repository can have different sets of annexed files available. -* `git annex --push $repository` pushes *all* annexed files to the specified +* `git annex push $repository` pushes *all* annexed files to the specified repository. -* `git annex --pull $repository` pulls *all* annexed files from the specified +* `git annex pull $repository` pulls *all* annexed files from the specified repository. -* `git annex --want $file` indicates that you want access to a file's +* `git annex want $file` indicates that you want access to a file's content, without immediatly transferring it. -* `git annex --get $file` is used to transfer a specified file, and/or - files previously indicated with --want. If a configured repository has it, +* `git annex get $file` is used to transfer a specified file, and/or + files previously indicated with `git annex want`. If a configured repository has it, or it is available from other key/value storage, it will be immediatly downloaded. -* `git annex --drop $file` indicates that you no longer want the file's +* `git annex drop $file` indicates that you no longer want the file's content to be available in this repository. -* `git annex --unannex $file` undoes a `git annex --add`. But use `--drop` - if you're just done with a file; only use `--unannex` if you +* `git annex unannex $file` undoes a `git annex add`. But use `git annex drop` + if you're just done with a file; only use `unannex` if you accidentially added a file. -* `git annex $file` is a shorthand for either --add or --get. If the file - is already known, it does --get, otherwise it does --add. +* `git annex $file` is a shorthand. If the file + is already known, it does `git annex get`, otherwise it does `git annex add`. ## copies @@ -48,17 +48,17 @@ git-annex can be configured to try to keep N copies of a file's content available across all repositories. By default, N is 1 (configured by annex.numcopies). -`git annex --drop` attempts to check all other configured +`git annex drop` attempts to check all other configured repositories, to check that N copies of the file exist. If enough repositories cannot be verified to have it, it will retain the file content to avoid data loss. For example, consider three repositories: Server, Laptop, and USB. Both Server -and USB have a copy of a file, and N=1. If on Laptop, you `git annex --get +and USB have a copy of a file, and N=1. If on Laptop, you `git annex get $file`, this will transfer it from either Server or USB (depending on which is available), and there are now 3 copies of the file. -Suppose you want to free up space on laptop again, and you --drop the file +Suppose you want to free up space on laptop again, and you `git annex drop` the file there. If USB is connected, or Server can be contacted, git-annex can check that it still has a copy of the file, and the content is removed from Laptop. But if USB is currently disconnected, and Server also cannot be @@ -108,11 +108,11 @@ to store different files' contents in a given repository. git-annex keeps track of on which repository it last saw a file's content. 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 +you indicate you want a file, git-annex will tell you which repositories have the file's content. Location tracking information is stored in `.git-annex/$key.log`. -Repositories record their UUID and the date when they --get or --drop +Repositories record their UUID and the date when they get or drop a file's content. (Git is configured to use a union merge for this file, so the lines may be in arbitrary order, but it will never conflict.) @@ -150,7 +150,7 @@ If the symlink to annexed content is relative, moving it to a subdir will break it. But it it's absolute, moving the git repo (or mounting its drive elsewhere) will break it. Either: -* Use relative links and need `git annex --mv` to move (or post-commit +* Use relative links and need `git annex mv` to move (or post-commit hook that caches moves and updates links). * Use absolute links and need `git annex fixlinks` when location changes; note that would also mean that git would see the symlink targets changed -- cgit v1.2.3 From c977b6b1f3833ed1ead9212d956d8f83a4ca9028 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 22:09:03 -0400 Subject: forcing --- Commands.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/Commands.hs b/Commands.hs index a16470fe3..6c519c294 100644 --- a/Commands.hs +++ b/Commands.hs @@ -144,7 +144,10 @@ wantCmd file = do error "not implemented" -- TODO {- Indicates a file is not wanted. -} dropCmd :: FilePath -> Annex () dropCmd file = notinBackend file err $ \(key, backend) -> do - requireEnoughCopies key + force <- Annex.flagIsSet Force + if (not force) + then requireEnoughCopies key + else return () success <- Backend.removeKey backend key if (success) then do @@ -220,6 +223,9 @@ requireEnoughCopies key = do ++ unsafe listbad bad = "\nI was unable to access these remotes: " ++ (Remotes.list bad) - unsafe = "\n -- According to the " ++ config ++ - " setting, it is not safe to remove it!" + unsafe = "\n" ++ + " -- According to the " ++ config ++ + " setting, it is not safe to remove it!\n" ++ + " (Use --force to override.)" + config = "annex.numcopies" -- cgit v1.2.3 From bbbe9858fe2e83767661282f7ab8ed3470ec6568 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 23:52:45 -0400 Subject: avoid empty commits --- Annex.hs | 11 +++++++---- BackendTypes.hs | 2 +- Commands.hs | 3 ++- Core.hs | 9 ++++++--- 4 files changed, 16 insertions(+), 9 deletions(-) diff --git a/Annex.hs b/Annex.hs index 9e76b9b04..08607cafa 100644 --- a/Annex.hs +++ b/Annex.hs @@ -8,7 +8,7 @@ module Annex ( backends, backendsChange, flagIsSet, - flagsChange, + flagChange, Flag(..) ) where @@ -60,8 +60,11 @@ flagIsSet :: Flag -> Annex Bool flagIsSet flag = do state <- get return $ elem flag $ Backend.flags state -flagsChange :: [Flag] -> Annex () -flagsChange b = do +flagChange :: Flag -> Bool -> Annex () +flagChange flag set = do state <- get - put state { Backend.flags = b } + let f = filter (/= flag) $ Backend.flags state + if (set) + then put state { Backend.flags = (flag:f) } + else put state { Backend.flags = f } return () diff --git a/BackendTypes.hs b/BackendTypes.hs index 1b67ef584..13ffde7f8 100644 --- a/BackendTypes.hs +++ b/BackendTypes.hs @@ -10,7 +10,7 @@ import Data.String.Utils import qualified GitRepo as Git -- command-line flags -data Flag = Force +data Flag = Force | NeedCommit deriving (Eq, Read, Show) -- git-annex's runtime state type doesn't really belong here, diff --git a/Commands.hs b/Commands.hs index 6c519c294..5b5bc269b 100644 --- a/Commands.hs +++ b/Commands.hs @@ -178,7 +178,8 @@ logStatus key status = do g <- Annex.gitRepo u <- getUUID g f <- liftIO $ logChange g key u status - liftIO $ Git.run g ["add", f] -- committed at shutdown + liftIO $ Git.run g ["add", f] + Annex.flagChange NeedCommit True inBackend file yes no = do r <- liftIO $ Backend.lookupFile file diff --git a/Core.hs b/Core.hs index 765b1e6a7..8f1c9cc80 100644 --- a/Core.hs +++ b/Core.hs @@ -14,7 +14,7 @@ import qualified Annex {- Sets up a git repo for git-annex. -} startup :: [Flag] -> Annex () startup flags = do - Annex.flagsChange flags + mapM (\f -> Annex.flagChange f True) flags g <- Annex.gitRepo liftIO $ gitAttributes g prepUUID @@ -23,8 +23,11 @@ startup flags = do shutdown :: Annex () shutdown = do g <- Annex.gitRepo - liftIO $ Git.run g ["commit", "-m", - "git-annex log update", ".git-annex"] + needcommit <- Annex.flagIsSet NeedCommit + if (needcommit) + then liftIO $ Git.run g ["commit", "-m", + "git-annex log update", ".git-annex"] + else return () {- configure git to use union merge driver on state files, if it is not - already -} -- cgit v1.2.3 From e7ffa5b594deb9d89d555b24f8ed7842951905af Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 23:57:22 -0400 Subject: update --- Commands.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/Commands.hs b/Commands.hs index 5b5bc269b..5021ba260 100644 --- a/Commands.hs +++ b/Commands.hs @@ -21,8 +21,8 @@ import Types import Core import qualified Remotes -{- Parses command line and returns a list of actons to be run in the Annex - - monad. -} +{- Parses command line and returns a list of flags and a list of + - actions to be run in the Annex monad. -} parseCmd :: [String] -> IO ([Flag], [Annex ()]) parseCmd argv = do (flags, nonopts) <- getopt @@ -40,15 +40,16 @@ parseCmd argv = do (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) lookupCmd cmd = filter (\(c, a) -> c == cmd) cmds cmds = [ ("add", addCmd) + , ("get", getCmd) + , ("drop", dropCmd) + , ("want", wantCmd) , ("push", pushCmd) , ("pull", pullCmd) - , ("want", wantCmd) - , ("drop", dropCmd) , ("unannex", unannexCmd) ] header = "Usage: git-annex [" ++ (join "|" $ map fst cmds) ++ "] file ..." - options = [ Option ['f'] ["force"] (NoArg Force) "" ] + options = [ Option ['f'] ["force"] (NoArg Force) "allow actions that may loose annexed data" ] {- Default mode is to annex a file if it is not already, and otherwise - get its content. -} -- cgit v1.2.3 From d7b170c9a2f9a7f52b6ef88243e249a04685764a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 14:26:16 -0400 Subject: cleanup --- Commands.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/Commands.hs b/Commands.hs index 5021ba260..aed3a19d3 100644 --- a/Commands.hs +++ b/Commands.hs @@ -25,16 +25,17 @@ import qualified Remotes - actions to be run in the Annex monad. -} parseCmd :: [String] -> IO ([Flag], [Annex ()]) parseCmd argv = do - (flags, nonopts) <- getopt - case (length nonopts) of + (flags, files) <- getopt + case (length files) of 0 -> error header _ -> do - let c = lookupCmd (nonopts !! 0) + let c = lookupCmd (files !! 0) if (0 == length c) - then return $ (flags, map defaultCmd nonopts) - else do - return $ (flags, map (snd $ c !! 0) $ drop 1 nonopts) + then ret flags defaultCmd files + else ret flags (snd $ c !! 0) $ drop 1 files where + ret flags cmd files = return (flags, makeactions cmd files) + makeactions cmd files = map cmd files getopt = case getOpt Permute options argv of (flags, nonopts, []) -> return (flags, nonopts) (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) -- cgit v1.2.3 From 80104eab9a28b9a94fb36653b7cd95b734e16e4d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 14:31:06 -0400 Subject: bugfix --- Core.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Core.hs b/Core.hs index 8f1c9cc80..7e719888a 100644 --- a/Core.hs +++ b/Core.hs @@ -26,7 +26,7 @@ shutdown = do needcommit <- Annex.flagIsSet NeedCommit if (needcommit) then liftIO $ Git.run g ["commit", "-m", - "git-annex log update", ".git-annex"] + "git-annex log update", gitStateDir g] else return () {- configure git to use union merge driver on state files, if it is not -- cgit v1.2.3 From e577656fea6f66ef64547374e962adb7fd4ce80a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 16:09:30 -0400 Subject: relative link fix --- Commands.hs | 25 ++++++++++++------------- Locations.hs | 5 ++--- Utility.hs | 48 +++++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 61 insertions(+), 17 deletions(-) diff --git a/Commands.hs b/Commands.hs index aed3a19d3..a403a5a48 100644 --- a/Commands.hs +++ b/Commands.hs @@ -6,6 +6,7 @@ import System.Console.GetOpt import Control.Monad.State (liftIO) import System.Posix.Files import System.Directory +import System.Path import Data.String.Utils import List import IO @@ -66,13 +67,14 @@ defaultCmd file = do addCmd :: FilePath -> Annex () addCmd file = inBackend file err $ do liftIO $ checkLegal file - stored <- Backend.storeFileKey file g <- Annex.gitRepo + link <- liftIO $ calcGitLink file g + stored <- Backend.storeFileKey file case (stored) of Nothing -> error $ "no backend could store: " ++ file Just (key, backend) -> do logStatus key ValuePresent - liftIO $ setup g key + liftIO $ setup g key link where err = error $ "already annexed " ++ file checkLegal file = do @@ -80,24 +82,21 @@ addCmd file = inBackend file err $ do if ((isSymbolicLink s) || (not $ isRegularFile s)) then error $ "not a regular file: " ++ file else return () - setup g key = do + calcGitLink file g = do + cwd <- getCurrentDirectory + let absfile = case (absNormPath cwd file) of + Just f -> f + Nothing -> error $ "unable to normalize " ++ file + return $ relPathDirToDir (parentDir absfile) (Git.workTree g) + setup g key link = do let dest = annexLocation g key let reldest = annexLocationRelative g key createDirectoryIfMissing True (parentDir dest) renameFile file dest - createSymbolicLink ((linkTarget file) ++ reldest) file + createSymbolicLink (link ++ reldest) file Git.run g ["add", file] Git.run g ["commit", "-m", ("git-annex annexed " ++ file), file] - linkTarget file = - -- relies on file being relative to the top of the - -- git repo; just replace each subdirectory with ".." - if (subdirs > 0) - then (join "/" $ take subdirs $ repeat "..") ++ "/" - else "" - where - subdirs = (length $ split "/" file) - 1 - {- Inverse of addCmd. -} unannexCmd :: FilePath -> Annex () diff --git a/Locations.hs b/Locations.hs index 960a8938d..733e74553 100644 --- a/Locations.hs +++ b/Locations.hs @@ -31,10 +31,9 @@ annexLocation :: Git.Repo -> Key -> FilePath annexLocation r key = (Git.workTree r) ++ "/" ++ (annexLocationRelative r key) -{- Annexed file's location relative to the gitWorkTree -} +{- Annexed file's location relative to git's working tree. -} annexLocationRelative :: Git.Repo -> Key -> FilePath -annexLocationRelative r key = - Git.dir r ++ "/annex/" ++ (keyFile key) +annexLocationRelative r key = Git.dir r ++ "/annex/" ++ (keyFile key) {- Converts a key into a filename fragment. - diff --git a/Utility.hs b/Utility.hs index 349dd9355..a8324815e 100644 --- a/Utility.hs +++ b/Utility.hs @@ -4,12 +4,16 @@ module Utility ( withFileLocked, hGetContentsStrict, - parentDir + parentDir, + relPathCwdToDir, + relPathDirToDir, ) where import System.IO import System.Posix.IO import Data.String.Utils +import System.Path +import System.Directory {- Let's just say that Haskell makes reading/writing a file with - file locking excessively difficult. -} @@ -39,3 +43,45 @@ parentDir dir = where dirs = filter (\x -> length x > 0) $ split "/" dir absolute = if ((dir !! 0) == '/') then "/" else "" + +{- Constructs a relative path from the CWD to a directory. + - + - For example, assuming CWD is /tmp/foo/bar: + - relPathCwdToDir "/tmp/foo" == "../" + - relPathCwdToDir "/tmp/foo/bar" == "" + - relPathCwdToDir "/tmp/foo/bar" == "" + -} +relPathCwdToDir :: FilePath -> IO FilePath +relPathCwdToDir dir = do + cwd <- getCurrentDirectory + let absdir = abs cwd dir + return $ relPathDirToDir cwd absdir + where + -- absolute, normalized form of the directory + abs cwd dir = + case (absNormPath cwd dir) of + Just d -> d + Nothing -> error $ "unable to normalize " ++ dir + +{- Constructs a relative path from one directory to another. + - + - Both directories must be absolute, and normalized (eg with absNormpath). + - + - The path will end with "/", unless it is empty. + - -} +relPathDirToDir :: FilePath -> FilePath -> FilePath +relPathDirToDir from to = + if (0 < length path) + then if (endswith "/" path) + then path + else path ++ "/" + else "" + where + pfrom = split "/" from + pto = split "/" to + common = map fst $ filter same $ zip pfrom pto + same (c,d) = c == d + uncommon = drop numcommon pto + dotdots = take ((length pfrom) - numcommon) $ repeat ".." + numcommon = length $ common + path = join "/" $ dotdots ++ uncommon -- cgit v1.2.3 From 0e8cb63aabaa4a80769792fb07b0db2594efd6b0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 16:25:52 -0400 Subject: update --- TODO | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/TODO b/TODO index b800097a0..ddd076165 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,4 @@ -* bug when annexing files while in a subdir of a git repo -* bug when specifying absolute path to files when annexing +* bug: cannot "git annex ../foo" (GitRepo.relative is buggy) * --push/--pull/--want -- cgit v1.2.3 From 395625d0a7c00457f63925beb31078f3eb3d9f79 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 16:42:36 -0400 Subject: rename file -> WORM --- Backend/Checksum.hs | 1 - Backend/File.hs | 22 ++++++++++------------ Backend/Worm.hs | 16 ++++++++++++++++ BackendList.hs | 4 ++-- git-annex.mdwn | 4 ++-- 5 files changed, 30 insertions(+), 17 deletions(-) create mode 100644 Backend/Worm.hs diff --git a/Backend/Checksum.hs b/Backend/Checksum.hs index bfc789e40..de98fbf44 100644 --- a/Backend/Checksum.hs +++ b/Backend/Checksum.hs @@ -7,7 +7,6 @@ import qualified Backend.File import Data.Digest.Pure.SHA import BackendTypes --- based on BackendFile just with a different key type backend = Backend.File.backend { name = "checksum", getKey = keyValue diff --git a/Backend/File.hs b/Backend/File.hs index 6267b478a..eba4b88f8 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -1,5 +1,12 @@ -{- git-annex "file" backend - - -} +{- git-annex pseudo-backend + - + - This backend does not really do any independant data storage, + - it relies on the file contents in .git/annex/ in this repo, + - and other accessible repos. + - + - This is an abstract backend; getKey has to be implemented to complete + - it. + -} module Backend.File (backend) where @@ -19,22 +26,13 @@ import qualified Annex import UUID backend = Backend { - name = "file", - getKey = keyValue, storeFileKey = dummyStore, retrieveKeyFile = copyKeyFile, removeKey = dummyRemove, hasKey = checkKeyFile } --- direct mapping from filename to key -keyValue :: FilePath -> Annex (Maybe Key) -keyValue file = return $ Just $ Key ((name backend), file) - -{- This backend does not really do any independant data storage, - - it relies on the file contents in .git/annex/ in this repo, - - and other accessible repos. So storing a key is - - a no-op. -} +{- Storing a key is a no-op. -} dummyStore :: FilePath -> Key -> Annex (Bool) dummyStore file key = return True diff --git a/Backend/Worm.hs b/Backend/Worm.hs new file mode 100644 index 000000000..26fffab52 --- /dev/null +++ b/Backend/Worm.hs @@ -0,0 +1,16 @@ +{- git-annex "WORM" backend -- Write Once, Read Many + - -} + +module Backend.Worm (backend) where + +import qualified Backend.File +import BackendTypes + +backend = Backend.File.backend { + name = "WORM", + getKey = keyValue +} + +-- direct mapping from filename to key +keyValue :: FilePath -> Annex (Maybe Key) +keyValue file = return $ Just $ Key ((name backend), file) diff --git a/BackendList.hs b/BackendList.hs index b66110905..93c0464f1 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -10,11 +10,11 @@ module BackendList ( import BackendTypes -- When adding a new backend, import it here and add it to the list. -import qualified Backend.File +import qualified Backend.Worm import qualified Backend.Checksum import qualified Backend.Url supportedBackends = - [ Backend.File.backend + [ Backend.Worm.backend , Backend.Checksum.backend , Backend.Url.backend ] diff --git a/git-annex.mdwn b/git-annex.mdwn index 70bd66e95..fba9648db 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -93,8 +93,8 @@ stable for a given file content, name, and size. Multiple pluggable backends are supported, and more than one can be used to store different files' contents in a given repository. -* `file` -- This backend stores the file's content in - `.git/annex/`, and assumes that any file with the same basename +* `WORM` ("Write Once, Read Many") This backend stores the file's content + in `.git/annex/`, and assumes that any file with the same basename has the same content. So with this backend, files can be moved around, but should never be added to or changed. This is the default, and the least expensive backend. -- cgit v1.2.3 From 1f585912e2097234ecad599a072610000e7744f0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 16:52:47 -0400 Subject: use basename as key --- Backend/Worm.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/Backend/Worm.hs b/Backend/Worm.hs index 26fffab52..ba79428ef 100644 --- a/Backend/Worm.hs +++ b/Backend/Worm.hs @@ -5,12 +5,14 @@ module Backend.Worm (backend) where import qualified Backend.File import BackendTypes +import Utility +import System.FilePath backend = Backend.File.backend { name = "WORM", getKey = keyValue } --- direct mapping from filename to key +-- direct mapping from basename of filename to key keyValue :: FilePath -> Annex (Maybe Key) -keyValue file = return $ Just $ Key ((name backend), file) +keyValue file = return $ Just $ Key ((name backend), (takeFileName file)) -- cgit v1.2.3 From 8e742bd89e6bd3d83c44847c0455043809c64c89 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 18:24:31 -0400 Subject: use some library functions --- Utility.hs | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/Utility.hs b/Utility.hs index a8324815e..105c533ec 100644 --- a/Utility.hs +++ b/Utility.hs @@ -13,6 +13,7 @@ import System.IO import System.Posix.IO import Data.String.Utils import System.Path +import System.FilePath import System.Directory {- Let's just say that Haskell makes reading/writing a file with @@ -38,11 +39,13 @@ hGetContentsStrict h = hGetContents h >>= \s -> length s `seq` return s parentDir :: String -> String parentDir dir = if length dirs > 0 - then absolute ++ (join "/" $ take ((length dirs) - 1) dirs) + then slash ++ (join s $ take ((length dirs) - 1) dirs) else "" where - dirs = filter (\x -> length x > 0) $ split "/" dir - absolute = if ((dir !! 0) == '/') then "/" else "" + dirs = filter (\x -> length x > 0) $ + split s dir + slash = if (isAbsolute dir) then "" else s + s = [pathSeparator] {- Constructs a relative path from the CWD to a directory. - @@ -68,20 +71,19 @@ relPathCwdToDir dir = do - Both directories must be absolute, and normalized (eg with absNormpath). - - The path will end with "/", unless it is empty. - - -} + -} relPathDirToDir :: FilePath -> FilePath -> FilePath relPathDirToDir from to = if (0 < length path) - then if (endswith "/" path) - then path - else path ++ "/" + then addTrailingPathSeparator path else "" where - pfrom = split "/" from - pto = split "/" to + s = [pathSeparator] + pfrom = split s from + pto = split s to common = map fst $ filter same $ zip pfrom pto same (c,d) = c == d uncommon = drop numcommon pto dotdots = take ((length pfrom) - numcommon) $ repeat ".." numcommon = length $ common - path = join "/" $ dotdots ++ uncommon + path = join s $ dotdots ++ uncommon -- cgit v1.2.3 From 44b8f7c95de84018044ce3669e62d40eac1b91a7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 18:57:05 -0400 Subject: better worm keys --- Backend/Worm.hs | 24 ++++++++++++++++++++++-- git-annex.mdwn | 8 ++++---- 2 files changed, 26 insertions(+), 6 deletions(-) diff --git a/Backend/Worm.hs b/Backend/Worm.hs index ba79428ef..89fe4bf57 100644 --- a/Backend/Worm.hs +++ b/Backend/Worm.hs @@ -3,16 +3,36 @@ module Backend.Worm (backend) where +import Control.Monad.State import qualified Backend.File import BackendTypes import Utility import System.FilePath +import System.Posix.Files +import Data.Digest.Pure.SHA -- slow, but we only checksum filenames +import qualified Data.ByteString.Lazy.Char8 as B backend = Backend.File.backend { name = "WORM", getKey = keyValue } --- direct mapping from basename of filename to key +-- A SHA1 of the basename of the filename, plus the file size and +-- modification time, is used as the unique part of the key. That +-- allows multiple files with the same names to have different keys, +-- while also allowing a file to be moved around while retaining the +-- same key. +-- +-- The basename of the filename is also included in the key, so it's clear +-- what the original filename was when a user sees the value. keyValue :: FilePath -> Annex (Maybe Key) -keyValue file = return $ Just $ Key ((name backend), (takeFileName file)) +keyValue file = do + stat <- liftIO $ getFileStatus file + return $ Just $ Key ((name backend), key stat) + where + key stat = (checksum $ uniqueid stat) ++ sep ++ base + checksum s = show $ sha1 $ B.pack s + uniqueid stat = (show $ fileSize stat) ++ sep ++ + (show $ modificationTime stat) + base = takeFileName file + sep = ":" diff --git a/git-annex.mdwn b/git-annex.mdwn index fba9648db..2079b5b46 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -94,10 +94,10 @@ Multiple pluggable backends are supported, and more than one can be used to store different files' contents in a given repository. * `WORM` ("Write Once, Read Many") This backend stores the file's content - in `.git/annex/`, and assumes that any file with the same basename - has the same content. So with this backend, files can be moved around, - but should never be added to or changed. This is the default, and - the least expensive backend. + in `.git/annex/`, and assumes that any file with the same basename, + size, and modification time has the same content. So with this backend, + files can be moved around, but should never be added to or changed. + This is the default, and the least expensive backend. * `sha1sum` -- This backend stores the file's content in `.git/annex/`, with a name based on its sha1 checksum. This backend allows modifications of files to be tracked. Its need to generate checksums -- cgit v1.2.3 From 0989dd2694e4be1bc851d0a50903ceaaa988907a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 18:58:26 -0400 Subject: Revert "use some library functions" This reverts commit 8e742bd89e6bd3d83c44847c0455043809c64c89. meh? --- Utility.hs | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/Utility.hs b/Utility.hs index 105c533ec..a8324815e 100644 --- a/Utility.hs +++ b/Utility.hs @@ -13,7 +13,6 @@ import System.IO import System.Posix.IO import Data.String.Utils import System.Path -import System.FilePath import System.Directory {- Let's just say that Haskell makes reading/writing a file with @@ -39,13 +38,11 @@ hGetContentsStrict h = hGetContents h >>= \s -> length s `seq` return s parentDir :: String -> String parentDir dir = if length dirs > 0 - then slash ++ (join s $ take ((length dirs) - 1) dirs) + then absolute ++ (join "/" $ take ((length dirs) - 1) dirs) else "" where - dirs = filter (\x -> length x > 0) $ - split s dir - slash = if (isAbsolute dir) then "" else s - s = [pathSeparator] + dirs = filter (\x -> length x > 0) $ split "/" dir + absolute = if ((dir !! 0) == '/') then "/" else "" {- Constructs a relative path from the CWD to a directory. - @@ -71,19 +68,20 @@ relPathCwdToDir dir = do - Both directories must be absolute, and normalized (eg with absNormpath). - - The path will end with "/", unless it is empty. - -} + - -} relPathDirToDir :: FilePath -> FilePath -> FilePath relPathDirToDir from to = if (0 < length path) - then addTrailingPathSeparator path + then if (endswith "/" path) + then path + else path ++ "/" else "" where - s = [pathSeparator] - pfrom = split s from - pto = split s to + pfrom = split "/" from + pto = split "/" to common = map fst $ filter same $ zip pfrom pto same (c,d) = c == d uncommon = drop numcommon pto dotdots = take ((length pfrom) - numcommon) $ repeat ".." numcommon = length $ common - path = join s $ dotdots ++ uncommon + path = join "/" $ dotdots ++ uncommon -- cgit v1.2.3 From 23f95ac6df5f25613ac2904c23821f3ca3054246 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 19:01:20 -0400 Subject: use some library functions retry with a bugfix --- Utility.hs | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/Utility.hs b/Utility.hs index a8324815e..e04b44e6f 100644 --- a/Utility.hs +++ b/Utility.hs @@ -13,6 +13,7 @@ import System.IO import System.Posix.IO import Data.String.Utils import System.Path +import System.FilePath import System.Directory {- Let's just say that Haskell makes reading/writing a file with @@ -38,11 +39,13 @@ hGetContentsStrict h = hGetContents h >>= \s -> length s `seq` return s parentDir :: String -> String parentDir dir = if length dirs > 0 - then absolute ++ (join "/" $ take ((length dirs) - 1) dirs) + then slash ++ (join s $ take ((length dirs) - 1) dirs) else "" where - dirs = filter (\x -> length x > 0) $ split "/" dir - absolute = if ((dir !! 0) == '/') then "/" else "" + dirs = filter (\x -> length x > 0) $ + split s dir + slash = if (not $ isAbsolute dir) then "" else s + s = [pathSeparator] {- Constructs a relative path from the CWD to a directory. - @@ -68,20 +71,19 @@ relPathCwdToDir dir = do - Both directories must be absolute, and normalized (eg with absNormpath). - - The path will end with "/", unless it is empty. - - -} + -} relPathDirToDir :: FilePath -> FilePath -> FilePath relPathDirToDir from to = if (0 < length path) - then if (endswith "/" path) - then path - else path ++ "/" + then addTrailingPathSeparator path else "" where - pfrom = split "/" from - pto = split "/" to + s = [pathSeparator] + pfrom = split s from + pto = split s to common = map fst $ filter same $ zip pfrom pto same (c,d) = c == d uncommon = drop numcommon pto dotdots = take ((length pfrom) - numcommon) $ repeat ".." numcommon = length $ common - path = join "/" $ dotdots ++ uncommon + path = join s $ dotdots ++ uncommon -- cgit v1.2.3 From 946a7f3f2128704c7b4eeea265a1375c1b60c622 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 19:32:33 -0400 Subject: update --- git-annex.mdwn | 61 ++++++++++++++++++++++++++-------------------------------- 1 file changed, 27 insertions(+), 34 deletions(-) diff --git a/git-annex.mdwn b/git-annex.mdwn index 2079b5b46..21649bfd1 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -1,15 +1,15 @@ git-annex allows managing files with git, without checking the file -contents into git. This is useful when dealing with files larger than git -can currently easily handle, whether due to limitations in memory, -checksumming time, or disk space (only one copy need be stored of an -annexed file). - -Even without file content tracking, being able to manage file metadata with -git, move files around and delete files with versioned directory trees, and use -branches and distributed clone, are all very handy reasons to use git. And -annexed files can co-exist in the same git repository with regularly versioned -files, which is convenient for maintaining code, Makefiles, etc that are -associated with annexed files but that benefit from full revision control. +contents into git. While that may seem paradoxical, it is useful when +dealing with files larger than git can currently easily handle, whether due +to limitations in memory, checksumming time, or disk space. + +Even without file content tracking, being able to manage files with git, +move files around and delete files with versioned directory trees, and use +branches and distributed clones, are all very handy reasons to use git. And +annexed files can co-exist in the same git repository with regularly +versioned files, which is convenient for maintaining documents, Makefiles, +etc that are associated with annexed files but that benefit from full +revision control. Enough broad picture, here's how it actually looks: @@ -17,13 +17,13 @@ Enough broad picture, here's how it actually looks: it with a symlink pointing at the annexed file, and then calls `git add` to version the *symlink*. (If the file has already been annexed, it does nothing.) +* If you use normal git push/pull commands, the annexed file content + won't be transferred, but the symlinks will be. So different clones of a + repository can have different sets of annexed files available. * You can move the symlink around, copy it, delete it, etc, and commit changes as desired using git. Reading the symlink will always get you the annexed file content, or the link may be broken if the content is not currently available. -* If you use normal git push/pull commands, the annexed file contents - won't be sent, but the symlinks will be. So different clones of a repository - can have different sets of annexed files available. * `git annex push $repository` pushes *all* annexed files to the specified repository. * `git annex pull $repository` pulls *all* annexed files from the specified @@ -31,9 +31,9 @@ Enough broad picture, here's how it actually looks: * `git annex want $file` indicates that you want access to a file's content, without immediatly transferring it. * `git annex get $file` is used to transfer a specified file, and/or - files previously indicated with `git annex want`. If a configured repository has it, - or it is available from other key/value storage, it will be immediatly - downloaded. + files previously indicated with `git annex want`. If a configured + repository has it, or it is available from other key/value storage, + it will be immediatly downloaded. * `git annex drop $file` indicates that you no longer want the file's content to be available in this repository. * `git annex unannex $file` undoes a `git annex add`. But use `git annex drop` @@ -48,17 +48,16 @@ git-annex can be configured to try to keep N copies of a file's content available across all repositories. By default, N is 1 (configured by annex.numcopies). -`git annex drop` attempts to check all other configured -repositories, to check that N copies of the file exist. If enough -repositories cannot be verified to have it, it will retain the file content -to avoid data loss. +`git annex drop` attempts to check with other git remotes, to check that N +copies of the file exist. If enough repositories cannot be verified to have +it, it will retain the file content to avoid data loss. For example, consider three repositories: Server, Laptop, and USB. Both Server and USB have a copy of a file, and N=1. If on Laptop, you `git annex get $file`, this will transfer it from either Server or USB (depending on which is available), and there are now 3 copies of the file. -Suppose you want to free up space on laptop again, and you `git annex drop` the file +Suppose you want to free up space on Laptop again, and you `git annex drop` the file there. If USB is connected, or Server can be contacted, git-annex can check that it still has a copy of the file, and the content is removed from Laptop. But if USB is currently disconnected, and Server also cannot be @@ -70,17 +69,11 @@ to both USB and Server. Note that different repositories can be configured with different values of N. So just because Laptop has N=2, this does not prevent the number of -copies falling to 1, when USB and Server have N=1, and if they have the -only copies of a file. - -## the .git-annex directory - -The `.git-annex` directory at the top of the repository is used to store -git-annex information that should be propigated between repositories. +copies falling to 1, when USB and Server have N=1. ## key/value storage -git-annex uses a key/value abstraction layer to allow files contents to be +git-annex uses a key/value abstraction layer to allow file contents to be stored in different ways. In theory, any key/value storage system could be used to store the file contents, and git-annex would then retrieve them as needed and put them in `.git/annex/`. @@ -94,15 +87,15 @@ Multiple pluggable backends are supported, and more than one can be used to store different files' contents in a given repository. * `WORM` ("Write Once, Read Many") This backend stores the file's content - in `.git/annex/`, and assumes that any file with the same basename, + only in `.git/annex/`, and assumes that any file with the same basename, size, and modification time has the same content. So with this backend, files can be moved around, but should never be added to or changed. This is the default, and the least expensive backend. -* `sha1sum` -- This backend stores the file's content in +* `SHA1` -- This backend stores the file's content in `.git/annex/`, with a name based on its sha1 checksum. This backend allows modifications of files to be tracked. Its need to generate checksums can make it slow for large files. -* `url` -- This backend downloads the file's content from an external URL. +* `URL` -- This backend downloads the file's content from an external URL. ## location tracking @@ -132,7 +125,7 @@ example: * `annex.numcopies` -- number of copies of files to keep (default: 1) * `annex.backends` -- space-separated list of names of the key/value backends to use. The first listed is used to store - new files. (default: file, checksum, url) + new files. (default: "WORM SHA1 URL") * `remote..annex-cost` -- When determining which repository to transfer annexed files from or to, ones with lower costs are preferred. The default cost is 100 for local repositories, and 200 for remote -- cgit v1.2.3 From e67887d98b61aeabffc9d1a231421bb00848dd13 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 19:32:56 -0400 Subject: lift to IO --- Backend/File.hs | 13 +++++++++---- UUID.hs | 4 ++-- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/Backend/File.hs b/Backend/File.hs index eba4b88f8..b2c5c90eb 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -26,12 +26,16 @@ import qualified Annex import UUID backend = Backend { + name = mustProvide, + getKey = mustProvide, storeFileKey = dummyStore, retrieveKeyFile = copyKeyFile, removeKey = dummyRemove, hasKey = checkKeyFile } +mustProvide = error "must provide this field" + {- Storing a key is a no-op. -} dummyStore :: FilePath -> Key -> Annex (Bool) dummyStore file key = return True @@ -74,11 +78,12 @@ copyKeyFile key file = do cantfind = do g <- Annex.gitRepo uuids <- liftIO $ keyLocations g key + ppuuids <- prettyPrintUUIDs uuids error $ "no available git remotes have: " ++ - (keyFile key) ++ (uuidlist uuids) - uuidlist [] = "" - uuidlist uuids = "\nIt has been seen before in these repositories:\n" ++ - prettyPrintUUIDs uuids + (keyFile key) ++ + if (0 < length uuids) + then "\nIt has been seen before in these repositories:\n" ++ ppuuids + else "" {- Tries to copy a file from a remote, exception on error. -} copyFromRemote :: Git.Repo -> Key -> FilePath -> IO () diff --git a/UUID.hs b/UUID.hs index 9348c7b43..3653eeec4 100644 --- a/UUID.hs +++ b/UUID.hs @@ -91,7 +91,7 @@ reposByUUID repos uuids = do {- Pretty-prints a list of UUIDs - TODO: use lookup file to really show pretty names. -} -prettyPrintUUIDs :: [UUID] -> String +prettyPrintUUIDs :: [UUID] -> Annex String prettyPrintUUIDs uuids = - unwords $ map (\u -> "\tUUID "++u++"\n") uuids + return $ unwords $ map (\u -> "\tUUID "++u++"\n") uuids -- cgit v1.2.3 From 5de102d5b90fb621bdb1bd81cf5f562a9a2549e4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 19:33:10 -0400 Subject: rename backends more --- Backend/Checksum.hs | 17 ----------------- Backend/SHA1.hs | 17 +++++++++++++++++ Backend/URL.hs | 41 +++++++++++++++++++++++++++++++++++++++++ Backend/Url.hs | 41 ----------------------------------------- Backend/WORM.hs | 38 ++++++++++++++++++++++++++++++++++++++ Backend/Worm.hs | 38 -------------------------------------- BackendList.hs | 12 ++++++------ 7 files changed, 102 insertions(+), 102 deletions(-) delete mode 100644 Backend/Checksum.hs create mode 100644 Backend/SHA1.hs create mode 100644 Backend/URL.hs delete mode 100644 Backend/Url.hs create mode 100644 Backend/WORM.hs delete mode 100644 Backend/Worm.hs diff --git a/Backend/Checksum.hs b/Backend/Checksum.hs deleted file mode 100644 index de98fbf44..000000000 --- a/Backend/Checksum.hs +++ /dev/null @@ -1,17 +0,0 @@ -{- git-annex "checksum" backend - - -} - -module Backend.Checksum (backend) where - -import qualified Backend.File -import Data.Digest.Pure.SHA -import BackendTypes - -backend = Backend.File.backend { - name = "checksum", - getKey = keyValue -} - --- checksum the file to get its key -keyValue :: FilePath -> Annex (Maybe Key) -keyValue k = error "checksum keyValue unimplemented" -- TODO diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs new file mode 100644 index 000000000..8c7c99bbd --- /dev/null +++ b/Backend/SHA1.hs @@ -0,0 +1,17 @@ +{- git-annex "SHA1" backend + - -} + +module Backend.SHA1 (backend) where + +import qualified Backend.File +import Data.Digest.Pure.SHA +import BackendTypes + +backend = Backend.File.backend { + name = "SHA1", + getKey = keyValue +} + +-- checksum the file to get its key +keyValue :: FilePath -> Annex (Maybe Key) +keyValue k = error "SHA1 keyValue unimplemented" -- TODO diff --git a/Backend/URL.hs b/Backend/URL.hs new file mode 100644 index 000000000..4e87ca4c2 --- /dev/null +++ b/Backend/URL.hs @@ -0,0 +1,41 @@ +{- git-annex "URL" backend + - -} + +module Backend.URL (backend) where + +import Control.Monad.State (liftIO) +import Data.String.Utils +import System.Cmd +import System.Exit +import BackendTypes + +backend = Backend { + name = "URL", + getKey = keyValue, + storeFileKey = dummyStore, + retrieveKeyFile = downloadUrl, + removeKey = dummyOk, + hasKey = dummyOk +} + +-- cannot generate url from filename +keyValue :: FilePath -> Annex (Maybe Key) +keyValue file = return Nothing + +-- cannot change url contents +dummyStore :: FilePath -> Key -> Annex Bool +dummyStore file url = return False + +-- allow keys to be removed; presumably they can always be downloaded again +dummyOk :: Key -> Annex Bool +dummyOk url = return True + +downloadUrl :: Key -> FilePath -> Annex Bool +downloadUrl key file = do + liftIO $ putStrLn $ "download: " ++ url + result <- liftIO $ rawSystem "curl" ["-#", "-o", file, url] + if (result == ExitSuccess) + then return True + else return False + where + url = join ":" $ drop 1 $ split ":" $ show key diff --git a/Backend/Url.hs b/Backend/Url.hs deleted file mode 100644 index e23767208..000000000 --- a/Backend/Url.hs +++ /dev/null @@ -1,41 +0,0 @@ -{- git-annex "url" backend - - -} - -module Backend.Url (backend) where - -import Control.Monad.State (liftIO) -import Data.String.Utils -import System.Cmd -import System.Exit -import BackendTypes - -backend = Backend { - name = "url", - getKey = keyValue, - storeFileKey = dummyStore, - retrieveKeyFile = downloadUrl, - removeKey = dummyOk, - hasKey = dummyOk -} - --- cannot generate url from filename -keyValue :: FilePath -> Annex (Maybe Key) -keyValue file = return Nothing - --- cannot change url contents -dummyStore :: FilePath -> Key -> Annex Bool -dummyStore file url = return False - --- allow keys to be removed; presumably they can always be downloaded again -dummyOk :: Key -> Annex Bool -dummyOk url = return True - -downloadUrl :: Key -> FilePath -> Annex Bool -downloadUrl key file = do - liftIO $ putStrLn $ "download: " ++ url - result <- liftIO $ rawSystem "curl" ["-#", "-o", file, url] - if (result == ExitSuccess) - then return True - else return False - where - url = join ":" $ drop 1 $ split ":" $ show key diff --git a/Backend/WORM.hs b/Backend/WORM.hs new file mode 100644 index 000000000..9a1e17ec5 --- /dev/null +++ b/Backend/WORM.hs @@ -0,0 +1,38 @@ +{- git-annex "WORM" backend -- Write Once, Read Many + - -} + +module Backend.WORM (backend) where + +import Control.Monad.State +import qualified Backend.File +import BackendTypes +import Utility +import System.FilePath +import System.Posix.Files +import Data.Digest.Pure.SHA -- slow, but we only checksum filenames +import qualified Data.ByteString.Lazy.Char8 as B + +backend = Backend.File.backend { + name = "WORM", + getKey = keyValue +} + +-- A SHA1 of the basename of the filename, plus the file size and +-- modification time, is used as the unique part of the key. That +-- allows multiple files with the same names to have different keys, +-- while also allowing a file to be moved around while retaining the +-- same key. +-- +-- The basename of the filename is also included in the key, so it's clear +-- what the original filename was when a user sees the value. +keyValue :: FilePath -> Annex (Maybe Key) +keyValue file = do + stat <- liftIO $ getFileStatus file + return $ Just $ Key ((name backend), key stat) + where + key stat = (checksum $ uniqueid stat) ++ sep ++ base + checksum s = show $ sha1 $ B.pack s + uniqueid stat = (show $ fileSize stat) ++ sep ++ + (show $ modificationTime stat) + base = takeFileName file + sep = ":" diff --git a/Backend/Worm.hs b/Backend/Worm.hs deleted file mode 100644 index 89fe4bf57..000000000 --- a/Backend/Worm.hs +++ /dev/null @@ -1,38 +0,0 @@ -{- git-annex "WORM" backend -- Write Once, Read Many - - -} - -module Backend.Worm (backend) where - -import Control.Monad.State -import qualified Backend.File -import BackendTypes -import Utility -import System.FilePath -import System.Posix.Files -import Data.Digest.Pure.SHA -- slow, but we only checksum filenames -import qualified Data.ByteString.Lazy.Char8 as B - -backend = Backend.File.backend { - name = "WORM", - getKey = keyValue -} - --- A SHA1 of the basename of the filename, plus the file size and --- modification time, is used as the unique part of the key. That --- allows multiple files with the same names to have different keys, --- while also allowing a file to be moved around while retaining the --- same key. --- --- The basename of the filename is also included in the key, so it's clear --- what the original filename was when a user sees the value. -keyValue :: FilePath -> Annex (Maybe Key) -keyValue file = do - stat <- liftIO $ getFileStatus file - return $ Just $ Key ((name backend), key stat) - where - key stat = (checksum $ uniqueid stat) ++ sep ++ base - checksum s = show $ sha1 $ B.pack s - uniqueid stat = (show $ fileSize stat) ++ sep ++ - (show $ modificationTime stat) - base = takeFileName file - sep = ":" diff --git a/BackendList.hs b/BackendList.hs index 93c0464f1..42e237204 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -10,13 +10,13 @@ module BackendList ( import BackendTypes -- When adding a new backend, import it here and add it to the list. -import qualified Backend.Worm -import qualified Backend.Checksum -import qualified Backend.Url +import qualified Backend.WORM +import qualified Backend.SHA1 +import qualified Backend.URL supportedBackends = - [ Backend.Worm.backend - , Backend.Checksum.backend - , Backend.Url.backend + [ Backend.WORM.backend + , Backend.SHA1.backend + , Backend.URL.backend ] {- Parses a string with a list of backend names into -- cgit v1.2.3 From 46ac19a51d8994aa0ac978fef3359729ed91c6ba Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Oct 2010 20:20:16 -0400 Subject: implemented uuid.log --- UUID.hs | 50 +++++++++++++++++++++++++++++++++++++++++++------- git-annex.mdwn | 2 +- 2 files changed, 44 insertions(+), 8 deletions(-) diff --git a/UUID.hs b/UUID.hs index 3653eeec4..8cdee43de 100644 --- a/UUID.hs +++ b/UUID.hs @@ -11,7 +11,8 @@ module UUID ( prepUUID, genUUID, reposByUUID, - prettyPrintUUIDs + prettyPrintUUIDs, + describeUUID ) where import Control.Monad.State @@ -19,8 +20,10 @@ import Maybe import List import System.Cmd.Utils import System.IO +import qualified Data.Map as M import qualified GitRepo as Git import Types +import Locations import qualified Annex type UUID = String @@ -29,7 +32,7 @@ configkey="annex.uuid" {- Generates a UUID. There is a library for this, but it's not packaged, - so use the command line tool. -} -genUUID :: Annex UUID +genUUID :: IO UUID genUUID = liftIO $ pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h {- Looks up a repo's UUID. May return "" if none is known. @@ -66,7 +69,7 @@ prepUUID = do u <- getUUID g if ("" == u) then do - uuid <- genUUID + uuid <- liftIO $ genUUID setConfig configkey uuid else return () @@ -89,9 +92,42 @@ reposByUUID repos uuids = do u <- getUUID r return $ isJust $ elemIndex u uuids -{- Pretty-prints a list of UUIDs - - TODO: use lookup file to really show pretty names. -} +{- Pretty-prints a list of UUIDs -} prettyPrintUUIDs :: [UUID] -> Annex String -prettyPrintUUIDs uuids = - return $ unwords $ map (\u -> "\tUUID "++u++"\n") uuids +prettyPrintUUIDs uuids = do + m <- uuidMap + return $ unwords $ map (\u -> " "++(prettify m u)++"\n") uuids + where + prettify m u = + if (0 < (length $ findlog m u)) + then u ++ " -- " ++ (findlog m u) + else u + findlog m u = M.findWithDefault "" u m + +{- Records a description for a uuid in the uuidLog. -} +describeUUID :: UUID -> String -> Annex () +describeUUID uuid desc = do + m <- uuidMap + let m' = M.insert uuid desc m + log <- uuidLog + liftIO $ writeFile log $ serialize m' + where + serialize m = unlines $ map (\(u, d) -> u++" "++d) $ M.toList m +{- Read and parse the uuidLog into a Map -} +uuidMap :: Annex (M.Map UUID String) +uuidMap = do + log <- uuidLog + s <- liftIO $ catch (readFile log) (\error -> return "") + return $ M.fromList $ map (\l -> pair l) $ lines s + where + pair l = + if (1 < (length $ words l)) + then ((words l) !! 0, unwords $ drop 1 $ words l) + else ("", "") + +{- Filename of uuid.log. -} +uuidLog :: Annex String +uuidLog = do + g <- Annex.gitRepo + return $ (gitStateDir g) ++ "uuid.log" diff --git a/git-annex.mdwn b/git-annex.mdwn index 21649bfd1..1261a196f 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -109,7 +109,7 @@ Repositories record their UUID and the date when they get or drop a file's content. (Git is configured to use a union merge for this file, so the lines may be in arbitrary order, but it will never conflict.) -The optional file `.git-annex/uuid.map` can be created to add a description +The optional file `.git-annex/uuid.log` can be created to add a description to a UUID. If git-annex needs a file from a repository and it cannot find the repository amoung the remotes, it will use the description from this file when asking for the repository to be made available. The file format -- cgit v1.2.3 From 645bc94d3d9e5f08bda74a99e0584768b32da81c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 13:22:48 -0400 Subject: quiet commit of logs --- Core.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Core.hs b/Core.hs index 7e719888a..006973fc9 100644 --- a/Core.hs +++ b/Core.hs @@ -25,7 +25,7 @@ shutdown = do g <- Annex.gitRepo needcommit <- Annex.flagIsSet NeedCommit if (needcommit) - then liftIO $ Git.run g ["commit", "-m", + then liftIO $ Git.run g ["commit", "-q", "-m", "git-annex log update", gitStateDir g] else return () -- cgit v1.2.3 From 1260adbd7700ab9e35f61f4ad94b9cc0536f243e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 13:38:59 -0400 Subject: basic recursion done; skipping git stuff still todo --- Commands.hs | 17 +++++++++-------- TODO | 2 ++ Utility.hs | 14 ++++++++++++++ git-annex.mdwn | 5 +++++ 4 files changed, 30 insertions(+), 8 deletions(-) diff --git a/Commands.hs b/Commands.hs index a403a5a48..f28b3e72b 100644 --- a/Commands.hs +++ b/Commands.hs @@ -26,20 +26,21 @@ import qualified Remotes - actions to be run in the Annex monad. -} parseCmd :: [String] -> IO ([Flag], [Annex ()]) parseCmd argv = do - (flags, files) <- getopt - case (length files) of + (flags, params) <- getopt + case (length params) of 0 -> error header _ -> do - let c = lookupCmd (files !! 0) - if (0 == length c) - then ret flags defaultCmd files - else ret flags (snd $ c !! 0) $ drop 1 files + let (cmd, locs) = takeCmd params $ lookupCmd (params !! 0) + files <- mapM recurseFiles locs + return (flags, map cmd $ foldl (++) [] files) where - ret flags cmd files = return (flags, makeactions cmd files) - makeactions cmd files = map cmd files getopt = case getOpt Permute options argv of (flags, nonopts, []) -> return (flags, nonopts) (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) + takeCmd files cmds = + if (0 == length cmds) + then (defaultCmd, files) + else ((snd $ cmds !! 0), drop 1 files) lookupCmd cmd = filter (\(c, a) -> c == cmd) cmds cmds = [ ("add", addCmd) , ("get", getCmd) diff --git a/TODO b/TODO index ddd076165..8cb77fe9f 100644 --- a/TODO +++ b/TODO @@ -2,6 +2,8 @@ * --push/--pull/--want +* isn't pull the same as get? + * recurse on directories * how to handle git mv file? diff --git a/Utility.hs b/Utility.hs index e04b44e6f..8005fd17c 100644 --- a/Utility.hs +++ b/Utility.hs @@ -7,12 +7,14 @@ module Utility ( parentDir, relPathCwdToDir, relPathDirToDir, + recurseFiles, ) where import System.IO import System.Posix.IO import Data.String.Utils import System.Path +import System.IO.HVFS import System.FilePath import System.Directory @@ -87,3 +89,15 @@ relPathDirToDir from to = dotdots = take ((length pfrom) - numcommon) $ repeat ".." numcommon = length $ common path = join s $ dotdots ++ uncommon + +{- Recursively returns all files and symlinks (to anything) in the specified + - path. If the path is a file, returns only it. Does not follow symlinks to + - directories. -} +recurseFiles :: FilePath -> IO [FilePath] +recurseFiles path = do + find <- recurseDirStat SystemFS path + return $ filesOnly find + where + filesOnly l = map (\(f,s) -> f) $ filter isFile l + isFile (f, HVFSStatEncap s) = + vIsRegularFile s || vIsSymbolicLink s diff --git a/git-annex.mdwn b/git-annex.mdwn index 1261a196f..1922a1b63 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -42,6 +42,11 @@ Enough broad picture, here's how it actually looks: * `git annex $file` is a shorthand. If the file is already known, it does `git annex get`, otherwise it does `git annex add`. +Oh yeah, "$file" in the above can be any number of files, or directories. +git-annex automatically recurses into directories, but skips files that are +checked into git (as well as skipping `.git` itself), so "git annex ." works +fine. + ## copies git-annex can be configured to try to keep N copies of a file's content -- cgit v1.2.3 From 5f73fd5b661ecdeae164cc3d5a6c4d0b6113eba7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 13:59:48 -0400 Subject: dropped defaultCmd With recusrion, it doesn't really make sense. --- Commands.hs | 23 ++++++----------------- Core.hs | 2 ++ git-annex.mdwn | 2 -- 3 files changed, 8 insertions(+), 19 deletions(-) diff --git a/Commands.hs b/Commands.hs index f28b3e72b..3d85b12b9 100644 --- a/Commands.hs +++ b/Commands.hs @@ -29,18 +29,16 @@ parseCmd argv = do (flags, params) <- getopt case (length params) of 0 -> error header - _ -> do - let (cmd, locs) = takeCmd params $ lookupCmd (params !! 0) - files <- mapM recurseFiles locs - return (flags, map cmd $ foldl (++) [] files) + _ -> case (lookupCmd (params !! 0)) of + [] -> error header + [(_,cmd)] -> do + let locs = drop 1 params + files <- mapM recurseFiles locs + return (flags, map cmd $ foldl (++) [] files) where getopt = case getOpt Permute options argv of (flags, nonopts, []) -> return (flags, nonopts) (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) - takeCmd files cmds = - if (0 == length cmds) - then (defaultCmd, files) - else ((snd $ cmds !! 0), drop 1 files) lookupCmd cmd = filter (\(c, a) -> c == cmd) cmds cmds = [ ("add", addCmd) , ("get", getCmd) @@ -54,15 +52,6 @@ parseCmd argv = do (join "|" $ map fst cmds) ++ "] file ..." options = [ Option ['f'] ["force"] (NoArg Force) "allow actions that may loose annexed data" ] -{- Default mode is to annex a file if it is not already, and otherwise - - get its content. -} -defaultCmd :: FilePath -> Annex () -defaultCmd file = do - r <- liftIO $ Backend.lookupFile file - case (r) of - Just v -> getCmd file - Nothing -> addCmd file - {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} addCmd :: FilePath -> Annex () diff --git a/Core.hs b/Core.hs index 006973fc9..19d1737c3 100644 --- a/Core.hs +++ b/Core.hs @@ -58,3 +58,5 @@ inAnnex :: Key -> Annex Bool inAnnex key = do g <- Annex.gitRepo liftIO $ doesFileExist $ annexLocation g key + +{- -} diff --git a/git-annex.mdwn b/git-annex.mdwn index 1922a1b63..2796f48fb 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -39,8 +39,6 @@ Enough broad picture, here's how it actually looks: * `git annex unannex $file` undoes a `git annex add`. But use `git annex drop` if you're just done with a file; only use `unannex` if you accidentially added a file. -* `git annex $file` is a shorthand. If the file - is already known, it does `git annex get`, otherwise it does `git annex add`. Oh yeah, "$file" in the above can be any number of files, or directories. git-annex automatically recurses into directories, but skips files that are -- cgit v1.2.3 From 5a32804115a73d3c6fb2de17a1f9a6c628beba5d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 14:20:43 -0400 Subject: add inGit/notInGit --- GitRepo.hs | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index f3bb5427a..5981a6ca1 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -20,10 +20,13 @@ module GitRepo ( configMap, configRead, run, + pipeRead, attributes, remotes, remotesAdd, - repoRemoteName + repoRemoteName, + inGit, + notInGit ) where import Directory @@ -167,16 +170,30 @@ run repo params = assertlocal repo $ do return () {- Runs a git subcommand and returns its output. -} -gitPipeRead :: Repo -> [String] -> IO String -gitPipeRead repo params = assertlocal repo $ do +pipeRead :: Repo -> [String] -> IO String +pipeRead repo params = assertlocal repo $ do pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do ret <- hGetContentsStrict h return ret +{- Passed a location, recursively scans for all files that + - are checked into git at that location. -} +inGit :: Repo -> FilePath -> IO [FilePath] +inGit repo location = do + s <- pipeRead repo ["ls-files", "--cached", "--exclude-standard"] + return $ lines s + +{- Passed a location, recursively scans for all files that are not checked + - into git, and not gitignored. -} +notInGit :: Repo -> FilePath -> IO [FilePath] +notInGit repo location = do + s <- pipeRead repo ["ls-files", "--others", "--exclude-standard"] + return $ lines s + {- Runs git config and populates a repo with its config. -} configRead :: Repo -> IO Repo configRead repo = assertlocal repo $ do - {- Cannot use gitPipeRead because it relies on the config having + {- Cannot use pipeRead because it relies on the config having been already read. Instead, chdir to the repo. -} cwd <- getCurrentDirectory bracket_ (changeWorkingDirectory (top repo)) -- cgit v1.2.3 From bfa581a218719c46dbc19a212a005b0cf2e145c2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 14:58:14 -0400 Subject: bugfix --- GitRepo.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/GitRepo.hs b/GitRepo.hs index 5981a6ca1..76150b309 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -25,8 +25,8 @@ module GitRepo ( remotes, remotesAdd, repoRemoteName, - inGit, - notInGit + inRepo, + notInRepo ) where import Directory @@ -178,16 +178,16 @@ pipeRead repo params = assertlocal repo $ do {- Passed a location, recursively scans for all files that - are checked into git at that location. -} -inGit :: Repo -> FilePath -> IO [FilePath] -inGit repo location = do - s <- pipeRead repo ["ls-files", "--cached", "--exclude-standard"] +inRepo :: Repo -> FilePath -> IO [FilePath] +inRepo repo location = do + s <- pipeRead repo ["ls-files", "--cached", "--exclude-standard", location] return $ lines s {- Passed a location, recursively scans for all files that are not checked - into git, and not gitignored. -} -notInGit :: Repo -> FilePath -> IO [FilePath] -notInGit repo location = do - s <- pipeRead repo ["ls-files", "--others", "--exclude-standard"] +notInRepo :: Repo -> FilePath -> IO [FilePath] +notInRepo repo location = do + s <- pipeRead repo ["ls-files", "--others", "--exclude-standard", location] return $ lines s {- Runs git config and populates a repo with its config. -} -- cgit v1.2.3 From e80160380a16fbeb38f21f4683917b49a9221a91 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 14:58:35 -0400 Subject: now finds files in git or not depending on what command wants --- Commands.hs | 56 +++++++++++++++++++++++++++++++++++++++----------------- Utility.hs | 15 +-------------- git-annex.hs | 2 +- 3 files changed, 41 insertions(+), 32 deletions(-) diff --git a/Commands.hs b/Commands.hs index 3d85b12b9..a2535001e 100644 --- a/Commands.hs +++ b/Commands.hs @@ -21,35 +21,57 @@ import LocationLog import Types import Core import qualified Remotes +import qualified BackendTypes + +data CmdWants = FilesInGit | FilesNotInGit | RepoName +data Command = Command { + cmdname :: String, + cmdaction :: (String -> Annex ()), + cmdwants :: CmdWants +} + +cmds :: [Command] +cmds = [ (Command "add" addCmd FilesNotInGit) + , (Command "get" getCmd FilesInGit) + , (Command "drop" dropCmd FilesInGit) + , (Command "want" wantCmd FilesInGit) + , (Command "push" pushCmd RepoName) + , (Command "pull" pullCmd RepoName) + , (Command "unannex" unannexCmd FilesInGit) + ] + +{- Finds the type of parameters a command wants, from among the passed + - parameter list. -} +findWanted :: CmdWants -> [String] -> Git.Repo -> IO [String] +findWanted FilesNotInGit params repo = do + files <- mapM (Git.notInRepo repo) params + return $ foldl (++) [] files +findWanted FilesInGit params repo = do + files <- mapM (Git.inRepo repo) params + return $ foldl (++) [] files +findWanted RepoName params _ = do + return $ params {- Parses command line and returns a list of flags and a list of - actions to be run in the Annex monad. -} -parseCmd :: [String] -> IO ([Flag], [Annex ()]) -parseCmd argv = do +parseCmd :: [String] -> AnnexState -> IO ([Flag], [Annex ()]) +parseCmd argv state = do (flags, params) <- getopt case (length params) of 0 -> error header _ -> case (lookupCmd (params !! 0)) of [] -> error header - [(_,cmd)] -> do - let locs = drop 1 params - files <- mapM recurseFiles locs - return (flags, map cmd $ foldl (++) [] files) + [Command _ action want] -> do + f <- findWanted want (drop 1 params) + (BackendTypes.repo state) + return (flags, map action f) where getopt = case getOpt Permute options argv of - (flags, nonopts, []) -> return (flags, nonopts) + (flags, params, []) -> return (flags, params) (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) - lookupCmd cmd = filter (\(c, a) -> c == cmd) cmds - cmds = [ ("add", addCmd) - , ("get", getCmd) - , ("drop", dropCmd) - , ("want", wantCmd) - , ("push", pushCmd) - , ("pull", pullCmd) - , ("unannex", unannexCmd) - ] + lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds header = "Usage: git-annex [" ++ - (join "|" $ map fst cmds) ++ "] file ..." + (join "|" $ map cmdname cmds) ++ "] file ..." options = [ Option ['f'] ["force"] (NoArg Force) "allow actions that may loose annexed data" ] {- Annexes a file, storing it in a backend, and then moving it into diff --git a/Utility.hs b/Utility.hs index 8005fd17c..e4278ff3f 100644 --- a/Utility.hs +++ b/Utility.hs @@ -6,8 +6,7 @@ module Utility ( hGetContentsStrict, parentDir, relPathCwdToDir, - relPathDirToDir, - recurseFiles, + relPathDirToDir ) where import System.IO @@ -89,15 +88,3 @@ relPathDirToDir from to = dotdots = take ((length pfrom) - numcommon) $ repeat ".." numcommon = length $ common path = join s $ dotdots ++ uncommon - -{- Recursively returns all files and symlinks (to anything) in the specified - - path. If the path is a file, returns only it. Does not follow symlinks to - - directories. -} -recurseFiles :: FilePath -> IO [FilePath] -recurseFiles path = do - find <- recurseDirStat SystemFS path - return $ filesOnly find - where - filesOnly l = map (\(f,s) -> f) $ filter isFile l - isFile (f, HVFSStatEncap s) = - vIsRegularFile s || vIsSymbolicLink s diff --git a/git-annex.hs b/git-annex.hs index cd67242af..01416f6dd 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -12,9 +12,9 @@ import qualified GitRepo as Git main = do args <- getArgs - (flags, actions) <- parseCmd args gitrepo <- Git.repoFromCwd state <- new gitrepo + (flags, actions) <- parseCmd args state tryRun state $ [startup flags] ++ actions ++ [shutdown] {- Runs a list of Annex actions. Catches exceptions, not stopping -- cgit v1.2.3 From eed4a7fcdfbae821485d120055c8aec4824ecb3e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 15:10:07 -0400 Subject: tweak --- Commands.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Commands.hs b/Commands.hs index a2535001e..11f808c21 100644 --- a/Commands.hs +++ b/Commands.hs @@ -71,7 +71,7 @@ parseCmd argv state = do (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds header = "Usage: git-annex [" ++ - (join "|" $ map cmdname cmds) ++ "] file ..." + (join "|" $ map cmdname cmds) ++ "] ..." options = [ Option ['f'] ["force"] (NoArg Force) "allow actions that may loose annexed data" ] {- Annexes a file, storing it in a backend, and then moving it into -- cgit v1.2.3 From 684011175cc75bb6a667e65ba0ec6cabd1f0897a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 15:22:47 -0400 Subject: update --- git-annex.mdwn | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/git-annex.mdwn b/git-annex.mdwn index 2796f48fb..bb216f038 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -40,16 +40,15 @@ Enough broad picture, here's how it actually looks: if you're just done with a file; only use `unannex` if you accidentially added a file. -Oh yeah, "$file" in the above can be any number of files, or directories. -git-annex automatically recurses into directories, but skips files that are -checked into git (as well as skipping `.git` itself), so "git annex ." works -fine. +Oh yeah, "$file" in the above can be any number of files, or directories, +same as you'd pass to "git add" or "git rm". +So "git annex add ." or "git annex get dir/" work fine. ## copies git-annex can be configured to try to keep N copies of a file's content -available across all repositories. By default, N is 1 (configured by -annex.numcopies). +available across all repositories. By default, N is 1; it is configured by +annex.numcopies. `git annex drop` attempts to check with other git remotes, to check that N copies of the file exist. If enough repositories cannot be verified to have @@ -105,7 +104,11 @@ to store different files' contents in a given repository. git-annex keeps track of on which repository it last saw a file's content. 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. +have the file's content. For example: + + # git annex get myfile + git-annex: unable to get: myfile + To get that file, need access to one of these remotes: usbdrive Location tracking information is stored in `.git-annex/$key.log`. Repositories record their UUID and the date when they get or drop @@ -113,7 +116,7 @@ a file's content. (Git is configured to use a union merge for this file, so the lines may be in arbitrary order, but it will never conflict.) The optional file `.git-annex/uuid.log` can be created to add a description -to a UUID. If git-annex needs a file from a repository and it cannot find +to a UUID. If git-annex needs a file from some repository, and it cannot find the repository amoung the remotes, it will use the description from this file when asking for the repository to be made available. The file format is a UUID, a space, and the rest of the line is its description. For -- cgit v1.2.3 From a31dc74806f165e01f56dbc3322e738a921cc6e9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 15:23:03 -0400 Subject: update --- TODO | 7 +-- doc/git-annex.mdwn | 182 +++++++++++++++++++++++++++++++++++++++++++++++++++++ git-annex.mdwn | 182 ----------------------------------------------------- 3 files changed, 184 insertions(+), 187 deletions(-) create mode 100644 doc/git-annex.mdwn delete mode 100644 git-annex.mdwn diff --git a/TODO b/TODO index 8cb77fe9f..8fc17fca9 100644 --- a/TODO +++ b/TODO @@ -1,11 +1,8 @@ -* bug: cannot "git annex ../foo" (GitRepo.relative is buggy) +* bug: cannot "git annex ../foo" (GitRepo.relative is buggy and + git-ls-files also refuses w/o --full-name, which would need other changes) * --push/--pull/--want -* isn't pull the same as get? - -* recurse on directories - * how to handle git mv file? * finish BackendChecksum diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn new file mode 100644 index 000000000..bb216f038 --- /dev/null +++ b/doc/git-annex.mdwn @@ -0,0 +1,182 @@ +git-annex allows managing files with git, without checking the file +contents into git. While that may seem paradoxical, it is useful when +dealing with files larger than git can currently easily handle, whether due +to limitations in memory, checksumming time, or disk space. + +Even without file content tracking, being able to manage files with git, +move files around and delete files with versioned directory trees, and use +branches and distributed clones, are all very handy reasons to use git. And +annexed files can co-exist in the same git repository with regularly +versioned files, which is convenient for maintaining documents, Makefiles, +etc that are associated with annexed files but that benefit from full +revision control. + +Enough broad picture, here's how it actually looks: + +* `git annex add $file` moves the file into `.git/annex/`, and replaces + it with a symlink pointing at the annexed file, and then calls `git add` + to version the *symlink*. (If the file has already been annexed, it does + nothing.) +* If you use normal git push/pull commands, the annexed file content + won't be transferred, but the symlinks will be. So different clones of a + repository can have different sets of annexed files available. +* You can move the symlink around, copy it, delete it, etc, and commit changes + as desired using git. Reading the symlink will always get you the annexed + file content, or the link may be broken if the content is not currently + available. +* `git annex push $repository` pushes *all* annexed files to the specified + repository. +* `git annex pull $repository` pulls *all* annexed files from the specified + repository. +* `git annex want $file` indicates that you want access to a file's + content, without immediatly transferring it. +* `git annex get $file` is used to transfer a specified file, and/or + files previously indicated with `git annex want`. If a configured + repository has it, or it is available from other key/value storage, + it will be immediatly downloaded. +* `git annex drop $file` indicates that you no longer want the file's + content to be available in this repository. +* `git annex unannex $file` undoes a `git annex add`. But use `git annex drop` + if you're just done with a file; only use `unannex` if you + accidentially added a file. + +Oh yeah, "$file" in the above can be any number of files, or directories, +same as you'd pass to "git add" or "git rm". +So "git annex add ." or "git annex get dir/" work fine. + +## copies + +git-annex can be configured to try to keep N copies of a file's content +available across all repositories. By default, N is 1; it is configured by +annex.numcopies. + +`git annex drop` attempts to check with other git remotes, to check that N +copies of the file exist. If enough repositories cannot be verified to have +it, it will retain the file content to avoid data loss. + +For example, consider three repositories: Server, Laptop, and USB. Both Server +and USB have a copy of a file, and N=1. If on Laptop, you `git annex get +$file`, this will transfer it from either Server or USB (depending on which +is available), and there are now 3 copies of the file. + +Suppose you want to free up space on Laptop again, and you `git annex drop` the file +there. If USB is connected, or Server can be contacted, git-annex can check +that it still has a copy of the file, and the content is removed from +Laptop. But if USB is currently disconnected, and Server also cannot be +contacted, it can't verify that it is safe to drop the file, and will +refuse to do so. + +With N=2, in order to drop the file content from Laptop, it would need access +to both USB and Server. + +Note that different repositories can be configured with different values of +N. So just because Laptop has N=2, this does not prevent the number of +copies falling to 1, when USB and Server have N=1. + +## key/value storage + +git-annex uses a key/value abstraction layer to allow file contents to be +stored in different ways. In theory, any key/value storage system could be +used to store the file contents, and git-annex would then retrieve them +as needed and put them in `.git/annex/`. + +When a file is annexed, a key is generated from its content and/or metadata. +The file checked into git symlinks to the key. This key can later be used +to retrieve the file's content (its value). This key generation must be +stable for a given file content, name, and size. + +Multiple pluggable backends are supported, and more than one can be used +to store different files' contents in a given repository. + +* `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, + size, and modification time has the same content. So with this backend, + files can be moved around, but should never be added to 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 + modifications of files to be tracked. Its need to generate checksums + can make it slow for large files. +* `URL` -- This backend downloads the file's content from an external URL. + +## location tracking + +git-annex keeps track of on which repository it last saw a file's content. +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. For example: + + # git annex get myfile + git-annex: unable to get: myfile + To get that file, need access to one of these remotes: usbdrive + +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. (Git is configured to use a union merge for this file, +so the lines may be in arbitrary order, but it will never conflict.) + +The optional file `.git-annex/uuid.log` can be created to add a description +to a UUID. If git-annex needs a file from some repository, and it cannot find +the repository amoung the remotes, it will use the description from this +file when asking for the repository to be made available. The file format +is a UUID, a space, and the rest of the line is its description. For +example: + + UUID d3d2474c-d5c3-11df-80a9-002170d25c55 USB drive in red enclosure + UUID 60cf39c8-d5c6-11df-aa8b-93fda39008d6 my colocated server + +## configuration + +* `annex.uuid` -- a unique UUID for this repository +* `annex.numcopies` -- number of copies of files to keep (default: 1) +* `annex.backends` -- space-separated list of names of + the key/value backends to use. The first listed is used to store + new files. (default: "WORM SHA1 URL") +* `remote..annex-cost` -- When determining which repository to + transfer annexed files from or to, ones with lower costs are preferred. + The default cost is 100 for local repositories, and 200 for remote + repositories. Note that other factors may be configured when pushing + files to repositories, in particular, whether the repository is on + a filesystem with sufficient free space. +* `remote..annex-uuid` -- git-annex caches UUIDs of repositories + here. + +## issues + +### symlinks + +If the symlink to annexed content is relative, moving it to a subdir will +break it. But it it's absolute, moving the git repo (or mounting its drive +elsewhere) will break it. Either: + +* Use relative links and need `git annex mv` to move (or post-commit + hook that caches moves and updates links). +* Use absolute links and need `git annex fixlinks` when location changes; + note that would also mean that git would see the symlink targets changed + and want to commit the change. And, other clones of the repo would + diverge and there would be conflicts on the symlink text. Ugh. + +Hard links are not an option, because git would then happily commit the +file content. Amoung other reasons.. + +### free space determination + +Need a way to tell how much free space is available on the disk containing +a given repository. The repository may be remote, so ssh may need to be +used. + +Similarly, need a way to tell the size of a file before downloading it from +remote, to check local disk space. + +### auto-drop files on rm + +When git-rm removed a file, it should get dropped too. Of course, it may +not be dropped right away, depending on number of copies available. + +### branching + +The use of `.git-annex` to store logs means that if a repo has branches +and the user switched between them, git-annex will see different logs in +the different branches, and so may miss info about what remotes have which +files (though it can re-learn). An alternative would be to +store the log data directly in the git repo as `pristine-tar` does. diff --git a/git-annex.mdwn b/git-annex.mdwn deleted file mode 100644 index bb216f038..000000000 --- a/git-annex.mdwn +++ /dev/null @@ -1,182 +0,0 @@ -git-annex allows managing files with git, without checking the file -contents into git. While that may seem paradoxical, it is useful when -dealing with files larger than git can currently easily handle, whether due -to limitations in memory, checksumming time, or disk space. - -Even without file content tracking, being able to manage files with git, -move files around and delete files with versioned directory trees, and use -branches and distributed clones, are all very handy reasons to use git. And -annexed files can co-exist in the same git repository with regularly -versioned files, which is convenient for maintaining documents, Makefiles, -etc that are associated with annexed files but that benefit from full -revision control. - -Enough broad picture, here's how it actually looks: - -* `git annex add $file` moves the file into `.git/annex/`, and replaces - it with a symlink pointing at the annexed file, and then calls `git add` - to version the *symlink*. (If the file has already been annexed, it does - nothing.) -* If you use normal git push/pull commands, the annexed file content - won't be transferred, but the symlinks will be. So different clones of a - repository can have different sets of annexed files available. -* You can move the symlink around, copy it, delete it, etc, and commit changes - as desired using git. Reading the symlink will always get you the annexed - file content, or the link may be broken if the content is not currently - available. -* `git annex push $repository` pushes *all* annexed files to the specified - repository. -* `git annex pull $repository` pulls *all* annexed files from the specified - repository. -* `git annex want $file` indicates that you want access to a file's - content, without immediatly transferring it. -* `git annex get $file` is used to transfer a specified file, and/or - files previously indicated with `git annex want`. If a configured - repository has it, or it is available from other key/value storage, - it will be immediatly downloaded. -* `git annex drop $file` indicates that you no longer want the file's - content to be available in this repository. -* `git annex unannex $file` undoes a `git annex add`. But use `git annex drop` - if you're just done with a file; only use `unannex` if you - accidentially added a file. - -Oh yeah, "$file" in the above can be any number of files, or directories, -same as you'd pass to "git add" or "git rm". -So "git annex add ." or "git annex get dir/" work fine. - -## copies - -git-annex can be configured to try to keep N copies of a file's content -available across all repositories. By default, N is 1; it is configured by -annex.numcopies. - -`git annex drop` attempts to check with other git remotes, to check that N -copies of the file exist. If enough repositories cannot be verified to have -it, it will retain the file content to avoid data loss. - -For example, consider three repositories: Server, Laptop, and USB. Both Server -and USB have a copy of a file, and N=1. If on Laptop, you `git annex get -$file`, this will transfer it from either Server or USB (depending on which -is available), and there are now 3 copies of the file. - -Suppose you want to free up space on Laptop again, and you `git annex drop` the file -there. If USB is connected, or Server can be contacted, git-annex can check -that it still has a copy of the file, and the content is removed from -Laptop. But if USB is currently disconnected, and Server also cannot be -contacted, it can't verify that it is safe to drop the file, and will -refuse to do so. - -With N=2, in order to drop the file content from Laptop, it would need access -to both USB and Server. - -Note that different repositories can be configured with different values of -N. So just because Laptop has N=2, this does not prevent the number of -copies falling to 1, when USB and Server have N=1. - -## key/value storage - -git-annex uses a key/value abstraction layer to allow file contents to be -stored in different ways. In theory, any key/value storage system could be -used to store the file contents, and git-annex would then retrieve them -as needed and put them in `.git/annex/`. - -When a file is annexed, a key is generated from its content and/or metadata. -The file checked into git symlinks to the key. This key can later be used -to retrieve the file's content (its value). This key generation must be -stable for a given file content, name, and size. - -Multiple pluggable backends are supported, and more than one can be used -to store different files' contents in a given repository. - -* `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, - size, and modification time has the same content. So with this backend, - files can be moved around, but should never be added to 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 - modifications of files to be tracked. Its need to generate checksums - can make it slow for large files. -* `URL` -- This backend downloads the file's content from an external URL. - -## location tracking - -git-annex keeps track of on which repository it last saw a file's content. -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. For example: - - # git annex get myfile - git-annex: unable to get: myfile - To get that file, need access to one of these remotes: usbdrive - -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. (Git is configured to use a union merge for this file, -so the lines may be in arbitrary order, but it will never conflict.) - -The optional file `.git-annex/uuid.log` can be created to add a description -to a UUID. If git-annex needs a file from some repository, and it cannot find -the repository amoung the remotes, it will use the description from this -file when asking for the repository to be made available. The file format -is a UUID, a space, and the rest of the line is its description. For -example: - - UUID d3d2474c-d5c3-11df-80a9-002170d25c55 USB drive in red enclosure - UUID 60cf39c8-d5c6-11df-aa8b-93fda39008d6 my colocated server - -## configuration - -* `annex.uuid` -- a unique UUID for this repository -* `annex.numcopies` -- number of copies of files to keep (default: 1) -* `annex.backends` -- space-separated list of names of - the key/value backends to use. The first listed is used to store - new files. (default: "WORM SHA1 URL") -* `remote..annex-cost` -- When determining which repository to - transfer annexed files from or to, ones with lower costs are preferred. - The default cost is 100 for local repositories, and 200 for remote - repositories. Note that other factors may be configured when pushing - files to repositories, in particular, whether the repository is on - a filesystem with sufficient free space. -* `remote..annex-uuid` -- git-annex caches UUIDs of repositories - here. - -## issues - -### symlinks - -If the symlink to annexed content is relative, moving it to a subdir will -break it. But it it's absolute, moving the git repo (or mounting its drive -elsewhere) will break it. Either: - -* Use relative links and need `git annex mv` to move (or post-commit - hook that caches moves and updates links). -* Use absolute links and need `git annex fixlinks` when location changes; - note that would also mean that git would see the symlink targets changed - and want to commit the change. And, other clones of the repo would - diverge and there would be conflicts on the symlink text. Ugh. - -Hard links are not an option, because git would then happily commit the -file content. Amoung other reasons.. - -### free space determination - -Need a way to tell how much free space is available on the disk containing -a given repository. The repository may be remote, so ssh may need to be -used. - -Similarly, need a way to tell the size of a file before downloading it from -remote, to check local disk space. - -### auto-drop files on rm - -When git-rm removed a file, it should get dropped too. Of course, it may -not be dropped right away, depending on number of copies available. - -### branching - -The use of `.git-annex` to store logs means that if a repo has branches -and the user switched between them, git-annex will see different logs in -the different branches, and so may miss info about what remotes have which -files (though it can re-learn). An alternative would be to -store the log data directly in the git repo as `pristine-tar` does. -- cgit v1.2.3 From 81d628a8cd6f20c2ef336271ae03376dc75b6920 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 15:58:42 -0400 Subject: updatte --- doc/git-annex.mdwn | 102 ++++++++++++++++++++++++++++++++--------------------- 1 file changed, 62 insertions(+), 40 deletions(-) diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index bb216f038..ad45c0842 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -11,34 +11,48 @@ versioned files, which is convenient for maintaining documents, Makefiles, etc that are associated with annexed files but that benefit from full revision control. +My motivation for git-annex was the growing number of external drives I +use. Some are used to archive data, others hold backups, and yet others +come with me when I'm away from home to carry data that doesn't fit on my +netbook. Maintaining all that was a nightmare, lots of ad-hoc moving files +around, rsyncing files (unison is too slow), and deleting multiple copies +of files from multiple places. I realized what what I needed was revision +control where each drive was a repository, and where copying the files +around, and deciding which copies were safe to delete was automated. +I posted about this to the VCS-home mailing list and got a great suggestion +to make it support arbitrary key-value stores. A week of coding later, +and git-annex is born. + Enough broad picture, here's how it actually looks: * `git annex add $file` moves the file into `.git/annex/`, and replaces it with a symlink pointing at the annexed file, and then calls `git add` to version the *symlink*. (If the file has already been annexed, it does - nothing.) -* If you use normal git push/pull commands, the annexed file content - won't be transferred, but the symlinks will be. So different clones of a - repository can have different sets of annexed files available. -* You can move the symlink around, copy it, delete it, etc, and commit changes + nothing.) + + If you then use normal git push/pull commands, the annexed file content + won't be transferred between repositories, but the symlinks will be. + So different clones of a repository can have different sets of annexed + files available. + + You can move the symlink around, copy it, delete it, etc, and commit changes as desired using git. Reading the symlink will always get you the annexed file content, or the link may be broken if the content is not currently available. +* `git annex get $file` is used to transfer a specified file from the + backend storage to the current repository. +* `git annex drop $file` indicates that you no longer want the file's + content to be available in this repository. * `git annex push $repository` pushes *all* annexed files to the specified repository. * `git annex pull $repository` pulls *all* annexed files from the specified repository. -* `git annex want $file` indicates that you want access to a file's - content, without immediatly transferring it. -* `git annex get $file` is used to transfer a specified file, and/or - files previously indicated with `git annex want`. If a configured - repository has it, or it is available from other key/value storage, - it will be immediatly downloaded. -* `git annex drop $file` indicates that you no longer want the file's - content to be available in this repository. * `git annex unannex $file` undoes a `git annex add`. But use `git annex drop` if you're just done with a file; only use `unannex` if you accidentially added a file. +* `git annex describe "some description"` allows associating some description + (such as "USB archive drive 1") with a repository. This can help with + finding it later, see "Location Tracking" below. Oh yeah, "$file" in the above can be any number of files, or directories, same as you'd pass to "git add" or "git rm". @@ -73,10 +87,10 @@ Note that different repositories can be configured with different values of N. So just because Laptop has N=2, this does not prevent the number of copies falling to 1, when USB and Server have N=1. -## key/value storage +## key-value storage -git-annex uses a key/value abstraction layer to allow file contents to be -stored in different ways. In theory, any key/value storage system could be +git-annex uses a key-value abstraction layer to allow file contents to be +stored in different ways. In theory, any key-value storage system could be used to store the file contents, and git-annex would then retrieve them as needed and put them in `.git/annex/`. @@ -101,36 +115,40 @@ to store different files' contents in a given repository. ## location tracking -git-annex keeps track of on which repository it last saw a file's content. -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. For example: - - # git annex get myfile - git-annex: unable to get: myfile - To get that file, need access to one of these remotes: usbdrive - -Location tracking information is stored in `.git-annex/$key.log`. +git-annex keeps track of in which repositories it last saw a file's content. +This 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. (Git is configured to use a union merge for this file, so the lines may be in arbitrary order, but it will never conflict.) -The optional file `.git-annex/uuid.log` can be created to add a description -to a UUID. If git-annex needs a file from some repository, and it cannot find -the repository amoung the remotes, it will use the description from this -file when asking for the repository to be made available. The file format -is a UUID, a space, and the rest of the line is its description. For -example: +This location tracking information is useful if you have multiple +repositories, and not all are always accessible. For example, perhaps one +is on a home file server, and you are away from home. Then git-annex can +tell you what git remote it needs access to in order to get a file: - UUID d3d2474c-d5c3-11df-80a9-002170d25c55 USB drive in red enclosure - UUID 60cf39c8-d5c6-11df-aa8b-93fda39008d6 my colocated server + # git annex get myfile + git-annex: unable to get file with key: WORM:8b01f6d371178722367393eb26043482e1820306:myfile + To get that file, need access to one of these remotes: home + +Another way the location tracking comes in handy is if you put repositories +on removable USB drives, that might be archived away offline in a safe +place. In this sort of case, you probably don't have a git remotes +configured for every USB drive. So git-annex may have to resort to talking +about repository UUIDs. If you have previously used "git annex describe" +in those repositories, it will include their description to help you with +finding them: + + git-annex: no available git remotes have file with key: WORM:8b01f6d371178722367393eb26043482e1820306:myfile + It has been seen before in these repositories: + c0a28e06-d7ef-11df-885c-775af44f8882 -- USB archive drive 1 + e1938fee-d95b-11df-96cc-002170d25c55 ## configuration * `annex.uuid` -- a unique UUID for this repository * `annex.numcopies` -- number of copies of files to keep (default: 1) * `annex.backends` -- space-separated list of names of - the key/value backends to use. The first listed is used to store + the key-value backends to use. The first listed is used to store new files. (default: "WORM SHA1 URL") * `remote..annex-cost` -- When determining which repository to transfer annexed files from or to, ones with lower costs are preferred. @@ -165,13 +183,13 @@ Need a way to tell how much free space is available on the disk containing a given repository. The repository may be remote, so ssh may need to be used. -Similarly, need a way to tell the size of a file before downloading it from -remote, to check local disk space. +Similarly, need a way to tell the size of a file before copying it from +a remote, to check local disk space. -### auto-drop files on rm +### auto-drop on rm -When git-rm removed a file, it should get dropped too. Of course, it may -not be dropped right away, depending on number of copies available. +When git-rm removed a file, its key should get dropped too. Of course, it +may not be dropped right away, depending on number of copies available. ### branching @@ -180,3 +198,7 @@ and the user switched between them, git-annex will see different logs in the different branches, and so may miss info about what remotes have which files (though it can re-learn). An alternative would be to store the log data directly in the git repo as `pristine-tar` does. + +## contact + +Joey Hess -- cgit v1.2.3 From 6d13ae10cf1d295b64855984f5a526f8209f3341 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 16:15:31 -0400 Subject: git annex describe --- Backend.hs | 6 +++--- Backend/File.hs | 4 ++-- BackendTypes.hs | 2 +- Commands.hs | 24 +++++++++++++++++------- UUID.hs | 10 +++++++--- 5 files changed, 30 insertions(+), 16 deletions(-) diff --git a/Backend.hs b/Backend.hs index f419831d2..636557d7d 100644 --- a/Backend.hs +++ b/Backend.hs @@ -1,7 +1,7 @@ -{- git-annex key/value storage backends +{- git-annex key-value storage backends - - - git-annex uses a key/value abstraction layer to allow files contents to be - - stored in different ways. In theory, any key/value storage system could be + - git-annex uses a key-value abstraction layer to allow files contents to be + - stored in different ways. In theory, any key-value storage system could be - used to store the file contents, and git-annex would then retrieve them - as needed and put them in `.git/annex/`. - diff --git a/Backend/File.hs b/Backend/File.hs index b2c5c90eb..c443b4f7a 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -58,7 +58,7 @@ copyKeyFile key file = do else return () trycopy remotes remotes where - trycopy full [] = error $ "unable to get: " ++ (keyFile key) ++ "\n" ++ + trycopy full [] = error $ "unable to get file with key: " ++ (keyFile key) ++ "\n" ++ "To get that file, need access to one of these remotes: " ++ (Remotes.list full) trycopy full (r:rs) = do @@ -79,7 +79,7 @@ copyKeyFile key file = do g <- Annex.gitRepo uuids <- liftIO $ keyLocations g key ppuuids <- prettyPrintUUIDs uuids - error $ "no available git remotes have: " ++ + error $ "no available git remotes have file with key: " ++ (keyFile key) ++ if (0 < length uuids) then "\nIt has been seen before in these repositories:\n" ++ ppuuids diff --git a/BackendTypes.hs b/BackendTypes.hs index 13ffde7f8..41bc77858 100644 --- a/BackendTypes.hs +++ b/BackendTypes.hs @@ -49,7 +49,7 @@ backendName (Key (b,k)) = b keyFrag :: Key -> KeyFrag keyFrag (Key (b,k)) = k --- this structure represents a key/value backend +-- this structure represents a key-value backend data Backend = Backend { -- name of this backend name :: String, diff --git a/Commands.hs b/Commands.hs index 11f808c21..1f9128011 100644 --- a/Commands.hs +++ b/Commands.hs @@ -23,7 +23,7 @@ import Core import qualified Remotes import qualified BackendTypes -data CmdWants = FilesInGit | FilesNotInGit | RepoName +data CmdWants = FilesInGit | FilesNotInGit | RepoName | SingleString data Command = Command { cmdname :: String, cmdaction :: (String -> Annex ()), @@ -34,10 +34,10 @@ cmds :: [Command] cmds = [ (Command "add" addCmd FilesNotInGit) , (Command "get" getCmd FilesInGit) , (Command "drop" dropCmd FilesInGit) - , (Command "want" wantCmd FilesInGit) , (Command "push" pushCmd RepoName) , (Command "pull" pullCmd RepoName) , (Command "unannex" unannexCmd FilesInGit) + , (Command "describe" describeCmd SingleString) ] {- Finds the type of parameters a command wants, from among the passed @@ -49,6 +49,8 @@ findWanted FilesNotInGit params repo = do findWanted FilesInGit params repo = do files <- mapM (Git.inRepo repo) params return $ foldl (++) [] files +findWanted SingleString params _ = do + return $ [unwords params] findWanted RepoName params _ = do return $ params @@ -150,11 +152,8 @@ getCmd file = notinBackend file err $ \(key, backend) -> do where err = error $ "not annexed " ++ file -{- Indicates a file is wanted. -} -wantCmd :: FilePath -> Annex () -wantCmd file = do error "not implemented" -- TODO - -{- Indicates a file is not wanted. -} +{- Indicates a file's content is not wanted anymore, and should be removed + - if it's safe to do so. -} dropCmd :: FilePath -> Annex () dropCmd file = notinBackend file err $ \(key, backend) -> do force <- Annex.flagIsSet Force @@ -185,6 +184,17 @@ pushCmd reponame = do error "not implemented" -- TODO pullCmd :: String -> Annex () pullCmd reponame = do error "not implemented" -- TODO +{- Stores description for the repository. -} +describeCmd :: String -> Annex () +describeCmd description = do + g <- Annex.gitRepo + u <- getUUID g + describeUUID u description + log <- uuidLog + liftIO $ Git.run g ["add", log] + Annex.flagChange NeedCommit True + liftIO $ putStrLn "description set" + {- Updates the LocationLog when a key's presence changes. -} logStatus :: Key -> LogStatus -> Annex () logStatus key status = do diff --git a/UUID.hs b/UUID.hs index 8cdee43de..3e6991d48 100644 --- a/UUID.hs +++ b/UUID.hs @@ -12,7 +12,8 @@ module UUID ( genUUID, reposByUUID, prettyPrintUUIDs, - describeUUID + describeUUID, + uuidLog ) where import Control.Monad.State @@ -25,6 +26,7 @@ import qualified GitRepo as Git import Types import Locations import qualified Annex +import Utility type UUID = String @@ -110,7 +112,7 @@ describeUUID uuid desc = do m <- uuidMap let m' = M.insert uuid desc m log <- uuidLog - liftIO $ writeFile log $ serialize m' + liftIO $ withFileLocked log WriteMode (\h -> hPutStr h $ serialize m') where serialize m = unlines $ map (\(u, d) -> u++" "++d) $ M.toList m @@ -118,7 +120,9 @@ describeUUID uuid desc = do uuidMap :: Annex (M.Map UUID String) uuidMap = do log <- uuidLog - s <- liftIO $ catch (readFile log) (\error -> return "") + s <- liftIO $ catch + (withFileLocked log ReadMode $ \h -> hGetContentsStrict h) + (\error -> return "") return $ M.fromList $ map (\l -> pair l) $ lines s where pair l = -- cgit v1.2.3 From 909f619c07699fe6c76d40bb4649e07737a0b9ae Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 16:20:49 -0400 Subject: tweaks --- Annex.hs | 1 + Backend.hs | 1 + Backend/File.hs | 1 + Backend/SHA1.hs | 3 ++- Backend/URL.hs | 1 + Backend/WORM.hs | 7 ++++--- BackendTypes.hs | 1 + Commands.hs | 1 + Core.hs | 1 + GitRepo.hs | 1 + LocationLog.hs | 1 + Locations.hs | 1 + Remotes.hs | 1 + UUID.hs | 3 +++ doc/git-annex.mdwn | 10 +++++----- git-annex.hs | 4 ++-- 16 files changed, 27 insertions(+), 11 deletions(-) diff --git a/Annex.hs b/Annex.hs index 08607cafa..68c0cb88e 100644 --- a/Annex.hs +++ b/Annex.hs @@ -13,6 +13,7 @@ module Annex ( ) where import Control.Monad.State + import qualified GitRepo as Git import Types import qualified BackendTypes as Backend diff --git a/Backend.hs b/Backend.hs index 636557d7d..874191924 100644 --- a/Backend.hs +++ b/Backend.hs @@ -27,6 +27,7 @@ import System.Directory import System.FilePath import Data.String.Utils import System.Posix.Files + import BackendList import Locations import qualified GitRepo as Git diff --git a/Backend/File.hs b/Backend/File.hs index c443b4f7a..f5237f721 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -15,6 +15,7 @@ import System.IO import System.Cmd import System.Exit import Control.Exception + import BackendTypes import LocationLog import Locations diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs index 8c7c99bbd..c01e01a72 100644 --- a/Backend/SHA1.hs +++ b/Backend/SHA1.hs @@ -3,8 +3,9 @@ module Backend.SHA1 (backend) where -import qualified Backend.File import Data.Digest.Pure.SHA + +import qualified Backend.File import BackendTypes backend = Backend.File.backend { diff --git a/Backend/URL.hs b/Backend/URL.hs index 4e87ca4c2..9e64e0499 100644 --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -7,6 +7,7 @@ import Control.Monad.State (liftIO) import Data.String.Utils import System.Cmd import System.Exit + import BackendTypes backend = Backend { diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 9a1e17ec5..420f336e9 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -4,14 +4,15 @@ module Backend.WORM (backend) where import Control.Monad.State -import qualified Backend.File -import BackendTypes -import Utility import System.FilePath import System.Posix.Files import Data.Digest.Pure.SHA -- slow, but we only checksum filenames import qualified Data.ByteString.Lazy.Char8 as B +import qualified Backend.File +import BackendTypes +import Utility + backend = Backend.File.backend { name = "WORM", getKey = keyValue diff --git a/BackendTypes.hs b/BackendTypes.hs index 41bc77858..49bd1bceb 100644 --- a/BackendTypes.hs +++ b/BackendTypes.hs @@ -7,6 +7,7 @@ module BackendTypes where import Control.Monad.State (StateT) import Data.String.Utils + import qualified GitRepo as Git -- command-line flags diff --git a/Commands.hs b/Commands.hs index 1f9128011..c477a81fd 100644 --- a/Commands.hs +++ b/Commands.hs @@ -10,6 +10,7 @@ import System.Path import Data.String.Utils import List import IO + import qualified GitRepo as Git import qualified Annex import Utility diff --git a/Core.hs b/Core.hs index 19d1737c3..fcbce4163 100644 --- a/Core.hs +++ b/Core.hs @@ -5,6 +5,7 @@ module Core where import System.IO import System.Directory import Control.Monad.State (liftIO) + import Types import Locations import UUID diff --git a/GitRepo.hs b/GitRepo.hs index 76150b309..32383197b 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -42,6 +42,7 @@ import Data.String.Utils import Data.Map as Map hiding (map, split) import Network.URI import Maybe + import Utility {- A git repository can be on local disk or remote. Not to be confused diff --git a/LocationLog.hs b/LocationLog.hs index ba9178704..c0d6170b2 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -29,6 +29,7 @@ import qualified Data.Map as Map import System.IO import System.Directory import Data.Char + import qualified GitRepo as Git import Utility import UUID diff --git a/Locations.hs b/Locations.hs index 733e74553..497850062 100644 --- a/Locations.hs +++ b/Locations.hs @@ -11,6 +11,7 @@ module Locations ( ) where import Data.String.Utils + import Types import qualified BackendTypes as Backend import qualified GitRepo as Git diff --git a/Remotes.hs b/Remotes.hs index 2fffcffa7..3774f993c 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -12,6 +12,7 @@ import qualified Data.Map as Map import Data.String.Utils import List import Maybe + import Types import qualified GitRepo as Git import qualified Annex diff --git a/UUID.hs b/UUID.hs index 3e6991d48..6bd483a18 100644 --- a/UUID.hs +++ b/UUID.hs @@ -21,7 +21,9 @@ import Maybe import List import System.Cmd.Utils import System.IO +import System.Directory import qualified Data.Map as M + import qualified GitRepo as Git import Types import Locations @@ -112,6 +114,7 @@ describeUUID uuid desc = do m <- uuidMap let m' = M.insert uuid desc m log <- uuidLog + liftIO $ createDirectoryIfMissing True (parentDir log) liftIO $ withFileLocked log WriteMode (\h -> hPutStr h $ serialize m') where serialize m = unlines $ map (\(u, d) -> u++" "++d) $ M.toList m diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index ad45c0842..e552dc770 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -16,12 +16,12 @@ use. Some are used to archive data, others hold backups, and yet others come with me when I'm away from home to carry data that doesn't fit on my netbook. Maintaining all that was a nightmare, lots of ad-hoc moving files around, rsyncing files (unison is too slow), and deleting multiple copies -of files from multiple places. I realized what what I needed was revision -control where each drive was a repository, and where copying the files -around, and deciding which copies were safe to delete was automated. +of files from multiple places. I realized what what I needed was a form of +revision control where each drive was a repository, and where copying the +files around, and deciding which copies were safe to delete was automated. I posted about this to the VCS-home mailing list and got a great suggestion -to make it support arbitrary key-value stores. A week of coding later, -and git-annex is born. +to make it support arbitrary key-value stores, for more generality and +flexability. A week of coding later, and git-annex is born. Enough broad picture, here's how it actually looks: diff --git a/git-annex.hs b/git-annex.hs index 01416f6dd..f4f0cfcdf 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -3,17 +3,17 @@ import Control.Exception import System.IO import System.Environment + import qualified Annex import Types import Core import Commands -import Annex import qualified GitRepo as Git main = do args <- getArgs gitrepo <- Git.repoFromCwd - state <- new gitrepo + state <- Annex.new gitrepo (flags, actions) <- parseCmd args state tryRun state $ [startup flags] ++ actions ++ [shutdown] -- cgit v1.2.3 From 117e97ea30f6e414a99f413d1e2050da84edd9df Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 16:41:24 -0400 Subject: debianization --- INSTALL | 5 +++++ Makefile | 4 ++++ debian/changelog | 5 +++++ debian/compat | 1 + debian/control | 26 ++++++++++++++++++++++++++ debian/docs | 1 + debian/rules | 7 +++++++ 7 files changed, 49 insertions(+) create mode 100644 INSTALL create mode 100644 debian/changelog create mode 100644 debian/compat create mode 100644 debian/control create mode 100644 debian/docs create mode 100755 debian/rules diff --git a/INSTALL b/INSTALL new file mode 100644 index 000000000..5c149dc45 --- /dev/null +++ b/INSTALL @@ -0,0 +1,5 @@ +To build and use git-annex, you will need: + +* ghc +* These haskell libraries: MissingH +* a "uuid" command diff --git a/Makefile b/Makefile index 876407de0..d1fcbbeee 100644 --- a/Makefile +++ b/Makefile @@ -2,6 +2,10 @@ git-annex: mkdir -p build ghc -odir build -hidir build --make git-annex +install: + install -d $(DESTDIR)/usr/bin + install git-annex $(DESTDIR)/usr/bin + clean: rm -rf build git-annex diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 000000000..998754777 --- /dev/null +++ b/debian/changelog @@ -0,0 +1,5 @@ +git-annex (0.01) UNRELEASED; urgency=low + + * First release + + -- Joey Hess Thu, 09 Sep 2010 08:24:58 -0400 diff --git a/debian/compat b/debian/compat new file mode 100644 index 000000000..7f8f011eb --- /dev/null +++ b/debian/compat @@ -0,0 +1 @@ +7 diff --git a/debian/control b/debian/control new file mode 100644 index 000000000..fa4fd6115 --- /dev/null +++ b/debian/control @@ -0,0 +1,26 @@ +Source: git-annex +Section: utils +Priority: optional +Build-Depends: debhelper (>= 7.0.50), ghc6, libghc6-missingh-dev +Maintainer: Joey Hess +Standards-Version: 3.9.1 +Vcs-Git: git://git.kitenet.net/git-annex +Homepage: http://kitenet.net/~joey/code/git-annex/ + +Package: git-annex +Architecture: any +Section: utils +Depends: ${misc:Depends}, ${shlibs:Depends}, git | git-core, uuid +Description: manage files with git, without checking their contents into git + git-annex allows managing files with git, without checking the file + contents into git. While that may seem paradoxical, it is useful when + dealing with files larger than git can currently easily handle, whether due + to limitations in memory, checksumming time, or disk space. + . + Even without file content tracking, being able to manage files with git, + move files around and delete files with versioned directory trees, and use + branches and distributed clones, are all very handy reasons to use git. And + annexed files can co-exist in the same git repository with regularly + versioned files, which is convenient for maintaining documents, Makefiles, + etc that are associated with annexed files but that benefit from full + revision control. diff --git a/debian/docs b/debian/docs new file mode 100644 index 000000000..9de86edc7 --- /dev/null +++ b/debian/docs @@ -0,0 +1 @@ +doc/*.mdwn diff --git a/debian/rules b/debian/rules new file mode 100755 index 000000000..e0a209a72 --- /dev/null +++ b/debian/rules @@ -0,0 +1,7 @@ +#!/usr/bin/make -f +%: + dh $@ + +# Not intended for use by anyone except the author. +announcedir: + @echo ${HOME}/src/joeywiki/code/git-annex/news -- cgit v1.2.3 From d1a455bdb4bd96c4ecf590b56f0517538c9d8eb0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 16:52:20 -0400 Subject: need SHA too --- INSTALL | 2 +- debian/control | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/INSTALL b/INSTALL index 5c149dc45..11f573488 100644 --- a/INSTALL +++ b/INSTALL @@ -1,5 +1,5 @@ To build and use git-annex, you will need: * ghc -* These haskell libraries: MissingH +* These haskell libraries: MissingH SHA * a "uuid" command diff --git a/debian/control b/debian/control index fa4fd6115..e58f55af9 100644 --- a/debian/control +++ b/debian/control @@ -1,7 +1,7 @@ Source: git-annex Section: utils Priority: optional -Build-Depends: debhelper (>= 7.0.50), ghc6, libghc6-missingh-dev +Build-Depends: debhelper (>= 7.0.50), ghc6, libghc6-missingh-dev, libghc6-sha-dev Maintainer: Joey Hess Standards-Version: 3.9.1 Vcs-Git: git://git.kitenet.net/git-annex -- cgit v1.2.3 From 4da793b51441e65c48bbf680d8650c57a4c9874d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 17:08:08 -0400 Subject: up --- TODO | 3 +++ 1 file changed, 3 insertions(+) diff --git a/TODO b/TODO index 8fc17fca9..ed150cff0 100644 --- a/TODO +++ b/TODO @@ -5,4 +5,7 @@ * how to handle git mv file? +* Support for remote git repositories (ssh:// specifically can be made to + work, although the other end probably needs to have git-annex installed..) + * finish BackendChecksum -- cgit v1.2.3 From 91c9cd2b8eb9934eebf9a20adde7794a103d144a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 17:15:58 -0400 Subject: todo --- INSTALL | 2 +- TODO | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/INSTALL b/INSTALL index 11f573488..9594448e7 100644 --- a/INSTALL +++ b/INSTALL @@ -2,4 +2,4 @@ To build and use git-annex, you will need: * ghc * These haskell libraries: MissingH SHA -* a "uuid" command +* uuid diff --git a/TODO b/TODO index ed150cff0..5bef280e2 100644 --- a/TODO +++ b/TODO @@ -8,4 +8,8 @@ * Support for remote git repositories (ssh:// specifically can be made to work, although the other end probably needs to have git-annex installed..) +* Find a way to copy a file with a progress bar, while still preserving + stat. Easiest way might be to use pv and fix up the permissions etc + after? + * finish BackendChecksum -- cgit v1.2.3 From b3e5590fb2995d73d5e69a3954fcb11d9fe98d28 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 17:44:59 -0400 Subject: update --- Remotes.hs | 6 ++++-- TODO | 3 +++ 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/Remotes.hs b/Remotes.hs index 3774f993c..f21f5a6ba 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -6,8 +6,8 @@ module Remotes ( tryGitConfigRead ) where +import Control.Exception import Control.Monad.State (liftIO) -import IO import qualified Data.Map as Map import Data.String.Utils import List @@ -85,7 +85,9 @@ tryGitConfigRead :: Git.Repo -> Annex (Maybe Git.Repo) tryGitConfigRead r = do if (Map.null $ Git.configMap r) then do - result <- liftIO $ try (Git.configRead r) + -- configRead can fail due to IO error or + -- for other reasons; catch all possible exceptions + result <- liftIO $ (try (Git.configRead r)::IO (Either SomeException (Git.Repo))) case (result) of Left err -> return Nothing Right r' -> do diff --git a/TODO b/TODO index 5bef280e2..cd94f03bc 100644 --- a/TODO +++ b/TODO @@ -8,6 +8,9 @@ * Support for remote git repositories (ssh:// specifically can be made to work, although the other end probably needs to have git-annex installed..) +* Copy files atomically, don't leaf a partial key on interrupt. + (Fix for URL download too..) + * Find a way to copy a file with a progress bar, while still preserving stat. Easiest way might be to use pv and fix up the permissions etc after? -- cgit v1.2.3 From be5b1defeb2f3b5499fd3c002fcdba5b5e9d15f5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 19:43:32 -0400 Subject: add --no-commit option --- BackendTypes.hs | 2 +- Commands.hs | 37 ++++++++++++++++++++++++++----------- Core.hs | 3 ++- TODO | 3 +++ 4 files changed, 32 insertions(+), 13 deletions(-) diff --git a/BackendTypes.hs b/BackendTypes.hs index 49bd1bceb..06ecfb8fe 100644 --- a/BackendTypes.hs +++ b/BackendTypes.hs @@ -11,7 +11,7 @@ import Data.String.Utils import qualified GitRepo as Git -- command-line flags -data Flag = Force | NeedCommit +data Flag = Force | NoCommit | NeedCommit deriving (Eq, Read, Show) -- git-annex's runtime state type doesn't really belong here, diff --git a/Commands.hs b/Commands.hs index c477a81fd..63ca6b5e4 100644 --- a/Commands.hs +++ b/Commands.hs @@ -32,7 +32,8 @@ data Command = Command { } cmds :: [Command] -cmds = [ (Command "add" addCmd FilesNotInGit) +cmds = [ + (Command "add" addCmd FilesNotInGit) , (Command "get" getCmd FilesInGit) , (Command "drop" dropCmd FilesInGit) , (Command "push" pushCmd RepoName) @@ -41,6 +42,11 @@ cmds = [ (Command "add" addCmd FilesNotInGit) , (Command "describe" describeCmd SingleString) ] +options = [ + Option ['f'] ["force"] (NoArg Force) "allow actions that may loose annexed data" + , Option ['N'] ["no-commit"] (NoArg NoCommit) "do not stage or commit changes" + ] + {- Finds the type of parameters a command wants, from among the passed - parameter list. -} findWanted :: CmdWants -> [String] -> Git.Repo -> IO [String] @@ -75,7 +81,6 @@ parseCmd argv state = do lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds header = "Usage: git-annex [" ++ (join "|" $ map cmdname cmds) ++ "] ..." - options = [ Option ['f'] ["force"] (NoArg Force) "allow actions that may loose annexed data" ] {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} @@ -89,7 +94,7 @@ addCmd file = inBackend file err $ do Nothing -> error $ "no backend could store: " ++ file Just (key, backend) -> do logStatus key ValuePresent - liftIO $ setup g key link + setup g key link where err = error $ "already annexed " ++ file checkLegal file = do @@ -106,12 +111,16 @@ addCmd file = inBackend file err $ do setup g key link = do let dest = annexLocation g key let reldest = annexLocationRelative g key - createDirectoryIfMissing True (parentDir dest) - renameFile file dest - createSymbolicLink (link ++ reldest) file - Git.run g ["add", file] - Git.run g ["commit", "-m", - ("git-annex annexed " ++ file), file] + liftIO $ createDirectoryIfMissing True (parentDir dest) + liftIO $ renameFile file dest + liftIO $ createSymbolicLink (link ++ reldest) file + nocommit <- Annex.flagIsSet NoCommit + if (not nocommit) + then do + liftIO $ Git.run g ["add", file] + liftIO $ Git.run g ["commit", "-m", + ("git-annex annexed " ++ file), file] + else return () {- Inverse of addCmd. -} unannexCmd :: FilePath -> Annex () @@ -192,7 +201,10 @@ describeCmd description = do u <- getUUID g describeUUID u description log <- uuidLog - liftIO $ Git.run g ["add", log] + nocommit <- Annex.flagIsSet NoCommit + if (not nocommit) + then liftIO $ Git.run g ["add", log] + else return () Annex.flagChange NeedCommit True liftIO $ putStrLn "description set" @@ -202,7 +214,10 @@ logStatus key status = do g <- Annex.gitRepo u <- getUUID g f <- liftIO $ logChange g key u status - liftIO $ Git.run g ["add", f] + nocommit <- Annex.flagIsSet NoCommit + if (not nocommit) + then liftIO $ Git.run g ["add", f] + else return () Annex.flagChange NeedCommit True inBackend file yes no = do diff --git a/Core.hs b/Core.hs index fcbce4163..6e48068f9 100644 --- a/Core.hs +++ b/Core.hs @@ -24,8 +24,9 @@ startup flags = do shutdown :: Annex () shutdown = do g <- Annex.gitRepo + nocommit <- Annex.flagIsSet NoCommit needcommit <- Annex.flagIsSet NeedCommit - if (needcommit) + if (needcommit && not nocommit) then liftIO $ Git.run g ["commit", "-q", "-m", "git-annex log update", gitStateDir g] else return () diff --git a/TODO b/TODO index cd94f03bc..fedcce6dd 100644 --- a/TODO +++ b/TODO @@ -5,6 +5,9 @@ * how to handle git mv file? +* how to handle git rm file? (should try to drop keys that have no + referring file, if it seems safe..) + * Support for remote git repositories (ssh:// specifically can be made to work, although the other end probably needs to have git-annex installed..) -- cgit v1.2.3 From c69e747d383d308d0cf65d88dc1c3be139d056a9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 19:57:56 -0400 Subject: refactor --- Commands.hs | 20 +++----------------- Core.hs | 21 ++++++++++++++++++++- 2 files changed, 23 insertions(+), 18 deletions(-) diff --git a/Commands.hs b/Commands.hs index 63ca6b5e4..f33be5393 100644 --- a/Commands.hs +++ b/Commands.hs @@ -114,13 +114,7 @@ addCmd file = inBackend file err $ do liftIO $ createDirectoryIfMissing True (parentDir dest) liftIO $ renameFile file dest liftIO $ createSymbolicLink (link ++ reldest) file - nocommit <- Annex.flagIsSet NoCommit - if (not nocommit) - then do - liftIO $ Git.run g ["add", file] - liftIO $ Git.run g ["commit", "-m", - ("git-annex annexed " ++ file), file] - else return () + gitAdd file $ Just $ "git-annex annexed " ++ file {- Inverse of addCmd. -} unannexCmd :: FilePath -> Annex () @@ -201,11 +195,7 @@ describeCmd description = do u <- getUUID g describeUUID u description log <- uuidLog - nocommit <- Annex.flagIsSet NoCommit - if (not nocommit) - then liftIO $ Git.run g ["add", log] - else return () - Annex.flagChange NeedCommit True + gitAdd log Nothing -- all logs are committed at end liftIO $ putStrLn "description set" {- Updates the LocationLog when a key's presence changes. -} @@ -214,11 +204,7 @@ logStatus key status = do g <- Annex.gitRepo u <- getUUID g f <- liftIO $ logChange g key u status - nocommit <- Annex.flagIsSet NoCommit - if (not nocommit) - then liftIO $ Git.run g ["add", f] - else return () - Annex.flagChange NeedCommit True + gitAdd f Nothing -- all logs are committed at end inBackend file yes no = do r <- liftIO $ Backend.lookupFile file diff --git a/Core.hs b/Core.hs index 6e48068f9..5f5cba295 100644 --- a/Core.hs +++ b/Core.hs @@ -2,6 +2,7 @@ module Core where +import Maybe import System.IO import System.Directory import Control.Monad.State (liftIO) @@ -61,4 +62,22 @@ inAnnex key = do g <- Annex.gitRepo liftIO $ doesFileExist $ annexLocation g key -{- -} +{- Adds, optionally also commits a file to git. + - + - All changes to the git repository should go through this function. + - + - This is careful to not rely on the index. It may have staged changes, + - so only use operations that avoid committing such changes. + -} +gitAdd :: FilePath -> Maybe String -> Annex () +gitAdd file commitmessage = do + nocommit <- Annex.flagIsSet NoCommit + if (nocommit) + then Annex.flagChange NeedCommit True + else do + g <- Annex.gitRepo + liftIO $ Git.run g ["add", file] + if (isJust commitmessage) + then liftIO $ Git.run g ["commit", "-m", + (fromJust commitmessage), file] + else return () -- cgit v1.2.3 From 96347a25a26d01ae4814e9eeb44e7c82a68fb560 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 20:03:41 -0400 Subject: show full usage --- Commands.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Commands.hs b/Commands.hs index f33be5393..b9f31a56c 100644 --- a/Commands.hs +++ b/Commands.hs @@ -67,9 +67,9 @@ parseCmd :: [String] -> AnnexState -> IO ([Flag], [Annex ()]) parseCmd argv state = do (flags, params) <- getopt case (length params) of - 0 -> error header + 0 -> error usage _ -> case (lookupCmd (params !! 0)) of - [] -> error header + [] -> error usage [Command _ action want] -> do f <- findWanted want (drop 1 params) (BackendTypes.repo state) @@ -77,10 +77,11 @@ parseCmd argv state = do where getopt = case getOpt Permute options argv of (flags, params, []) -> return (flags, params) - (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) + (_, _, errs) -> ioError (userError (concat errs ++ usage)) lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds header = "Usage: git-annex [" ++ (join "|" $ map cmdname cmds) ++ "] ..." + usage = usageInfo header options {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} -- cgit v1.2.3 From b02a3b3f5b264ca12fcbf225db3c3ddd341ac51a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 21:03:25 -0400 Subject: add fix subcommand --- Commands.hs | 37 +++++++++++++++++++++++++------------ Core.hs | 13 +++++++++++++ doc/git-annex.mdwn | 2 ++ 3 files changed, 40 insertions(+), 12 deletions(-) diff --git a/Commands.hs b/Commands.hs index b9f31a56c..8afe66b91 100644 --- a/Commands.hs +++ b/Commands.hs @@ -40,6 +40,7 @@ cmds = [ , (Command "pull" pullCmd RepoName) , (Command "unannex" unannexCmd FilesInGit) , (Command "describe" describeCmd SingleString) + , (Command "fix" fixCmd FilesInGit) ] options = [ @@ -89,13 +90,12 @@ addCmd :: FilePath -> Annex () addCmd file = inBackend file err $ do liftIO $ checkLegal file g <- Annex.gitRepo - link <- liftIO $ calcGitLink file g stored <- Backend.storeFileKey file case (stored) of Nothing -> error $ "no backend could store: " ++ file Just (key, backend) -> do logStatus key ValuePresent - setup g key link + setup g key where err = error $ "already annexed " ++ file checkLegal file = do @@ -103,21 +103,15 @@ addCmd file = inBackend file err $ do if ((isSymbolicLink s) || (not $ isRegularFile s)) then error $ "not a regular file: " ++ file else return () - calcGitLink file g = do - cwd <- getCurrentDirectory - let absfile = case (absNormPath cwd file) of - Just f -> f - Nothing -> error $ "unable to normalize " ++ file - return $ relPathDirToDir (parentDir absfile) (Git.workTree g) - setup g key link = do + setup g key = do let dest = annexLocation g key - let reldest = annexLocationRelative g key liftIO $ createDirectoryIfMissing True (parentDir dest) liftIO $ renameFile file dest - liftIO $ createSymbolicLink (link ++ reldest) file + link <- calcGitLink file key + liftIO $ createSymbolicLink link file gitAdd file $ Just $ "git-annex annexed " ++ file -{- Inverse of addCmd. -} +{- Undo addCmd. -} unannexCmd :: FilePath -> Annex () unannexCmd file = notinBackend file err $ \(key, backend) -> do Backend.removeKey backend key @@ -181,6 +175,25 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do where err = error $ "not annexed " ++ file +{- Fixes the symlink to an annexed file. -} +fixCmd :: String -> Annex () +fixCmd file = notinBackend file err $ \(key, backend) -> do + link <- calcGitLink file key + checkLegal file + liftIO $ createDirectoryIfMissing True (parentDir file) + liftIO $ removeFile file + liftIO $ createSymbolicLink link file + gitAdd file $ Just $ "git-annex fix " ++ file + where + checkLegal file = do + s <- liftIO $ getSymbolicLinkStatus file + force <- Annex.flagIsSet Force + if (not (isSymbolicLink s) && not force) + then error $ "not a symbolic link : " ++ file ++ + " (use --force to override this sanity check)" + else return () + err = error $ "not annexed " ++ file + {- Pushes all files to a remote repository. -} pushCmd :: String -> Annex () pushCmd reponame = do error "not implemented" -- TODO diff --git a/Core.hs b/Core.hs index 5f5cba295..021595f8b 100644 --- a/Core.hs +++ b/Core.hs @@ -6,12 +6,14 @@ import Maybe import System.IO import System.Directory import Control.Monad.State (liftIO) +import System.Path import Types import Locations import UUID import qualified GitRepo as Git import qualified Annex +import Utility {- Sets up a git repo for git-annex. -} startup :: [Flag] -> Annex () @@ -81,3 +83,14 @@ gitAdd file commitmessage = do then liftIO $ Git.run g ["commit", "-m", (fromJust commitmessage), file] else return () + +{- Calculates the relative path to use to link a file to a key. -} +calcGitLink :: FilePath -> Key -> Annex FilePath +calcGitLink file key = do + g <- Annex.gitRepo + cwd <- liftIO $ getCurrentDirectory + let absfile = case (absNormPath cwd file) of + Just f -> f + Nothing -> error $ "unable to normalize " ++ file + return $ (relPathDirToDir (parentDir absfile) (Git.workTree g)) ++ + annexLocationRelative g key diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index e552dc770..e65ad5b02 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -47,6 +47,8 @@ Enough broad picture, here's how it actually looks: repository. * `git annex pull $repository` pulls *all* annexed files from the specified repository. +* `git annex file $file` adjusts the symlink for the file to point to its + content again. Use this if you've moved the file around. * `git annex unannex $file` undoes a `git annex add`. But use `git annex drop` if you're just done with a file; only use `unannex` if you accidentially added a file. -- cgit v1.2.3 From 0c0ae028386aaf17aed1771eee6731c62b72e839 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 21:15:23 -0400 Subject: add fix subcommand --- Commands.hs | 20 +++++++++++++++----- TODO | 6 ++++-- 2 files changed, 19 insertions(+), 7 deletions(-) diff --git a/Commands.hs b/Commands.hs index 8afe66b91..9a3f92524 100644 --- a/Commands.hs +++ b/Commands.hs @@ -24,7 +24,8 @@ import Core import qualified Remotes import qualified BackendTypes -data CmdWants = FilesInGit | FilesNotInGit | RepoName | SingleString +data CmdWants = FilesInGit | FilesNotInGit | FilesInOrNotInGit | + RepoName | SingleString data Command = Command { cmdname :: String, cmdaction :: (String -> Annex ()), @@ -40,7 +41,7 @@ cmds = [ , (Command "pull" pullCmd RepoName) , (Command "unannex" unannexCmd FilesInGit) , (Command "describe" describeCmd SingleString) - , (Command "fix" fixCmd FilesInGit) + , (Command "fix" fixCmd FilesInOrNotInGit) ] options = [ @@ -57,6 +58,10 @@ findWanted FilesNotInGit params repo = do findWanted FilesInGit params repo = do files <- mapM (Git.inRepo repo) params return $ foldl (++) [] files +findWanted FilesInOrNotInGit params repo = do + a <- findWanted FilesInGit params repo + b <- findWanted FilesNotInGit params repo + return $ union a b findWanted SingleString params _ = do return $ [unwords params] findWanted RepoName params _ = do @@ -178,20 +183,25 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do {- Fixes the symlink to an annexed file. -} fixCmd :: String -> Annex () fixCmd file = notinBackend file err $ \(key, backend) -> do + liftIO $ putStrLn $ "fix " ++ file link <- calcGitLink file key - checkLegal file + checkLegal file link liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ removeFile file liftIO $ createSymbolicLink link file gitAdd file $ Just $ "git-annex fix " ++ file where - checkLegal file = do + checkLegal file link = do s <- liftIO $ getSymbolicLinkStatus file force <- Annex.flagIsSet Force if (not (isSymbolicLink s) && not force) then error $ "not a symbolic link : " ++ file ++ " (use --force to override this sanity check)" - else return () + else do + l <- liftIO $ readSymbolicLink file + if (link == l) + then error $ "symbolic link already ok for: " ++ file + else return () err = error $ "not annexed " ++ file {- Pushes all files to a remote repository. -} diff --git a/TODO b/TODO index fedcce6dd..038ed0d4a 100644 --- a/TODO +++ b/TODO @@ -3,15 +3,17 @@ * --push/--pull/--want -* how to handle git mv file? +* how to handle git mv file? -> git annex fix -> run automatically? * how to handle git rm file? (should try to drop keys that have no referring file, if it seems safe..) +* add a git annex fsck that finds keys that have no referring file + * Support for remote git repositories (ssh:// specifically can be made to work, although the other end probably needs to have git-annex installed..) -* Copy files atomically, don't leaf a partial key on interrupt. +* Copy files atomically, don't leave a partial key on interrupt. (Fix for URL download too..) * Find a way to copy a file with a progress bar, while still preserving -- cgit v1.2.3 From 38825f48645c0220b6b2e0368c2ebdbb625f6703 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 21:18:21 -0400 Subject: remove useless checks the file will always be a symlink at this point --- Commands.hs | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/Commands.hs b/Commands.hs index 9a3f92524..4346a35e2 100644 --- a/Commands.hs +++ b/Commands.hs @@ -192,16 +192,10 @@ fixCmd file = notinBackend file err $ \(key, backend) -> do gitAdd file $ Just $ "git-annex fix " ++ file where checkLegal file link = do - s <- liftIO $ getSymbolicLinkStatus file - force <- Annex.flagIsSet Force - if (not (isSymbolicLink s) && not force) - then error $ "not a symbolic link : " ++ file ++ - " (use --force to override this sanity check)" - else do - l <- liftIO $ readSymbolicLink file - if (link == l) - then error $ "symbolic link already ok for: " ++ file - else return () + l <- liftIO $ readSymbolicLink file + if (link == l) + then error $ "symbolic link already ok for: " ++ file + else return () err = error $ "not annexed " ++ file {- Pushes all files to a remote repository. -} -- cgit v1.2.3 From 19daf3fca40d99dd305a75e10dcaa8fbc734598b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 21:50:33 -0400 Subject: oops, should commit descriptions! --- Commands.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Commands.hs b/Commands.hs index 4346a35e2..af6b5aad7 100644 --- a/Commands.hs +++ b/Commands.hs @@ -213,7 +213,7 @@ describeCmd description = do u <- getUUID g describeUUID u description log <- uuidLog - gitAdd log Nothing -- all logs are committed at end + gitAdd log $ Just $ "description for UUID " ++ (show u) liftIO $ putStrLn "description set" {- Updates the LocationLog when a key's presence changes. -} -- cgit v1.2.3 From da453ba70149444672b8cd64e36fe34604edce73 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 22:36:35 -0400 Subject: bugfix: don't add files under .git-annex That could happen if git annex add -N were used repeatedly.. --- Commands.hs | 5 ++++- Core.hs | 2 +- Locations.hs | 4 ++-- doc/git-annex.mdwn | 3 ++- 4 files changed, 9 insertions(+), 5 deletions(-) diff --git a/Commands.hs b/Commands.hs index af6b5aad7..1364a1b35 100644 --- a/Commands.hs +++ b/Commands.hs @@ -54,7 +54,10 @@ options = [ findWanted :: CmdWants -> [String] -> Git.Repo -> IO [String] findWanted FilesNotInGit params repo = do files <- mapM (Git.notInRepo repo) params - return $ foldl (++) [] files + return $ filter notstate $ foldl (++) [] files + where + -- never include files in the state directory + notstate f = f /= take (length stateLoc) f findWanted FilesInGit params repo = do files <- mapM (Git.inRepo repo) params return $ foldl (++) [] files diff --git a/Core.hs b/Core.hs index 021595f8b..70e6e6680 100644 --- a/Core.hs +++ b/Core.hs @@ -51,7 +51,7 @@ gitAttributes repo = do commit else return () where - attrLine = stateLoc ++ "/*.log merge=union" + attrLine = stateLoc ++ "*.log merge=union" attributes = Git.attributes repo commit = do Git.run repo ["add", attributes] diff --git a/Locations.hs b/Locations.hs index 497850062..76516224c 100644 --- a/Locations.hs +++ b/Locations.hs @@ -18,9 +18,9 @@ import qualified GitRepo as Git {- Long-term, cross-repo state is stored in files inside the .git-annex - directory, in the git repository's working tree. -} -stateLoc = ".git-annex" +stateLoc = ".git-annex/" gitStateDir :: Git.Repo -> FilePath -gitStateDir repo = (Git.workTree repo) ++ "/" ++ stateLoc ++ "/" +gitStateDir repo = (Git.workTree repo) ++ "/" ++ stateLoc {- An annexed file's content is stored in - /path/to/repo/.git/annex/, where is of the form diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index e65ad5b02..50fd28e82 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -51,7 +51,8 @@ Enough broad picture, here's how it actually looks: content again. Use this if you've moved the file around. * `git annex unannex $file` undoes a `git annex add`. But use `git annex drop` if you're just done with a file; only use `unannex` if you - accidentially added a file. + accidentially added a file. (You can also run this on all your annexed + files come the Singularity. ;-) * `git annex describe "some description"` allows associating some description (such as "USB archive drive 1") with a repository. This can help with finding it later, see "Location Tracking" below. -- cgit v1.2.3 From 96451ac392d42973f508da08d7c1197c83c659a6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 22:43:38 -0400 Subject: nocommit does not make sense in unannex mode --- Commands.hs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/Commands.hs b/Commands.hs index 1364a1b35..be0a8e37f 100644 --- a/Commands.hs +++ b/Commands.hs @@ -122,11 +122,15 @@ addCmd file = inBackend file err $ do {- Undo addCmd. -} unannexCmd :: FilePath -> Annex () unannexCmd file = notinBackend file err $ \(key, backend) -> do - Backend.removeKey backend key - logStatus key ValueMissing - g <- Annex.gitRepo - let src = annexLocation g key - liftIO $ moveout g src + nocommit <- Annex.flagIsSet NoCommit + if (nocommit) + then error "--nocommit cannot be used in unannex mode" + else do + Backend.removeKey backend key + logStatus key ValueMissing + g <- Annex.gitRepo + let src = annexLocation g key + liftIO $ moveout g src where err = error $ "not annexed " ++ file moveout g src = do -- cgit v1.2.3 From c0b16e0a7306bacce96564d80911bbdb5a246847 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 22:49:09 -0400 Subject: actually, unannex w/o commit can work just have to git rm --- Commands.hs | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/Commands.hs b/Commands.hs index be0a8e37f..67b8fe8ad 100644 --- a/Commands.hs +++ b/Commands.hs @@ -122,26 +122,25 @@ addCmd file = inBackend file err $ do {- Undo addCmd. -} unannexCmd :: FilePath -> Annex () unannexCmd file = notinBackend file err $ \(key, backend) -> do - nocommit <- Annex.flagIsSet NoCommit - if (nocommit) - then error "--nocommit cannot be used in unannex mode" - else do - Backend.removeKey backend key - logStatus key ValueMissing - g <- Annex.gitRepo - let src = annexLocation g key - liftIO $ moveout g src + Backend.removeKey backend key + logStatus key ValueMissing + g <- Annex.gitRepo + let src = annexLocation g key + moveout g src where err = error $ "not annexed " ++ file moveout g src = do - removeFile file - Git.run g ["rm", file] - Git.run g ["commit", "-m", - ("git-annex unannexed " ++ file), file] + nocommit <- Annex.flagIsSet NoCommit + liftIO removeFile file + liftIO Git.run g ["rm", file] + if (not nocommit) + then liftIO Git.run g ["commit", "-m", + ("git-annex unannexed " ++ file), file] + else return () -- git rm deletes empty directories; -- put them back - createDirectoryIfMissing True (parentDir file) - renameFile src file + liftIO createDirectoryIfMissing True (parentDir file) + liftIO renameFile src file return () {- Gets an annexed file from one of the backends. -} -- cgit v1.2.3 From 20b447782a974408594692c7aa6ce8bc26f87858 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 22:59:19 -0400 Subject: typo --- Commands.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Commands.hs b/Commands.hs index 67b8fe8ad..dfb3eef43 100644 --- a/Commands.hs +++ b/Commands.hs @@ -131,16 +131,16 @@ unannexCmd file = notinBackend file err $ \(key, backend) -> do err = error $ "not annexed " ++ file moveout g src = do nocommit <- Annex.flagIsSet NoCommit - liftIO removeFile file - liftIO Git.run g ["rm", file] + liftIO $ removeFile file + liftIO $ Git.run g ["rm", file] if (not nocommit) - then liftIO Git.run g ["commit", "-m", + then liftIO $ Git.run g ["commit", "-m", ("git-annex unannexed " ++ file), file] else return () -- git rm deletes empty directories; -- put them back - liftIO createDirectoryIfMissing True (parentDir file) - liftIO renameFile src file + liftIO $ createDirectoryIfMissing True (parentDir file) + liftIO $ renameFile src file return () {- Gets an annexed file from one of the backends. -} -- cgit v1.2.3 From aaee8e231f111b9b4a2ead95eaaeb3d635cc1699 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 16 Oct 2010 23:36:45 -0400 Subject: bugfix --- Commands.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Commands.hs b/Commands.hs index dfb3eef43..258490996 100644 --- a/Commands.hs +++ b/Commands.hs @@ -57,7 +57,7 @@ findWanted FilesNotInGit params repo = do return $ filter notstate $ foldl (++) [] files where -- never include files in the state directory - notstate f = f /= take (length stateLoc) f + notstate f = stateLoc /= take (length stateLoc) f findWanted FilesInGit params repo = do files <- mapM (Git.inRepo repo) params return $ foldl (++) [] files -- cgit v1.2.3 From c57b1a697c5de4e20ef10c2c4a39a77c20fde85b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 00:10:04 -0400 Subject: add visible size and time to worm keys --- Backend/WORM.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 420f336e9..7e86d4d24 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -23,7 +23,10 @@ backend = Backend.File.backend { -- allows multiple files with the same names to have different keys, -- while also allowing a file to be moved around while retaining the -- same key. --- +-- +-- The file size and modification time are also included in the key, +-- unhashed. This could be used as a sanity check. +-- -- The basename of the filename is also included in the key, so it's clear -- what the original filename was when a user sees the value. keyValue :: FilePath -> Annex (Maybe Key) @@ -31,9 +34,10 @@ keyValue file = do stat <- liftIO $ getFileStatus file return $ Just $ Key ((name backend), key stat) where - key stat = (checksum $ uniqueid stat) ++ sep ++ base + key stat = (checksum $ uniqueid stat) ++ sep ++ + uniqueid stat ++ sep ++ base checksum s = show $ sha1 $ B.pack s - uniqueid stat = (show $ fileSize stat) ++ sep ++ - (show $ modificationTime stat) + uniqueid stat = (show $ modificationTime stat) ++ sep ++ + (show $ fileSize stat) base = takeFileName file sep = ":" -- cgit v1.2.3 From a0b040524a595c16ddb2dbead205ca8ccb6890aa Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 00:33:05 -0400 Subject: remove checksum from WORM with size and mtime in the key, it's redundant --- Backend/WORM.hs | 18 +++++------------- Commands.hs | 9 ++++----- 2 files changed, 9 insertions(+), 18 deletions(-) diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 7e86d4d24..463b0ac8e 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -6,7 +6,6 @@ module Backend.WORM (backend) where import Control.Monad.State import System.FilePath import System.Posix.Files -import Data.Digest.Pure.SHA -- slow, but we only checksum filenames import qualified Data.ByteString.Lazy.Char8 as B import qualified Backend.File @@ -18,25 +17,18 @@ backend = Backend.File.backend { getKey = keyValue } --- A SHA1 of the basename of the filename, plus the file size and --- modification time, is used as the unique part of the key. That --- allows multiple files with the same names to have different keys, +-- The key is formed from the file size, modification time, and the +-- basename of the filename. +-- +-- That allows multiple files with the same names to have different keys, -- while also allowing a file to be moved around while retaining the -- same key. --- --- The file size and modification time are also included in the key, --- unhashed. This could be used as a sanity check. --- --- The basename of the filename is also included in the key, so it's clear --- what the original filename was when a user sees the value. keyValue :: FilePath -> Annex (Maybe Key) keyValue file = do stat <- liftIO $ getFileStatus file return $ Just $ Key ((name backend), key stat) where - key stat = (checksum $ uniqueid stat) ++ sep ++ - uniqueid stat ++ sep ++ base - checksum s = show $ sha1 $ B.pack s + key stat = uniqueid stat ++ sep ++ base uniqueid stat = (show $ modificationTime stat) ++ sep ++ (show $ fileSize stat) base = takeFileName file diff --git a/Commands.hs b/Commands.hs index 258490996..5931bf0a9 100644 --- a/Commands.hs +++ b/Commands.hs @@ -54,10 +54,7 @@ options = [ findWanted :: CmdWants -> [String] -> Git.Repo -> IO [String] findWanted FilesNotInGit params repo = do files <- mapM (Git.notInRepo repo) params - return $ filter notstate $ foldl (++) [] files - where - -- never include files in the state directory - notstate f = stateLoc /= take (length stateLoc) f + return $ foldl (++) [] files findWanted FilesInGit params repo = do files <- mapM (Git.inRepo repo) params return $ foldl (++) [] files @@ -82,8 +79,10 @@ parseCmd argv state = do [Command _ action want] -> do f <- findWanted want (drop 1 params) (BackendTypes.repo state) - return (flags, map action f) + return (flags, map action $ filter notstate f) where + -- never include files from the state directory + notstate f = stateLoc /= take (length stateLoc) f getopt = case getOpt Permute options argv of (flags, params, []) -> return (flags, params) (_, _, errs) -> ioError (userError (concat errs ++ usage)) -- cgit v1.2.3 From 6bfa534aa4d7552c4ccfdb9523b55da19fac8883 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 10:47:46 -0400 Subject: git annex drop -- do not try to drop if key is not in backend --- Commands.hs | 23 ++++++++++++++--------- TODO | 6 +++++- 2 files changed, 19 insertions(+), 10 deletions(-) diff --git a/Commands.hs b/Commands.hs index 5931bf0a9..b446dbfac 100644 --- a/Commands.hs +++ b/Commands.hs @@ -165,13 +165,20 @@ getCmd file = notinBackend file err $ \(key, backend) -> do - if it's safe to do so. -} dropCmd :: FilePath -> Annex () dropCmd file = notinBackend file err $ \(key, backend) -> do - force <- Annex.flagIsSet Force - if (not force) - then requireEnoughCopies key - else return () - success <- Backend.removeKey backend key - if (success) - then do + inbackend <- Backend.hasKey key + if (not inbackend) + then return () -- no-op + else do + force <- Annex.flagIsSet Force + if (not force) + then requireEnoughCopies key + else return () + success <- Backend.removeKey backend key + if (success) + then cleanup key + else error $ "backend refused to drop " ++ file + where + cleanup key = do logStatus key ValueMissing inannex <- inAnnex key if (inannex) @@ -181,8 +188,6 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do liftIO $ removeFile loc return () else return () - else error $ "backend refused to drop " ++ file - where err = error $ "not annexed " ++ file {- Fixes the symlink to an annexed file. -} diff --git a/TODO b/TODO index 038ed0d4a..807df32d8 100644 --- a/TODO +++ b/TODO @@ -1,7 +1,11 @@ * bug: cannot "git annex ../foo" (GitRepo.relative is buggy and git-ls-files also refuses w/o --full-name, which would need other changes) -* --push/--pull/--want +* bug: git annex add file is silent if file was a symlink and got replaced + with a file. The you then git command -a, you'll check in the fil contents.. + +* --push/--pull should take a reponame and files, and push those files + to that repo; dropping them from the current repo * how to handle git mv file? -> git annex fix -> run automatically? -- cgit v1.2.3 From b471822cfe4476995f539c6e7e7da7f7bf2b5e02 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 11:47:36 -0400 Subject: move supportedBackends list into annex monad This was necessary so the File backend could import Backend w/o a cycle. Moved code that checks whether enough backends have a file into File backend. --- Annex.hs | 26 ++++++++++++++++++------- Backend.hs | 35 +++++++++++++++++++++++---------- Backend/File.hs | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++----- BackendList.hs | 25 ++---------------------- BackendTypes.hs | 1 + Commands.hs | 50 +---------------------------------------------- git-annex.hs | 3 ++- 7 files changed, 105 insertions(+), 95 deletions(-) diff --git a/Annex.hs b/Annex.hs index 68c0cb88e..e76ccd1dc 100644 --- a/Annex.hs +++ b/Annex.hs @@ -7,6 +7,8 @@ module Annex ( gitRepoChange, backends, backendsChange, + supportedBackends, + supportedBackendsChange, flagIsSet, flagChange, Flag(..) @@ -20,20 +22,21 @@ import qualified BackendTypes as Backend {- Create and returns an Annex state object for the specified git repo. -} -new :: Git.Repo -> IO AnnexState -new g = do +new :: Git.Repo -> [Backend] -> IO AnnexState +new gitrepo allbackends = do let s = Backend.AnnexState { - Backend.repo = g, + Backend.repo = gitrepo, Backend.backends = [], + Backend.supportedBackends = allbackends, Backend.flags = [] } - (_,s') <- Annex.run s (prep g) + (_,s') <- Annex.run s (prep gitrepo) return s' where - prep g = do + prep gitrepo = do -- read git config and update state - g' <- liftIO $ Git.configRead g - Annex.gitRepoChange g' + gitrepo' <- liftIO $ Git.configRead gitrepo + Annex.gitRepoChange gitrepo' -- performs an action in the Annex monad run state action = runStateT (action) state @@ -57,6 +60,15 @@ backendsChange b = do state <- get put state { Backend.backends = b } return () +supportedBackends :: Annex [Backend] +supportedBackends = do + state <- get + return (Backend.supportedBackends state) +supportedBackendsChange :: [Backend] -> Annex () +supportedBackendsChange b = do + state <- get + put state { Backend.supportedBackends = b } + return () flagIsSet :: Flag -> Annex Bool flagIsSet flag = do state <- get diff --git a/Backend.hs b/Backend.hs index 874191924..dfaa55970 100644 --- a/Backend.hs +++ b/Backend.hs @@ -28,14 +28,12 @@ import System.FilePath import Data.String.Utils import System.Posix.Files -import BackendList import Locations import qualified GitRepo as Git import qualified Annex import Utility import Types import qualified BackendTypes as B -import BackendList {- List of backends in the order to try them when storing a new key. -} backendList :: Annex [Backend] @@ -44,10 +42,24 @@ backendList = do if (0 < length l) then return l else do + all <- Annex.supportedBackends g <- Annex.gitRepo - let l = parseBackendList $ Git.configGet g "annex.backends" "" + let l = parseBackendList all $ Git.configGet g "annex.backends" "" Annex.backendsChange l return l + where + parseBackendList all s = + if (length s == 0) + then all + else map (lookupBackendName all) $ words s + +{- Looks up a backend in the list of supportedBackends -} +lookupBackendName :: [Backend] -> String -> Backend +lookupBackendName all s = + if ((length matches) /= 1) + then error $ "unknown backend " ++ s + else matches !! 0 + where matches = filter (\b -> s == B.name b) all {- Attempts to store a file in one of the backends. -} storeFileKey :: FilePath -> Annex (Maybe (Key, Backend)) @@ -81,21 +93,24 @@ removeKey backend key = (B.removeKey backend) key {- Checks if a backend has its key. -} hasKey :: Key -> Annex Bool -hasKey key = (B.hasKey (lookupBackendName $ backendName key)) key +hasKey key = do + all <- Annex.supportedBackends + (B.hasKey (lookupBackendName all $ backendName key)) key {- Looks up the key and backend corresponding to an annexed file, - by examining what the file symlinks to. -} -lookupFile :: FilePath -> IO (Maybe (Key, Backend)) +lookupFile :: FilePath -> Annex (Maybe (Key, Backend)) lookupFile file = do - result <- try (lookup)::IO (Either SomeException (Maybe (Key, Backend))) + all <- Annex.supportedBackends + result <- liftIO $ (try (lookup all)::IO (Either SomeException (Maybe (Key, Backend)))) case (result) of Left err -> return Nothing Right succ -> return succ where - lookup = do + lookup all = do l <- readSymbolicLink file - return $ Just $ pair $ takeFileName l - pair file = (k, b) + return $ Just $ pair all $ takeFileName l + pair all file = (k, b) where k = fileKey file - b = lookupBackendName $ backendName k + b = lookupBackendName all $ backendName k diff --git a/Backend/File.hs b/Backend/File.hs index f5237f721..591ff3db4 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -25,13 +25,14 @@ import Utility import Core import qualified Annex import UUID +import qualified Backend backend = Backend { name = mustProvide, getKey = mustProvide, storeFileKey = dummyStore, retrieveKeyFile = copyKeyFile, - removeKey = dummyRemove, + removeKey = checkRemoveKey, hasKey = checkKeyFile } @@ -41,10 +42,6 @@ mustProvide = error "must provide this field" dummyStore :: FilePath -> Key -> Annex (Bool) dummyStore file key = return True -{- Allow keys to be removed. -} -dummyRemove :: Key -> Annex Bool -dummyRemove url = return True - {- Just check if the .git/annex/ file for the key exists. -} checkKeyFile :: Key -> Annex Bool checkKeyFile k = inAnnex k @@ -102,3 +99,56 @@ copyFromRemote r key file = do else error "cp failed" getremote = error "get via network not yet implemented!" location = annexLocation r key + +{- Checks remotes to verify that enough copies of a key exist to allow + - for a key to be safely removed (with no data loss), and fails with an + - error if not. -} +checkRemoveKey :: Key -> Annex (Bool) +checkRemoveKey key = do + force <- Annex.flagIsSet Force + if (force) + then return True + else do + g <- Annex.gitRepo + let numcopies = read $ Git.configGet g config "1" + remotes <- Remotes.withKey key + if (numcopies > length remotes) + then retNotEnoughCopiesKnown remotes numcopies + else findcopies numcopies remotes [] + where + failMsg w = do + liftIO $ hPutStrLn stderr $ "git-annex: " ++ w + return False -- failure, not enough copies found + findcopies 0 _ _ = return True -- success, enough copies found + findcopies _ [] bad = notEnoughCopiesSeen bad + findcopies n (r:rs) bad = do + all <- Annex.supportedBackends + result <- liftIO $ ((try $ remoteHasKey r all)::IO (Either SomeException Bool)) + case (result) of + Right True -> findcopies (n-1) rs bad + Right False -> findcopies n rs bad + Left _ -> findcopies n rs (r:bad) + remoteHasKey r all = do + -- To check if a remote has a key, construct a new + -- Annex monad and query its backend. + a <- Annex.new r all + (result, _) <- Annex.run a (Backend.hasKey key) + return result + notEnoughCopiesSeen bad = failMsg $ + "I failed to find enough other copies of: " ++ + (keyFile key) ++ + (if (0 /= length bad) then listbad bad else "") + ++ unsafe + listbad bad = "\nI was unable to access these remotes: " ++ + (Remotes.list bad) + retNotEnoughCopiesKnown remotes numcopies = failMsg $ + "I only know about " ++ (show $ length remotes) ++ + " out of " ++ (show numcopies) ++ + " necessary copies of: " ++ (keyFile key) ++ + unsafe + unsafe = "\n" ++ + " -- According to the " ++ config ++ + " setting, it is not safe to remove it!\n" ++ + " (Use --force to override.)" + + config = "annex.numcopies" diff --git a/BackendList.hs b/BackendList.hs index 42e237204..920f8fc0a 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -1,11 +1,7 @@ {- git-annex backend list - -} -module BackendList ( - supportedBackends, - parseBackendList, - lookupBackendName -) where +module BackendList (allBackends) where import BackendTypes @@ -13,25 +9,8 @@ import BackendTypes import qualified Backend.WORM import qualified Backend.SHA1 import qualified Backend.URL -supportedBackends = +allBackends = [ Backend.WORM.backend , Backend.SHA1.backend , Backend.URL.backend ] - -{- Parses a string with a list of backend names into - - a list of Backend objects. If the list is empty, - - defaults to supportedBackends. -} -parseBackendList :: String -> [Backend] -parseBackendList s = - if (length s == 0) - then supportedBackends - else map (lookupBackendName) $ words s - -{- Looks up a supported backend by name. -} -lookupBackendName :: String -> Backend -lookupBackendName s = - if ((length matches) /= 1) - then error $ "unknown backend " ++ s - else matches !! 0 - where matches = filter (\b -> s == name b) supportedBackends diff --git a/BackendTypes.hs b/BackendTypes.hs index 06ecfb8fe..e372099b2 100644 --- a/BackendTypes.hs +++ b/BackendTypes.hs @@ -19,6 +19,7 @@ data Flag = Force | NoCommit | NeedCommit data AnnexState = AnnexState { repo :: Git.Repo, backends :: [Backend], + supportedBackends :: [Backend], flags :: [Flag] } deriving (Show) diff --git a/Commands.hs b/Commands.hs index b446dbfac..62376e4dd 100644 --- a/Commands.hs +++ b/Commands.hs @@ -16,7 +16,6 @@ import qualified Annex import Utility import Locations import qualified Backend -import BackendList import UUID import LocationLog import Types @@ -169,10 +168,6 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do if (not inbackend) then return () -- no-op else do - force <- Annex.flagIsSet Force - if (not force) - then requireEnoughCopies key - else return () success <- Backend.removeKey backend key if (success) then cleanup key @@ -235,51 +230,8 @@ logStatus key status = do gitAdd f Nothing -- all logs are committed at end inBackend file yes no = do - r <- liftIO $ Backend.lookupFile file + r <- Backend.lookupFile file case (r) of Just v -> yes v Nothing -> no notinBackend file yes no = inBackend file no yes - -{- Checks remotes to verify that enough copies of a key exist to allow - - for a key to be safely removed (with no data loss), and fails with an - - error if not. -} -requireEnoughCopies :: Key -> Annex () -requireEnoughCopies key = do - g <- Annex.gitRepo - let numcopies = read $ Git.configGet g config "1" - remotes <- Remotes.withKey key - if (numcopies > length remotes) - then error $ "I only know about " ++ (show $ length remotes) ++ - " out of " ++ (show numcopies) ++ - " necessary copies of: " ++ (keyFile key) ++ - unsafe - else findcopies numcopies remotes [] - where - findcopies 0 _ _ = return () -- success, enough copies found - findcopies _ [] bad = die bad - findcopies n (r:rs) bad = do - result <- liftIO $ try $ haskey r - case (result) of - Right True -> findcopies (n-1) rs bad - Right False -> findcopies n rs bad - Left _ -> findcopies n rs (r:bad) - haskey r = do - -- To check if a remote has a key, construct a new - -- Annex monad and query its backend. - a <- Annex.new r - (result, _) <- Annex.run a (Backend.hasKey key) - return result - die bad = - error $ "I failed to find enough other copies of: " ++ - (keyFile key) ++ - (if (0 /= length bad) then listbad bad else "") - ++ unsafe - listbad bad = "\nI was unable to access these remotes: " ++ - (Remotes.list bad) - unsafe = "\n" ++ - " -- According to the " ++ config ++ - " setting, it is not safe to remove it!\n" ++ - " (Use --force to override.)" - - config = "annex.numcopies" diff --git a/git-annex.hs b/git-annex.hs index f4f0cfcdf..947868f23 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -9,11 +9,12 @@ import Types import Core import Commands import qualified GitRepo as Git +import BackendList main = do args <- getArgs gitrepo <- Git.repoFromCwd - state <- Annex.new gitrepo + state <- Annex.new gitrepo allBackends (flags, actions) <- parseCmd args state tryRun state $ [startup flags] ++ actions ++ [shutdown] -- cgit v1.2.3 From cb1a0a387f93e882ced50709f938bd0a28cd14be Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 11:51:53 -0400 Subject: update --- doc/git-annex.mdwn | 63 ++++++++++++++++++++++++++++-------------------------- 1 file changed, 33 insertions(+), 30 deletions(-) diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 50fd28e82..4d2872aa3 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -61,35 +61,6 @@ Oh yeah, "$file" in the above can be any number of files, or directories, same as you'd pass to "git add" or "git rm". So "git annex add ." or "git annex get dir/" work fine. -## copies - -git-annex can be configured to try to keep N copies of a file's content -available across all repositories. By default, N is 1; it is configured by -annex.numcopies. - -`git annex drop` attempts to check with other git remotes, to check that N -copies of the file exist. If enough repositories cannot be verified to have -it, it will retain the file content to avoid data loss. - -For example, consider three repositories: Server, Laptop, and USB. Both Server -and USB have a copy of a file, and N=1. If on Laptop, you `git annex get -$file`, this will transfer it from either Server or USB (depending on which -is available), and there are now 3 copies of the file. - -Suppose you want to free up space on Laptop again, and you `git annex drop` the file -there. If USB is connected, or Server can be contacted, git-annex can check -that it still has a copy of the file, and the content is removed from -Laptop. But if USB is currently disconnected, and Server also cannot be -contacted, it can't verify that it is safe to drop the file, and will -refuse to do so. - -With N=2, in order to drop the file content from Laptop, it would need access -to both USB and Server. - -Note that different repositories can be configured with different values of -N. So just because Laptop has N=2, this does not prevent the number of -copies falling to 1, when USB and Server have N=1. - ## key-value storage git-annex uses a key-value abstraction layer to allow file contents to be @@ -116,6 +87,37 @@ to store different files' contents in a given repository. can make it slow for large files. * `URL` -- This backend downloads the file's content from an external URL. +## copies + +The WORM and SHA1 key-value backends store data inside your git repository. +It's important that data not get lost by an ill-though `git annex drop` +command. So, then using those backends, git-annex can be configured to try +to keep N copies of a file's content available across all repositories. By +default, N is 1; it is configured by annex.numcopies. + +`git annex drop` attempts to check with other git remotes, to check that N +copies of the file exist. If enough repositories cannot be verified to have +it, it will retain the file content to avoid data loss. + +For example, consider three repositories: Server, Laptop, and USB. Both Server +and USB have a copy of a file, and N=1. If on Laptop, you `git annex get +$file`, this will transfer it from either Server or USB (depending on which +is available), and there are now 3 copies of the file. + +Suppose you want to free up space on Laptop again, and you `git annex drop` the file +there. If USB is connected, or Server can be contacted, git-annex can check +that it still has a copy of the file, and the content is removed from +Laptop. But if USB is currently disconnected, and Server also cannot be +contacted, it can't verify that it is safe to drop the file, and will +refuse to do so. + +With N=2, in order to drop the file content from Laptop, it would need access +to both USB and Server. + +Note that different repositories can be configured with different values of +N. So just because Laptop has N=2, this does not prevent the number of +copies falling to 1, when USB and Server have N=1. + ## location tracking git-annex keeps track of in which repositories it last saw a file's content. @@ -149,7 +151,8 @@ finding them: ## configuration * `annex.uuid` -- a unique UUID for this repository -* `annex.numcopies` -- number of copies of files to keep (default: 1) +* `annex.numcopies` -- number of copies of files to keep across all + repositories (default: 1) * `annex.backends` -- space-separated list of names of the key-value backends to use. The first listed is used to store new files. (default: "WORM SHA1 URL") -- cgit v1.2.3 From ae4d20d157eb288046dddf4555bfc9f2660ed675 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 11:57:39 -0400 Subject: bugfix --- Core.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Core.hs b/Core.hs index 70e6e6680..1832b3513 100644 --- a/Core.hs +++ b/Core.hs @@ -75,14 +75,14 @@ gitAdd :: FilePath -> Maybe String -> Annex () gitAdd file commitmessage = do nocommit <- Annex.flagIsSet NoCommit if (nocommit) - then Annex.flagChange NeedCommit True + then return () else do g <- Annex.gitRepo liftIO $ Git.run g ["add", file] if (isJust commitmessage) then liftIO $ Git.run g ["commit", "-m", (fromJust commitmessage), file] - else return () + else Annex.flagChange NeedCommit True {- Calculates the relative path to use to link a file to a key. -} calcGitLink :: FilePath -> Key -> Annex FilePath -- cgit v1.2.3 From 76ba2d003072da67bd9b0fb5b84bf7a268a956ee Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 12:08:59 -0400 Subject: reorg --- Commands.hs | 9 +-------- Core.hs | 10 ++++++++++ 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/Commands.hs b/Commands.hs index 62376e4dd..2ff8d0d7b 100644 --- a/Commands.hs +++ b/Commands.hs @@ -221,14 +221,7 @@ describeCmd description = do gitAdd log $ Just $ "description for UUID " ++ (show u) liftIO $ putStrLn "description set" -{- Updates the LocationLog when a key's presence changes. -} -logStatus :: Key -> LogStatus -> Annex () -logStatus key status = do - g <- Annex.gitRepo - u <- getUUID g - f <- liftIO $ logChange g key u status - gitAdd f Nothing -- all logs are committed at end - +-- helpers inBackend file yes no = do r <- Backend.lookupFile file case (r) of diff --git a/Core.hs b/Core.hs index 1832b3513..70ec2eca0 100644 --- a/Core.hs +++ b/Core.hs @@ -10,6 +10,7 @@ import System.Path import Types import Locations +import LocationLog import UUID import qualified GitRepo as Git import qualified Annex @@ -94,3 +95,12 @@ calcGitLink file key = do Nothing -> error $ "unable to normalize " ++ file return $ (relPathDirToDir (parentDir absfile) (Git.workTree g)) ++ annexLocationRelative g key + +{- Updates the LocationLog when a key's presence changes. -} +logStatus :: Key -> LogStatus -> Annex () +logStatus key status = do + g <- Annex.gitRepo + u <- getUUID g + f <- liftIO $ logChange g key u status + gitAdd f Nothing -- all logs are committed at end + -- cgit v1.2.3 From 98676928c8dec5183951006450cc26cf5fb6a985 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 12:09:52 -0400 Subject: prune --- Annex.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/Annex.hs b/Annex.hs index e76ccd1dc..5fd500d94 100644 --- a/Annex.hs +++ b/Annex.hs @@ -8,7 +8,6 @@ module Annex ( backends, backendsChange, supportedBackends, - supportedBackendsChange, flagIsSet, flagChange, Flag(..) @@ -64,11 +63,6 @@ supportedBackends :: Annex [Backend] supportedBackends = do state <- get return (Backend.supportedBackends state) -supportedBackendsChange :: [Backend] -> Annex () -supportedBackendsChange b = do - state <- get - put state { Backend.supportedBackends = b } - return () flagIsSet :: Flag -> Annex Bool flagIsSet flag = do state <- get -- cgit v1.2.3 From 8f6e5da18f80ea5dfc124afed0ff2671a3909d56 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 12:12:23 -0400 Subject: verbosity --- Commands.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Commands.hs b/Commands.hs index 2ff8d0d7b..e9b5ddcbd 100644 --- a/Commands.hs +++ b/Commands.hs @@ -95,6 +95,7 @@ parseCmd argv state = do addCmd :: FilePath -> Annex () addCmd file = inBackend file err $ do liftIO $ checkLegal file + liftIO $ putStrLn $ "add " ++ file g <- Annex.gitRepo stored <- Backend.storeFileKey file case (stored) of @@ -120,6 +121,7 @@ addCmd file = inBackend file err $ do {- Undo addCmd. -} unannexCmd :: FilePath -> Annex () unannexCmd file = notinBackend file err $ \(key, backend) -> do + liftIO $ putStrLn $ "unannex " ++ file Backend.removeKey backend key logStatus key ValueMissing g <- Annex.gitRepo @@ -168,6 +170,7 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do if (not inbackend) then return () -- no-op else do + liftIO $ putStrLn $ "drop " ++ file success <- Backend.removeKey backend key if (success) then cleanup key -- cgit v1.2.3 From 6d4fc0ca7eb220298e42d368ead57622e80929a3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 13:13:49 -0400 Subject: command output cleanup --- Backend/File.hs | 59 +++++++++++++++++++++++++++++---------------------------- Commands.hs | 33 +++++++++++++++++++------------- Core.hs | 26 +++++++++++++++++++++++-- UUID.hs | 2 +- 4 files changed, 75 insertions(+), 45 deletions(-) diff --git a/Backend/File.hs b/Backend/File.hs index 591ff3db4..f7796532b 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -53,12 +53,13 @@ copyKeyFile key file = do remotes <- Remotes.withKey key if (0 == length remotes) then cantfind - else return () - trycopy remotes remotes + else trycopy remotes remotes where - trycopy full [] = error $ "unable to get file with key: " ++ (keyFile key) ++ "\n" ++ - "To get that file, need access to one of these remotes: " ++ - (Remotes.list full) + trycopy full [] = do + showNote $ + "need access to one of these remotes: " ++ + (Remotes.list full) + return False trycopy full (r:rs) = do -- annexLocation needs the git config to have been -- read for a remote, so do that now, @@ -67,6 +68,7 @@ copyKeyFile key file = do case (result) of Nothing -> trycopy full rs Just r' -> do + showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..." result <- liftIO $ (try (copyFromRemote r' key file)::IO (Either SomeException ())) case (result) of Left err -> do @@ -77,17 +79,15 @@ copyKeyFile key file = do g <- Annex.gitRepo uuids <- liftIO $ keyLocations g key ppuuids <- prettyPrintUUIDs uuids - error $ "no available git remotes have file with key: " ++ - (keyFile key) ++ - if (0 < length uuids) - then "\nIt has been seen before in these repositories:\n" ++ ppuuids - else "" + showNote $ "No available git remotes have the file." + if (0 < length uuids) + then showLongNote $ "It has been seen before in these repositories:\n" ++ ppuuids + else return () + return False {- Tries to copy a file from a remote, exception on error. -} copyFromRemote :: Git.Repo -> Key -> FilePath -> IO () copyFromRemote r key file = do - putStrLn $ "copy from " ++ (Git.repoDescribe r ) ++ " " ++ file - if (Git.repoIsLocal r) then getlocal else getremote @@ -116,9 +116,6 @@ checkRemoveKey key = do then retNotEnoughCopiesKnown remotes numcopies else findcopies numcopies remotes [] where - failMsg w = do - liftIO $ hPutStrLn stderr $ "git-annex: " ++ w - return False -- failure, not enough copies found findcopies 0 _ _ = return True -- success, enough copies found findcopies _ [] bad = notEnoughCopiesSeen bad findcopies n (r:rs) bad = do @@ -134,21 +131,25 @@ checkRemoveKey key = do a <- Annex.new r all (result, _) <- Annex.run a (Backend.hasKey key) return result - notEnoughCopiesSeen bad = failMsg $ - "I failed to find enough other copies of: " ++ - (keyFile key) ++ - (if (0 /= length bad) then listbad bad else "") - ++ unsafe - listbad bad = "\nI was unable to access these remotes: " ++ - (Remotes.list bad) - retNotEnoughCopiesKnown remotes numcopies = failMsg $ + notEnoughCopiesSeen bad = do + showNote "failed to find enough other copies of the file" + if (0 /= length bad) then listbad bad else return () + unsafe + return False + listbad bad = + showLongNote $ + "I was unable to access these remotes: " ++ + (Remotes.list bad) + retNotEnoughCopiesKnown remotes numcopies = do + showNote $ "I only know about " ++ (show $ length remotes) ++ " out of " ++ (show numcopies) ++ - " necessary copies of: " ++ (keyFile key) ++ - unsafe - unsafe = "\n" ++ - " -- According to the " ++ config ++ - " setting, it is not safe to remove it!\n" ++ - " (Use --force to override.)" + " necessary copies of the file" + unsafe + return False + unsafe = do + showLongNote $ "According to the " ++ config ++ + " setting, it is not safe to remove it!" + showLongNote "(Use --force to override.)" config = "annex.numcopies" diff --git a/Commands.hs b/Commands.hs index e9b5ddcbd..8591dbf6a 100644 --- a/Commands.hs +++ b/Commands.hs @@ -95,11 +95,11 @@ parseCmd argv state = do addCmd :: FilePath -> Annex () addCmd file = inBackend file err $ do liftIO $ checkLegal file - liftIO $ putStrLn $ "add " ++ file + showStart "add" file g <- Annex.gitRepo stored <- Backend.storeFileKey file case (stored) of - Nothing -> error $ "no backend could store: " ++ file + Nothing -> showEndFail "no backend could store" file Just (key, backend) -> do logStatus key ValuePresent setup g key @@ -117,11 +117,13 @@ addCmd file = inBackend file err $ do link <- calcGitLink file key liftIO $ createSymbolicLink link file gitAdd file $ Just $ "git-annex annexed " ++ file + showEndOk {- Undo addCmd. -} unannexCmd :: FilePath -> Annex () unannexCmd file = notinBackend file err $ \(key, backend) -> do - liftIO $ putStrLn $ "unannex " ++ file + showStart "unannex" file + Annex.flagChange Force True -- force backend to always remove Backend.removeKey backend key logStatus key ValueMissing g <- Annex.gitRepo @@ -132,16 +134,17 @@ unannexCmd file = notinBackend file err $ \(key, backend) -> do moveout g src = do nocommit <- Annex.flagIsSet NoCommit liftIO $ removeFile file - liftIO $ Git.run g ["rm", file] + liftIO $ Git.run g ["rm", "--quiet", file] if (not nocommit) - then liftIO $ Git.run g ["commit", "-m", - ("git-annex unannexed " ++ file), file] + then liftIO $ Git.run g ["commit", "--quiet", + "-m", ("git-annex unannexed " ++ file), + file] else return () -- git rm deletes empty directories; -- put them back liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ renameFile src file - return () + showEndOk {- Gets an annexed file from one of the backends. -} getCmd :: FilePath -> Annex () @@ -150,6 +153,7 @@ getCmd file = notinBackend file err $ \(key, backend) -> do if (inannex) then return () else do + showStart "get" file g <- Annex.gitRepo let dest = annexLocation g key liftIO $ createDirectoryIfMissing True (parentDir dest) @@ -157,8 +161,8 @@ getCmd file = notinBackend file err $ \(key, backend) -> do if (success) then do logStatus key ValuePresent - return () - else error $ "failed to get " ++ file + showEndOk + else showEndFail "get" file where err = error $ "not annexed " ++ file @@ -170,11 +174,13 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do if (not inbackend) then return () -- no-op else do - liftIO $ putStrLn $ "drop " ++ file + showStart "drop" file success <- Backend.removeKey backend key if (success) - then cleanup key - else error $ "backend refused to drop " ++ file + then do + cleanup key + showEndOk + else showEndFail "backend refused to drop" file where cleanup key = do logStatus key ValueMissing @@ -191,13 +197,14 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do {- Fixes the symlink to an annexed file. -} fixCmd :: String -> Annex () fixCmd file = notinBackend file err $ \(key, backend) -> do - liftIO $ putStrLn $ "fix " ++ file link <- calcGitLink file key checkLegal file link + showStart "fix" file liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ removeFile file liftIO $ createSymbolicLink link file gitAdd file $ Just $ "git-annex fix " ++ file + showEndOk where checkLegal file link = do l <- liftIO $ readSymbolicLink file diff --git a/Core.hs b/Core.hs index 70ec2eca0..27411b2e6 100644 --- a/Core.hs +++ b/Core.hs @@ -7,6 +7,7 @@ import System.IO import System.Directory import Control.Monad.State (liftIO) import System.Path +import Data.String.Utils import Types import Locations @@ -81,8 +82,8 @@ gitAdd file commitmessage = do g <- Annex.gitRepo liftIO $ Git.run g ["add", file] if (isJust commitmessage) - then liftIO $ Git.run g ["commit", "-m", - (fromJust commitmessage), file] + then liftIO $ Git.run g ["commit", "--quiet", + "-m", (fromJust commitmessage), file] else Annex.flagChange NeedCommit True {- Calculates the relative path to use to link a file to a key. -} @@ -104,3 +105,24 @@ logStatus key status = do f <- liftIO $ logChange g key u status gitAdd f Nothing -- all logs are committed at end +{- Output logging -} +showStart :: String -> String -> Annex () +showStart command file = do + liftIO $ putStr $ command ++ " " ++ file + liftIO $ hFlush stdout +showNote :: String -> Annex () +showNote s = do + liftIO $ putStr $ " (" ++ s ++ ")" + liftIO $ hFlush stdout +showLongNote :: String -> Annex () +showLongNote s = do + liftIO $ putStr $ "\n" ++ (indent s) + where + indent s = join "\n" $ map (\l -> " " ++ l) $ lines s +showEndOk :: Annex () +showEndOk = do + liftIO $ putStrLn " ok" +showEndFail :: String -> String -> Annex () +showEndFail command file = do + liftIO $ putStrLn "" + error $ command ++ " " ++ file ++ " failed" diff --git a/UUID.hs b/UUID.hs index 6bd483a18..b665c27e9 100644 --- a/UUID.hs +++ b/UUID.hs @@ -100,7 +100,7 @@ reposByUUID repos uuids = do prettyPrintUUIDs :: [UUID] -> Annex String prettyPrintUUIDs uuids = do m <- uuidMap - return $ unwords $ map (\u -> " "++(prettify m u)++"\n") uuids + return $ unwords $ map (\u -> "\t"++(prettify m u)++"\n") uuids where prettify m u = if (0 < (length $ findlog m u)) -- cgit v1.2.3 From 8398b9ab4a654f3f6ec570b70229a8a0030e8ab6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 13:17:34 -0400 Subject: cleanup output --- Backend/URL.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Backend/URL.hs b/Backend/URL.hs index 9e64e0499..753520766 100644 --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -9,6 +9,7 @@ import System.Cmd import System.Exit import BackendTypes +import Core backend = Backend { name = "URL", @@ -33,7 +34,8 @@ dummyOk url = return True downloadUrl :: Key -> FilePath -> Annex Bool downloadUrl key file = do - liftIO $ putStrLn $ "download: " ++ url + showNote "downloading" + liftIO $ putStrLn "" -- make way for curl progress bar result <- liftIO $ rawSystem "curl" ["-#", "-o", file, url] if (result == ExitSuccess) then return True -- cgit v1.2.3 From a020b0c25c4e7c2e14d685eac8c4d3aa0e1fef8a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 16:39:30 -0400 Subject: atomic file retrieval from backends --- Commands.hs | 9 ++++++--- Core.hs | 9 +++++++++ Locations.hs | 8 +++++++- TODO | 6 ------ 4 files changed, 22 insertions(+), 10 deletions(-) diff --git a/Commands.hs b/Commands.hs index 8591dbf6a..05af0ab2d 100644 --- a/Commands.hs +++ b/Commands.hs @@ -156,13 +156,16 @@ getCmd file = notinBackend file err $ \(key, backend) -> do showStart "get" file g <- Annex.gitRepo let dest = annexLocation g key - liftIO $ createDirectoryIfMissing True (parentDir dest) - success <- Backend.retrieveKeyFile backend key dest + let tmp = (annexTmpLocation g) ++ (keyFile key) + liftIO $ createDirectoryIfMissing True (parentDir tmp) + success <- Backend.retrieveKeyFile backend key tmp if (success) then do + liftIO $ renameFile tmp dest logStatus key ValuePresent showEndOk - else showEndFail "get" file + else do + showEndFail "get" file where err = error $ "not annexed " ++ file diff --git a/Core.hs b/Core.hs index 27411b2e6..302e304e4 100644 --- a/Core.hs +++ b/Core.hs @@ -29,6 +29,8 @@ startup flags = do shutdown :: Annex () shutdown = do g <- Annex.gitRepo + + -- handle pending commits nocommit <- Annex.flagIsSet NoCommit needcommit <- Annex.flagIsSet NeedCommit if (needcommit && not nocommit) @@ -36,6 +38,13 @@ shutdown = do "git-annex log update", gitStateDir g] else return () + -- clean up any files left in the temp directory + let tmp = annexTmpLocation g + exists <- liftIO $ doesDirectoryExist tmp + if (exists) + then liftIO $ removeDirectoryRecursive $ tmp + else return () + {- configure git to use union merge driver on state files, if it is not - already -} gitAttributes :: Git.Repo -> IO () diff --git a/Locations.hs b/Locations.hs index 76516224c..2b0adb7ba 100644 --- a/Locations.hs +++ b/Locations.hs @@ -7,7 +7,8 @@ module Locations ( keyFile, fileKey, annexLocation, - annexLocationRelative + annexLocationRelative, + annexTmpLocation ) where import Data.String.Utils @@ -36,6 +37,11 @@ annexLocation r key = annexLocationRelative :: Git.Repo -> Key -> FilePath annexLocationRelative r key = Git.dir r ++ "/annex/" ++ (keyFile key) +{- .git-annex/tmp is used for temp files + -} +annexTmpLocation :: Git.Repo -> FilePath +annexTmpLocation r = (Git.workTree r) ++ "/" ++ Git.dir r ++ "/annex/tmp/" + {- Converts a key into a filename fragment. - - Escape "/" in the key name, to keep a flat tree of files and avoid diff --git a/TODO b/TODO index 807df32d8..410c694c2 100644 --- a/TODO +++ b/TODO @@ -1,9 +1,6 @@ * bug: cannot "git annex ../foo" (GitRepo.relative is buggy and git-ls-files also refuses w/o --full-name, which would need other changes) -* bug: git annex add file is silent if file was a symlink and got replaced - with a file. The you then git command -a, you'll check in the fil contents.. - * --push/--pull should take a reponame and files, and push those files to that repo; dropping them from the current repo @@ -17,9 +14,6 @@ * Support for remote git repositories (ssh:// specifically can be made to work, although the other end probably needs to have git-annex installed..) -* Copy files atomically, don't leave a partial key on interrupt. - (Fix for URL download too..) - * Find a way to copy a file with a progress bar, while still preserving stat. Easiest way might be to use pv and fix up the permissions etc after? -- cgit v1.2.3 From a4dc920f6b2c31cbdd2c727f1ba7550216303991 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 16:44:06 -0400 Subject: remove some old todos --- Commands.hs | 10 ---------- LocationLog.hs | 1 - doc/git-annex.mdwn | 4 ---- 3 files changed, 15 deletions(-) diff --git a/Commands.hs b/Commands.hs index 05af0ab2d..48186928a 100644 --- a/Commands.hs +++ b/Commands.hs @@ -36,8 +36,6 @@ cmds = [ (Command "add" addCmd FilesNotInGit) , (Command "get" getCmd FilesInGit) , (Command "drop" dropCmd FilesInGit) - , (Command "push" pushCmd RepoName) - , (Command "pull" pullCmd RepoName) , (Command "unannex" unannexCmd FilesInGit) , (Command "describe" describeCmd SingleString) , (Command "fix" fixCmd FilesInOrNotInGit) @@ -216,14 +214,6 @@ fixCmd file = notinBackend file err $ \(key, backend) -> do else return () err = error $ "not annexed " ++ file -{- Pushes all files to a remote repository. -} -pushCmd :: String -> Annex () -pushCmd reponame = do error "not implemented" -- TODO - -{- Pulls all files from a remote repository. -} -pullCmd :: String -> Annex () -pullCmd reponame = do error "not implemented" -- TODO - {- Stores description for the repository. -} describeCmd :: String -> Annex () describeCmd description = do diff --git a/LocationLog.hs b/LocationLog.hs index c0d6170b2..4a5fe449c 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -112,7 +112,6 @@ appendLog file line = do createDirectoryIfMissing True (parentDir file) withFileLocked file AppendMode $ \h -> hPutStrLn h $ show line - -- TODO git add log {- Writes a set of lines to a log file -} writeLog :: FilePath -> [LogLine] -> IO () diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 4d2872aa3..66d9897d0 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -43,10 +43,6 @@ Enough broad picture, here's how it actually looks: backend storage to the current repository. * `git annex drop $file` indicates that you no longer want the file's content to be available in this repository. -* `git annex push $repository` pushes *all* annexed files to the specified - repository. -* `git annex pull $repository` pulls *all* annexed files from the specified - repository. * `git annex file $file` adjusts the symlink for the file to point to its content again. Use this if you've moved the file around. * `git annex unannex $file` undoes a `git annex add`. But use `git annex drop` -- cgit v1.2.3 From 632a4e2c6de54aec47a5553d68edd4921231d3c4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 17:10:20 -0400 Subject: rename describe to init and show usage --- Commands.hs | 93 +++++++++++++++++++++++++++++++----------------------- doc/git-annex.mdwn | 24 +++++++------- 2 files changed, 67 insertions(+), 50 deletions(-) diff --git a/Commands.hs b/Commands.hs index 48186928a..6d68fc4e7 100644 --- a/Commands.hs +++ b/Commands.hs @@ -23,22 +23,28 @@ import Core import qualified Remotes import qualified BackendTypes -data CmdWants = FilesInGit | FilesNotInGit | FilesInOrNotInGit | - RepoName | SingleString +data CmdWants = FilesInGit | FilesNotInGit | RepoName | SingleString data Command = Command { cmdname :: String, cmdaction :: (String -> Annex ()), - cmdwants :: CmdWants + cmdwants :: CmdWants, + cmddesc :: String } cmds :: [Command] cmds = [ - (Command "add" addCmd FilesNotInGit) - , (Command "get" getCmd FilesInGit) - , (Command "drop" dropCmd FilesInGit) - , (Command "unannex" unannexCmd FilesInGit) - , (Command "describe" describeCmd SingleString) - , (Command "fix" fixCmd FilesInOrNotInGit) + (Command "add" addCmd FilesNotInGit + "add files to annex") + , (Command "get" getCmd FilesInGit + "make content of annexed files available") + , (Command "drop" dropCmd FilesInGit + "indicate content of files not currently wanted") + , (Command "unannex" unannexCmd FilesInGit + "undo accidential add command") + , (Command "init" initCmd SingleString + "initialize git-annex with repository description") + , (Command "fix" fixCmd FilesInGit + "fix up files' symlinks to point to annexed content") ] options = [ @@ -46,6 +52,17 @@ options = [ , Option ['N'] ["no-commit"] (NoArg NoCommit) "do not stage or commit changes" ] +header = "Usage: git-annex [" ++ (join "|" $ map cmdname cmds) ++ "] ..." + +usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs + where + cmddescs = unlines $ map (\c -> indent $ showcmd c) cmds + showcmd c = + (cmdname c) ++ + (take (10 - (length (cmdname c))) $ repeat ' ') ++ + (cmddesc c) + indent l = " " ++ l + {- Finds the type of parameters a command wants, from among the passed - parameter list. -} findWanted :: CmdWants -> [String] -> Git.Repo -> IO [String] @@ -55,10 +72,6 @@ findWanted FilesNotInGit params repo = do findWanted FilesInGit params repo = do files <- mapM (Git.inRepo repo) params return $ foldl (++) [] files -findWanted FilesInOrNotInGit params repo = do - a <- findWanted FilesInGit params repo - b <- findWanted FilesNotInGit params repo - return $ union a b findWanted SingleString params _ = do return $ [unwords params] findWanted RepoName params _ = do @@ -73,7 +86,7 @@ parseCmd argv state = do 0 -> error usage _ -> case (lookupCmd (params !! 0)) of [] -> error usage - [Command _ action want] -> do + [Command _ action want _] -> do f <- findWanted want (drop 1 params) (BackendTypes.repo state) return (flags, map action $ filter notstate f) @@ -84,9 +97,6 @@ parseCmd argv state = do (flags, params, []) -> return (flags, params) (_, _, errs) -> ioError (userError (concat errs ++ usage)) lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds - header = "Usage: git-annex [" ++ - (join "|" $ map cmdname cmds) ++ "] ..." - usage = usageInfo header options {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} @@ -197,32 +207,37 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do {- Fixes the symlink to an annexed file. -} fixCmd :: String -> Annex () -fixCmd file = notinBackend file err $ \(key, backend) -> do +fixCmd file = notinBackend file skip $ \(key, backend) -> do link <- calcGitLink file key - checkLegal file link - showStart "fix" file - liftIO $ createDirectoryIfMissing True (parentDir file) - liftIO $ removeFile file - liftIO $ createSymbolicLink link file - gitAdd file $ Just $ "git-annex fix " ++ file - showEndOk + l <- liftIO $ readSymbolicLink file + if (link == l) + then skip + else do + showStart "fix" file + liftIO $ createDirectoryIfMissing True (parentDir file) + liftIO $ removeFile file + liftIO $ createSymbolicLink link file + gitAdd file $ Just $ "git-annex fix " ++ file + showEndOk where - checkLegal file link = do - l <- liftIO $ readSymbolicLink file - if (link == l) - then error $ "symbolic link already ok for: " ++ file - else return () - err = error $ "not annexed " ++ file + -- quietly skip non-annexed files, so this can be used + -- as a commit hook + skip = return () {- Stores description for the repository. -} -describeCmd :: String -> Annex () -describeCmd description = do - g <- Annex.gitRepo - u <- getUUID g - describeUUID u description - log <- uuidLog - gitAdd log $ Just $ "description for UUID " ++ (show u) - liftIO $ putStrLn "description set" +initCmd :: String -> Annex () +initCmd description = do + if (0 == length description) + then error $ + "please specify a description of this repository\n" ++ + usage + else do + g <- Annex.gitRepo + u <- getUUID g + describeUUID u description + log <- uuidLog + gitAdd log $ Just $ "description for UUID " ++ (show u) + liftIO $ putStrLn "description set" -- helpers inBackend file yes no = do diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 66d9897d0..4647eb058 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -49,7 +49,7 @@ Enough broad picture, here's how it actually looks: if you're just done with a file; only use `unannex` if you accidentially added a file. (You can also run this on all your annexed files come the Singularity. ;-) -* `git annex describe "some description"` allows associating some description +* `git annex init "some description"` allows associating some description (such as "USB archive drive 1") with a repository. This can help with finding it later, see "Location Tracking" below. @@ -128,21 +128,23 @@ is on a home file server, and you are away from home. Then git-annex can tell you what git remote it needs access to in order to get a file: # git annex get myfile - git-annex: unable to get file with key: WORM:8b01f6d371178722367393eb26043482e1820306:myfile - To get that file, need access to one of these remotes: home + get myfile (need access to one of these remotes: home) + git-annex: get myfile failed Another way the location tracking comes in handy is if you put repositories on removable USB drives, that might be archived away offline in a safe place. In this sort of case, you probably don't have a git remotes configured for every USB drive. So git-annex may have to resort to talking -about repository UUIDs. If you have previously used "git annex describe" -in those repositories, it will include their description to help you with -finding them: - - git-annex: no available git remotes have file with key: WORM:8b01f6d371178722367393eb26043482e1820306:myfile - It has been seen before in these repositories: - c0a28e06-d7ef-11df-885c-775af44f8882 -- USB archive drive 1 - e1938fee-d95b-11df-96cc-002170d25c55 +about repository UUIDs. If you have previously used "git annex init" +to attach descriptions to those repositories, it will include their +descriptions to help you with finding them: + + # git annex get myfile + get myfile (No available git remotes have the file.) + It has been seen before in these repositories: + c0a28e06-d7ef-11df-885c-775af44f8882 -- USB archive drive 1 + e1938fee-d95b-11df-96cc-002170d25c55 + git-annex: get myfile failed ## configuration -- cgit v1.2.3 From 97b20e7ffeae1e6b678a77c72871af8b03d62cc6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 17:13:37 -0400 Subject: update --- INSTALL | 2 ++ 1 file changed, 2 insertions(+) diff --git a/INSTALL b/INSTALL index 9594448e7..a7fc7f6f3 100644 --- a/INSTALL +++ b/INSTALL @@ -3,3 +3,5 @@ To build and use git-annex, you will need: * ghc * These haskell libraries: MissingH SHA * uuid + +Then just run make; make install -- cgit v1.2.3 From e602238cd8cd309cea812ae85044f7d9f79be530 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 18:27:37 -0400 Subject: don't complain if a file is not annexed --- Commands.hs | 33 ++++++++++++++------------------- 1 file changed, 14 insertions(+), 19 deletions(-) diff --git a/Commands.hs b/Commands.hs index 6d68fc4e7..028c458ca 100644 --- a/Commands.hs +++ b/Commands.hs @@ -101,7 +101,7 @@ parseCmd argv state = do {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} addCmd :: FilePath -> Annex () -addCmd file = inBackend file err $ do +addCmd file = inBackend file $ do liftIO $ checkLegal file showStart "add" file g <- Annex.gitRepo @@ -112,7 +112,6 @@ addCmd file = inBackend file err $ do logStatus key ValuePresent setup g key where - err = error $ "already annexed " ++ file checkLegal file = do s <- getSymbolicLinkStatus file if ((isSymbolicLink s) || (not $ isRegularFile s)) @@ -129,7 +128,7 @@ addCmd file = inBackend file err $ do {- Undo addCmd. -} unannexCmd :: FilePath -> Annex () -unannexCmd file = notinBackend file err $ \(key, backend) -> do +unannexCmd file = notinBackend file $ \(key, backend) -> do showStart "unannex" file Annex.flagChange Force True -- force backend to always remove Backend.removeKey backend key @@ -138,7 +137,6 @@ unannexCmd file = notinBackend file err $ \(key, backend) -> do let src = annexLocation g key moveout g src where - err = error $ "not annexed " ++ file moveout g src = do nocommit <- Annex.flagIsSet NoCommit liftIO $ removeFile file @@ -156,7 +154,7 @@ unannexCmd file = notinBackend file err $ \(key, backend) -> do {- Gets an annexed file from one of the backends. -} getCmd :: FilePath -> Annex () -getCmd file = notinBackend file err $ \(key, backend) -> do +getCmd file = notinBackend file $ \(key, backend) -> do inannex <- inAnnex key if (inannex) then return () @@ -174,13 +172,11 @@ getCmd file = notinBackend file err $ \(key, backend) -> do showEndOk else do showEndFail "get" file - where - err = error $ "not annexed " ++ file {- Indicates a file's content is not wanted anymore, and should be removed - if it's safe to do so. -} dropCmd :: FilePath -> Annex () -dropCmd file = notinBackend file err $ \(key, backend) -> do +dropCmd file = notinBackend file $ \(key, backend) -> do inbackend <- Backend.hasKey key if (not inbackend) then return () -- no-op @@ -203,15 +199,14 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do liftIO $ removeFile loc return () else return () - err = error $ "not annexed " ++ file {- Fixes the symlink to an annexed file. -} fixCmd :: String -> Annex () -fixCmd file = notinBackend file skip $ \(key, backend) -> do +fixCmd file = notinBackend file $ \(key, backend) -> do link <- calcGitLink file key l <- liftIO $ readSymbolicLink file if (link == l) - then skip + then return () else do showStart "fix" file liftIO $ createDirectoryIfMissing True (parentDir file) @@ -219,10 +214,6 @@ fixCmd file = notinBackend file skip $ \(key, backend) -> do liftIO $ createSymbolicLink link file gitAdd file $ Just $ "git-annex fix " ++ file showEndOk - where - -- quietly skip non-annexed files, so this can be used - -- as a commit hook - skip = return () {- Stores description for the repository. -} initCmd :: String -> Annex () @@ -240,9 +231,13 @@ initCmd description = do liftIO $ putStrLn "description set" -- helpers -inBackend file yes no = do +inBackend file a = do + r <- Backend.lookupFile file + case (r) of + Just v -> return () + Nothing -> a +notinBackend file a = do r <- Backend.lookupFile file case (r) of - Just v -> yes v - Nothing -> no -notinBackend file yes no = inBackend file no yes + Just v -> a v + Nothing -> return () -- cgit v1.2.3 From bb6707020d08f7509c21c1229088bb6017438caf Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 18:52:01 -0400 Subject: update --- doc/git-annex.mdwn | 29 +++++++++++++---------------- 1 file changed, 13 insertions(+), 16 deletions(-) diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 4647eb058..d15ca4a9f 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -146,6 +146,19 @@ descriptions to help you with finding them: e1938fee-d95b-11df-96cc-002170d25c55 git-annex: get myfile failed +## symlink farming commit hook + +git-annex does use a lot of symlinks. Specicially, relative symlinks, +that are checked into git. To allow you to move those around without +annoyance, git-annex can run as a post-commit hook. This way, you can `git mv` +a symlink to an annexed file, and as soon as you commit, it will be fixed +up. + +`git annex init` tries to set up a post-commit hook that is itself a symlink +back to git-annex. If you want to have your own shell script in the post-commit +hook, just make it call `git annex` with no parameters. git-annex will detect +when it's run from a git hook and do the necessary fixups. + ## configuration * `annex.uuid` -- a unique UUID for this repository @@ -165,22 +178,6 @@ descriptions to help you with finding them: ## issues -### symlinks - -If the symlink to annexed content is relative, moving it to a subdir will -break it. But it it's absolute, moving the git repo (or mounting its drive -elsewhere) will break it. Either: - -* Use relative links and need `git annex mv` to move (or post-commit - hook that caches moves and updates links). -* Use absolute links and need `git annex fixlinks` when location changes; - note that would also mean that git would see the symlink targets changed - and want to commit the change. And, other clones of the repo would - diverge and there would be conflicts on the symlink text. Ugh. - -Hard links are not an option, because git would then happily commit the -file content. Amoung other reasons.. - ### free space determination Need a way to tell how much free space is available on the disk containing -- cgit v1.2.3 From 335c06171ac9a45a76b3b92d647615142bcc6ba0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 18:52:09 -0400 Subject: commit logs at end; faster --- Backend/File.hs | 4 ++-- Commands.hs | 6 +++--- Core.hs | 20 +++++++++----------- 3 files changed, 14 insertions(+), 16 deletions(-) diff --git a/Backend/File.hs b/Backend/File.hs index f7796532b..9b81bef9a 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -116,6 +116,8 @@ checkRemoveKey key = do then retNotEnoughCopiesKnown remotes numcopies else findcopies numcopies remotes [] where + config = "annex.numcopies" + findcopies 0 _ _ = return True -- success, enough copies found findcopies _ [] bad = notEnoughCopiesSeen bad findcopies n (r:rs) bad = do @@ -151,5 +153,3 @@ checkRemoveKey key = do showLongNote $ "According to the " ++ config ++ " setting, it is not safe to remove it!" showLongNote "(Use --force to override.)" - - config = "annex.numcopies" diff --git a/Commands.hs b/Commands.hs index 028c458ca..9a79e9d0c 100644 --- a/Commands.hs +++ b/Commands.hs @@ -123,7 +123,7 @@ addCmd file = inBackend file $ do liftIO $ renameFile file dest link <- calcGitLink file key liftIO $ createSymbolicLink link file - gitAdd file $ Just $ "git-annex annexed " ++ file + gitAdd file $ "git-annex annexed " ++ file showEndOk {- Undo addCmd. -} @@ -212,7 +212,7 @@ fixCmd file = notinBackend file $ \(key, backend) -> do liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ removeFile file liftIO $ createSymbolicLink link file - gitAdd file $ Just $ "git-annex fix " ++ file + gitAdd file $ "git-annex fix " ++ file showEndOk {- Stores description for the repository. -} @@ -227,7 +227,7 @@ initCmd description = do u <- getUUID g describeUUID u description log <- uuidLog - gitAdd log $ Just $ "description for UUID " ++ (show u) + gitAdd log $ "description for UUID " ++ (show u) liftIO $ putStrLn "description set" -- helpers diff --git a/Core.hs b/Core.hs index 302e304e4..5f63002c1 100644 --- a/Core.hs +++ b/Core.hs @@ -34,8 +34,10 @@ shutdown = do nocommit <- Annex.flagIsSet NoCommit needcommit <- Annex.flagIsSet NeedCommit if (needcommit && not nocommit) - then liftIO $ Git.run g ["commit", "-q", "-m", - "git-annex log update", gitStateDir g] + then do + liftIO $ Git.run g ["add", gitStateDir g] + liftIO $ Git.run g ["commit", "-q", "-m", + "git-annex log update", gitStateDir g] else return () -- clean up any files left in the temp directory @@ -75,14 +77,12 @@ inAnnex key = do g <- Annex.gitRepo liftIO $ doesFileExist $ annexLocation g key -{- Adds, optionally also commits a file to git. - - - - All changes to the git repository should go through this function. +{- Adds and commits a file to git. - - This is careful to not rely on the index. It may have staged changes, - so only use operations that avoid committing such changes. -} -gitAdd :: FilePath -> Maybe String -> Annex () +gitAdd :: FilePath -> String -> Annex () gitAdd file commitmessage = do nocommit <- Annex.flagIsSet NoCommit if (nocommit) @@ -90,10 +90,8 @@ gitAdd file commitmessage = do else do g <- Annex.gitRepo liftIO $ Git.run g ["add", file] - if (isJust commitmessage) - then liftIO $ Git.run g ["commit", "--quiet", - "-m", (fromJust commitmessage), file] - else Annex.flagChange NeedCommit True + liftIO $ Git.run g ["commit", "--quiet", + "-m", commitmessage, file] {- Calculates the relative path to use to link a file to a key. -} calcGitLink :: FilePath -> Key -> Annex FilePath @@ -112,7 +110,7 @@ logStatus key status = do g <- Annex.gitRepo u <- getUUID g f <- liftIO $ logChange g key u status - gitAdd f Nothing -- all logs are committed at end + Annex.flagChange NeedCommit True -- commit all logs at end {- Output logging -} showStart :: String -> String -> Annex () -- cgit v1.2.3 From 8f634a5e16a7fae58c5bb24628e19c319905606e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 20:35:33 -0400 Subject: cleanup --- Commands.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Commands.hs b/Commands.hs index 9a79e9d0c..de3089a56 100644 --- a/Commands.hs +++ b/Commands.hs @@ -187,7 +187,7 @@ dropCmd file = notinBackend file $ \(key, backend) -> do then do cleanup key showEndOk - else showEndFail "backend refused to drop" file + else showEndFail "drop" file where cleanup key = do logStatus key ValueMissing -- cgit v1.2.3 From 939a6f860e1a2eea58e46a05861076e1b174cbd2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Oct 2010 23:53:01 -0400 Subject: thoughts --- doc/git-annex.mdwn | 35 +++++++++++++++++++++++++++++++++-- 1 file changed, 33 insertions(+), 2 deletions(-) diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index d15ca4a9f..4c85a03b6 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -197,8 +197,39 @@ may not be dropped right away, depending on number of copies available. The use of `.git-annex` to store logs means that if a repo has branches and the user switched between them, git-annex will see different logs in the different branches, and so may miss info about what remotes have which -files (though it can re-learn). An alternative would be to -store the log data directly in the git repo as `pristine-tar` does. +files (though it can re-learn). + +An alternative would be to store the log data directly in the git repo +as `pristine-tar` does. Problem with that approach is that git won't merge +conflicting changes to log files if they are not in the currently checked +out branch. + +It would be possible to use a branch with a tree like this, to avoid +conflicts: + +key/uuid/time/status + +As long as new files are only added, and old timestamped files deleted, +there would be no conflicts. + +A related problem though is the size of the tree objects git needs to +commit. Having the logs in a separate branch doesn't help with that. +As more keys are added, the tree object size will increase, and git will +take longer and longer to commit, and use more space. One way to deal with +this is simply by splitting the logs amoung subdirectories. Git then can +reuse trees for most directories. (Check: Does it still have to build +dup trees in memory?) + +Another approach would be to have git-annex *delete* old logs. Keep logs +for the currently available files, or something like that. If other log +info is needed, look back through history to find the first occurance of a +log. Maybe even look at other branches -- so if the logs were on master, +a new empty branch could be made and git-annex would still know where to +get keys in that branch. + +Would have to be careful about conflicts when deleting and bringing back +files with the same name. And would need to avoid expensive searching thru +all history to try to find an old log file. ## contact -- cgit v1.2.3 From 4b1086cc7d1dd9cb4eba78210976a731a683948d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 18 Oct 2010 01:52:06 -0400 Subject: experimentally, removing all actual git committing Idea is the user will commit when ready, just stage everything. --- BackendTypes.hs | 3 +-- Commands.hs | 14 ++++---------- Core.hs | 29 ++--------------------------- LocationLog.hs | 6 ++---- 4 files changed, 9 insertions(+), 43 deletions(-) diff --git a/BackendTypes.hs b/BackendTypes.hs index e372099b2..548ef17a2 100644 --- a/BackendTypes.hs +++ b/BackendTypes.hs @@ -11,8 +11,7 @@ import Data.String.Utils import qualified GitRepo as Git -- command-line flags -data Flag = Force | NoCommit | NeedCommit - deriving (Eq, Read, Show) +data Flag = Force deriving (Eq, Read, Show) -- git-annex's runtime state type doesn't really belong here, -- but it uses Backend, so has to be here to avoid a depends loop. diff --git a/Commands.hs b/Commands.hs index de3089a56..718e991c9 100644 --- a/Commands.hs +++ b/Commands.hs @@ -49,7 +49,6 @@ cmds = [ options = [ Option ['f'] ["force"] (NoArg Force) "allow actions that may loose annexed data" - , Option ['N'] ["no-commit"] (NoArg NoCommit) "do not stage or commit changes" ] header = "Usage: git-annex [" ++ (join "|" $ map cmdname cmds) ++ "] ..." @@ -123,7 +122,7 @@ addCmd file = inBackend file $ do liftIO $ renameFile file dest link <- calcGitLink file key liftIO $ createSymbolicLink link file - gitAdd file $ "git-annex annexed " ++ file + liftIO $ Git.run g ["add", file] showEndOk {- Undo addCmd. -} @@ -138,14 +137,8 @@ unannexCmd file = notinBackend file $ \(key, backend) -> do moveout g src where moveout g src = do - nocommit <- Annex.flagIsSet NoCommit liftIO $ removeFile file liftIO $ Git.run g ["rm", "--quiet", file] - if (not nocommit) - then liftIO $ Git.run g ["commit", "--quiet", - "-m", ("git-annex unannexed " ++ file), - file] - else return () -- git rm deletes empty directories; -- put them back liftIO $ createDirectoryIfMissing True (parentDir file) @@ -212,7 +205,8 @@ fixCmd file = notinBackend file $ \(key, backend) -> do liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ removeFile file liftIO $ createSymbolicLink link file - gitAdd file $ "git-annex fix " ++ file + g <- Annex.gitRepo + liftIO $ Git.run g ["add", file] showEndOk {- Stores description for the repository. -} @@ -227,7 +221,7 @@ initCmd description = do u <- getUUID g describeUUID u description log <- uuidLog - gitAdd log $ "description for UUID " ++ (show u) + liftIO $ Git.run g ["add", log] liftIO $ putStrLn "description set" -- helpers diff --git a/Core.hs b/Core.hs index 5f63002c1..0af22ee73 100644 --- a/Core.hs +++ b/Core.hs @@ -30,15 +30,7 @@ shutdown :: Annex () shutdown = do g <- Annex.gitRepo - -- handle pending commits - nocommit <- Annex.flagIsSet NoCommit - needcommit <- Annex.flagIsSet NeedCommit - if (needcommit && not nocommit) - then do - liftIO $ Git.run g ["add", gitStateDir g] - liftIO $ Git.run g ["commit", "-q", "-m", - "git-annex log update", gitStateDir g] - else return () + liftIO $ Git.run g ["add", gitStateDir g] -- clean up any files left in the temp directory let tmp = annexTmpLocation g @@ -77,22 +69,6 @@ inAnnex key = do g <- Annex.gitRepo liftIO $ doesFileExist $ annexLocation g key -{- Adds and commits a file to git. - - - - This is careful to not rely on the index. It may have staged changes, - - so only use operations that avoid committing such changes. - -} -gitAdd :: FilePath -> String -> Annex () -gitAdd file commitmessage = do - nocommit <- Annex.flagIsSet NoCommit - if (nocommit) - then return () - else do - g <- Annex.gitRepo - liftIO $ Git.run g ["add", file] - liftIO $ Git.run g ["commit", "--quiet", - "-m", commitmessage, file] - {- Calculates the relative path to use to link a file to a key. -} calcGitLink :: FilePath -> Key -> Annex FilePath calcGitLink file key = do @@ -109,8 +85,7 @@ logStatus :: Key -> LogStatus -> Annex () logStatus key status = do g <- Annex.gitRepo u <- getUUID g - f <- liftIO $ logChange g key u status - Annex.flagChange NeedCommit True -- commit all logs at end + liftIO $ logChange g key u status {- Output logging -} showStart :: String -> String -> Annex () diff --git a/LocationLog.hs b/LocationLog.hs index 4a5fe449c..785b3330d 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -80,14 +80,12 @@ instance Read LogLine where undefined = ret $ LogLine (0) Undefined "" ret v = [(v, "")] -{- Log a change in the presence of a key's value in a repository, - - and return the log filename. -} -logChange :: Git.Repo -> Key -> UUID -> LogStatus -> IO FilePath +{- Log a change in the presence of a key's value in a repository. -} +logChange :: Git.Repo -> Key -> UUID -> LogStatus -> IO () logChange repo key uuid status = do log <- logNow status uuid ls <- readLog logfile writeLog logfile (compactLog $ log:ls) - return logfile where logfile = logFile repo key -- cgit v1.2.3 From 0382d26cdbdc52c1e985cba9667a4d50d0653216 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 18 Oct 2010 01:57:32 -0400 Subject: speling --- Commands.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Commands.hs b/Commands.hs index 718e991c9..bdeab5fc9 100644 --- a/Commands.hs +++ b/Commands.hs @@ -48,7 +48,7 @@ cmds = [ ] options = [ - Option ['f'] ["force"] (NoArg Force) "allow actions that may loose annexed data" + Option ['f'] ["force"] (NoArg Force) "allow actions that may lose annexed data" ] header = "Usage: git-annex [" ++ (join "|" $ map cmdname cmds) ++ "] ..." -- cgit v1.2.3 From f3dcc8489d7b7f9417f9752987a298976838ce47 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 18 Oct 2010 02:06:27 -0400 Subject: gratuitous rename --- Annex.hs | 30 ++++++++++++------------ Backend.hs | 14 ++++++------ Backend/File.hs | 2 +- Backend/SHA1.hs | 2 +- Backend/URL.hs | 2 +- Backend/WORM.hs | 2 +- BackendList.hs | 2 -- BackendTypes.hs | 70 -------------------------------------------------------- Commands.hs | 4 ++-- Locations.hs | 2 +- TypeInternals.hs | 70 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Types.hs | 2 +- 12 files changed, 100 insertions(+), 102 deletions(-) delete mode 100644 BackendTypes.hs create mode 100644 TypeInternals.hs diff --git a/Annex.hs b/Annex.hs index 5fd500d94..b68e51355 100644 --- a/Annex.hs +++ b/Annex.hs @@ -17,17 +17,17 @@ import Control.Monad.State import qualified GitRepo as Git import Types -import qualified BackendTypes as Backend +import qualified TypeInternals as Internals {- Create and returns an Annex state object for the specified git repo. -} new :: Git.Repo -> [Backend] -> IO AnnexState new gitrepo allbackends = do - let s = Backend.AnnexState { - Backend.repo = gitrepo, - Backend.backends = [], - Backend.supportedBackends = allbackends, - Backend.flags = [] + let s = Internals.AnnexState { + Internals.repo = gitrepo, + Internals.backends = [], + Internals.supportedBackends = allbackends, + Internals.flags = [] } (_,s') <- Annex.run s (prep gitrepo) return s' @@ -44,34 +44,34 @@ run state action = runStateT (action) state gitRepo :: Annex Git.Repo gitRepo = do state <- get - return (Backend.repo state) + return (Internals.repo state) gitRepoChange :: Git.Repo -> Annex () gitRepoChange r = do state <- get - put state { Backend.repo = r } + put state { Internals.repo = r } return () backends :: Annex [Backend] backends = do state <- get - return (Backend.backends state) + return (Internals.backends state) backendsChange :: [Backend] -> Annex () backendsChange b = do state <- get - put state { Backend.backends = b } + put state { Internals.backends = b } return () supportedBackends :: Annex [Backend] supportedBackends = do state <- get - return (Backend.supportedBackends state) + return (Internals.supportedBackends state) flagIsSet :: Flag -> Annex Bool flagIsSet flag = do state <- get - return $ elem flag $ Backend.flags state + return $ elem flag $ Internals.flags state flagChange :: Flag -> Bool -> Annex () flagChange flag set = do state <- get - let f = filter (/= flag) $ Backend.flags state + let f = filter (/= flag) $ Internals.flags state if (set) - then put state { Backend.flags = (flag:f) } - else put state { Backend.flags = f } + then put state { Internals.flags = (flag:f) } + else put state { Internals.flags = f } return () diff --git a/Backend.hs b/Backend.hs index dfaa55970..a427234d7 100644 --- a/Backend.hs +++ b/Backend.hs @@ -33,7 +33,7 @@ import qualified GitRepo as Git import qualified Annex import Utility import Types -import qualified BackendTypes as B +import qualified TypeInternals as Internals {- List of backends in the order to try them when storing a new key. -} backendList :: Annex [Backend] @@ -59,7 +59,7 @@ lookupBackendName all s = if ((length matches) /= 1) then error $ "unknown backend " ++ s else matches !! 0 - where matches = filter (\b -> s == B.name b) all + where matches = filter (\b -> s == Internals.name b) all {- Attempts to store a file in one of the backends. -} storeFileKey :: FilePath -> Annex (Maybe (Key, Backend)) @@ -70,11 +70,11 @@ storeFileKey file = do storeFileKey' b file relfile storeFileKey' [] _ _ = return Nothing storeFileKey' (b:bs) file relfile = do - try <- (B.getKey b) relfile + try <- (Internals.getKey b) relfile case (try) of Nothing -> nextbackend Just key -> do - stored <- (B.storeFileKey b) file key + stored <- (Internals.storeFileKey b) file key if (not stored) then nextbackend else do @@ -85,17 +85,17 @@ storeFileKey' (b:bs) file relfile = do {- Attempts to retrieve an key from one of the backends, saving it to - a specified location. -} retrieveKeyFile :: Backend -> Key -> FilePath -> Annex Bool -retrieveKeyFile backend key dest = (B.retrieveKeyFile backend) key dest +retrieveKeyFile backend key dest = (Internals.retrieveKeyFile backend) key dest {- Removes a key from a backend. -} removeKey :: Backend -> Key -> Annex Bool -removeKey backend key = (B.removeKey backend) key +removeKey backend key = (Internals.removeKey backend) key {- Checks if a backend has its key. -} hasKey :: Key -> Annex Bool hasKey key = do all <- Annex.supportedBackends - (B.hasKey (lookupBackendName all $ backendName key)) key + (Internals.hasKey (lookupBackendName all $ backendName key)) key {- Looks up the key and backend corresponding to an annexed file, - by examining what the file symlinks to. -} diff --git a/Backend/File.hs b/Backend/File.hs index 9b81bef9a..c97a354d0 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -16,7 +16,7 @@ import System.Cmd import System.Exit import Control.Exception -import BackendTypes +import TypeInternals import LocationLog import Locations import qualified Remotes diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs index c01e01a72..2143a6af5 100644 --- a/Backend/SHA1.hs +++ b/Backend/SHA1.hs @@ -6,7 +6,7 @@ module Backend.SHA1 (backend) where import Data.Digest.Pure.SHA import qualified Backend.File -import BackendTypes +import TypeInternals backend = Backend.File.backend { name = "SHA1", diff --git a/Backend/URL.hs b/Backend/URL.hs index 753520766..5c1fd74c9 100644 --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -8,7 +8,7 @@ import Data.String.Utils import System.Cmd import System.Exit -import BackendTypes +import TypeInternals import Core backend = Backend { diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 463b0ac8e..0588ddaf8 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -9,7 +9,7 @@ import System.Posix.Files import qualified Data.ByteString.Lazy.Char8 as B import qualified Backend.File -import BackendTypes +import TypeInternals import Utility backend = Backend.File.backend { diff --git a/BackendList.hs b/BackendList.hs index 920f8fc0a..25f3ae5ea 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -3,8 +3,6 @@ module BackendList (allBackends) where -import BackendTypes - -- When adding a new backend, import it here and add it to the list. import qualified Backend.WORM import qualified Backend.SHA1 diff --git a/BackendTypes.hs b/BackendTypes.hs deleted file mode 100644 index 548ef17a2..000000000 --- a/BackendTypes.hs +++ /dev/null @@ -1,70 +0,0 @@ -{- git-annex backend data types - - - - Mostly only backend implementations should need to import this. - -} - -module BackendTypes where - -import Control.Monad.State (StateT) -import Data.String.Utils - -import qualified GitRepo as Git - --- command-line flags -data Flag = Force deriving (Eq, Read, Show) - --- git-annex's runtime state type doesn't really belong here, --- but it uses Backend, so has to be here to avoid a depends loop. -data AnnexState = AnnexState { - repo :: Git.Repo, - backends :: [Backend], - supportedBackends :: [Backend], - flags :: [Flag] -} deriving (Show) - --- git-annex's monad -type Annex = StateT AnnexState IO - --- annexed filenames are mapped through a backend into keys -type KeyFrag = String -type BackendName = String -data Key = Key (BackendName, KeyFrag) deriving (Eq) - --- show a key to convert it to a string; the string includes the --- name of the backend to avoid collisions between key strings -instance Show Key where - show (Key (b, k)) = b ++ ":" ++ k - -instance Read Key where - readsPrec _ s = [((Key (b,k)) ,"")] - where - l = split ":" s - b = l !! 0 - k = join ":" $ drop 1 l - --- pulls the backend name out -backendName :: Key -> BackendName -backendName (Key (b,k)) = b - --- pulls the key fragment out -keyFrag :: Key -> KeyFrag -keyFrag (Key (b,k)) = k - --- this structure represents a key-value backend -data Backend = Backend { - -- name of this backend - name :: String, - -- converts a filename to a key - getKey :: FilePath -> Annex (Maybe Key), - -- stores a file's contents to a key - storeFileKey :: FilePath -> Key -> Annex Bool, - -- retrieves a key's contents to a file - retrieveKeyFile :: Key -> FilePath -> Annex Bool, - -- removes a key - removeKey :: Key -> Annex Bool, - -- checks if a backend is storing the content of a key - hasKey :: Key -> Annex Bool -} - -instance Show Backend where - show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" diff --git a/Commands.hs b/Commands.hs index bdeab5fc9..fab72160a 100644 --- a/Commands.hs +++ b/Commands.hs @@ -21,7 +21,7 @@ import LocationLog import Types import Core import qualified Remotes -import qualified BackendTypes +import qualified TypeInternals data CmdWants = FilesInGit | FilesNotInGit | RepoName | SingleString data Command = Command { @@ -87,7 +87,7 @@ parseCmd argv state = do [] -> error usage [Command _ action want _] -> do f <- findWanted want (drop 1 params) - (BackendTypes.repo state) + (TypeInternals.repo state) return (flags, map action $ filter notstate f) where -- never include files from the state directory diff --git a/Locations.hs b/Locations.hs index 2b0adb7ba..18d416eb4 100644 --- a/Locations.hs +++ b/Locations.hs @@ -14,7 +14,7 @@ module Locations ( import Data.String.Utils import Types -import qualified BackendTypes as Backend +import qualified TypeInternals as Internals import qualified GitRepo as Git {- Long-term, cross-repo state is stored in files inside the .git-annex diff --git a/TypeInternals.hs b/TypeInternals.hs new file mode 100644 index 000000000..e8f7cb9e7 --- /dev/null +++ b/TypeInternals.hs @@ -0,0 +1,70 @@ +{- git-annex internal data types + - + - Most things should not need this, using Types and/or Annex instead. + -} + +module TypeInternals where + +import Control.Monad.State (StateT) +import Data.String.Utils + +import qualified GitRepo as Git + +-- command-line flags +data Flag = Force deriving (Eq, Read, Show) + +-- git-annex's runtime state type doesn't really belong here, +-- but it uses Backend, so has to be here to avoid a depends loop. +data AnnexState = AnnexState { + repo :: Git.Repo, + backends :: [Backend], + supportedBackends :: [Backend], + flags :: [Flag] +} deriving (Show) + +-- git-annex's monad +type Annex = StateT AnnexState IO + +-- annexed filenames are mapped through a backend into keys +type KeyFrag = String +type BackendName = String +data Key = Key (BackendName, KeyFrag) deriving (Eq) + +-- show a key to convert it to a string; the string includes the +-- name of the backend to avoid collisions between key strings +instance Show Key where + show (Key (b, k)) = b ++ ":" ++ k + +instance Read Key where + readsPrec _ s = [((Key (b,k)) ,"")] + where + l = split ":" s + b = l !! 0 + k = join ":" $ drop 1 l + +-- pulls the backend name out +backendName :: Key -> BackendName +backendName (Key (b,k)) = b + +-- pulls the key fragment out +keyFrag :: Key -> KeyFrag +keyFrag (Key (b,k)) = k + +-- this structure represents a key-value backend +data Backend = Backend { + -- name of this backend + name :: String, + -- converts a filename to a key + getKey :: FilePath -> Annex (Maybe Key), + -- stores a file's contents to a key + storeFileKey :: FilePath -> Key -> Annex Bool, + -- retrieves a key's contents to a file + retrieveKeyFile :: Key -> FilePath -> Annex Bool, + -- removes a key + removeKey :: Key -> Annex Bool, + -- checks if a backend is storing the content of a key + hasKey :: Key -> Annex Bool +} + +instance Show Backend where + show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" diff --git a/Types.hs b/Types.hs index 6bf26d36e..2284d9267 100644 --- a/Types.hs +++ b/Types.hs @@ -10,4 +10,4 @@ module Types ( Flag(..), ) where -import BackendTypes +import TypeInternals -- cgit v1.2.3 From 33432a32775d23dff5e5b6f499656b247e4ed604 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 18 Oct 2010 21:08:27 -0400 Subject: bug --- TODO | 3 +++ 1 file changed, 3 insertions(+) diff --git a/TODO b/TODO index 410c694c2..6fa34046d 100644 --- a/TODO +++ b/TODO @@ -1,6 +1,9 @@ * bug: cannot "git annex ../foo" (GitRepo.relative is buggy and git-ls-files also refuses w/o --full-name, which would need other changes) +* bug: ctrl+c does not stop it from running another action; need to + not catch UserInterrupt exceptions. + * --push/--pull should take a reponame and files, and push those files to that repo; dropping them from the current repo -- cgit v1.2.3 From 15986f01d1fd565da151dcb08697e21a94fc9037 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 18 Oct 2010 21:36:26 -0400 Subject: bug --- TODO | 3 +++ 1 file changed, 3 insertions(+) diff --git a/TODO b/TODO index 6fa34046d..eca1922b7 100644 --- a/TODO +++ b/TODO @@ -1,6 +1,9 @@ * bug: cannot "git annex ../foo" (GitRepo.relative is buggy and git-ls-files also refuses w/o --full-name, which would need other changes) +* bug: doesn't learn new remote's uuids if a known (but maybe not accessible) + uuids has a wanted file + * bug: ctrl+c does not stop it from running another action; need to not catch UserInterrupt exceptions. -- cgit v1.2.3 From c7664588f81fe27b3e88d49523ef3c483ac6481a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 01:19:56 -0400 Subject: use safesystem --- Backend/File.hs | 7 ++----- Backend/URL.hs | 11 +++++++---- GitRepo.hs | 2 +- TODO | 3 --- 4 files changed, 10 insertions(+), 13 deletions(-) diff --git a/Backend/File.hs b/Backend/File.hs index c97a354d0..8969d7556 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -13,6 +13,7 @@ module Backend.File (backend) where import Control.Monad.State import System.IO import System.Cmd +import System.Cmd.Utils import System.Exit import Control.Exception @@ -92,11 +93,7 @@ copyFromRemote r key file = do then getlocal else getremote where - getlocal = do - res <-rawSystem "cp" ["-a", location, file] - if (res == ExitSuccess) - then return () - else error "cp failed" + getlocal = safeSystem "cp" ["-a", location, file] getremote = error "get via network not yet implemented!" location = annexLocation r key diff --git a/Backend/URL.hs b/Backend/URL.hs index 5c1fd74c9..c9b6ab6df 100644 --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -3,9 +3,11 @@ module Backend.URL (backend) where +import Control.Exception import Control.Monad.State (liftIO) import Data.String.Utils import System.Cmd +import System.Cmd.Utils import System.Exit import TypeInternals @@ -36,9 +38,10 @@ downloadUrl :: Key -> FilePath -> Annex Bool downloadUrl key file = do showNote "downloading" liftIO $ putStrLn "" -- make way for curl progress bar - result <- liftIO $ rawSystem "curl" ["-#", "-o", file, url] - if (result == ExitSuccess) - then return True - else return False + result <- liftIO $ (try curl::IO (Either SomeException ())) + case result of + Left err -> return False + Right succ -> return True where + curl = safeSystem "curl" ["-#", "-o", file, url] url = join ":" $ drop 1 $ split ":" $ show key diff --git a/GitRepo.hs b/GitRepo.hs index 32383197b..5b0e68cd6 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -167,7 +167,7 @@ gitCommandLine repo params = assertlocal repo $ {- Runs git in the specified repo. -} run :: Repo -> [String] -> IO () run repo params = assertlocal repo $ do - r <- rawSystem "git" (gitCommandLine repo params) + r <- safeSystem "git" (gitCommandLine repo params) return () {- Runs a git subcommand and returns its output. -} diff --git a/TODO b/TODO index eca1922b7..e6fdcd0b2 100644 --- a/TODO +++ b/TODO @@ -4,9 +4,6 @@ * bug: doesn't learn new remote's uuids if a known (but maybe not accessible) uuids has a wanted file -* bug: ctrl+c does not stop it from running another action; need to - not catch UserInterrupt exceptions. - * --push/--pull should take a reponame and files, and push those files to that repo; dropping them from the current repo -- cgit v1.2.3 From 7afac113443b8e93e19ad87d769a24c52706f551 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 01:45:45 -0400 Subject: add boolSystem --- Utility.hs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/Utility.hs b/Utility.hs index e4278ff3f..09b973002 100644 --- a/Utility.hs +++ b/Utility.hs @@ -6,10 +6,15 @@ module Utility ( hGetContentsStrict, parentDir, relPathCwdToDir, - relPathDirToDir + relPathDirToDir, + boolSystem ) where import System.IO +import System.Cmd +import System.Exit +import System.Posix.Signals +import Data.Typeable import System.Posix.IO import Data.String.Utils import System.Path @@ -88,3 +93,18 @@ relPathDirToDir from to = dotdots = take ((length pfrom) - numcommon) $ repeat ".." numcommon = length $ common path = join s $ dotdots ++ uncommon + +{- Run a system command, and returns True or False + - if it succeeded or failed. + - + - An error is thrown if the command exits due to SIGINT, + - to propigate ctrl-c. + -} +boolSystem :: FilePath -> [String] -> IO Bool +boolSystem command params = do + r <- rawSystem command params + case r of + ExitSuccess -> return True + ExitFailure e -> if Just e == cast sigINT + then error $ command ++ "interrupted" + else return False -- cgit v1.2.3 From 470e0a2fbd1f554df677127212643d534c2f7857 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 01:46:07 -0400 Subject: use boolSystem --- Backend/File.hs | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/Backend/File.hs b/Backend/File.hs index 8969d7556..6b2e82726 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -14,7 +14,6 @@ import Control.Monad.State import System.IO import System.Cmd import System.Cmd.Utils -import System.Exit import Control.Exception import TypeInternals @@ -70,12 +69,7 @@ copyKeyFile key file = do Nothing -> trycopy full rs Just r' -> do showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..." - result <- liftIO $ (try (copyFromRemote r' key file)::IO (Either SomeException ())) - case (result) of - Left err -> do - liftIO $ hPutStrLn stderr (show err) - trycopy full rs - Right succ -> return True + liftIO $ copyFromRemote r' key file cantfind = do g <- Annex.gitRepo uuids <- liftIO $ keyLocations g key @@ -86,15 +80,15 @@ copyKeyFile key file = do else return () return False -{- Tries to copy a file from a remote, exception on error. -} -copyFromRemote :: Git.Repo -> Key -> FilePath -> IO () +{- Tries to copy a file from a remote. -} +copyFromRemote :: Git.Repo -> Key -> FilePath -> IO Bool copyFromRemote r key file = do if (Git.repoIsLocal r) then getlocal else getremote where - getlocal = safeSystem "cp" ["-a", location, file] - getremote = error "get via network not yet implemented!" + getlocal = boolSystem "cp" ["-a", location, file] + getremote = return False -- TODO implement get from remote location = annexLocation r key {- Checks remotes to verify that enough copies of a key exist to allow -- cgit v1.2.3 From 2caf711827470976f935bb06bb3b6b87e1776299 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 01:46:20 -0400 Subject: stop trapping all exceptions Need to allow exceptions to be thrown for SIGPIPE propigation. Converted places that used error unncessarily to not. --- Commands.hs | 26 ++++++++++++-------------- git-annex.hs | 10 +++++----- 2 files changed, 17 insertions(+), 19 deletions(-) diff --git a/Commands.hs b/Commands.hs index fab72160a..115c3b3ed 100644 --- a/Commands.hs +++ b/Commands.hs @@ -101,21 +101,19 @@ parseCmd argv state = do - the annex directory and setting up the symlink pointing to its content. -} addCmd :: FilePath -> Annex () addCmd file = inBackend file $ do - liftIO $ checkLegal file - showStart "add" file - g <- Annex.gitRepo - stored <- Backend.storeFileKey file - case (stored) of - Nothing -> showEndFail "no backend could store" file - Just (key, backend) -> do - logStatus key ValuePresent - setup g key + s <- liftIO $ getSymbolicLinkStatus file + if ((isSymbolicLink s) || (not $ isRegularFile s)) + then return () + else do + showStart "add" file + g <- Annex.gitRepo + stored <- Backend.storeFileKey file + case (stored) of + Nothing -> showEndFail "no backend could store" file + Just (key, backend) -> do + logStatus key ValuePresent + setup g key where - checkLegal file = do - s <- getSymbolicLinkStatus file - if ((isSymbolicLink s) || (not $ isRegularFile s)) - then error $ "not a regular file: " ++ file - else return () setup g key = do let dest = annexLocation g key liftIO $ createDirectoryIfMissing True (parentDir dest) diff --git a/git-annex.hs b/git-annex.hs index 947868f23..71a21379d 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -1,6 +1,6 @@ {- git-annex main program -} -import Control.Exception +import IO (try) import System.IO import System.Environment @@ -18,8 +18,9 @@ main = do (flags, actions) <- parseCmd args state tryRun state $ [startup flags] ++ actions ++ [shutdown] -{- Runs a list of Annex actions. Catches exceptions, not stopping - - if some error out, and propigates an overall error status at the end. +{- Runs a list of Annex actions. Catches IO errors and continues + - (but explicitly thrown errors terminate the whole command). + - Propigates an overall error status at the end. - - This runs in the IO monad, not in the Annex monad. It seems that - exceptions can only be caught in the IO monad, not in a stacked monad; @@ -29,8 +30,7 @@ main = do tryRun :: AnnexState -> [Annex ()] -> IO () tryRun state actions = tryRun' state 0 actions tryRun' state errnum (a:as) = do - result <- try - (Annex.run state a)::IO (Either SomeException ((), AnnexState)) + result <- try $ Annex.run state a case (result) of Left err -> do showErr err -- cgit v1.2.3 From 2ea589e117bcc36ee613454ffb52b8e52cc96bc9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 12:53:51 -0400 Subject: don't throw a fatal error --- Core.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Core.hs b/Core.hs index 0af22ee73..5bf108393 100644 --- a/Core.hs +++ b/Core.hs @@ -107,4 +107,4 @@ showEndOk = do showEndFail :: String -> String -> Annex () showEndFail command file = do liftIO $ putStrLn "" - error $ command ++ " " ++ file ++ " failed" + liftIO $ hPutStrLn stderr $ command ++ " " ++ file ++ " failed" -- cgit v1.2.3 From d23fc22f0e17c95765f940f81f733f9580e19107 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 12:55:40 -0400 Subject: less verbose failures seem better here --- Commands.hs | 6 +++--- Core.hs | 7 +++---- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/Commands.hs b/Commands.hs index 115c3b3ed..e38f9c372 100644 --- a/Commands.hs +++ b/Commands.hs @@ -109,7 +109,7 @@ addCmd file = inBackend file $ do g <- Annex.gitRepo stored <- Backend.storeFileKey file case (stored) of - Nothing -> showEndFail "no backend could store" file + Nothing -> showEndFail Just (key, backend) -> do logStatus key ValuePresent setup g key @@ -162,7 +162,7 @@ getCmd file = notinBackend file $ \(key, backend) -> do logStatus key ValuePresent showEndOk else do - showEndFail "get" file + showEndFail {- Indicates a file's content is not wanted anymore, and should be removed - if it's safe to do so. -} @@ -178,7 +178,7 @@ dropCmd file = notinBackend file $ \(key, backend) -> do then do cleanup key showEndOk - else showEndFail "drop" file + else showEndFail where cleanup key = do logStatus key ValueMissing diff --git a/Core.hs b/Core.hs index 5bf108393..3532c71d5 100644 --- a/Core.hs +++ b/Core.hs @@ -104,7 +104,6 @@ showLongNote s = do showEndOk :: Annex () showEndOk = do liftIO $ putStrLn " ok" -showEndFail :: String -> String -> Annex () -showEndFail command file = do - liftIO $ putStrLn "" - liftIO $ hPutStrLn stderr $ command ++ " " ++ file ++ " failed" +showEndFail :: Annex () +showEndFail = do + liftIO $ putStrLn " failed" -- cgit v1.2.3 From 3531ce5c54e380d15d54d838c90f4ebe311782af Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 13:08:05 -0400 Subject: fix remote uuid learning bug --- Remotes.hs | 11 ++++++++--- TODO | 3 --- TypeInternals.hs | 6 ++++-- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/Remotes.hs b/Remotes.hs index f21f5a6ba..828dc753f 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -30,17 +30,22 @@ withKey key = do g <- Annex.gitRepo uuids <- liftIO $ keyLocations g key allremotes <- remotesByCost - -- this only uses cached data, so may not find new remotes + -- This only uses cached data, so may not include new remotes + -- or remotes whose uuid has changed (eg by a different drive being + -- mounted at their location). So unless it happens to find all + -- remotes, try harder, loading the remotes' configs. remotes <- reposByUUID allremotes uuids - if (0 == length remotes) + remotesread <- Annex.flagIsSet RemotesRead + if ((length allremotes /= length remotes) && not remotesread) then tryharder allremotes uuids else return remotes where tryharder allremotes uuids = do - -- more expensive; check each remote's config + -- more expensive; read each remote's config mayberemotes <- mapM tryGitConfigRead allremotes let allremotes' = catMaybes mayberemotes remotes' <- reposByUUID allremotes' uuids + Annex.flagChange RemotesRead True return remotes' {- Cost Ordered list of remotes. -} diff --git a/TODO b/TODO index e6fdcd0b2..410c694c2 100644 --- a/TODO +++ b/TODO @@ -1,9 +1,6 @@ * bug: cannot "git annex ../foo" (GitRepo.relative is buggy and git-ls-files also refuses w/o --full-name, which would need other changes) -* bug: doesn't learn new remote's uuids if a known (but maybe not accessible) - uuids has a wanted file - * --push/--pull should take a reponame and files, and push those files to that repo; dropping them from the current repo diff --git a/TypeInternals.hs b/TypeInternals.hs index e8f7cb9e7..4a9d2653e 100644 --- a/TypeInternals.hs +++ b/TypeInternals.hs @@ -10,8 +10,10 @@ import Data.String.Utils import qualified GitRepo as Git --- command-line flags -data Flag = Force deriving (Eq, Read, Show) +data Flag = + Force | -- command-line flags + RemotesRead -- indicates that remote repo configs have been read + deriving (Eq, Read, Show) -- git-annex's runtime state type doesn't really belong here, -- but it uses Backend, so has to be here to avoid a depends loop. -- cgit v1.2.3 From ed3f6653b664d72e4b89c4dd0c56f4b7db7cbab9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 13:39:53 -0400 Subject: better drop error messages --- Backend/File.hs | 49 +++++++++++++++++++++++++++++-------------------- UUID.hs | 2 +- 2 files changed, 30 insertions(+), 21 deletions(-) diff --git a/Backend/File.hs b/Backend/File.hs index 6b2e82726..6944a8b62 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -15,6 +15,8 @@ import System.IO import System.Cmd import System.Cmd.Utils import Control.Exception +import List +import Maybe import TypeInternals import LocationLog @@ -52,7 +54,10 @@ copyKeyFile :: Key -> FilePath -> Annex (Bool) copyKeyFile key file = do remotes <- Remotes.withKey key if (0 == length remotes) - then cantfind + then do + showNote $ "No available git remotes have the file." + showLocations key + return False else trycopy remotes remotes where trycopy full [] = do @@ -70,15 +75,6 @@ copyKeyFile key file = do Just r' -> do showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..." liftIO $ copyFromRemote r' key file - cantfind = do - g <- Annex.gitRepo - uuids <- liftIO $ keyLocations g key - ppuuids <- prettyPrintUUIDs uuids - showNote $ "No available git remotes have the file." - if (0 < length uuids) - then showLongNote $ "It has been seen before in these repositories:\n" ++ ppuuids - else return () - return False {- Tries to copy a file from a remote. -} copyFromRemote :: Git.Repo -> Key -> FilePath -> IO Bool @@ -90,6 +86,17 @@ copyFromRemote r key file = do getlocal = boolSystem "cp" ["-a", location, file] getremote = return False -- TODO implement get from remote location = annexLocation r key + +showLocations :: Key -> Annex () +showLocations key = do + g <- Annex.gitRepo + u <- getUUID g + uuids <- liftIO $ keyLocations g key + let uuidsf = filter (\v -> v /= u) uuids + ppuuids <- prettyPrintUUIDs uuidsf + if (0 < length uuidsf) + then showLongNote $ "Try making some of these repositories available:\n" ++ ppuuids + else showLongNote $ "No other repository is known to contain the file." {- Checks remotes to verify that enough copies of a key exist to allow - for a key to be safely removed (with no data loss), and fails with an @@ -125,22 +132,24 @@ checkRemoveKey key = do (result, _) <- Annex.run a (Backend.hasKey key) return result notEnoughCopiesSeen bad = do - showNote "failed to find enough other copies of the file" - if (0 /= length bad) then listbad bad else return () unsafe + if (0 /= length bad) then listbad bad else return () + showLocations key + hint return False listbad bad = showLongNote $ "I was unable to access these remotes: " ++ (Remotes.list bad) retNotEnoughCopiesKnown remotes numcopies = do - showNote $ - "I only know about " ++ (show $ length remotes) ++ - " out of " ++ (show numcopies) ++ - " necessary copies of the file" unsafe + showLongNote $ + "Could only verify the existence of " ++ + (show $ length remotes) ++ + " out of " ++ (show numcopies) ++ + " necessary copies" + showLocations key + hint return False - unsafe = do - showLongNote $ "According to the " ++ config ++ - " setting, it is not safe to remove it!" - showLongNote "(Use --force to override.)" + unsafe = showNote "unsafe" + hint = showLongNote $ "(Use --force to override this check, or adjust annex.numcopies.)" diff --git a/UUID.hs b/UUID.hs index b665c27e9..47d305c4f 100644 --- a/UUID.hs +++ b/UUID.hs @@ -51,7 +51,7 @@ getUUID r = do let c = cached r g let u = uncached r - + if (c /= u && u /= "") then do updatecache g r u -- cgit v1.2.3 From 4f8d28819da8e13bfa741dae8d84b0000e38e083 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 14:13:48 -0400 Subject: improved messages when a file is not available in remotes --- Backend/File.hs | 55 +++++++++++++++++++++++++------------------------------ Remotes.hs | 13 +++++++------ 2 files changed, 32 insertions(+), 36 deletions(-) diff --git a/Backend/File.hs b/Backend/File.hs index 6944a8b62..4ea25daa7 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -55,15 +55,15 @@ copyKeyFile key file = do remotes <- Remotes.withKey key if (0 == length remotes) then do - showNote $ "No available git remotes have the file." + showNote "not available" showLocations key return False else trycopy remotes remotes where trycopy full [] = do - showNote $ - "need access to one of these remotes: " ++ - (Remotes.list full) + showNote "not available" + showTriedRemotes full + showLocations key return False trycopy full (r:rs) = do -- annexLocation needs the git config to have been @@ -71,8 +71,8 @@ copyKeyFile key file = do -- if it hasn't been already result <- Remotes.tryGitConfigRead r case (result) of - Nothing -> trycopy full rs - Just r' -> do + Left err -> trycopy full rs + Right r' -> do showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..." liftIO $ copyFromRemote r' key file @@ -86,7 +86,7 @@ copyFromRemote r key file = do getlocal = boolSystem "cp" ["-a", location, file] getremote = return False -- TODO implement get from remote location = annexLocation r key - + showLocations :: Key -> Annex () showLocations key = do g <- Annex.gitRepo @@ -97,6 +97,10 @@ showLocations key = do if (0 < length uuidsf) then showLongNote $ "Try making some of these repositories available:\n" ++ ppuuids else showLongNote $ "No other repository is known to contain the file." + +showTriedRemotes remotes = + showLongNote $ "I was unable to access these remotes: " ++ + (Remotes.list remotes) {- Checks remotes to verify that enough copies of a key exist to allow - for a key to be safely removed (with no data loss), and fails with an @@ -108,46 +112,37 @@ checkRemoveKey key = do then return True else do g <- Annex.gitRepo - let numcopies = read $ Git.configGet g config "1" remotes <- Remotes.withKey key + let numcopies = read $ Git.configGet g config "1" if (numcopies > length remotes) - then retNotEnoughCopiesKnown remotes numcopies - else findcopies numcopies remotes [] + then notEnoughCopies numcopies (length remotes) [] + else findcopies numcopies 0 remotes [] where config = "annex.numcopies" - - findcopies 0 _ _ = return True -- success, enough copies found - findcopies _ [] bad = notEnoughCopiesSeen bad - findcopies n (r:rs) bad = do + findcopies need have [] bad = + if (have >= need) + then return True + else notEnoughCopies need have bad + findcopies need have (r:rs) bad = do all <- Annex.supportedBackends result <- liftIO $ ((try $ remoteHasKey r all)::IO (Either SomeException Bool)) case (result) of - Right True -> findcopies (n-1) rs bad - Right False -> findcopies n rs bad - Left _ -> findcopies n rs (r:bad) + Right True -> findcopies need (have+1) rs bad + Right False -> findcopies need have rs bad + Left _ -> findcopies need have rs (r:bad) remoteHasKey r all = do -- To check if a remote has a key, construct a new -- Annex monad and query its backend. a <- Annex.new r all (result, _) <- Annex.run a (Backend.hasKey key) return result - notEnoughCopiesSeen bad = do - unsafe - if (0 /= length bad) then listbad bad else return () - showLocations key - hint - return False - listbad bad = - showLongNote $ - "I was unable to access these remotes: " ++ - (Remotes.list bad) - retNotEnoughCopiesKnown remotes numcopies = do + notEnoughCopies need have bad = do unsafe showLongNote $ "Could only verify the existence of " ++ - (show $ length remotes) ++ - " out of " ++ (show numcopies) ++ + (show have) ++ " out of " ++ (show need) ++ " necessary copies" + if (0 /= length bad) then showTriedRemotes bad else return () showLocations key hint return False diff --git a/Remotes.hs b/Remotes.hs index 828dc753f..a0894f418 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -10,6 +10,7 @@ import Control.Exception import Control.Monad.State (liftIO) import qualified Data.Map as Map import Data.String.Utils +import Data.Either.Utils import List import Maybe @@ -42,8 +43,8 @@ withKey key = do where tryharder allremotes uuids = do -- more expensive; read each remote's config - mayberemotes <- mapM tryGitConfigRead allremotes - let allremotes' = catMaybes mayberemotes + eitherremotes <- mapM tryGitConfigRead allremotes + let allremotes' = map fromEither eitherremotes remotes' <- reposByUUID allremotes' uuids Annex.flagChange RemotesRead True return remotes' @@ -86,7 +87,7 @@ repoCost r = do - because reading it may be expensive. This function tries to read the - config for a specified remote, and updates state. If successful, it - returns the updated git repo. -} -tryGitConfigRead :: Git.Repo -> Annex (Maybe Git.Repo) +tryGitConfigRead :: Git.Repo -> Annex (Either Git.Repo Git.Repo) tryGitConfigRead r = do if (Map.null $ Git.configMap r) then do @@ -94,15 +95,15 @@ tryGitConfigRead r = do -- for other reasons; catch all possible exceptions result <- liftIO $ (try (Git.configRead r)::IO (Either SomeException (Git.Repo))) case (result) of - Left err -> return Nothing + Left err -> return $ Left r Right r' -> do g <- Annex.gitRepo let l = Git.remotes g let g' = Git.remotesAdd g $ exchange l r' Annex.gitRepoChange g' - return $ Just r' - else return $ Just r + return $ Right r' + else return $ Right r -- config already read where exchange [] new = [] exchange (old:ls) new = -- cgit v1.2.3 From 731cabbe3d083bcca6535fc9751b63cc16a83b83 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 14:15:53 -0400 Subject: newlines before failed message needed if a long message was shown --- Core.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Core.hs b/Core.hs index 3532c71d5..8dc4bff6f 100644 --- a/Core.hs +++ b/Core.hs @@ -106,4 +106,4 @@ showEndOk = do liftIO $ putStrLn " ok" showEndFail :: Annex () showEndFail = do - liftIO $ putStrLn " failed" + liftIO $ putStrLn "\nfailed" -- cgit v1.2.3 From f3c5a8543b2793f507b4a4801315d1f333e758cc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 14:17:41 -0400 Subject: update --- TODO | 2 +- debian/docs | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/TODO b/TODO index 410c694c2..a804597b8 100644 --- a/TODO +++ b/TODO @@ -4,7 +4,7 @@ * --push/--pull should take a reponame and files, and push those files to that repo; dropping them from the current repo -* how to handle git mv file? -> git annex fix -> run automatically? +* how to handle git mv file? -> git annex fix -> run automatically on commit * how to handle git rm file? (should try to drop keys that have no referring file, if it seems safe..) diff --git a/debian/docs b/debian/docs index 9de86edc7..d6fa57dd7 100644 --- a/debian/docs +++ b/debian/docs @@ -1 +1,2 @@ doc/*.mdwn +TODO -- cgit v1.2.3 From e8267f1b9e99cce79209eb2f47fce02d52d60b56 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 14:37:19 -0400 Subject: add doc wiki --- Makefile | 12 +++++++++ debian/control | 2 +- doc/Makefile | 15 +++++++++++ doc/bugs.mdwn | 4 +++ doc/bugs/branching.mdwn | 36 +++++++++++++++++++++++++ doc/bugs/done.mdwn | 3 +++ doc/bugs/free_space_checking.mdwn | 8 ++++++ doc/contact.mdwn | 4 +++ doc/download.mdwn | 5 ++++ doc/git-annex.mdwn | 55 --------------------------------------- doc/index.mdwn | 23 ++++++++++++++++ doc/news.mdwn | 5 ++++ 12 files changed, 116 insertions(+), 56 deletions(-) create mode 100644 doc/Makefile create mode 100644 doc/bugs.mdwn create mode 100644 doc/bugs/branching.mdwn create mode 100644 doc/bugs/done.mdwn create mode 100644 doc/bugs/free_space_checking.mdwn create mode 100644 doc/contact.mdwn create mode 100644 doc/download.mdwn create mode 100644 doc/index.mdwn create mode 100644 doc/news.mdwn diff --git a/Makefile b/Makefile index d1fcbbeee..87c725efe 100644 --- a/Makefile +++ b/Makefile @@ -8,5 +8,17 @@ install: clean: rm -rf build git-annex + rm -rf doc/.ikiwiki html + +# Build static html docs suitable for being shipped in the software +# package. This depends on ikiwiki being installed to build the docs. +ifeq ($(shell which ikiwiki),) +IKIWIKI=echo "** ikiwiki not found" >&2 ; echo ikiwiki +else +IKIWIKI=ikiwiki +endif + +docs: + $(IKIWIKI) doc html -v --wikiname git-annex --plugin=goodstuff .PHONY: git-annex diff --git a/debian/control b/debian/control index e58f55af9..846844c32 100644 --- a/debian/control +++ b/debian/control @@ -1,7 +1,7 @@ Source: git-annex Section: utils Priority: optional -Build-Depends: debhelper (>= 7.0.50), ghc6, libghc6-missingh-dev, libghc6-sha-dev +Build-Depends: debhelper (>= 7.0.50), ghc6, libghc6-missingh-dev, libghc6-sha-dev, ikiwiki Maintainer: Joey Hess Standards-Version: 3.9.1 Vcs-Git: git://git.kitenet.net/git-annex diff --git a/doc/Makefile b/doc/Makefile new file mode 100644 index 000000000..f2c4d8e54 --- /dev/null +++ b/doc/Makefile @@ -0,0 +1,15 @@ +# Build static html docs suitable for being shipped in the software +# package. This depends on ikiwiki being installed to build the docs. + +ifeq ($(shell which ikiwiki),) +IKIWIKI=echo "** ikiwiki not found" >&2 ; echo ikiwiki +else +IKIWIKI=ikiwiki +endif + +all: + $(IKIWIKI) `pwd` html -v --wikiname FooBar --plugin=goodstuff \ + --exclude=html --exclude=Makefile + +clean: + rm -rf .ikiwiki html diff --git a/doc/bugs.mdwn b/doc/bugs.mdwn new file mode 100644 index 000000000..dd2a9b403 --- /dev/null +++ b/doc/bugs.mdwn @@ -0,0 +1,4 @@ +This is git-annex's bug list. Link bugs to [[bugs/done]] when done. + +[[!inline pages="./bugs/* and !./bugs/done and !link(done) +and !*/Discussion" actions=yes postform=yes show=0]] diff --git a/doc/bugs/branching.mdwn b/doc/bugs/branching.mdwn new file mode 100644 index 000000000..21996ecc0 --- /dev/null +++ b/doc/bugs/branching.mdwn @@ -0,0 +1,36 @@ +The use of `.git-annex` to store logs means that if a repo has branches +and the user switched between them, git-annex will see different logs in +the different branches, and so may miss info about what remotes have which +files (though it can re-learn). + +An alternative would be to store the log data directly in the git repo +as `pristine-tar` does. Problem with that approach is that git won't merge +conflicting changes to log files if they are not in the currently checked +out branch. + +It would be possible to use a branch with a tree like this, to avoid +conflicts: + +key/uuid/time/status + +As long as new files are only added, and old timestamped files deleted, +there would be no conflicts. + +A related problem though is the size of the tree objects git needs to +commit. Having the logs in a separate branch doesn't help with that. +As more keys are added, the tree object size will increase, and git will +take longer and longer to commit, and use more space. One way to deal with +this is simply by splitting the logs amoung subdirectories. Git then can +reuse trees for most directories. (Check: Does it still have to build +dup trees in memory?) + +Another approach would be to have git-annex *delete* old logs. Keep logs +for the currently available files, or something like that. If other log +info is needed, look back through history to find the first occurance of a +log. Maybe even look at other branches -- so if the logs were on master, +a new empty branch could be made and git-annex would still know where to +get keys in that branch. + +Would have to be careful about conflicts when deleting and bringing back +files with the same name. And would need to avoid expensive searching thru +all history to try to find an old log file. diff --git a/doc/bugs/done.mdwn b/doc/bugs/done.mdwn new file mode 100644 index 000000000..ad332e2a2 --- /dev/null +++ b/doc/bugs/done.mdwn @@ -0,0 +1,3 @@ +recently fixed [[bugs]] + +[[!inline pages="./* and link(./done) and !*/Discussion" sort=mtime show=10]] diff --git a/doc/bugs/free_space_checking.mdwn b/doc/bugs/free_space_checking.mdwn new file mode 100644 index 000000000..34528a7b3 --- /dev/null +++ b/doc/bugs/free_space_checking.mdwn @@ -0,0 +1,8 @@ +Should check that there is enough free space before trying to copy a +file around. + +* Need a way to tell how much free space is available on the disk containing + a given repository. + +* And, need a way to tell the size of a file before copying it from + a remote, to check local disk space. diff --git a/doc/contact.mdwn b/doc/contact.mdwn new file mode 100644 index 000000000..1238ca040 --- /dev/null +++ b/doc/contact.mdwn @@ -0,0 +1,4 @@ +Joey Hess is the author of git-annex. + +The [VCS-home mailing list](http://lists.madduck.net/listinfo/vcs-home) +is a good place to discuss it. diff --git a/doc/download.mdwn b/doc/download.mdwn new file mode 100644 index 000000000..2ceb73193 --- /dev/null +++ b/doc/download.mdwn @@ -0,0 +1,5 @@ +The main git repository for git-annex is `git://git.kitenet.net/git-annex` +[[gitweb](http://git.kitenet.net/?p=git-annex;a=summary)] + +There are no binary packages yet, but you can build Debian packages from +the source tree with `dpkg-buildpackage`. diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 4c85a03b6..eb5fa9ced 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -176,61 +176,6 @@ when it's run from a git hook and do the necessary fixups. * `remote..annex-uuid` -- git-annex caches UUIDs of repositories here. -## issues - -### free space determination - -Need a way to tell how much free space is available on the disk containing -a given repository. The repository may be remote, so ssh may need to be -used. - -Similarly, need a way to tell the size of a file before copying it from -a remote, to check local disk space. - -### auto-drop on rm - -When git-rm removed a file, its key should get dropped too. Of course, it -may not be dropped right away, depending on number of copies available. - -### branching - -The use of `.git-annex` to store logs means that if a repo has branches -and the user switched between them, git-annex will see different logs in -the different branches, and so may miss info about what remotes have which -files (though it can re-learn). - -An alternative would be to store the log data directly in the git repo -as `pristine-tar` does. Problem with that approach is that git won't merge -conflicting changes to log files if they are not in the currently checked -out branch. - -It would be possible to use a branch with a tree like this, to avoid -conflicts: - -key/uuid/time/status - -As long as new files are only added, and old timestamped files deleted, -there would be no conflicts. - -A related problem though is the size of the tree objects git needs to -commit. Having the logs in a separate branch doesn't help with that. -As more keys are added, the tree object size will increase, and git will -take longer and longer to commit, and use more space. One way to deal with -this is simply by splitting the logs amoung subdirectories. Git then can -reuse trees for most directories. (Check: Does it still have to build -dup trees in memory?) - -Another approach would be to have git-annex *delete* old logs. Keep logs -for the currently available files, or something like that. If other log -info is needed, look back through history to find the first occurance of a -log. Maybe even look at other branches -- so if the logs were on master, -a new empty branch could be made and git-annex would still know where to -get keys in that branch. - -Would have to be careful about conflicts when deleting and bringing back -files with the same name. And would need to avoid expensive searching thru -all history to try to find an old log file. - ## contact Joey Hess diff --git a/doc/index.mdwn b/doc/index.mdwn new file mode 100644 index 000000000..8d2cb1ef5 --- /dev/null +++ b/doc/index.mdwn @@ -0,0 +1,23 @@ +git-annex allows managing files with git, without checking the file +contents into git. While that may seem paradoxical, it is useful when +dealing with files larger than git can currently easily handle, whether due +to limitations in memory, checksumming time, or disk space. + +Even without file content tracking, being able to manage files with git, +move files around and delete files with versioned directory trees, and use +branches and distributed clones, are all very handy reasons to use git. And +annexed files can co-exist in the same git repository with regularly +versioned files, which is convenient for maintaining documents, Makefiles, +etc that are associated with annexed files but that benefit from full +revision control. + +* [[man page|git-annex]] +* **[[download]]** +* [[news]] +* [[bugs]] +* [[contact]] + +---- + +git-annex's wiki is powered by [Ikiwiki](http://ikiwiki.info/) and +hosted by [Branchable](http://branchable.com/). diff --git a/doc/news.mdwn b/doc/news.mdwn new file mode 100644 index 000000000..d0ff1ca2c --- /dev/null +++ b/doc/news.mdwn @@ -0,0 +1,5 @@ +This is where announcements of new releases, features, and other news is +posted. git-annex users are recommended to subscribe to this page's RSS +feed. + +[[!inline pages="./news/* and !*/Discussion" rootpage="news" show="30"]] -- cgit v1.2.3 From 21128c88e71cb2050b78f996888d9e251a448807 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 14:39:40 -0400 Subject: tweak --- Makefile | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/Makefile b/Makefile index 87c725efe..a0911df04 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,5 @@ +all: git-annex docs + git-annex: mkdir -p build ghc -odir build -hidir build --make git-annex @@ -10,15 +12,16 @@ clean: rm -rf build git-annex rm -rf doc/.ikiwiki html -# Build static html docs suitable for being shipped in the software -# package. This depends on ikiwiki being installed to build the docs. +# If ikiwiki is available, build static html docs suitable for being +# shipped in the software package. ifeq ($(shell which ikiwiki),) -IKIWIKI=echo "** ikiwiki not found" >&2 ; echo ikiwiki +IKIWIKI=echo "** ikiwiki not found, skipping building docs" >&2 else IKIWIKI=ikiwiki endif docs: - $(IKIWIKI) doc html -v --wikiname git-annex --plugin=goodstuff + $(IKIWIKI) doc html -v --wikiname git-annex --plugin=goodstuff \ + --no-usedirs .PHONY: git-annex -- cgit v1.2.3 From 6ef1c2d2daf37dc92b4c364ea34802b62688018b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 15:17:26 -0400 Subject: allow lines with leading tab, to be preformatted text --- mdwn2man | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100755 mdwn2man diff --git a/mdwn2man b/mdwn2man new file mode 100755 index 000000000..c21253945 --- /dev/null +++ b/mdwn2man @@ -0,0 +1,43 @@ +#!/usr/bin/perl +# Warning: hack + +my $prog=shift; +my $section=shift; + +print ".TH $prog $section\n"; + +while (<>) { + s{(\\?)\[\[([^\s\|\]]+)(\|[^\s\]]+)?\]\]}{$1 ? "[[$2]]" : $2}eg; + s/\`//g; + s/^\s*\./\\&./g; + if (/^#\s/) { + s/^#\s/.SH /; + <>; # blank; + } + s/^ +//; + s/^\t/ /; + s/-/\\-/g; + s/^Warning:.*//g; + s/^$/.PP\n/; + s/^\*\s+(.*)/.IP "$1"/; + next if $_ eq ".PP\n" && $skippara; + if (/^.IP /) { + $inlist=1; + $spippara=0; + } + elsif (/.SH/) { + $skippara=0; + $inlist=0; + } + elsif (/^\./) { + $skippara=1; + } + else { + $skippara=0; + } + if ($inlist && $_ eq ".PP\n") { + $_=".IP\n"; + } + + print $_; +} -- cgit v1.2.3 From 7bc4435ffdc1760a7ac8638cdc1cfac78aebaabb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 15:59:40 -0400 Subject: update --- .gitignore | 3 + Commands.hs | 2 +- Makefile | 9 +- doc/Makefile | 15 -- doc/backends.mdwn | 21 +++ doc/bugs/symlink_farming_commit_hook.mdwn | 12 ++ doc/copies.mdwn | 30 ++++ doc/git-annex.mdwn | 271 +++++++++++++----------------- doc/index.mdwn | 9 +- doc/location_tracking.mdwn | 28 +++ 10 files changed, 226 insertions(+), 174 deletions(-) delete mode 100644 doc/Makefile create mode 100644 doc/backends.mdwn create mode 100644 doc/bugs/symlink_farming_commit_hook.mdwn create mode 100644 doc/copies.mdwn create mode 100644 doc/location_tracking.mdwn diff --git a/.gitignore b/.gitignore index 2b3e3aef1..13deb526a 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,5 @@ build/* git-annex +git-annex.1 +doc/.ikiwiki +html diff --git a/Commands.hs b/Commands.hs index e38f9c372..2addf714e 100644 --- a/Commands.hs +++ b/Commands.hs @@ -51,7 +51,7 @@ options = [ Option ['f'] ["force"] (NoArg Force) "allow actions that may lose annexed data" ] -header = "Usage: git-annex [" ++ (join "|" $ map cmdname cmds) ++ "] ..." +header = "Usage: git-annex " ++ (join "|" $ map cmdname cmds) ++ " [path ...]" usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs where diff --git a/Makefile b/Makefile index a0911df04..f18f076da 100644 --- a/Makefile +++ b/Makefile @@ -8,10 +8,6 @@ install: install -d $(DESTDIR)/usr/bin install git-annex $(DESTDIR)/usr/bin -clean: - rm -rf build git-annex - rm -rf doc/.ikiwiki html - # If ikiwiki is available, build static html docs suitable for being # shipped in the software package. ifeq ($(shell which ikiwiki),) @@ -21,7 +17,12 @@ IKIWIKI=ikiwiki endif docs: + ./mdwn2man git-annex 1 doc/git-annex.mdwn > git-annex.1 $(IKIWIKI) doc html -v --wikiname git-annex --plugin=goodstuff \ --no-usedirs +clean: + rm -rf build git-annex git-annex.1 + rm -rf doc/.ikiwiki html + .PHONY: git-annex diff --git a/doc/Makefile b/doc/Makefile deleted file mode 100644 index f2c4d8e54..000000000 --- a/doc/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# Build static html docs suitable for being shipped in the software -# package. This depends on ikiwiki being installed to build the docs. - -ifeq ($(shell which ikiwiki),) -IKIWIKI=echo "** ikiwiki not found" >&2 ; echo ikiwiki -else -IKIWIKI=ikiwiki -endif - -all: - $(IKIWIKI) `pwd` html -v --wikiname FooBar --plugin=goodstuff \ - --exclude=html --exclude=Makefile - -clean: - rm -rf .ikiwiki html diff --git a/doc/backends.mdwn b/doc/backends.mdwn new file mode 100644 index 000000000..d3ccaec49 --- /dev/null +++ b/doc/backends.mdwn @@ -0,0 +1,21 @@ +git-annex uses a key-value abstraction layer to allow file contents to be +stored in different ways. In theory, any key-value storage system could be +used to store file contents. + +When a file is annexed, a key is generated from its content and/or metadata. +The file checked into git symlinks to the key. This key can later be used +to retrieve the file's content (its value). + +Multiple pluggable backends are supported, and more than one can be used +to store different files' contents in a given repository. + +* `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, + size, and modification time has the same content. So with this backend, + files can be moved around, but should never be added to 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 + modifications of files to be tracked. Its need to generate checksums + can make it slower for large files. +* `URL` -- This backend downloads the file's content from an external URL. diff --git a/doc/bugs/symlink_farming_commit_hook.mdwn b/doc/bugs/symlink_farming_commit_hook.mdwn new file mode 100644 index 000000000..af03beb70 --- /dev/null +++ b/doc/bugs/symlink_farming_commit_hook.mdwn @@ -0,0 +1,12 @@ +TODO: implement below + +git-annex does use a lot of symlinks. Specicially, relative symlinks, +that are checked into git. To allow you to move those around without +annoyance, git-annex can run as a post-commit hook. This way, you can `git mv` +a symlink to an annexed file, and as soon as you commit, it will be fixed +up. + +`git annex init` tries to set up a post-commit hook that is itself a symlink +back to git-annex. If you want to have your own shell script in the post-commit +hook, just make it call `git annex` with no parameters. git-annex will detect +when it's run from a git hook and do the necessary fixups. diff --git a/doc/copies.mdwn b/doc/copies.mdwn new file mode 100644 index 000000000..ff66f4e8a --- /dev/null +++ b/doc/copies.mdwn @@ -0,0 +1,30 @@ +The WORM and SHA1 key-value [[backends|backend]] store data inside +your git repository's `.git` directory, not in some external data store. + +It's important that data not get lost by an ill-considered `git annex drop` +command. So, then using those backends, git-annex can be configured to try +to keep N copies of a file's content available across all repositories. By +default, N is 1; it is configured by annex.numcopies. + +`git annex drop` attempts to check with other git remotes, to check that N +copies of the file exist. If enough repositories cannot be verified to have +it, it will retain the file content to avoid data loss. + +For example, consider three repositories: Server, Laptop, and USB. Both Server +and USB have a copy of a file, and N=1. If on Laptop, you `git annex get +$file`, this will transfer it from either Server or USB (depending on which +is available), and there are now 3 copies of the file. + +Suppose you want to free up space on Laptop again, and you `git annex drop` the file +there. If USB is connected, or Server can be contacted, git-annex can check +that it still has a copy of the file, and the content is removed from +Laptop. But if USB is currently disconnected, and Server also cannot be +contacted, it can't verify that it is safe to drop the file, and will +refuse to do so. + +With N=2, in order to drop the file content from Laptop, it would need access +to both USB and Server. + +Note that different repositories can be configured with different values of +N. So just because Laptop has N=2, this does not prevent the number of +copies falling to 1, when USB and Server have N=1. diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index eb5fa9ced..25cf6f776 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -1,3 +1,13 @@ +# NAME + +git-annex - manage files with git, without checking their contents in + +# SYNOPSIS + +git annex subcommand [path ...] + +# DESCRIPTION + git-annex allows managing files with git, without checking the file contents into git. While that may seem paradoxical, it is useful when dealing with files larger than git can currently easily handle, whether due @@ -11,157 +21,94 @@ versioned files, which is convenient for maintaining documents, Makefiles, etc that are associated with annexed files but that benefit from full revision control. -My motivation for git-annex was the growing number of external drives I -use. Some are used to archive data, others hold backups, and yet others -come with me when I'm away from home to carry data that doesn't fit on my -netbook. Maintaining all that was a nightmare, lots of ad-hoc moving files -around, rsyncing files (unison is too slow), and deleting multiple copies -of files from multiple places. I realized what what I needed was a form of -revision control where each drive was a repository, and where copying the -files around, and deciding which copies were safe to delete was automated. -I posted about this to the VCS-home mailing list and got a great suggestion -to make it support arbitrary key-value stores, for more generality and -flexability. A week of coding later, and git-annex is born. - -Enough broad picture, here's how it actually looks: - -* `git annex add $file` moves the file into `.git/annex/`, and replaces - it with a symlink pointing at the annexed file, and then calls `git add` - to version the *symlink*. (If the file has already been annexed, it does - nothing.) - - If you then use normal git push/pull commands, the annexed file content - won't be transferred between repositories, but the symlinks will be. - So different clones of a repository can have different sets of annexed - files available. - - You can move the symlink around, copy it, delete it, etc, and commit changes - as desired using git. Reading the symlink will always get you the annexed - file content, or the link may be broken if the content is not currently - available. -* `git annex get $file` is used to transfer a specified file from the - backend storage to the current repository. -* `git annex drop $file` indicates that you no longer want the file's - content to be available in this repository. -* `git annex file $file` adjusts the symlink for the file to point to its - content again. Use this if you've moved the file around. -* `git annex unannex $file` undoes a `git annex add`. But use `git annex drop` - if you're just done with a file; only use `unannex` if you - accidentially added a file. (You can also run this on all your annexed - files come the Singularity. ;-) -* `git annex init "some description"` allows associating some description - (such as "USB archive drive 1") with a repository. This can help with - finding it later, see "Location Tracking" below. - -Oh yeah, "$file" in the above can be any number of files, or directories, -same as you'd pass to "git add" or "git rm". -So "git annex add ." or "git annex get dir/" work fine. - -## key-value storage - -git-annex uses a key-value abstraction layer to allow file contents to be -stored in different ways. In theory, any key-value storage system could be -used to store the file contents, and git-annex would then retrieve them -as needed and put them in `.git/annex/`. - -When a file is annexed, a key is generated from its content and/or metadata. -The file checked into git symlinks to the key. This key can later be used -to retrieve the file's content (its value). This key generation must be -stable for a given file content, name, and size. - -Multiple pluggable backends are supported, and more than one can be used -to store different files' contents in a given repository. - -* `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, - size, and modification time has the same content. So with this backend, - files can be moved around, but should never be added to 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 - modifications of files to be tracked. Its need to generate checksums - can make it slow for large files. -* `URL` -- This backend downloads the file's content from an external URL. - -## copies - -The WORM and SHA1 key-value backends store data inside your git repository. -It's important that data not get lost by an ill-though `git annex drop` -command. So, then using those backends, git-annex can be configured to try -to keep N copies of a file's content available across all repositories. By -default, N is 1; it is configured by annex.numcopies. - -`git annex drop` attempts to check with other git remotes, to check that N -copies of the file exist. If enough repositories cannot be verified to have -it, it will retain the file content to avoid data loss. - -For example, consider three repositories: Server, Laptop, and USB. Both Server -and USB have a copy of a file, and N=1. If on Laptop, you `git annex get -$file`, this will transfer it from either Server or USB (depending on which -is available), and there are now 3 copies of the file. - -Suppose you want to free up space on Laptop again, and you `git annex drop` the file -there. If USB is connected, or Server can be contacted, git-annex can check -that it still has a copy of the file, and the content is removed from -Laptop. But if USB is currently disconnected, and Server also cannot be -contacted, it can't verify that it is safe to drop the file, and will -refuse to do so. - -With N=2, in order to drop the file content from Laptop, it would need access -to both USB and Server. - -Note that different repositories can be configured with different values of -N. So just because Laptop has N=2, this does not prevent the number of -copies falling to 1, when USB and Server have N=1. - -## location tracking - -git-annex keeps track of in which repositories it last saw a file's content. -This 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. (Git is configured to use a union merge for this file, -so the lines may be in arbitrary order, but it will never conflict.) - -This location tracking information is useful if you have multiple -repositories, and not all are always accessible. For example, perhaps one -is on a home file server, and you are away from home. Then git-annex can -tell you what git remote it needs access to in order to get a file: - - # git annex get myfile - get myfile (need access to one of these remotes: home) - git-annex: get myfile failed - -Another way the location tracking comes in handy is if you put repositories -on removable USB drives, that might be archived away offline in a safe -place. In this sort of case, you probably don't have a git remotes -configured for every USB drive. So git-annex may have to resort to talking -about repository UUIDs. If you have previously used "git annex init" -to attach descriptions to those repositories, it will include their -descriptions to help you with finding them: - - # git annex get myfile - get myfile (No available git remotes have the file.) - It has been seen before in these repositories: - c0a28e06-d7ef-11df-885c-775af44f8882 -- USB archive drive 1 - e1938fee-d95b-11df-96cc-002170d25c55 - git-annex: get myfile failed - -## symlink farming commit hook - -git-annex does use a lot of symlinks. Specicially, relative symlinks, -that are checked into git. To allow you to move those around without -annoyance, git-annex can run as a post-commit hook. This way, you can `git mv` -a symlink to an annexed file, and as soon as you commit, it will be fixed -up. - -`git annex init` tries to set up a post-commit hook that is itself a symlink -back to git-annex. If you want to have your own shell script in the post-commit -hook, just make it call `git annex` with no parameters. git-annex will detect -when it's run from a git hook and do the necessary fixups. - -## configuration - -* `annex.uuid` -- a unique UUID for this repository +When a file is annexed, its content is moved into a key-value store, and +a symlink is made that points to the content. These symlinks are checked into +git and versioned like regular files. You can move them around, delete +them, and so on. Pushing to another git repository will make git-annex +there aware of the annexed file, and it can be used to retrieve its +content from the key-value store. + +# EXAMPLES + + # git annex get video/hackity_hack_and_kaxxt.mov + get video/_why_hackity_hack_and_kaxxt.mov (not available) + I was unable to access these remotes: server + Try making some of these repositories available: + 5863d8c0-d9a9-11df-adb2-af51e6559a49 -- my home file server + 58d84e8a-d9ae-11df-a1aa-ab9aa8c00826 -- portable USB drive + ca20064c-dbb5-11df-b2fe-002170d25c55 -- backup SATA drive + failed + # sudo mount /media/usb + # git remote add usbdrive /media/usb + # git annex get video/hackity_hack_and_kaxxt.mov + get video/hackity_hack_and_kaxxt.mov (copying from usbdrive...) ok + # git commit -a -m "got a video I want to rewatch on the plane" + + # git annex add iso + add iso/Debian_5.0.iso ok + # git commit -a -m "saving Debian CD for later" + + # git annex push usbdrive iso + error: push not yet implemented! + # git annex drop iso + drop iso/Debian_5.0.iso ok + # git commit -a -m "freed up space" + +# SUBCOMMANDS + +Like many git commands, git-annex can be passed a path that +is either a file or a directory. In the latter case it acts on all relevant +files in the directory. + +Many git-annex subcommands will stage changes for later `git commit` by you. + +* add [path ...] + + Adds files in the path to the annex. Files that are already checked into + git, or that git has been configured to ignore will be silently skipped. + +* get [path ...] + + Makes the content of annexed files available in this repository. Depending + on the backend used, this will involve copying them from another repository, + or downloading them, or transferring them from some kind of key-value store. + +* drop [path ...] + + Drops the content of annexed files from this repository. + + git-annex may refuse to drop a content if the backend does not think + it is safe to do so. + +* unannex [path ...] + + Use this to undo an accidental add command. This is not the command you + should use if you intentionally annexed a file and don't want its contents + any more. In that case you should use `git annex drop` instead, and you + can also `git rm` the file. + +* init "description" + + Initializes git-annex with a descripotion of the git repository. + This is an optional, but recommended step. + +* fix [path ...] + + Fixes up symlinks that have become broken to again point to annexed content. + This is useful to run if you have been moving the symlinks around. + +# OPTIONS + +* --force + + Force unsafe actions, such as dropping a file's content when no other + source of it can be verified to still exist. Use with care. + +## CONFIGURATION + +Like other git commands, git-annex is configured via `.git/config`. + +* `annex.uuid` -- a unique UUID for this repository (automatically set) * `annex.numcopies` -- number of copies of files to keep across all repositories (default: 1) * `annex.backends` -- space-separated list of names of @@ -176,6 +123,24 @@ when it's run from a git hook and do the necessary fixups. * `remote..annex-uuid` -- git-annex caches UUIDs of repositories here. -## contact +# FILES + +These files are used, in your git repository: + +`.git/annex/` 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 +decscriptions. You may edit it. + +`.git-annex/*.log` is where git-annex records its content tracking +information. These files should be committed to git. + +`.git-annex/.gitattributes` is configured to use git's union merge driver +to avoid conflicts when merging files in the `.git-annex` directory. + +# AUTHOR + +Joey Hess -Joey Hess +Warning: this page is automatically made into a man page via [mdwn2man](http://git.ikiwiki.info/?p=ikiwiki;a=blob;f=mdwn2man;hb=HEAD). Edit with care diff --git a/doc/index.mdwn b/doc/index.mdwn index 8d2cb1ef5..df42eabc1 100644 --- a/doc/index.mdwn +++ b/doc/index.mdwn @@ -11,12 +11,19 @@ versioned files, which is convenient for maintaining documents, Makefiles, etc that are associated with annexed files but that benefit from full revision control. -* [[man page|git-annex]] * **[[download]]** * [[news]] * [[bugs]] * [[contact]] +## documentation + +* [[man page|git-annex]] +* [[key-value backends|backends]] for data storage +* [[location_tracking]] reminds you where git-annex has seen files +* git-annex prevents accidential data loss by [[tracking copies|copies]] + of your files + ---- git-annex's wiki is powered by [Ikiwiki](http://ikiwiki.info/) and diff --git a/doc/location_tracking.mdwn b/doc/location_tracking.mdwn new file mode 100644 index 000000000..a7d5c150b --- /dev/null +++ b/doc/location_tracking.mdwn @@ -0,0 +1,28 @@ +git-annex keeps track of in which repositories it last saw a file's content. +This 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. (Git is configured to use a union merge for this file, +so the lines may be in arbitrary order, but it will never conflict.) + +This location tracking information is useful if you have multiple +repositories, and not all are always accessible. For example, perhaps one +is on a home file server, and you are away from home. Then git-annex can +tell you what git remote it needs access to in order to get a file: + + # git annex get myfile + get myfile(not available) + I was unable to access these remotes: home + +Another way the location tracking comes in handy is if you put repositories +on removable USB drives, that might be archived away offline in a safe +place. In this sort of case, you probably don't have a git remotes +configured for every USB drive. So git-annex may have to resort to talking +about repository UUIDs. If you have previously used "git annex init" +to attach descriptions to those repositories, it will include their +descriptions to help you with finding them: + + # git annex get myfile + get myfile (not available) + Try making some of these repositories available: + c0a28e06-d7ef-11df-885c-775af44f8882 -- USB archive drive 1 + e1938fee-d95b-11df-96cc-002170d25c55 -- cgit v1.2.3 From 05539c773ea1246de253e1373ca1711412b91503 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 16:01:48 -0400 Subject: split TODO --- TODO | 21 --------------------- debian/docs | 3 +-- doc/bugs/backendchecksum.mdwn | 1 + doc/bugs/dotdot_problem.mdwn | 2 ++ doc/bugs/file_copy_progress_bar.mdwn | 3 +++ doc/bugs/fsck.mdwn | 1 + doc/bugs/gitrm.mdwn | 2 ++ doc/bugs/network_remotes.mdwn | 3 +++ doc/bugs/pushpull.mdwn | 2 ++ 9 files changed, 15 insertions(+), 23 deletions(-) delete mode 100644 TODO create mode 100644 doc/bugs/backendchecksum.mdwn create mode 100644 doc/bugs/dotdot_problem.mdwn create mode 100644 doc/bugs/file_copy_progress_bar.mdwn create mode 100644 doc/bugs/fsck.mdwn create mode 100644 doc/bugs/gitrm.mdwn create mode 100644 doc/bugs/network_remotes.mdwn create mode 100644 doc/bugs/pushpull.mdwn diff --git a/TODO b/TODO deleted file mode 100644 index a804597b8..000000000 --- a/TODO +++ /dev/null @@ -1,21 +0,0 @@ -* bug: cannot "git annex ../foo" (GitRepo.relative is buggy and - git-ls-files also refuses w/o --full-name, which would need other changes) - -* --push/--pull should take a reponame and files, and push those files - to that repo; dropping them from the current repo - -* how to handle git mv file? -> git annex fix -> run automatically on commit - -* how to handle git rm file? (should try to drop keys that have no - referring file, if it seems safe..) - -* add a git annex fsck that finds keys that have no referring file - -* Support for remote git repositories (ssh:// specifically can be made to - work, although the other end probably needs to have git-annex installed..) - -* Find a way to copy a file with a progress bar, while still preserving - stat. Easiest way might be to use pv and fix up the permissions etc - after? - -* finish BackendChecksum diff --git a/debian/docs b/debian/docs index d6fa57dd7..1936cc1d4 100644 --- a/debian/docs +++ b/debian/docs @@ -1,2 +1 @@ -doc/*.mdwn -TODO +html diff --git a/doc/bugs/backendchecksum.mdwn b/doc/bugs/backendchecksum.mdwn new file mode 100644 index 000000000..40ff868c2 --- /dev/null +++ b/doc/bugs/backendchecksum.mdwn @@ -0,0 +1 @@ +This backend is not finished. diff --git a/doc/bugs/dotdot_problem.mdwn b/doc/bugs/dotdot_problem.mdwn new file mode 100644 index 000000000..9d247a9c0 --- /dev/null +++ b/doc/bugs/dotdot_problem.mdwn @@ -0,0 +1,2 @@ +cannot "git annex ../foo" (GitRepo.relative is buggy and +git-ls-files also refuses w/o --full-name, which would need other changes) diff --git a/doc/bugs/file_copy_progress_bar.mdwn b/doc/bugs/file_copy_progress_bar.mdwn new file mode 100644 index 000000000..cd4ea33b7 --- /dev/null +++ b/doc/bugs/file_copy_progress_bar.mdwn @@ -0,0 +1,3 @@ +Find a way to copy a file with a progress bar, while still preserving +stat. Easiest way might be to use pv and fix up the permissions etc +after? diff --git a/doc/bugs/fsck.mdwn b/doc/bugs/fsck.mdwn new file mode 100644 index 000000000..308a1cb63 --- /dev/null +++ b/doc/bugs/fsck.mdwn @@ -0,0 +1 @@ +add a git annex fsck that finds keys that have no referring file diff --git a/doc/bugs/gitrm.mdwn b/doc/bugs/gitrm.mdwn new file mode 100644 index 000000000..d771aa32a --- /dev/null +++ b/doc/bugs/gitrm.mdwn @@ -0,0 +1,2 @@ +how to handle git rm file? (should try to drop keys that have no +referring file, if it seems safe..) diff --git a/doc/bugs/network_remotes.mdwn b/doc/bugs/network_remotes.mdwn new file mode 100644 index 000000000..be43ee20b --- /dev/null +++ b/doc/bugs/network_remotes.mdwn @@ -0,0 +1,3 @@ +Support for remote git repositories (ssh:// specifically can be made to +work, although the other end probably needs to have git-annex +installed..) diff --git a/doc/bugs/pushpull.mdwn b/doc/bugs/pushpull.mdwn new file mode 100644 index 000000000..47da2107f --- /dev/null +++ b/doc/bugs/pushpull.mdwn @@ -0,0 +1,2 @@ +--push/--pull should take a reponame and files, and push those files + to that repo; dropping them from the current repo -- cgit v1.2.3 From b1d22b3229a1cc86e0df8d4899b44d3e44e960d0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 16:07:33 -0400 Subject: update --- doc/bugs/using_url_backend.mdwn | 9 +++++++++ doc/index.mdwn | 2 +- 2 files changed, 10 insertions(+), 1 deletion(-) create mode 100644 doc/bugs/using_url_backend.mdwn diff --git a/doc/bugs/using_url_backend.mdwn b/doc/bugs/using_url_backend.mdwn new file mode 100644 index 000000000..a0d447c6e --- /dev/null +++ b/doc/bugs/using_url_backend.mdwn @@ -0,0 +1,9 @@ +There is no way to `git annex add` a file using the URL [[backend|backends]]. + +For now, we have to manually make the symlink. Something like this: + + ln -s .git/annex/URL:http:%%www.example.com%foo.tar.gz + +Note the escaping of slashes. + +A `git annex register ` command could do this.. diff --git a/doc/index.mdwn b/doc/index.mdwn index df42eabc1..285f84f13 100644 --- a/doc/index.mdwn +++ b/doc/index.mdwn @@ -18,7 +18,7 @@ revision control. ## documentation -* [[man page|git-annex]] +* [[git-annex man page|git-annex]] * [[key-value backends|backends]] for data storage * [[location_tracking]] reminds you where git-annex has seen files * git-annex prevents accidential data loss by [[tracking copies|copies]] -- cgit v1.2.3 From d6911f57b76a6469484076dc991adb39d8d9b8e0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 16:17:29 -0400 Subject: update --- Makefile | 2 +- debian/control | 2 +- debian/copyright | 5 + debian/manpages | 1 + doc/GPL | 339 +++++++++++++++++++++++++++++++++++++++++++++++++++++ doc/git-annex.mdwn | 4 +- doc/index.mdwn | 1 + 7 files changed, 351 insertions(+), 3 deletions(-) create mode 100644 debian/copyright create mode 100644 debian/manpages create mode 100644 doc/GPL diff --git a/Makefile b/Makefile index f18f076da..39f5ba8ad 100644 --- a/Makefile +++ b/Makefile @@ -19,7 +19,7 @@ endif docs: ./mdwn2man git-annex 1 doc/git-annex.mdwn > git-annex.1 $(IKIWIKI) doc html -v --wikiname git-annex --plugin=goodstuff \ - --no-usedirs + --no-usedirs --disable-plugin=openid clean: rm -rf build git-annex git-annex.1 diff --git a/debian/control b/debian/control index 846844c32..4e3ad01bd 100644 --- a/debian/control +++ b/debian/control @@ -5,7 +5,7 @@ Build-Depends: debhelper (>= 7.0.50), ghc6, libghc6-missingh-dev, libghc6-sha-de Maintainer: Joey Hess Standards-Version: 3.9.1 Vcs-Git: git://git.kitenet.net/git-annex -Homepage: http://kitenet.net/~joey/code/git-annex/ +Homepage: http://git-annex.branchable.com/ Package: git-annex Architecture: any diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 000000000..5d0ae13c8 --- /dev/null +++ b/debian/copyright @@ -0,0 +1,5 @@ +Files: * +Copyright: © 2010 Joey Hess +License: GPL-2+ + The full text of the GPL is distributed as doc/GPL in this package's + source, or in /usr/share/common-licenses/GPL on Debian systems. diff --git a/debian/manpages b/debian/manpages new file mode 100644 index 000000000..ca34203aa --- /dev/null +++ b/debian/manpages @@ -0,0 +1 @@ +git-annex.1 diff --git a/doc/GPL b/doc/GPL new file mode 100644 index 000000000..d159169d1 --- /dev/null +++ b/doc/GPL @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 25cf6f776..09b245497 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -87,7 +87,7 @@ Many git-annex subcommands will stage changes for later `git commit` by you. any more. In that case you should use `git annex drop` instead, and you can also `git rm` the file. -* init "description" +* init description Initializes git-annex with a descripotion of the git repository. This is an optional, but recommended step. @@ -143,4 +143,6 @@ to avoid conflicts when merging files in the `.git-annex` directory. Joey Hess + + Warning: this page is automatically made into a man page via [mdwn2man](http://git.ikiwiki.info/?p=ikiwiki;a=blob;f=mdwn2man;hb=HEAD). Edit with care diff --git a/doc/index.mdwn b/doc/index.mdwn index 285f84f13..3541847fa 100644 --- a/doc/index.mdwn +++ b/doc/index.mdwn @@ -23,6 +23,7 @@ revision control. * [[location_tracking]] reminds you where git-annex has seen files * git-annex prevents accidential data loss by [[tracking copies|copies]] of your files +* git-annex is Free Software, licensed under the [[GPL]]. ---- -- cgit v1.2.3 From d53519fade3baf9dfb3a92adcfa3c03d852171d2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 16:30:17 -0400 Subject: probably won't use SHA module --- Backend/SHA1.hs | 2 -- debian/control | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs index 2143a6af5..caece6b78 100644 --- a/Backend/SHA1.hs +++ b/Backend/SHA1.hs @@ -3,8 +3,6 @@ module Backend.SHA1 (backend) where -import Data.Digest.Pure.SHA - import qualified Backend.File import TypeInternals diff --git a/debian/control b/debian/control index 4e3ad01bd..83bc8c82b 100644 --- a/debian/control +++ b/debian/control @@ -1,7 +1,7 @@ Source: git-annex Section: utils Priority: optional -Build-Depends: debhelper (>= 7.0.50), ghc6, libghc6-missingh-dev, libghc6-sha-dev, ikiwiki +Build-Depends: debhelper (>= 7.0.50), ghc6, libghc6-missingh-dev, ikiwiki Maintainer: Joey Hess Standards-Version: 3.9.1 Vcs-Git: git://git.kitenet.net/git-annex -- cgit v1.2.3 From 0f153765b7552054cb459730b95477f8f4f1ae21 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 16:32:40 -0400 Subject: update --- INSTALL | 8 +------- doc/download.mdwn | 2 ++ doc/index.mdwn | 1 + 3 files changed, 4 insertions(+), 7 deletions(-) diff --git a/INSTALL b/INSTALL index a7fc7f6f3..f024541c1 100644 --- a/INSTALL +++ b/INSTALL @@ -1,7 +1 @@ -To build and use git-annex, you will need: - -* ghc -* These haskell libraries: MissingH SHA -* uuid - -Then just run make; make install +See doc/install.mdwn for installation instructions. diff --git a/doc/download.mdwn b/doc/download.mdwn index 2ceb73193..664f46ed9 100644 --- a/doc/download.mdwn +++ b/doc/download.mdwn @@ -3,3 +3,5 @@ The main git repository for git-annex is `git://git.kitenet.net/git-annex` There are no binary packages yet, but you can build Debian packages from the source tree with `dpkg-buildpackage`. + +Next: [[install]] diff --git a/doc/index.mdwn b/doc/index.mdwn index 3541847fa..e30326853 100644 --- a/doc/index.mdwn +++ b/doc/index.mdwn @@ -12,6 +12,7 @@ etc that are associated with annexed files but that benefit from full revision control. * **[[download]]** +* [[install]] * [[news]] * [[bugs]] * [[contact]] -- cgit v1.2.3 From e7572f9249f0e4c3f757bb8da889a41f53fd9e34 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 16:32:50 -0400 Subject: add --- doc/install.mdwn | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 doc/install.mdwn diff --git a/doc/install.mdwn b/doc/install.mdwn new file mode 100644 index 000000000..cc6fb6fb3 --- /dev/null +++ b/doc/install.mdwn @@ -0,0 +1,7 @@ +To build and use git-annex, you will need: + +* The Haskell Platform: +* MissingH: +* uuid: + +Then just [[download]] git-annex and run: `make; make install` -- cgit v1.2.3 From 9d5b8ebab0e247c5c9c05a5216dcd4c638299190 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 19:28:29 -0400 Subject: update --- Makefile | 3 ++- doc/bugs.mdwn | 2 +- doc/bugs/done.mdwn | 3 ++- doc/index.mdwn | 18 ++++++++++++++++++ doc/not.mdwn | 10 ++++++++++ doc/templates/bare.tmpl | 1 + doc/use_case/Alice.mdwn | 18 ++++++++++++++++++ doc/use_case/Bob.mdwn | 18 ++++++++++++++++++ 8 files changed, 70 insertions(+), 3 deletions(-) create mode 100644 doc/not.mdwn create mode 100644 doc/templates/bare.tmpl create mode 100644 doc/use_case/Alice.mdwn create mode 100644 doc/use_case/Bob.mdwn diff --git a/Makefile b/Makefile index 39f5ba8ad..d35e82ad5 100644 --- a/Makefile +++ b/Makefile @@ -19,7 +19,8 @@ endif docs: ./mdwn2man git-annex 1 doc/git-annex.mdwn > git-annex.1 $(IKIWIKI) doc html -v --wikiname git-annex --plugin=goodstuff \ - --no-usedirs --disable-plugin=openid + --no-usedirs --disable-plugin=openid --plugin=sidebar \ + --underlaydir=/dev/null clean: rm -rf build git-annex git-annex.1 diff --git a/doc/bugs.mdwn b/doc/bugs.mdwn index dd2a9b403..2786e5bf7 100644 --- a/doc/bugs.mdwn +++ b/doc/bugs.mdwn @@ -1,4 +1,4 @@ This is git-annex's bug list. Link bugs to [[bugs/done]] when done. [[!inline pages="./bugs/* and !./bugs/done and !link(done) -and !*/Discussion" actions=yes postform=yes show=0]] +and !*/Discussion" actions=yes postform=yes show=0 archive=yes]] diff --git a/doc/bugs/done.mdwn b/doc/bugs/done.mdwn index ad332e2a2..a35d42719 100644 --- a/doc/bugs/done.mdwn +++ b/doc/bugs/done.mdwn @@ -1,3 +1,4 @@ recently fixed [[bugs]] -[[!inline pages="./* and link(./done) and !*/Discussion" sort=mtime show=10]] +[[!inline pages="./* and link(./done) and !*/Discussion" sort=mtime show=10 +archive=yes]] diff --git a/doc/index.mdwn b/doc/index.mdwn index e30326853..b3a871627 100644 --- a/doc/index.mdwn +++ b/doc/index.mdwn @@ -11,11 +11,28 @@ versioned files, which is convenient for maintaining documents, Makefiles, etc that are associated with annexed files but that benefit from full revision control. +[[!sidebar content=""" * **[[download]]** * [[install]] * [[news]] * [[bugs]] * [[contact]] +"""]] + + +## sample use cases + + + + + + +
[[!inline feeds=no template=bare pages=use_case/bob]][[!inline feeds=no template=bare pages=use_case/alice]]
+ +If that describes you, or if you're some from column A and some from column +B, then git-annex may be the tool you've been looking for to expand from +keeping all your small important files in git, to managing your large +files with git. ## documentation @@ -24,6 +41,7 @@ revision control. * [[location_tracking]] reminds you where git-annex has seen files * git-annex prevents accidential data loss by [[tracking copies|copies]] of your files +* [[what git annex is not|not]] * git-annex is Free Software, licensed under the [[GPL]]. ---- diff --git a/doc/not.mdwn b/doc/not.mdwn new file mode 100644 index 000000000..2697a9b1f --- /dev/null +++ b/doc/not.mdwn @@ -0,0 +1,10 @@ +[[!meta title="what git-annex is not"]] + +* git-annex is not a backup system. It may be a useful component of an + [[archival|use_case/bob]] system, or a way to deliver files to a backup + system. + + For a backup system that uses git, take a look at + [bup](http://github.com/apenwarr/bup). + +* probably several other things.. diff --git a/doc/templates/bare.tmpl b/doc/templates/bare.tmpl new file mode 100644 index 000000000..2d476b716 --- /dev/null +++ b/doc/templates/bare.tmpl @@ -0,0 +1 @@ + diff --git a/doc/use_case/Alice.mdwn b/doc/use_case/Alice.mdwn new file mode 100644 index 000000000..c42eb3a74 --- /dev/null +++ b/doc/use_case/Alice.mdwn @@ -0,0 +1,18 @@ +### The Nomad + +Alice is always on the move, often with her trusty netbook and a small +handheld terabyte USB drive, or a smaller USB keydrive. She has a server +out there on the net. All these things can have different files on them, +but Alice no longer has to deal with the tedious process of keeping them +manually in sync. + +When she has 1 bar on her cell, Alice queues up interesting files on her +server for later. At a coffee shop, she has git-annex download them to her +USB drive. High in the sky or in a remote cabin, she catches up on +podcasts, videos, and games, first letting git-annex copy them from +her USB drive to the netbook (this saves battery power). + +When she's done, she tells git-annex which to keep and which to remove. +They're all removed from her netbook to save space, and Alice knowns +that next time she syncs up to the net, her changes will be synced back +to her server. diff --git a/doc/use_case/Bob.mdwn b/doc/use_case/Bob.mdwn new file mode 100644 index 000000000..a5dc01b37 --- /dev/null +++ b/doc/use_case/Bob.mdwn @@ -0,0 +1,18 @@ +### The Archivist + +Bob has many drives to archive his data, most of them kept offline, in a +safe place. + +With git-annex, Bob has a single directory tree that includes all +his files, even if their content is being stored offline. He can +reorganize his files using that tree, committing new versions to git, +without worry about accidentially deleting anything. + +When Bob needs access to some files, git-annex can tell him which drive(s) +they're on, and easily make them available. Indeed, every drive knows what +is on every other drive. + +Run in a cron job, git-annex adds new files to achival drives at night. It +also helps Bob keep track of intentional, and unintentional copies of +files, and logs information he can use to decide when it's time to duplicate +the content of old drives. -- cgit v1.2.3 From b08b45815dffeadd5f5fb2492bb4e5c36b921aee Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 19:30:08 -0400 Subject: update --- doc/not.mdwn | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/doc/not.mdwn b/doc/not.mdwn index 2697a9b1f..a91a6a7a0 100644 --- a/doc/not.mdwn +++ b/doc/not.mdwn @@ -7,4 +7,8 @@ For a backup system that uses git, take a look at [bup](http://github.com/apenwarr/bup). +* git-annex is not unison, but if you're finding unison's checksumming + too slow, or its strict mirroring of everything to both places too + limiting, then git-annex could be a useful alternative. + * probably several other things.. -- cgit v1.2.3 From 972639d85c663855dd0c7476b732dcb319efdb2e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 19 Oct 2010 19:35:56 -0400 Subject: update --- doc/not.mdwn | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/doc/not.mdwn b/doc/not.mdwn index a91a6a7a0..affcb57f1 100644 --- a/doc/not.mdwn +++ b/doc/not.mdwn @@ -11,4 +11,6 @@ too slow, or its strict mirroring of everything to both places too limiting, then git-annex could be a useful alternative. -* probably several other things.. +* git-annex is not some flaky script that was quickly thrown together. + I wrote it in Haskell because I wanted it to be solid and to compile + down to a binary. -- cgit v1.2.3