add Remote.Directory

.gitignore

@@ -13,3 +13,4 @@ html
 .hpc
 Touch.hs
 StatFS.hs
+Remote/S3.hs

Remote.hs

@@ -46,11 +46,13 @@ import Config
 
 import qualified Remote.Git
 import qualified Remote.S3
+import qualified Remote.Directory
 
 remoteTypes :: [RemoteType Annex]
 remoteTypes =
 	[ Remote.Git.remote
 	, Remote.S3.remote
+	, Remote.Directory.remote
 	]
 
 {- Builds a list of all available Remotes.

Remote/Directory.hs

@@ -0,0 +1,110 @@
+{- A "remote" that is just a local directory.
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Remote.Directory (remote) where
+
+import IO
+import Control.Exception.Extensible (IOException)
+import qualified Data.Map as M
+import Data.Maybe
+import Data.String.Utils
+import Control.Monad (when)
+import Control.Monad.State (liftIO)
+import System.Directory (doesDirectoryExist, doesFileExist, removeFile)
+import System.FilePath
+
+import RemoteClass
+import Types
+import qualified GitRepo as Git
+import qualified Annex
+import UUID
+import Config
+import Utility
+import Locations
+import CopyFile
+
+remote :: RemoteType Annex
+remote = RemoteType {
+	typename = "directory",
+	enumerate = list,
+	generate = gen,
+	setup = dosetup
+}
+
+list :: Annex [Git.Repo]
+list = do
+	g <- Annex.gitRepo
+	return $ findDirectoryRemotes g
+
+findDirectoryRemotes :: Git.Repo -> [Git.Repo]
+findDirectoryRemotes r = map construct remotepairs
+	where
+		remotepairs = M.toList $ filterremotes $ Git.configMap r
+		filterremotes = M.filterWithKey (\k _ -> directoryremote k)
+		construct (k,_) = Git.repoRemoteNameSet Git.repoFromUnknown k
+		directoryremote k = startswith "remote." k && endswith ".annex-directory" k
+
+gen :: Git.Repo -> Maybe (M.Map String String) -> Annex (Remote Annex)
+gen r c = do
+	u <- getUUID r
+	cst <- remoteCost r
+	return $ genRemote r u c cst
+	where
+
+genRemote :: Git.Repo -> UUID -> Maybe (M.Map String String) -> Int -> Remote Annex
+genRemote r u c cst = this
+	where
+		this = Remote {
+			uuid = u,
+			cost = cst,
+			name = Git.repoDescribe r,
+	 		storeKey = store this,
+			retrieveKeyFile = retrieve this,
+			removeKey = remove this,
+			hasKey = checkPresent this,
+			hasKeyCheap = True,
+			config = c
+		}
+
+dosetup :: UUID -> M.Map String String -> Annex (M.Map String String)
+dosetup u c = do
+	-- verify configuration is sane
+	let dir = case M.lookup "directory" c of
+		Nothing -> error "Specify directory="
+		Just d -> d
+	e <- liftIO $ doesDirectoryExist dir
+	when (not e) $ error $ "Directory does not exist: " ++ dir
+
+	g <- Annex.gitRepo
+	liftIO $ do
+		Git.run g "config" [Param (configsetting "annex-directory"), Param "true"]
+		Git.run g "config" [Param (configsetting "annex-uuid"), Param u]
+	return c
+	where
+		remotename = fromJust (M.lookup "name" c)
+		configsetting s = "remote." ++ remotename ++ "." ++ s
+
+dirKey :: Remote Annex -> Key -> FilePath
+dirKey r k = dir </> show k
+	where
+		dir = fromJust $ M.lookup "directory" $ fromJust $ config r
+
+store :: Remote Annex -> Key -> Annex Bool
+store r k = do
+	g <- Annex.gitRepo
+	liftIO $ copyFile (gitAnnexLocation g k) (dirKey r k)
+
+retrieve :: Remote Annex -> Key -> FilePath -> Annex Bool
+retrieve r k f = liftIO $ copyFile (dirKey r k) f
+
+remove :: Remote Annex -> Key -> Annex Bool
+remove r k = liftIO $ catch
+	(removeFile (dirKey r k) >> return True)
+	(const $ return False)
+
+checkPresent :: Remote Annex -> Key -> Annex (Either IOException Bool)
+checkPresent r k = liftIO $ try $ doesFileExist (dirKey r k)

debian/changelog

@@ -6,6 +6,8 @@ git-annex (0.20110329) UNRELEASED; urgency=low
     as hS3 is not packaged.
   * fsck: Ensure that files and directories in .git/annex/objects
     have proper permissions.
+  * Added a special type of remote called a directory remote, which
+    simply stores files in an arbitrary local directory.
 
  -- Joey Hess <joeyh@debian.org>  Sat, 26 Mar 2011 14:36:16 -0400
 

doc/special_remotes.mdwn

@@ -7,3 +7,4 @@ types of remotes. These can be used just like any normal remote by git-annex.
 They cannot be used by other git commands though.
 
 * [[Amazon_S3]]
+* [[directory]]

doc/special_remotes/directory.mdwn

@@ -0,0 +1,10 @@
+This special remote type stores file contents in directory on the system.
+
+One use case for this would be if you have a removable drive, that you
+cannot put a git repository on for some reason, and you want to use it
+to sneakernet files between systems. Just set up both systems to use
+the drive's mountpoint as a directory remote.
+
+Setup example:
+
+	# git annex initremote usbdrive directory=/media/usbdrive/