Merge branch 'master' into watch

Command/AddUnused.hs

@@ -0,0 +1,34 @@
+{- git-annex command
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.AddUnused where
+
+import Common.Annex
+import Logs.Unused
+import Command
+import qualified Command.Add
+
+def :: [Command]
+def = [command "addunused" (paramRepeating paramNumRange)
+	seek "add back unused files"]
+
+seek :: [CommandSeek]
+seek = [withUnusedMaps start]
+
+start :: UnusedMaps -> Int -> CommandStart
+start = startUnused "addunused" perform (performOther "bad") (performOther "tmp")
+
+perform :: Key -> CommandPerform
+perform key = next $ Command.Add.cleanup file key True
+	where
+		file = "unused." ++ show key
+
+{- The content is not in the annex, but in another directory, and
+ - it seems better to error out, rather than moving bad/tmp content into
+ - the annex. -}
+performOther :: String -> Key -> CommandPerform
+performOther other _ = error $ "cannot addunused " ++ other ++ "content"

Command/AddUrl.hs

@@ -20,6 +20,7 @@ import Annex.Content
 import Logs.Web
 import qualified Option
 import Types.Key
+import Config
 
 def :: [Command]
 def = [withOptions [fileOption, pathdepthOption] $
@@ -53,8 +54,9 @@ perform url file = ifAnnexed file addurl geturl
 			liftIO $ createDirectoryIfMissing True (parentDir file)
 			ifM (Annex.getState Annex.fast)
 				( nodownload url file , download url file )
-		addurl (key, _backend) =
-			ifM (liftIO $ Url.check url $ keySize key)
+		addurl (key, _backend) = do
+			headers <- getHttpHeaders
+			ifM (liftIO $ Url.check url headers $ keySize key)
 				( do
 					setUrlPresent key url
 					next $ return True
@@ -81,7 +83,8 @@ download url file = do
 
 nodownload :: String -> FilePath -> CommandPerform
 nodownload url file = do
-	(exists, size) <- liftIO $ Url.exists url
+	headers <- getHttpHeaders
+	(exists, size) <- liftIO $ Url.exists url headers
 	if exists
 		then do
 			let key = Backend.URL.fromUrl url size

Command/DropUnused.hs

@@ -1,14 +1,13 @@
 {- git-annex command
  -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010,2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 module Command.DropUnused where
 
-import qualified Data.Map as M
-
+import Logs.Unused
 import Common.Annex
 import Command
 import qualified Annex
@@ -16,40 +15,17 @@ import qualified Command.Drop
 import qualified Remote
 import qualified Git
 import qualified Option
-import Types.Key
-
-type UnusedMap = M.Map String Key
 
 def :: [Command]
 def = [withOptions [Command.Drop.fromOption] $
-	command "dropunused" (paramRepeating paramNumber)
+	command "dropunused" (paramRepeating paramNumRange)
 		seek "drop unused file content"]
 
 seek :: [CommandSeek]
-seek = [withUnusedMaps]
+seek = [withUnusedMaps start]
 
-{- Read unused logs once, and pass the maps to each start action. -}
-withUnusedMaps :: CommandSeek
-withUnusedMaps params = do
-	unused <- readUnusedLog ""
-	unusedbad <- readUnusedLog "bad"
-	unusedtmp <- readUnusedLog "tmp"
-	return $ map (start (unused, unusedbad, unusedtmp)) params
-
-start :: (UnusedMap, UnusedMap, UnusedMap) -> FilePath -> CommandStart
-start (unused, unusedbad, unusedtmp) s = search
-	[ (unused, perform)
-	, (unusedbad, performOther gitAnnexBadLocation)
-	, (unusedtmp, performOther gitAnnexTmpLocation)
-	]
-	where
-		search [] = stop
-		search ((m, a):rest) =
-			case M.lookup s m of
-				Nothing -> search rest
-				Just key -> do
-					showStart "dropunused" s
-					next $ a key
+start :: UnusedMaps -> Int -> CommandStart
+start = startUnused "dropunused" perform (performOther gitAnnexBadLocation) (performOther gitAnnexTmpLocation)
 
 perform :: Key -> CommandPerform
 perform key = maybe droplocal dropremote =<< Remote.byName =<< from
@@ -66,15 +42,3 @@ performOther filespec key = do
 	f <- fromRepo $ filespec key
 	liftIO $ whenM (doesFileExist f) $ removeFile f
 	next $ return True
-
-readUnusedLog :: FilePath -> Annex UnusedMap
-readUnusedLog prefix = do
-	f <- fromRepo $ gitAnnexUnusedLog prefix
-	e <- liftIO $ doesFileExist f
-	if e
-		then M.fromList . map parse . lines <$> liftIO (readFile f)
-		else return M.empty
-	where
-		parse line = (num, fromJust $ readKey rest)
-			where
-				(num, rest) = separate (== ' ') line

Command/Fsck.hs

@@ -85,7 +85,7 @@ performRemote key file backend numcopies remote =
 			t <- fromRepo gitAnnexTmpDir
 			let tmp = t </> "fsck" ++ show pid ++ "." ++ keyFile key
 			liftIO $ createDirectoryIfMissing True t
-			let cleanup = liftIO $ catchIO (removeFile tmp) (const $ return ())
+			let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
 			cleanup
 			cleanup `after` a tmp
 		getfile tmp =
@@ -166,10 +166,9 @@ verifyLocationLog key desc = do
 	-- Since we're checking that a key's file is present, throw
 	-- in a permission fixup here too.
 	when present $ do
-		f <- inRepo $ gitAnnexLocation key
-		liftIO $ do
-			preventWrite f
-			preventWrite (parentDir f)
+		file <- inRepo $ gitAnnexLocation key
+		freezeContent file
+		freezeContentDir file
 
 	u <- getUUID
 	verifyLocationLog' key desc present u (logChange key u)

Command/Import.hs

@@ -0,0 +1,39 @@
+{- git-annex command
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Import where
+
+import Common.Annex
+import Command
+import qualified Annex
+import qualified Command.Add
+
+def :: [Command]
+def = [command "import" paramPaths seek "move and add files from outside git working copy"]
+
+seek :: [CommandSeek]
+seek = [withPathContents start]
+
+start :: (FilePath, FilePath) -> CommandStart
+start (srcfile, destfile) = notBareRepo $
+	ifM (liftIO $ isRegularFile <$> getSymbolicLinkStatus srcfile)
+		( do
+			showStart "import" destfile
+			next $ perform srcfile destfile
+		, stop
+		)
+
+perform :: FilePath -> FilePath -> CommandPerform
+perform srcfile destfile = do
+	whenM (liftIO $ doesFileExist destfile) $
+		unlessM (Annex.getState Annex.force) $
+			error $ "not overwriting existing " ++ destfile ++
+				" (use --force to override)"
+ 
+	liftIO $ createDirectoryIfMissing True (parentDir destfile)
+	liftIO $ moveFile srcfile destfile
+	Command.Add.perform destfile

Command/Lock.hs

@@ -24,9 +24,5 @@ start file = do
 
 perform :: FilePath -> CommandPerform
 perform file = do
-	liftIO $ removeFile file
-	-- Checkout from HEAD to get rid of any changes that might be 
-	-- staged in the index, and get back to the previous symlink to
-	-- the content.
-	Annex.Queue.add "checkout" [Param "HEAD", Param "--"] [file]
+	Annex.Queue.add "checkout" [Param "--"] [file]
 	next $ return True -- no cleanup needed

Command/Log.hs

@@ -133,7 +133,7 @@ compareChanges format changes = concatMap diff $ zip changes (drop 1 changes)
  - *lot* for newish files. -}
 getLog :: Key -> [CommandParam] -> Annex [String]
 getLog key os = do
-	top <- fromRepo Git.workTree
+	top <- fromRepo Git.repoPath
 	p <- liftIO $ relPathCwdToFile top
 	let logfile = p </> Logs.Location.logFile key
 	inRepo $ pipeNullSplit $

Command/Map.hs

@@ -156,14 +156,14 @@ absRepo :: Git.Repo -> Git.Repo -> Annex Git.Repo
 absRepo reference r
 	| Git.repoIsUrl reference = return $ Git.Construct.localToUrl reference r
 	| Git.repoIsUrl r = return r
-	| otherwise = liftIO $ Git.Construct.fromAbsPath =<< absPath (Git.workTree r)
+	| otherwise = liftIO $ Git.Construct.fromAbsPath =<< absPath (Git.repoPath r)
 
 {- Checks if two repos are the same. -}
 same :: Git.Repo -> Git.Repo -> Bool
 same a b
-	| both Git.repoIsSsh = matching Git.Url.authority && matching Git.workTree
+	| both Git.repoIsSsh = matching Git.Url.authority && matching Git.repoPath
 	| both Git.repoIsUrl && neither Git.repoIsSsh = matching show
-	| neither Git.repoIsSsh = matching Git.workTree
+	| neither Git.repoIsSsh = matching Git.repoPath
 	| otherwise = False
 		
 	where
@@ -210,7 +210,7 @@ tryScan r
 			where
 				sshcmd = cddir ++ " && " ++
 					"git config --null --list"
-				dir = Git.workTree r
+				dir = Git.repoPath r
 				cddir
 					| "/~" `isPrefixOf` dir =
 						let (userhome, reldir) = span (/= '/') (drop 1 dir)

Command/Status.hs

@@ -30,6 +30,7 @@ import Logs.UUID
 import Logs.Trust
 import Remote
 import Config
+import Utility.Percentage
 
 -- a named computation that produces a statistic
 type Stat = StatState (Maybe (String, StatState String))
@@ -69,6 +70,7 @@ fast_stats =
 	, remote_list SemiTrusted "semitrusted"
 	, remote_list UnTrusted "untrusted"
 	, remote_list DeadTrusted "dead"
+	, disk_size
 	]
 slow_stats :: [Stat]
 slow_stats = 
@@ -78,7 +80,6 @@ slow_stats =
 	, local_annex_size
 	, known_annex_keys
 	, known_annex_size
-	, disk_size
 	, bloom_info
 	, backend_usage
 	]
@@ -108,12 +109,11 @@ nojson :: StatState String -> String -> StatState String
 nojson a _ = a
 
 showStat :: Stat -> StatState ()
-showStat s = calc =<< s
+showStat s = maybe noop calc =<< s
 	where
-		calc (Just (desc, a)) = do
+		calc (desc, a) = do
 			(lift . showHeader) desc
 			lift . showRaw =<< a
-		calc Nothing = return ()
 
 supported_backends :: Stat
 supported_backends = stat "supported backends" $ json unwords $
@@ -161,7 +161,7 @@ bloom_info = stat "bloom filter size" $ json id $ do
 	let note = aside $
 		if localkeys >= capacity
 		then "appears too small for this repository; adjust annex.bloomcapacity"
-		else "has room for " ++ show (capacity - localkeys) ++ " more local annex keys"
+		else showPercentage 1 (percentage capacity localkeys) ++ " full"
 
 	-- Two bloom filters are used at the same time, so double the size
 	-- of one.
@@ -176,8 +176,12 @@ disk_size = stat "available local disk space" $ json id $ lift $
 		<$> getDiskReserve
 		<*> inRepo (getDiskFree . gitAnnexDir)
 	where
-		calcfree reserve (Just have) =
-			roughSize storageUnits False $ nonneg $ have - reserve
+		calcfree reserve (Just have) = unwords
+			[ roughSize storageUnits False $ nonneg $ have - reserve
+			, "(+" ++ roughSize storageUnits False reserve
+			, "reserved)"
+			]
+			
 		calcfree _ _ = "unknown"
 		nonneg x
 			| x >= 0 = x

Command/Sync.hs

@@ -57,10 +57,17 @@ syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )
 		wanted
 			| null rs = good =<< concat . byspeed <$> available
 			| otherwise = listed
-		listed = catMaybes <$> mapM (Remote.byName . Just) rs
+		listed = do
+			l <- catMaybes <$> mapM (Remote.byName . Just) rs
+			let s = filter special l
+			unless (null s) $
+				error $ "cannot sync special remotes: " ++
+					unwords (map Types.Remote.name s)
+			return l
 		available = filter nonspecial <$> Remote.enabledRemoteList
 		good = filterM $ Remote.Git.repoAvail . Types.Remote.repo
 		nonspecial r = Types.Remote.remotetype r == Remote.Git.remote
+		special = not . nonspecial
 		fastest = fromMaybe [] . headMaybe . byspeed
 		byspeed = map snd . sort . M.toList . costmap
 		costmap = M.fromListWith (++) . map costpair

Command/Unannex.hs

@@ -10,7 +10,6 @@ module Command.Unannex where
 import Common.Annex
 import Command
 import qualified Annex
-import Utility.FileMode
 import Logs.Location
 import Annex.Content
 import qualified Git.Command
@@ -51,9 +50,8 @@ cleanup file key = do
 		( do
 			-- fast mode: hard link to content in annex
 			src <- inRepo $ gitAnnexLocation key
-			liftIO $ do
-				createLink src file
-				allowWrite file
+			liftIO $ createLink src file
+			thawContent file
 		, do
 			fromAnnex key file
 			logStatus key InfoMissing

Command/Unlock.hs

@@ -11,7 +11,6 @@ import Common.Annex
 import Command
 import Annex.Content
 import Utility.CopyFile
-import Utility.FileMode
 
 def :: [Command]
 def =
@@ -34,8 +33,7 @@ start file (key, _) = do
 perform :: FilePath -> Key -> CommandPerform
 perform dest key = do
 	unlessM (inAnnex key) $ error "content not present"
-	
-	checkDiskSpace key
+	unlessM (checkDiskSpace Nothing key 0) $ error "cannot unlock"
 
 	src <- inRepo $ gitAnnexLocation key
 	tmpdest <- fromRepo $ gitAnnexTmpLocation key
@@ -47,6 +45,6 @@ perform dest key = do
 			liftIO $ do
 				removeFile dest
 				moveFile tmpdest dest
-				allowWrite dest
+			thawContent dest
 			next $ return True
                 else error "copy failed!"

Command/Unused.hs

@@ -19,9 +19,9 @@ import Control.Monad.ST
 
 import Common.Annex
 import Command
+import Logs.Unused
 import Annex.Content
 import Utility.FileMode
-import Utility.TempFile
 import Logs.Location
 import Config
 import qualified Annex
@@ -91,19 +91,13 @@ check file msg a c = do
 	l <- a
 	let unusedlist = number c l
 	unless (null l) $ showLongNote $ msg unusedlist
-	writeUnusedFile file unusedlist
+	writeUnusedLog file unusedlist
 	return $ c + length l
 
 number :: Int -> [a] -> [(Int, a)]
 number _ [] = []
 number n (x:xs) = (n+1, x) : number (n+1) xs
 
-writeUnusedFile :: FilePath -> [(Int, Key)] -> Annex ()
-writeUnusedFile prefix l = do
-	logfile <- fromRepo $ gitAnnexUnusedLog prefix
-	liftIO $ viaTmp writeFile logfile $
-		unlines $ map (\(n, k) -> show n ++ " " ++ show k) l
-
 table :: [(Int, Key)] -> [String]
 table l = "  NUMBER  KEY" : map cols l
 	where
@@ -189,10 +183,10 @@ exclude smaller larger = S.toList $ remove larger $ S.fromList smaller
  -}
 bloomCapacity :: Annex Int
 bloomCapacity = fromMaybe 500000 . readish
-	<$> getConfig "annex.bloomcapacity" ""
+	<$> getConfig (annexConfig "bloomcapacity") ""
 bloomAccuracy :: Annex Int
 bloomAccuracy = fromMaybe 1000 . readish
-	<$> getConfig "annex.bloomaccuracy" ""
+	<$> getConfig (annexConfig "bloomaccuracy") ""
 bloomBitsHashes :: Annex (Int, Int)
 bloomBitsHashes = do
 	capacity <- bloomCapacity
@@ -237,7 +231,7 @@ withKeysReferenced' :: v -> (Key -> v -> Annex v) -> Annex v
 withKeysReferenced' initial a = go initial =<< files
 	where
 		files = do
-			top <- fromRepo Git.workTree
+			top <- fromRepo Git.repoPath
 			inRepo $ LsFiles.inRepo [top]
 		go v [] = return v
 		go v (f:fs) = do
@@ -268,7 +262,7 @@ withKeysReferencedInGitRef a ref = do
 	showAction $ "checking " ++ Git.Ref.describe ref
 	go =<< inRepo (LsTree.lsTree ref)
 	where
-		go [] = return ()
+		go [] = noop
 		go (l:ls)
 			| isSymLink (LsTree.mode l) = do
 				content <- L.decodeUtf8 <$> catFile ref (LsTree.file l)

Command/Whereis.hs

@@ -46,9 +46,9 @@ perform remotemap key = do
 		untrustedheader = "The following untrusted locations may also have copies:\n"
 
 performRemote :: Key -> Remote -> Annex () 
-performRemote key remote = case whereisKey remote of
-	Nothing -> return ()
-	Just a -> do
-		ls <- a key
-		unless (null ls) $ showLongNote $
-			unlines $ map (\l -> name remote ++ ": " ++ l) ls
+performRemote key remote = maybe noop go $ whereisKey remote
+	where
+		go a = do
+			ls <- a key
+			unless (null ls) $ showLongNote $ unlines $
+				map (\l -> name remote ++ ": " ++ l) ls