diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-25 20:19:08 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-25 20:19:08 -0400 |
commit | fec9f611df1a5e973f4847ac71fe85bd85abdff4 (patch) | |
tree | 6e07ded9b85a030c3e6166688b2f968d6985167f | |
parent | a0e8ba37c69a7ce69a6bca42b4e4a20d046b3566 (diff) |
add setkey subcommand
And finished implementing move --to
-rw-r--r-- | Commands.hs | 65 | ||||
-rw-r--r-- | Core.hs | 4 | ||||
-rw-r--r-- | Remotes.hs | 30 | ||||
-rw-r--r-- | debian/changelog | 2 | ||||
-rw-r--r-- | doc/git-annex.mdwn | 11 |
5 files changed, 75 insertions, 37 deletions
diff --git a/Commands.hs b/Commands.hs index d201b6f79..3c6408391 100644 --- a/Commands.hs +++ b/Commands.hs @@ -68,7 +68,7 @@ doSubCmd cmdname start param = do {- A subcommand can broadly want one of several kinds of input parameters. - This allows a first stage of filtering before starting a subcommand. -} data SubCmdWants = FilesInGit | FilesNotInGit | FilesMissing - | Description | Keys + | Description | Keys | Tempfile data SubCommand = Command { subcmdname :: String, @@ -95,7 +95,9 @@ subCmds = [ , (Command "fromkey" fromKeyStart FilesMissing "adds a file using a specific key") , (Command "dropkey" dropKeyStart Keys - "drops cached content for specified keys") + "drops annexed content for specified keys") + , (Command "setkey" setKeyStart Tempfile + "sets annexed content for a key using a temp file") ] -- Each dashed command-line option results in generation of an action @@ -159,7 +161,7 @@ findWanted FilesMissing params repo = do if (e) then return False else return True findWanted Description params _ = do return $ [unwords params] -findWanted Keys params _ = return params +findWanted _ params _ = return params {- Parses command line and returns two lists of actions to be - run in the Annex monad. The first actions configure it @@ -302,6 +304,29 @@ dropKeyCleanup key = do logStatus key ValueMissing return True +{- Sets cached content for a key. -} +setKeyStart :: FilePath -> Annex (Maybe SubCmdPerform) +setKeyStart tmpfile = do + keyname <- Annex.flagGet "key" + if (null keyname) + then error "please specify the key with --key" + else return () + backends <- Backend.list + let key = genKey (backends !! 0) keyname + return $ Just $ setKeyPerform tmpfile key +setKeyPerform :: FilePath -> Key -> Annex (Maybe SubCmdCleanup) +setKeyPerform tmpfile key = do + g <- Annex.gitRepo + let loc = annexLocation g key + ok <- liftIO $ boolSystem "mv" [tmpfile, loc] + if (not ok) + then error "mv failed!" + else return $ Just $ setKeyCleanup tmpfile key +setKeyCleanup :: FilePath -> Key -> Annex Bool +setKeyCleanup tmpfile key = do + logStatus key ValuePresent + return True + {- Fixes the symlink to an annexed file. -} fixStart :: FilePath -> Annex (Maybe SubCmdPerform) fixStart file = isAnnexed file $ \(key, backend) -> do @@ -411,24 +436,26 @@ moveToPerform file key = do showNote $ show err return Nothing Right False -> do - ok <- Remotes.copyToRemote remote key + let tmpfile = (annexTmpLocation remote) ++ (keyFile key) + ok <- Remotes.copyToRemote remote key tmpfile if (ok) - then return $ Just $ moveToCleanup remote key + then return $ Just $ moveToCleanup remote key tmpfile else return Nothing -- failed - Right True -> return $ Just $ moveToCleanup remote key -moveToCleanup :: Git.Repo -> Key -> Annex Bool -moveToCleanup remote key = do - -- cleanup on the local side is the same as done for the drop subcommand - ok <- dropCleanup key - if (not ok) - then return False - else do - -- Record that the key is present on the remote. - u <- getUUID remote - liftIO $ logChange remote key u ValuePresent - -- Propigate location log to remote. - error "TODO: update remote locationlog" - return True + Right True -> return $ Just $ dropCleanup key +moveToCleanup :: Git.Repo -> Key -> FilePath -> Annex Bool +moveToCleanup remote key tmpfile = do + -- Tell remote to use the transferred content. + Remotes.runCmd remote "git-annex" ["setkey", "--quiet", + "--backend=" ++ (backendName key), + "--key=" ++ keyName key, + tmpfile] + -- Record that the key is present on the remote. + g <- Annex.gitRepo + remoteuuid <- getUUID remote + liftIO $ logChange g key remoteuuid ValuePresent + -- Cleanup on the local side is the same as done for the + -- drop subcommand. + dropCleanup key {- Moves the content of an annexed file from another repository to the current - repository and updates locationlog information on both. @@ -32,12 +32,14 @@ shutdown = do liftIO $ Git.run g ["add", gitStateDir g] - -- clean up any files left in the temp directory + -- clean up any files left in the temp directory, but leave + -- the tmp directory itself let tmp = annexTmpLocation g exists <- liftIO $ doesDirectoryExist tmp if (exists) then liftIO $ removeDirectoryRecursive $ tmp else return () + liftIO $ createDirectoryIfMissing True tmp return True diff --git a/Remotes.hs b/Remotes.hs index 985199e1c..1d5992704 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -195,31 +195,31 @@ copyFromRemote r key file = do then getssh else error "copying from non-ssh repo not supported" where - getlocal = liftIO $ boolSystem "cp" ["-a", location, file] + getlocal = liftIO $ boolSystem "cp" ["-a", keyloc, file] getssh = do liftIO $ putStrLn "" -- make way for scp progress bar - liftIO $ boolSystem "scp" [sshlocation, file] - location = annexLocation r key - sshlocation = (Git.urlHost r) ++ ":" ++ location + liftIO $ boolSystem "scp" [sshLocation r keyloc, file] + keyloc = annexLocation r key -{- Tries to copy a key's content to a remote. -} -copyToRemote :: Git.Repo -> Key -> Annex Bool -copyToRemote r key = do +{- Tries to copy a key's content to a file on a remote. -} +copyToRemote :: Git.Repo -> Key -> FilePath -> Annex Bool +copyToRemote r key file = do g <- Annex.gitRepo + let keyloc = annexLocation g key Core.showNote $ "copying to " ++ (Git.repoDescribe r) ++ "..." if (not $ Git.repoIsUrl r) - then sendlocal g + then putlocal keyloc else if (Git.repoIsSsh r) - then sendssh g + then putssh keyloc else error "copying to non-ssh repo not supported" where - sendlocal g = liftIO $ boolSystem "cp" ["-a", location g, file] - sendssh g = do + putlocal src = liftIO $ boolSystem "cp" ["-a", src, file] + putssh src = do liftIO $ putStrLn "" -- make way for scp progress bar - liftIO $ boolSystem "scp" [location g, sshlocation] - location g = annexLocation g key - sshlocation = (Git.urlHost r) ++ ":" ++ file - file = error "TODO" + liftIO $ boolSystem "scp" [src, sshLocation r file] + +sshLocation :: Git.Repo -> FilePath -> FilePath +sshLocation r file = (Git.urlHost r) ++ ":" ++ file {- Runs a command in a remote. -} runCmd :: Git.Repo -> String -> [String] -> Annex Bool diff --git a/debian/changelog b/debian/changelog index 292931d0f..46ad2ac5d 100644 --- a/debian/changelog +++ b/debian/changelog @@ -9,7 +9,7 @@ git-annex (0.02) UNRELEASED; urgency=low * --from/--to can be used to control the remote repository that git-annex uses. * --quiet can be used to avoid verbose output - * New plumbing-level dropkey subcommand. + * New plumbing-level dropkey and setkey subcommands. -- Joey Hess <joeyh@debian.org> Thu, 21 Oct 2010 16:38:00 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index e7057afee..cba634f20 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -118,11 +118,20 @@ Many git-annex subcommands will stage changes for later `git commit` by you. * dropkey [key ...] - Drops the cached data for the specified keys from this repository. + Drops the annexed data for the specified keys from this repository. This can be used to drop content for arbitrary keys, which do not need to have a file in the git repository pointing at them. +* setkey file + + Sets the annxed data for a key to the content of the specified file, + and then removes the file. + + Example: + + git annex setkey --key=1287765018:3 /tmp/file + # OPTIONS * --force |