From 19fde4960dc1d6c8c05efd0f5b4293c2fb52ebf9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 21 Oct 2010 16:30:16 -0400 Subject: new fromkey subcommand, for registering urls, etc had to redo Annex monad's flag storage --- Annex.hs | 27 +++++++----- Backend.hs | 19 +++++---- Backend/File.hs | 2 +- Commands.hs | 93 +++++++++++++++++++++++++++++++++-------- Core.hs | 5 +-- Makefile | 2 +- Remotes.hs | 4 +- TypeInternals.hs | 19 +++++---- Types.hs | 5 ++- doc/bugs/using_url_backend.mdwn | 2 + doc/git-annex.mdwn | 21 +++++++++- doc/walkthrough.mdwn | 31 ++++++++++++++ git-annex.hs | 4 +- 13 files changed, 179 insertions(+), 55 deletions(-) diff --git a/Annex.hs b/Annex.hs index b68e51355..d021f936e 100644 --- a/Annex.hs +++ b/Annex.hs @@ -10,10 +10,12 @@ module Annex ( supportedBackends, flagIsSet, flagChange, + flagGet, Flag(..) ) where import Control.Monad.State +import qualified Data.Map as M import qualified GitRepo as Git import Types @@ -27,7 +29,7 @@ new gitrepo allbackends = do Internals.repo = gitrepo, Internals.backends = [], Internals.supportedBackends = allbackends, - Internals.flags = [] + Internals.flags = M.empty } (_,s') <- Annex.run s (prep gitrepo) return s' @@ -63,15 +65,20 @@ supportedBackends :: Annex [Backend] supportedBackends = do state <- get return (Internals.supportedBackends state) -flagIsSet :: Flag -> Annex Bool -flagIsSet flag = do +flagIsSet :: FlagName -> Annex Bool +flagIsSet name = do state <- get - return $ elem flag $ Internals.flags state -flagChange :: Flag -> Bool -> Annex () -flagChange flag set = do + case (M.lookup name $ Internals.flags state) of + Just (FlagBool True) -> return True + _ -> return False +flagChange :: FlagName -> Flag -> Annex () +flagChange name val = do state <- get - let f = filter (/= flag) $ Internals.flags state - if (set) - then put state { Internals.flags = (flag:f) } - else put state { Internals.flags = f } + put state { Internals.flags = M.insert name val $ Internals.flags state } return () +flagGet :: FlagName -> Annex String +flagGet name = do + state <- get + case (M.lookup name $ Internals.flags state) of + Just (FlagString s) -> return s + _ -> return "" diff --git a/Backend.hs b/Backend.hs index a427234d7..b8def21cd 100644 --- a/Backend.hs +++ b/Backend.hs @@ -14,6 +14,7 @@ - -} module Backend ( + list, storeFileKey, retrieveKeyFile, removeKey, @@ -36,24 +37,28 @@ import Types import qualified TypeInternals as Internals {- List of backends in the order to try them when storing a new key. -} -backendList :: Annex [Backend] -backendList = do - l <- Annex.backends +list :: Annex [Backend] +list = do + l <- Annex.backends -- list is cached here if (0 < length l) then return l else do all <- Annex.supportedBackends g <- Annex.gitRepo let l = parseBackendList all $ Git.configGet g "annex.backends" "" - Annex.backendsChange l - return l + backendflag <- Annex.flagGet "backend" + let l' = if (0 < length backendflag) + then (lookupBackendName all backendflag):l + else l + 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 -} +{- Looks up a backend in a list -} lookupBackendName :: [Backend] -> String -> Backend lookupBackendName all s = if ((length matches) /= 1) @@ -66,7 +71,7 @@ storeFileKey :: FilePath -> Annex (Maybe (Key, Backend)) storeFileKey file = do g <- Annex.gitRepo let relfile = Git.relative g file - b <- backendList + b <- list storeFileKey' b file relfile storeFileKey' [] _ _ = return Nothing storeFileKey' (b:bs) file relfile = do diff --git a/Backend/File.hs b/Backend/File.hs index 4ea25daa7..d1ed1ec64 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -107,7 +107,7 @@ showTriedRemotes remotes = - error if not. -} checkRemoveKey :: Key -> Annex (Bool) checkRemoveKey key = do - force <- Annex.flagIsSet Force + force <- Annex.flagIsSet "force" if (force) then return True else do diff --git a/Commands.hs b/Commands.hs index 1cc046c03..59915f59c 100644 --- a/Commands.hs +++ b/Commands.hs @@ -8,6 +8,7 @@ import System.Posix.Files import System.Directory import System.Path import Data.String.Utils +import Control.Monad (filterM) import List import IO @@ -23,7 +24,8 @@ import Core import qualified Remotes import qualified TypeInternals -data CmdWants = FilesInGit | FilesNotInGit | RepoName | SingleString +data CmdWants = FilesInGit | FilesNotInGit | FilesMissing | + RepoName | Description data Command = Command { cmdname :: String, cmdaction :: (String -> Annex ()), @@ -41,26 +43,49 @@ cmds = [ "indicate content of files not currently wanted") , (Command "unannex" unannexCmd FilesInGit "undo accidential add command") - , (Command "init" initCmd SingleString + , (Command "init" initCmd Description "initialize git-annex with repository description") , (Command "fix" fixCmd FilesInGit "fix up files' symlinks to point to annexed content") + , (Command "fromkey" fromKeyCmd FilesMissing + "adds a file using a specific key") ] +-- Each dashed command-line option results in generation of an action +-- in the Annex monad that performs the necessary setting. +options :: [OptDescr (Annex ())] options = [ - Option ['f'] ["force"] (NoArg Force) "allow actions that may lose annexed data" + Option ['f'] ["force"] + (NoArg (Annex.flagChange "force" $ FlagBool True)) + "allow actions that may lose annexed data" + , Option ['b'] ["backend"] + (ReqArg (\s -> Annex.flagChange "backend" $ FlagString s) "NAME") + "specify default key-value backend to use" + , Option ['k'] ["key"] + (ReqArg (\s -> Annex.flagChange "key" $ FlagString s) "KEY") + "specify a key to use" ] -header = "Usage: git-annex " ++ (join "|" $ map cmdname cmds) ++ " [path ...]" +header = "Usage: git-annex " ++ (join "|" $ map cmdname cmds) +usage :: String 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 ' ') ++ + (pad 10 (cmdname c)) ++ + (descWanted (cmdwants c)) ++ + (pad 13 (descWanted (cmdwants c))) ++ (cmddesc c) indent l = " " ++ l + pad n s = take (n - (length s)) $ repeat ' ' + +{- Generate descrioptions of wanted parameters for subcommands. -} +descWanted :: CmdWants -> String +descWanted Description = "DESCRIPTION" +descWanted RepoName = "REPO" +descWanted _ = "PATH ..." {- Finds the type of parameters a command wants, from among the passed - parameter list. -} @@ -71,14 +96,23 @@ findWanted FilesNotInGit params repo = do findWanted FilesInGit params repo = do files <- mapM (Git.inRepo repo) params return $ foldl (++) [] files -findWanted SingleString params _ = do +findWanted FilesMissing params repo = do + files <- liftIO $ filterM missing params + return $ files + where + missing f = do + e <- doesFileExist f + if (e) then return False else return True +findWanted Description params _ = do return $ [unwords params] 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] -> AnnexState -> IO ([Flag], [Annex ()]) +{- Parses command line and returns two lists of actions to be + - run in the Annex monad. The first actions configure it + - according to command line options, while the second actions + - handle subcommands. -} +parseCmd :: [String] -> AnnexState -> IO ([Annex ()], [Annex ()]) parseCmd argv state = do (flags, params) <- getopt case (length params) of @@ -100,7 +134,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 $ do +addCmd file = notInBackend file $ do s <- liftIO $ getSymbolicLinkStatus file if ((isSymbolicLink s) || (not $ isRegularFile s)) then return () @@ -125,9 +159,9 @@ addCmd file = inBackend file $ do {- Undo addCmd. -} unannexCmd :: FilePath -> Annex () -unannexCmd file = notinBackend file $ \(key, backend) -> do +unannexCmd file = inBackend file $ \(key, backend) -> do showStart "unannex" file - Annex.flagChange Force True -- force backend to always remove + Annex.flagChange "force" $ FlagBool True -- force backend to always remove Backend.removeKey backend key logStatus key ValueMissing g <- Annex.gitRepo @@ -145,7 +179,7 @@ unannexCmd file = notinBackend file $ \(key, backend) -> do {- Gets an annexed file from one of the backends. -} getCmd :: FilePath -> Annex () -getCmd file = notinBackend file $ \(key, backend) -> do +getCmd file = inBackend file $ \(key, backend) -> do inannex <- inAnnex key if (inannex) then return () @@ -167,7 +201,7 @@ getCmd file = notinBackend file $ \(key, backend) -> do {- 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 $ \(key, backend) -> do +dropCmd file = inBackend file $ \(key, backend) -> do inbackend <- Backend.hasKey key if (not inbackend) then return () -- no-op @@ -192,8 +226,8 @@ dropCmd file = notinBackend file $ \(key, backend) -> do else return () {- Fixes the symlink to an annexed file. -} -fixCmd :: String -> Annex () -fixCmd file = notinBackend file $ \(key, backend) -> do +fixCmd :: FilePath -> Annex () +fixCmd file = inBackend file $ \(key, backend) -> do link <- calcGitLink file key l <- liftIO $ readSymbolicLink file if (link == l) @@ -223,13 +257,36 @@ initCmd description = do liftIO $ Git.run g ["commit", "-m", "git annex init", log] liftIO $ putStrLn "description set" +{- Adds a file pointing at a manually-specified key -} +fromKeyCmd :: FilePath -> Annex () +fromKeyCmd file = do + keyname <- Annex.flagGet "key" + if (0 == length keyname) + then error "please specify the key with --key" + else return () + backends <- Backend.list + let key = genKey (backends !! 0) keyname + + inbackend <- Backend.hasKey key + if (not inbackend) + then error $ "key ("++keyname++") is not present in backend" + else return () + + link <- calcGitLink file key + showStart "fromkey" file + liftIO $ createDirectoryIfMissing True (parentDir file) + liftIO $ createSymbolicLink link file + g <- Annex.gitRepo + liftIO $ Git.run g ["add", file] + showEndOk + -- helpers -inBackend file a = do +notInBackend file a = do r <- Backend.lookupFile file case (r) of Just v -> return () Nothing -> a -notinBackend file a = do +inBackend file a = do r <- Backend.lookupFile file case (r) of Just v -> a v diff --git a/Core.hs b/Core.hs index 8dc4bff6f..4941dc26b 100644 --- a/Core.hs +++ b/Core.hs @@ -18,9 +18,8 @@ import qualified Annex import Utility {- Sets up a git repo for git-annex. -} -startup :: [Flag] -> Annex () -startup flags = do - mapM (\f -> Annex.flagChange f True) flags +startup :: Annex () +startup = do g <- Annex.gitRepo liftIO $ gitAttributes g prepUUID diff --git a/Makefile b/Makefile index d35e82ad5..5f8bb5012 100644 --- a/Makefile +++ b/Makefile @@ -20,7 +20,7 @@ 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 --plugin=sidebar \ - --underlaydir=/dev/null + --underlaydir=/dev/null --disable-plugin=shortcut clean: rm -rf build git-annex git-annex.1 diff --git a/Remotes.hs b/Remotes.hs index a0894f418..07aafe51b 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -36,7 +36,7 @@ withKey key = do -- mounted at their location). So unless it happens to find all -- remotes, try harder, loading the remotes' configs. remotes <- reposByUUID allremotes uuids - remotesread <- Annex.flagIsSet RemotesRead + remotesread <- Annex.flagIsSet "remotesread" if ((length allremotes /= length remotes) && not remotesread) then tryharder allremotes uuids else return remotes @@ -46,7 +46,7 @@ withKey key = do eitherremotes <- mapM tryGitConfigRead allremotes let allremotes' = map fromEither eitherremotes remotes' <- reposByUUID allremotes' uuids - Annex.flagChange RemotesRead True + Annex.flagChange "remotesread" $ FlagBool True return remotes' {- Cost Ordered list of remotes. -} diff --git a/TypeInternals.hs b/TypeInternals.hs index 4a9d2653e..6d1c72d2e 100644 --- a/TypeInternals.hs +++ b/TypeInternals.hs @@ -7,12 +7,15 @@ module TypeInternals where import Control.Monad.State (StateT) import Data.String.Utils +import qualified Data.Map as M import qualified GitRepo as Git -data Flag = - Force | -- command-line flags - RemotesRead -- indicates that remote repo configs have been read +-- command-line flags +type FlagName = String +data Flag = + FlagBool Bool | + FlagString String deriving (Eq, Read, Show) -- git-annex's runtime state type doesn't really belong here, @@ -21,7 +24,7 @@ data AnnexState = AnnexState { repo :: Git.Repo, backends :: [Backend], supportedBackends :: [Backend], - flags :: [Flag] + flags :: M.Map FlagName Flag } deriving (Show) -- git-annex's monad @@ -32,6 +35,10 @@ type KeyFrag = String type BackendName = String data Key = Key (BackendName, KeyFrag) deriving (Eq) +-- constructs a key in a backend +genKey :: Backend -> KeyFrag -> Key +genKey b f = Key (name b,f) + -- 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 @@ -48,10 +55,6 @@ instance Read Key where 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/Types.hs b/Types.hs index 2284d9267..50597962c 100644 --- a/Types.hs +++ b/Types.hs @@ -5,9 +5,10 @@ module Types ( AnnexState, Backend, Key, + genKey, backendName, - keyFrag, - Flag(..), + FlagName, + Flag(..) ) where import TypeInternals diff --git a/doc/bugs/using_url_backend.mdwn b/doc/bugs/using_url_backend.mdwn index a0d447c6e..1f3cd5628 100644 --- a/doc/bugs/using_url_backend.mdwn +++ b/doc/bugs/using_url_backend.mdwn @@ -7,3 +7,5 @@ For now, we have to manually make the symlink. Something like this: Note the escaping of slashes. A `git annex register ` command could do this.. + +[[done]] diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 09b245497..81c229c51 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -4,7 +4,7 @@ git-annex - manage files with git, without checking their contents in # SYNOPSIS -git annex subcommand [path ...] +git annex subcommand [params ...] # DESCRIPTION @@ -97,6 +97,16 @@ Many git-annex subcommands will stage changes for later `git commit` by you. 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. +* fromkey file + + This can be used to maually set up a file to link to a specified key + in the key-value backend. How you determine an existing key in the backend + varies. For the URL backend, the key is just a URL to the content. + + Example: + + git annex fromkey --backend=URL --key=http://www.archive.org/somefile somefile + # OPTIONS * --force @@ -104,6 +114,15 @@ Many git-annex subcommands will stage changes for later `git commit` by you. 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. +* --backend=name + + Specify the default key-value backend to use, adding it to the front + of the list normally configured by `annex.backends`. + +* --key=name + + Specifies a key to operate on, for use with the addkey subcommand. + ## CONFIGURATION Like other git commands, git-annex is configured via `.git/config`. diff --git a/doc/walkthrough.mdwn b/doc/walkthrough.mdwn index 0da11a8b3..7018a839e 100644 --- a/doc/walkthrough.mdwn +++ b/doc/walkthrough.mdwn @@ -1,3 +1,7 @@ +A walkthrough of the basic features of git-annex. + +[[!toc]] + ## creating a repository This is very straightforward. Just tell it a description of the repository. @@ -130,3 +134,30 @@ Here you might --force it to drop `important_file` if you trust your backup. But `other.iso` looks to have never been copied to anywhere else, so if it's something you want to hold onto, you'd need to transfer it to some other repository before dropping it. + +## using other backends: manually adding a remote URL + +git-annex has multiple key-value [[backends]]. So far this walkthrough has +demonstrated the default, WORM (Write Once, Read Many) backend. + +Another handy backend is the URL backend, which can fetch file's content +from remote URLs. Here's how to set up some files in your repository +that use this backend: + + # git annex fromkey --backend=URL --key=http://www.archive.org/somefile somefile + add somefile ok + # git commit -m "added a file from the Internet Archive" + +Now you if you ask git-annex to get that file, it will download it, +and cache it locally, until you have it drop it. + + # git annex get somefile + get somefile (downloading) + #########################################################################100.0% + ok + +You can always drop files downloaded by the URL backend. It is assumed +that the URL is stable; no local backup is kept. + + # git annex drop somefile + drop somefile (ok) diff --git a/git-annex.hs b/git-annex.hs index 71a21379d..602f672c5 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -15,8 +15,8 @@ main = do args <- getArgs gitrepo <- Git.repoFromCwd state <- Annex.new gitrepo allBackends - (flags, actions) <- parseCmd args state - tryRun state $ [startup flags] ++ actions ++ [shutdown] + (configure, actions) <- parseCmd args state + tryRun state $ [startup] ++ configure ++ actions ++ [shutdown] {- Runs a list of Annex actions. Catches IO errors and continues - (but explicitly thrown errors terminate the whole command). -- cgit v1.2.3