Merge branch 'master' into concurrentprogress

Conflicts:
	Command/Fsck.hs
	Messages.hs
	Remote/Directory.hs
	Remote/Git.hs
	Remote/Helper/Special.hs
	Types/Remote.hs
	debian/changelog
	git-annex.cabal

5 files changed, 172 insertions, 23 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 9d70ccee3..dc60dfe1a 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -280,17 +280,19 @@ withTmp key action = do
 {- Checks that there is disk space available to store a given key,
  - in a destination (or the annex) printing a warning if not. -}
 checkDiskSpace :: Maybe FilePath -> Key -> Integer -> Annex Bool
-checkDiskSpace destination key alreadythere = do
-	reserve <- annexDiskReserve <$> Annex.getGitConfig
-	free <- liftIO . getDiskFree =<< dir
-	force <- Annex.getState Annex.force
-	case (free, keySize key) of
-		(Just have, Just need) -> do
-			let ok = (need + reserve <= have + alreadythere) || force
-			unless ok $
-				needmorespace (need + reserve - have - alreadythere)
-			return ok
-		_ -> return True
+checkDiskSpace destination key alreadythere = ifM (Annex.getState Annex.force)
+	( return True
+	, do
+		reserve <- annexDiskReserve <$> Annex.getGitConfig
+		free <- liftIO . getDiskFree =<< dir
+		case (free, fromMaybe 1 (keySize key)) of
+			(Just have, need) -> do
+				let ok = (need + reserve <= have + alreadythere)
+				unless ok $
+					needmorespace (need + reserve - have - alreadythere)
+				return ok
+			_ -> return True
+	)
   where
 	dir = maybe (fromRepo gitAnnexDir) return destination
 	needmorespace n =
@@ -498,9 +500,9 @@ getKeysPresent keyloc = do
 	direct <- isDirect
 	dir <- fromRepo gitAnnexObjectDir
 	s <- getstate direct
-	liftIO $ traverse s direct (2 :: Int) dir
+	liftIO $ walk s direct (2 :: Int) dir
   where
-	traverse s direct depth dir = do
+	walk s direct depth dir = do
 		contents <- catchDefaultIO [] (dirContents dir)
 		if depth == 0
 			then do
@@ -508,7 +510,7 @@ getKeysPresent keyloc = do
 				let keys = mapMaybe (fileKey . takeFileName) contents'
 				continue keys []
 			else do
-				let deeper = traverse s direct (depth - 1)
+				let deeper = walk s direct (depth - 1)
 				continue [] (map deeper contents)
 	continue keys [] = return keys
 	continue keys (a:as) = do
diff --git a/Annex/Drop.hs b/Annex/Drop.hs
index 0ea815db2..973e51348 100644
--- a/Annex/Drop.hs
+++ b/Annex/Drop.hs
@@ -9,7 +9,7 @@ module Annex.Drop where
 
 import Common.Annex
 import Logs.Trust
-import Config.NumCopies
+import Annex.NumCopies
 import Types.Remote (uuid)
 import Types.Key (key2file)
 import qualified Remote
diff --git a/Annex/Init.hs b/Annex/Init.hs
index 50f4d8522..2cc1c1897 100644
--- a/Annex/Init.hs
+++ b/Annex/Init.hs
@@ -57,15 +57,15 @@ genDescription Nothing = do
 
 initialize :: Maybe String -> Annex ()
 initialize mdescription = do
+	{- This will make the first commit to git, so ensure git is set up
+	 - properly to allow commits when running it. -}
+	ensureCommit $ Annex.Branch.create
+
 	prepUUID
 	initialize'
 
 	u <- getUUID
-	{- This will make the first commit to git, so ensure git is set up
-	 - properly to allow commits when running it. -}
-	ensureCommit $ do
-		Annex.Branch.create
-		describeUUID u =<< genDescription mdescription
+	describeUUID u =<< genDescription mdescription
 
 -- Everything except for uuid setup.
 initialize' :: Annex ()
