From fdd455e913964200177530df085f2a7ad7c7f8b2 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 30 Mar 2011 14:56:31 -0400
Subject: use same directory structure as .git/annex/objects for directory
 remotes

And same file perms.
---
 Remote/Directory.hs | 36 +++++++++++++++++++++++++++++-------
 1 file changed, 29 insertions(+), 7 deletions(-)

(limited to 'Remote')

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 919dcc295..cc37e496e 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -1,4 +1,4 @@
-{- A "remote" that is just a local directory.
+{- A "remote" that is just a filesystem directory.
  -
  - Copyright 2011 Joey Hess <joey@kitenet.net>
  -
@@ -12,7 +12,7 @@ import Control.Exception.Extensible (IOException)
 import qualified Data.Map as M
 import Control.Monad (when)
 import Control.Monad.State (liftIO)
-import System.Directory (doesDirectoryExist, doesFileExist, removeFile)
+import System.Directory hiding (copyFile)
 import System.FilePath
 
 import RemoteClass
@@ -23,6 +23,8 @@ import UUID
 import Locations
 import CopyFile
 import Config
+import Content
+import Utility
 import Remote.Special
 
 remote :: RemoteType Annex
@@ -63,20 +65,40 @@ directorySetup u c = do
 	return $ M.delete "directory" c
 
 dirKey :: FilePath -> Key -> FilePath
-dirKey d k = d </> show k
+dirKey d k = d </> hashDir k </> f </> f
+	where
+		f = keyFile k
 
 store :: FilePath -> Key -> Annex Bool
 store d k = do
 	g <- Annex.gitRepo
-	liftIO $ copyFile (gitAnnexLocation g k) (dirKey d k)
+	let src = gitAnnexLocation g k
+	liftIO $ catch (copy src) (const $ return False)
+	where
+		dest = dirKey d k
+		dir = parentDir dest
+		copy src = do
+			createDirectoryIfMissing True dir
+			allowWrite dir
+			ok <- copyFile src dest
+			when ok $ do
+				preventWrite dest
+				preventWrite dir
+			return ok
 
 retrieve :: FilePath -> Key -> FilePath -> Annex Bool
 retrieve d k f = liftIO $ copyFile (dirKey d k) f
 
 remove :: FilePath -> Key -> Annex Bool
-remove d k = liftIO $ catch
-	(removeFile (dirKey d k) >> return True)
-	(const $ return False)
+remove d k = liftIO $ catch del (const $ return False)
+	where
+		file = dirKey d k
+		dir = parentDir file
+		del = do
+			allowWrite dir
+			removeFile file
+			removeDirectory dir
+			return True
 
 checkPresent :: FilePath -> Key -> Annex (Either IOException Bool)
 checkPresent d k = liftIO $ try $ doesFileExist (dirKey d k)
-- 
cgit v1.2.3