added direct and indirect commands

Annex/Content.hs

@@ -26,6 +26,8 @@ module Annex.Content (
 	freezeContent,
 	thawContent,
 	freezeContentDir,
+	createContentDir,
+	replaceFile,
 ) where
 
 import System.IO.Unsafe (unsafeInterleaveIO)

Command/Direct.hs

@@ -0,0 +1,67 @@
+{- git-annex command
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Direct where
+
+import Common.Annex
+import Command
+import qualified Git
+import qualified Git.Command
+import qualified Git.LsFiles
+import Config
+import Annex.Content
+import Annex.Content.Direct
+
+def :: [Command]
+def = [command "direct" paramNothing seek "switch repository to direct mode"]
+
+seek :: [CommandSeek]
+seek = [withNothing start]
+
+start :: CommandStart
+start = notBareRepo $
+	ifM isDirect
+		( stop , next perform )
+
+perform :: CommandPerform
+perform = do
+	showStart "commit" ""
+	showOutput
+	_ <- inRepo $ Git.Command.runBool "commit"
+		[Param "-a", Param "-m", Param "commit before switching to direct mode"]
+	top <- fromRepo Git.repoPath
+	(l, clean) <- inRepo $ Git.LsFiles.inRepo [top]
+	forM_ l go
+	void $ liftIO clean
+	next cleanup
+  where
+	{- Walk tree from top and move all present objects to the
+	 - files that link to them, while updating direct mode mappings. -}
+	go = whenAnnexed $ \f (k, _) -> do
+		loc <- inRepo $ gitAnnexLocation k
+		createContentDir loc -- thaws directory too
+		locs <- filter (/= f) <$> addAssociatedFile k f
+		case locs of
+			[] -> whenM (liftIO $ doesFileExist loc) $ do
+				{- Move content from annex to direct file. -}
+				showStart "direct" f
+				updateCache k loc
+				thawContent loc
+				liftIO $ replaceFile f $ moveFile loc
+				showEndOk
+			(loc':_) -> do
+				{- Another direct file has the content, so
+				 - hard link to it. -}
+				showStart "direct" f
+				liftIO $ replaceFile f $ createLink loc'
+				showEndOk
+		return Nothing
+
+cleanup :: CommandCleanup
+cleanup = do
+	setDirect True
+	return True

Command/Indirect.hs

@@ -0,0 +1,80 @@
+{- git-annex command
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Indirect where
+
+import Common.Annex
+import Command
+import qualified Git
+import qualified Git.Command
+import qualified Git.LsFiles
+import Config
+import Annex.Direct
+import Annex.Content
+import Annex.CatFile
+
+def :: [Command]
+def = [command "indirect" paramNothing seek "switch repository to indirect mode"]
+
+seek :: [CommandSeek]
+seek = [withNothing start]
+
+start :: CommandStart
+start = notBareRepo $
+	ifM isDirect
+		( next perform, stop )
+
+perform :: CommandPerform
+perform = do
+	showStart "commit" ""
+	whenM (stageDirect) $ do
+		showOutput
+		void $ inRepo $ Git.Command.runBool "commit"
+			[Param "-m", Param "commit before switching to indirect mode"]
+
+	-- Note that we set indirect mode early, so that we can use
+	-- moveAnnex in indirect mode.
+	setDirect False
+
+	top <- fromRepo Git.repoPath
+	(l, clean) <- inRepo $ Git.LsFiles.stagedDetails [top]
+	forM_ l go
+	void $ liftIO clean
+	next cleanup
+  where
+	{- Walk tree from top and move all present direct mode files into
+	 - the annex, replacing with symlinks. Also delete direct mode
+	 - caches and mappings. -}
+	go (_, Nothing) = noop
+	go (f, Just sha) = do
+		r <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus f
+		case r of
+			Just s
+				| isSymbolicLink s -> void $ flip whenAnnexed f $
+					\_ (k, _) -> do
+						cleandirect k
+						return Nothing
+				| otherwise -> 
+					maybe noop (fromdirect f)
+						=<< catKey sha
+			_ -> noop
+
+	fromdirect f k = do
+		showStart "indirect" f
+		cleandirect k -- clean before content directory gets frozen
+		whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do
+			moveAnnex k f
+			l <- calcGitLink f k
+			liftIO $ createSymbolicLink l f
+		showEndOk
+
+	cleandirect k = do
+		liftIO . nukeFile =<< inRepo (gitAnnexCache k)
+		liftIO . nukeFile =<< inRepo (gitAnnexMapping k)
+
+cleanup :: CommandCleanup
+cleanup = return True

Config.hs

@@ -121,6 +121,9 @@ isDirect :: Annex Bool
 isDirect = fromMaybe False . Git.Config.isTrue <$>
 	getConfig (annexConfig "direct") ""
 
+setDirect :: Bool -> Annex ()
+setDirect b = setConfig (annexConfig "direct") (if b then "true" else "false")
+
 {- Gets annex.httpheaders or annex.httpheaders-command setting,
  - splitting it into lines. -}
 getHttpHeaders :: Annex [String]

GitAnnex.hs

@@ -62,6 +62,8 @@ import qualified Command.Sync
 import qualified Command.AddUrl
 import qualified Command.Import
 import qualified Command.Map
+import qualified Command.Direct
+import qualified Command.Indirect
 import qualified Command.Upgrade
 import qualified Command.Version
 import qualified Command.Help
@@ -118,6 +120,8 @@ cmds = concat
 	, Command.Status.def
 	, Command.Migrate.def
 	, Command.Map.def
+	, Command.Direct.def
+	, Command.Indirect.def
 	, Command.Upgrade.def
 	, Command.Version.def
 	, Command.Help.def

debian/changelog

@@ -1,3 +1,13 @@
+git-annex (3.20121212) UNRELEASED; urgency=low
+
+  * direct, indirect: New commands, that switch a repository to and from
+    direct mode. In direct mode, files are accessed directly, rather than
+    via symlinks. Note that direct mode is currently experimental. Many
+    git and git-annex commands do not work, or can even cause data loss in
+    direct mode.
+
+ -- Joey Hess <joeyh@debian.org>  Thu, 13 Dec 2012 14:06:43 -0400
+
 git-annex (3.20121211) unstable; urgency=low
 
   * webapp: Defaults to sharing box.com account info with friends, allowing

doc/direct_mode.mdwn

@@ -8,15 +8,28 @@ including modifying them. The disadvantage is that most regular git
 commands cannot safely be used, and only a subset of git-annex commands
 can be used.
 
-## make a direct mode repository
+## enabling (and disabling) direct mode
 
-To make a repository using direct mode, either make a fresh clone of an
+Any repository can be converted to use direct mode at any time, and if you
-existing repository, or start a new repository. Then configure direct mode:
+decide not to use it, you can convert back to indirect mode just as easily.
-`git config annex.direct true`
+Also, you can have one clone of a repository using direct mode, and another
+using indirect mode; direct mode interoperates.
 
-You're strongly encouraged to tell git-annex that direct mode repositories
+To start using direct mode:
-cannot be trusted to retain the content of a file (because it can be
+
-deleted or modified at any time). To do so: `git annex untrust .`
+	git annex direct
+
+To stop using direct mode:
+
+	git annex indirect
+
+With direct mode, you're operating without large swathes of git-annex's
+carefully constructed safety net. So you're strongly encouraged to tell
+git-annex that your direct mode repository cannot be trusted to retain
+the content of a file (because any file can be deleted or modified at
+any time). To do so:
+
+	git annex untrust .
 
 ## use a direct mode repository
 
@@ -59,5 +72,4 @@ had of something, it'll be lost.
 
 This is one reason it's wise to make git-annex untrust your direct mode
 repositories. Still, you can lose data using these sort of git commands, so
-use extreme caution. With direct mode, you're operating without large
+use extreme caution. 
-swathes of git-annex's carefully constructed safety net.

doc/git-annex.mdwn

@@ -263,6 +263,21 @@ subdirectories).
   settings, and when it exits, stores any changes made back to the git-annex
   branch.
 
+* direct
+
+  Switches a repository to use direct mode, where rather than symlinks to
+  files, the files are directly present in the repository. Note that many git
+  and git-annex commands will not work in direct mode; you're mostly
+  limited to using "git annex sync" and "git annex get".
+
+  As part of the switch to direct mode, any changed files will be committed.
+
+* indirect
+
+  Switches a repository back from direct mode to the default, indirect mode.
+  
+  As part of the switch from direct mode, any changed files will be committed.
+
 # REPOSITORY MAINTENANCE COMMANDS
 
 * fsck [path ...]