diff --git a/Annex/NumCopies.hs b/Annex/NumCopies.hs
new file mode 100644
index 000000000..879513927
--- /dev/null
+++ b/Annex/NumCopies.hs
@@ -0,0 +1,147 @@
+{- git-annex numcopies configuration and checking
+ -
+ - Copyright 2014-2015 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.NumCopies (
+	module Types.NumCopies,
+	module Logs.NumCopies,
+	getFileNumCopies,
+	getGlobalFileNumCopies,
+	getNumCopies,
+	deprecatedNumCopies,
+	defaultNumCopies,
+	numCopiesCheck,
+	numCopiesCheck',
+	verifyEnoughCopies,
+	knownCopies,
+) where
+
+import Common.Annex
+import qualified Annex
+import Types.NumCopies
+import Logs.NumCopies
+import Logs.Trust
+import Annex.CheckAttr
+import qualified Remote
+import Annex.UUID
+import Annex.Content
+
+defaultNumCopies :: NumCopies
+defaultNumCopies = NumCopies 1
+
+fromSources :: [Annex (Maybe NumCopies)] -> Annex NumCopies
+fromSources = fromMaybe defaultNumCopies <$$> getM id
+
+{- The git config annex.numcopies is deprecated. -}
+deprecatedNumCopies :: Annex (Maybe NumCopies)
+deprecatedNumCopies = annexNumCopies <$> Annex.getGitConfig
+
+{- Value forced on the command line by --numcopies. -}
+getForcedNumCopies :: Annex (Maybe NumCopies)
+getForcedNumCopies = Annex.getState Annex.forcenumcopies
+
+{- Numcopies value from any of the non-.gitattributes configuration
+ - sources. -}
+getNumCopies :: Annex NumCopies
+getNumCopies = fromSources
+	[ getForcedNumCopies
+	, getGlobalNumCopies
+	, deprecatedNumCopies
+	]
+
+{- Numcopies value for a file, from any configuration source, including the
+ - deprecated git config. -}
+getFileNumCopies :: FilePath -> Annex NumCopies
+getFileNumCopies f = fromSources
+	[ getForcedNumCopies
+	, getFileNumCopies' f
+	, deprecatedNumCopies
+	]
+
+{- This is the globally visible numcopies value for a file. So it does
+ - not include local configuration in the git config or command line
+ - options. -}
+getGlobalFileNumCopies :: FilePath  -> Annex NumCopies
+getGlobalFileNumCopies f = fromSources
+	[ getFileNumCopies' f
+	]
+
+getFileNumCopies' :: FilePath  -> Annex (Maybe NumCopies)
+getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr
+  where
+	getattr = (NumCopies <$$> readish)
+		<$> checkAttr "annex.numcopies" file
+
+{- Checks if numcopies are satisfied for a file by running a comparison
+ - between the number of (not untrusted) copies that are
+ - belived to exist, and the configured value. -}
+numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v
+numCopiesCheck file key vs = do
+	have <- trustExclude UnTrusted =<< Remote.keyLocations key
+	numCopiesCheck' file vs have
+
+numCopiesCheck' :: FilePath -> (Int -> Int -> v) -> [UUID] -> Annex v
+numCopiesCheck' file vs have = do
+	NumCopies needed <- getFileNumCopies file
+	return $ length have `vs` needed
+
+{- Verifies that enough copies of a key exist amoung the listed remotes,
+ - priting an informative message if not.
+ -}
+verifyEnoughCopies 
+	:: String -- message to print when there are no known locations
+	-> Key
+	-> NumCopies
+	-> [UUID] -- repos to skip (generally untrusted remotes)
+	-> [UUID] -- repos that are trusted or already verified to have it
+	-> [Remote] -- remotes to check to see if they have it
+	-> Annex Bool
+verifyEnoughCopies nolocmsg key need skip trusted tocheck = 
+	helper [] [] (nub trusted) (nub tocheck)
+  where
+	helper bad missing have []
+		| NumCopies (length have) >= need = return True
+		| otherwise = do
+			notEnoughCopies key need have (skip++missing) bad nolocmsg
+			return False
+	helper bad missing have (r:rs)
+		| NumCopies (length have) >= need = return True
+		| otherwise = do
+			let u = Remote.uuid r
+			let duplicate = u `elem` have
+			haskey <- Remote.hasKey r key
+			case (duplicate, haskey) of
+				(False, Right True)  -> helper bad missing (u:have) rs
+				(False, Left _)      -> helper (r:bad) missing have rs
+				(False, Right False) -> helper bad (u:missing) have rs
+				_                    -> helper bad missing have rs
+
+notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> String -> Annex ()
+notEnoughCopies key need have skip bad nolocmsg = do
+	showNote "unsafe"
+	showLongNote $
+		"Could only verify the existence of " ++
+		show (length have) ++ " out of " ++ show (fromNumCopies need) ++ 
+		" necessary copies"
+	Remote.showTriedRemotes bad
+	Remote.showLocations True key (have++skip) nolocmsg
+
+{- Cost ordered lists of remotes that the location log indicates
+ - may have a key.
+ -
+ - Also returns a list of UUIDs that are trusted to have the key
+ - (some may not have configured remotes). If the current repository
+ - currently has the key, and is not untrusted, it is included in this list.
+ -}
+knownCopies :: Key -> Annex ([Remote], [UUID])
+knownCopies key = do
+	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
+	u <- getUUID
+	trusteduuids' <- ifM (inAnnex key <&&> (<= SemiTrusted) <$> lookupTrust u)
+		( pure (u:trusteduuids)
+		, pure trusteduuids
+		)
+	return (remotes, trusteduuids')
diff --git a/Annex/Perms.hs b/Annex/Perms.hs
index 3ae351d8c..06971173f 100644
--- a/Annex/Perms.hs
+++ b/Annex/Perms.hs
@@ -69,14 +69,14 @@ annexFileMode = withShared $ return . go
 {- Creates a directory inside the gitAnnexDir, including any parent
  - directories. Makes directories with appropriate permissions. -}
 createAnnexDirectory :: FilePath -> Annex ()
-createAnnexDirectory dir = traverse dir [] =<< top
+createAnnexDirectory dir = walk dir [] =<< top
   where
 	top = parentDir <$> fromRepo gitAnnexDir
-	traverse d below stop
+	walk d below stop
 		| d `equalFilePath` stop = done
 		| otherwise = ifM (liftIO $ doesDirectoryExist d)
 			( done
-			, traverse (parentDir d) (d:below) stop
+			, walk (parentDir d) (d:below) stop
 			)
 	  where
 		done = forM_ below $ \p -> do