add setkey subcommand

And finished implementing move --to

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
+		Right True -> return $ Just $ dropCleanup key
-moveToCleanup :: Git.Repo -> Key -> Annex Bool
+moveToCleanup :: Git.Repo -> Key -> FilePath -> Annex Bool
-moveToCleanup remote key = do
+moveToCleanup remote key tmpfile = do
-	-- cleanup on the local side is the same as done for the drop subcommand
+	-- Tell remote to use the transferred content.
-	ok <- dropCleanup key
+	Remotes.runCmd remote "git-annex" ["setkey", "--quiet",
-	if (not ok)
+		"--backend=" ++ (backendName key),
-		then return False
+		"--key=" ++ keyName key,
-		else do
+		tmpfile]
 	-- Record that the key is present on the remote.
-			u <- getUUID remote
+	g <- Annex.gitRepo
-			liftIO $ logChange remote key u ValuePresent
+	remoteuuid <- getUUID remote
-			-- Propigate location log to remote.
+	liftIO $ logChange g key remoteuuid ValuePresent
-			error "TODO: update remote locationlog"
+	-- Cleanup on the local side is the same as done for the
-			return True
+	-- drop subcommand.
+	dropCleanup key
 
 {- Moves the content of an annexed file from another repository to the current
  - repository and updates locationlog information on both.

Core.hs

@@ -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
 

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]
+			liftIO $ boolSystem "scp" [sshLocation r keyloc, file]
-		location = annexLocation r key
+		keyloc = annexLocation r key
-		sshlocation = (Git.urlHost r) ++ ":" ++ location
 
-{- Tries to copy a key's content to a remote. -}
+{- Tries to copy a key's content to a file on a remote. -}
-copyToRemote :: Git.Repo -> Key -> Annex Bool
+copyToRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
-copyToRemote r key = do
+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]
+		putlocal src = liftIO $ boolSystem "cp" ["-a", src, file]
-		sendssh g = do
+		putssh src = do
 			liftIO $ putStrLn "" -- make way for scp progress bar
-			liftIO $ boolSystem "scp" [location g, sshlocation]
+			liftIO $ boolSystem "scp" [src, sshLocation r file]
-		location g = annexLocation g key
+
-		sshlocation = (Git.urlHost r) ++ ":" ++ file
+sshLocation :: Git.Repo -> FilePath -> FilePath
-		file = error "TODO"
+sshLocation r file = (Git.urlHost r) ++ ":" ++ file
 
 {- Runs a command in a remote. -}
 runCmd :: Git.Repo -> String -> [String] -> Annex Bool

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
 

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