From 8aec790a7aefba4dc2e8e0d219d333c12ad585e3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 7 Nov 2013 12:45:59 -0400 Subject: rename status to info, and update docs --- Command/Info.hs | 384 +++++++++++++++++++++ Command/Status.hs | 384 --------------------- GitAnnex.hs | 4 +- debian/changelog | 3 + doc/bare_repositories.mdwn | 2 +- doc/git-annex.mdwn | 14 +- ...Decentralized_repository_behind_a_Firewall.mdwn | 2 +- ...rate_disconnected_directories_to_git_annex.mdwn | 2 +- ...ent_1_41b212bde8bc88d2a5dea93bd0dc75f1._comment | 2 +- 9 files changed, 400 insertions(+), 397 deletions(-) create mode 100644 Command/Info.hs delete mode 100644 Command/Status.hs diff --git a/Command/Info.hs b/Command/Info.hs new file mode 100644 index 000000000..d465f2d84 --- /dev/null +++ b/Command/Info.hs @@ -0,0 +1,384 @@ +{- git-annex command + - + - Copyright 2011 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE BangPatterns #-} + +module Command.Info where + +import "mtl" Control.Monad.State.Strict +import qualified Data.Map as M +import Text.JSON +import Data.Tuple +import Data.Ord +import System.PosixCompat.Files + +import Common.Annex +import qualified Remote +import qualified Command.Unused +import qualified Git +import qualified Annex +import Command +import Utility.DataUnits +import Utility.DiskFree +import Annex.Content +import Types.Key +import Logs.UUID +import Logs.Trust +import Remote +import Config +import Utility.Percentage +import Logs.Transfer +import Types.TrustLevel +import Types.FileMatcher +import qualified Limit + +-- a named computation that produces a statistic +type Stat = StatState (Maybe (String, StatState String)) + +-- data about a set of keys +data KeyData = KeyData + { countKeys :: Integer + , sizeKeys :: Integer + , unknownSizeKeys :: Integer + , backendsKeys :: M.Map String Integer + } + +data NumCopiesStats = NumCopiesStats + { numCopiesVarianceMap :: M.Map Variance Integer + } + +newtype Variance = Variance Int + deriving (Eq, Ord) + +instance Show Variance where + show (Variance n) + | n >= 0 = "numcopies +" ++ show n + | otherwise = "numcopies " ++ show n + +-- cached info that multiple Stats use +data StatInfo = StatInfo + { presentData :: Maybe KeyData + , referencedData :: Maybe KeyData + , numCopiesStats :: Maybe NumCopiesStats + } + +-- a state monad for running Stats in +type StatState = StateT StatInfo Annex + +def :: [Command] +def = [noCommit $ command "info" paramPaths seek + SectionQuery "shows general information about the annex"] + +seek :: [CommandSeek] +seek = [withWords start] + +start :: [FilePath] -> CommandStart +start [] = do + globalInfo + stop +start ps = do + mapM_ localInfo =<< filterM isdir ps + stop + where + isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus) + +globalInfo :: Annex () +globalInfo = do + stats <- selStats global_fast_stats global_slow_stats + showCustom "info" $ do + evalStateT (mapM_ showStat stats) (StatInfo Nothing Nothing Nothing) + return True + +localInfo :: FilePath -> Annex () +localInfo dir = showCustom (unwords ["info", dir]) $ do + stats <- selStats (tostats local_fast_stats) (tostats local_slow_stats) + evalStateT (mapM_ showStat stats) =<< getLocalStatInfo dir + return True + where + tostats = map (\s -> s dir) + +selStats :: [Stat] -> [Stat] -> Annex [Stat] +selStats fast_stats slow_stats = do + fast <- Annex.getState Annex.fast + return $ if fast + then fast_stats + else fast_stats ++ slow_stats + +{- Order is significant. Less expensive operations, and operations + - that share data go together. + -} +global_fast_stats :: [Stat] +global_fast_stats = + [ repository_mode + , remote_list Trusted + , remote_list SemiTrusted + , remote_list UnTrusted + , transfer_list + , disk_size + ] +global_slow_stats :: [Stat] +global_slow_stats = + [ tmp_size + , bad_data_size + , local_annex_keys + , local_annex_size + , known_annex_files + , known_annex_size + , bloom_info + , backend_usage + ] +local_fast_stats :: [FilePath -> Stat] +local_fast_stats = + [ local_dir + , const local_annex_keys + , const local_annex_size + , const known_annex_files + , const known_annex_size + ] +local_slow_stats :: [FilePath -> Stat] +local_slow_stats = + [ const numcopies_stats + ] + +stat :: String -> (String -> StatState String) -> Stat +stat desc a = return $ Just (desc, a desc) + +nostat :: Stat +nostat = return Nothing + +json :: JSON j => (j -> String) -> StatState j -> String -> StatState String +json serialize a desc = do + j <- a + lift $ maybeShowJSON [(desc, j)] + return $ serialize j + +nojson :: StatState String -> String -> StatState String +nojson a _ = a + +showStat :: Stat -> StatState () +showStat s = maybe noop calc =<< s + where + calc (desc, a) = do + (lift . showHeader) desc + lift . showRaw =<< a + +repository_mode :: Stat +repository_mode = stat "repository mode" $ json id $ lift $ + ifM isDirect + ( return "direct", return "indirect" ) + +remote_list :: TrustLevel -> Stat +remote_list level = stat n $ nojson $ lift $ do + us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap Remote.name) + rs <- fst <$> trustPartition level us + s <- prettyPrintUUIDs n rs + return $ if null s then "0" else show (length rs) ++ "\n" ++ beginning s + where + n = showTrustLevel level ++ " repositories" + +local_dir :: FilePath -> Stat +local_dir dir = stat "directory" $ json id $ return dir + +local_annex_keys :: Stat +local_annex_keys = stat "local annex keys" $ json show $ + countKeys <$> cachedPresentData + +local_annex_size :: Stat +local_annex_size = stat "local annex size" $ json id $ + showSizeKeys <$> cachedPresentData + +known_annex_files :: Stat +known_annex_files = stat "annexed files in working tree" $ json show $ + countKeys <$> cachedReferencedData + +known_annex_size :: Stat +known_annex_size = stat "size of annexed files in working tree" $ json id $ + showSizeKeys <$> cachedReferencedData + +tmp_size :: Stat +tmp_size = staleSize "temporary directory size" gitAnnexTmpDir + +bad_data_size :: Stat +bad_data_size = staleSize "bad keys size" gitAnnexBadDir + +bloom_info :: Stat +bloom_info = stat "bloom filter size" $ json id $ do + localkeys <- countKeys <$> cachedPresentData + capacity <- fromIntegral <$> lift Command.Unused.bloomCapacity + let note = aside $ + if localkeys >= capacity + then "appears too small for this repository; adjust annex.bloomcapacity" + else showPercentage 1 (percentage capacity localkeys) ++ " full" + + -- Two bloom filters are used at the same time, so double the size + -- of one. + size <- roughSize memoryUnits False . (* 2) . fromIntegral . fst <$> + lift Command.Unused.bloomBitsHashes + + return $ size ++ note + +transfer_list :: Stat +transfer_list = stat "transfers in progress" $ nojson $ lift $ do + uuidmap <- Remote.remoteMap id + ts <- getTransfers + return $ if null ts + then "none" + else multiLine $ + map (uncurry $ line uuidmap) $ sort ts + where + line uuidmap t i = unwords + [ showLcDirection (transferDirection t) ++ "ing" + , fromMaybe (key2file $ transferKey t) (associatedFile i) + , if transferDirection t == Upload then "to" else "from" + , maybe (fromUUID $ transferUUID t) Remote.name $ + M.lookup (transferUUID t) uuidmap + ] + +disk_size :: Stat +disk_size = stat "available local disk space" $ json id $ lift $ + calcfree + <$> (annexDiskReserve <$> Annex.getGitConfig) + <*> inRepo (getDiskFree . gitAnnexDir) + where + calcfree reserve (Just have) = unwords + [ roughSize storageUnits False $ nonneg $ have - reserve + , "(+" ++ roughSize storageUnits False reserve + , "reserved)" + ] + calcfree _ _ = "unknown" + + nonneg x + | x >= 0 = x + | otherwise = 0 + +backend_usage :: Stat +backend_usage = stat "backend usage" $ nojson $ + calc + <$> (backendsKeys <$> cachedReferencedData) + <*> (backendsKeys <$> cachedPresentData) + where + calc x y = multiLine $ + map (\(n, b) -> b ++ ": " ++ show n) $ + reverse $ sort $ map swap $ M.toList $ + M.unionWith (+) x y + +numcopies_stats :: Stat +numcopies_stats = stat "numcopies stats" $ nojson $ + calc <$> (maybe M.empty numCopiesVarianceMap <$> cachedNumCopiesStats) + where + calc = multiLine + . map (\(variance, count) -> show variance ++ ": " ++ show count) + . reverse . sortBy (comparing snd) . M.toList + +cachedPresentData :: StatState KeyData +cachedPresentData = do + s <- get + case presentData s of + Just v -> return v + Nothing -> do + v <- foldKeys <$> lift getKeysPresent + put s { presentData = Just v } + return v + +cachedReferencedData :: StatState KeyData +cachedReferencedData = do + s <- get + case referencedData s of + Just v -> return v + Nothing -> do + !v <- lift $ Command.Unused.withKeysReferenced + emptyKeyData addKey + put s { referencedData = Just v } + return v + +-- currently only available for local info +cachedNumCopiesStats :: StatState (Maybe NumCopiesStats) +cachedNumCopiesStats = numCopiesStats <$> get + +getLocalStatInfo :: FilePath -> Annex StatInfo +getLocalStatInfo dir = do + fast <- Annex.getState Annex.fast + matcher <- Limit.getMatcher + (presentdata, referenceddata, numcopiesstats) <- + Command.Unused.withKeysFilesReferencedIn dir initial + (update matcher fast) + return $ StatInfo (Just presentdata) (Just referenceddata) (Just numcopiesstats) + where + initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats) + update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) = + ifM (matcher $ FileInfo file file) + ( do + !presentdata' <- ifM (inAnnex key) + ( return $ addKey key presentdata + , return presentdata + ) + let !referenceddata' = addKey key referenceddata + !numcopiesstats' <- if fast + then return numcopiesstats + else updateNumCopiesStats key file numcopiesstats + return $! (presentdata', referenceddata', numcopiesstats') + , return vs + ) + +emptyKeyData :: KeyData +emptyKeyData = KeyData 0 0 0 M.empty + +emptyNumCopiesStats :: NumCopiesStats +emptyNumCopiesStats = NumCopiesStats M.empty + +foldKeys :: [Key] -> KeyData +foldKeys = foldl' (flip addKey) emptyKeyData + +addKey :: Key -> KeyData -> KeyData +addKey key (KeyData count size unknownsize backends) = + KeyData count' size' unknownsize' backends' + where + {- All calculations strict to avoid thunks when repeatedly + - applied to many keys. -} + !count' = count + 1 + !backends' = M.insertWith' (+) (keyBackendName key) 1 backends + !size' = maybe size (+ size) ks + !unknownsize' = maybe (unknownsize + 1) (const unknownsize) ks + ks = keySize key + +updateNumCopiesStats :: Key -> FilePath -> NumCopiesStats -> Annex NumCopiesStats +updateNumCopiesStats key file (NumCopiesStats m) = do + !variance <- Variance <$> numCopiesCheck file key (-) + let !m' = M.insertWith' (+) variance 1 m + let !ret = NumCopiesStats m' + return ret + +showSizeKeys :: KeyData -> String +showSizeKeys d = total ++ missingnote + where + total = roughSize storageUnits False $ sizeKeys d + missingnote + | unknownSizeKeys d == 0 = "" + | otherwise = aside $ + "+ " ++ show (unknownSizeKeys d) ++ + " unknown size" + +staleSize :: String -> (Git.Repo -> FilePath) -> Stat +staleSize label dirspec = go =<< lift (dirKeys dirspec) + where + go [] = nostat + go keys = onsize =<< sum <$> keysizes keys + onsize 0 = nostat + onsize size = stat label $ + json (++ aside "clean up with git-annex unused") $ + return $ roughSize storageUnits False size + keysizes keys = do + dir <- lift $ fromRepo dirspec + liftIO $ forM keys $ \k -> catchDefaultIO 0 $ + fromIntegral . fileSize + <$> getFileStatus (dir keyFile k) + +aside :: String -> String +aside s = " (" ++ s ++ ")" + +multiLine :: [String] -> String +multiLine = concatMap (\l -> "\n\t" ++ l) diff --git a/Command/Status.hs b/Command/Status.hs deleted file mode 100644 index 44d868f6b..000000000 --- a/Command/Status.hs +++ /dev/null @@ -1,384 +0,0 @@ -{- git-annex command - - - - Copyright 2011 Joey Hess - - - - Licensed under the GNU GPL version 3 or higher. - -} - -{-# LANGUAGE BangPatterns #-} - -module Command.Status where - -import "mtl" Control.Monad.State.Strict -import qualified Data.Map as M -import Text.JSON -import Data.Tuple -import Data.Ord -import System.PosixCompat.Files - -import Common.Annex -import qualified Remote -import qualified Command.Unused -import qualified Git -import qualified Annex -import Command -import Utility.DataUnits -import Utility.DiskFree -import Annex.Content -import Types.Key -import Logs.UUID -import Logs.Trust -import Remote -import Config -import Utility.Percentage -import Logs.Transfer -import Types.TrustLevel -import Types.FileMatcher -import qualified Limit - --- a named computation that produces a statistic -type Stat = StatState (Maybe (String, StatState String)) - --- data about a set of keys -data KeyData = KeyData - { countKeys :: Integer - , sizeKeys :: Integer - , unknownSizeKeys :: Integer - , backendsKeys :: M.Map String Integer - } - -data NumCopiesStats = NumCopiesStats - { numCopiesVarianceMap :: M.Map Variance Integer - } - -newtype Variance = Variance Int - deriving (Eq, Ord) - -instance Show Variance where - show (Variance n) - | n >= 0 = "numcopies +" ++ show n - | otherwise = "numcopies " ++ show n - --- cached info that multiple Stats use -data StatInfo = StatInfo - { presentData :: Maybe KeyData - , referencedData :: Maybe KeyData - , numCopiesStats :: Maybe NumCopiesStats - } - --- a state monad for running Stats in -type StatState = StateT StatInfo Annex - -def :: [Command] -def = [noCommit $ command "status" paramPaths seek - SectionQuery "shows status information about the annex"] - -seek :: [CommandSeek] -seek = [withWords start] - -start :: [FilePath] -> CommandStart -start [] = do - globalStatus - stop -start ps = do - mapM_ localStatus =<< filterM isdir ps - stop - where - isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus) - -globalStatus :: Annex () -globalStatus = do - stats <- selStats global_fast_stats global_slow_stats - showCustom "status" $ do - evalStateT (mapM_ showStat stats) (StatInfo Nothing Nothing Nothing) - return True - -localStatus :: FilePath -> Annex () -localStatus dir = showCustom (unwords ["status", dir]) $ do - stats <- selStats (tostats local_fast_stats) (tostats local_slow_stats) - evalStateT (mapM_ showStat stats) =<< getLocalStatInfo dir - return True - where - tostats = map (\s -> s dir) - -selStats :: [Stat] -> [Stat] -> Annex [Stat] -selStats fast_stats slow_stats = do - fast <- Annex.getState Annex.fast - return $ if fast - then fast_stats - else fast_stats ++ slow_stats - -{- Order is significant. Less expensive operations, and operations - - that share data go together. - -} -global_fast_stats :: [Stat] -global_fast_stats = - [ repository_mode - , remote_list Trusted - , remote_list SemiTrusted - , remote_list UnTrusted - , transfer_list - , disk_size - ] -global_slow_stats :: [Stat] -global_slow_stats = - [ tmp_size - , bad_data_size - , local_annex_keys - , local_annex_size - , known_annex_files - , known_annex_size - , bloom_info - , backend_usage - ] -local_fast_stats :: [FilePath -> Stat] -local_fast_stats = - [ local_dir - , const local_annex_keys - , const local_annex_size - , const known_annex_files - , const known_annex_size - ] -local_slow_stats :: [FilePath -> Stat] -local_slow_stats = - [ const numcopies_stats - ] - -stat :: String -> (String -> StatState String) -> Stat -stat desc a = return $ Just (desc, a desc) - -nostat :: Stat -nostat = return Nothing - -json :: JSON j => (j -> String) -> StatState j -> String -> StatState String -json serialize a desc = do - j <- a - lift $ maybeShowJSON [(desc, j)] - return $ serialize j - -nojson :: StatState String -> String -> StatState String -nojson a _ = a - -showStat :: Stat -> StatState () -showStat s = maybe noop calc =<< s - where - calc (desc, a) = do - (lift . showHeader) desc - lift . showRaw =<< a - -repository_mode :: Stat -repository_mode = stat "repository mode" $ json id $ lift $ - ifM isDirect - ( return "direct", return "indirect" ) - -remote_list :: TrustLevel -> Stat -remote_list level = stat n $ nojson $ lift $ do - us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap Remote.name) - rs <- fst <$> trustPartition level us - s <- prettyPrintUUIDs n rs - return $ if null s then "0" else show (length rs) ++ "\n" ++ beginning s - where - n = showTrustLevel level ++ " repositories" - -local_dir :: FilePath -> Stat -local_dir dir = stat "directory" $ json id $ return dir - -local_annex_keys :: Stat -local_annex_keys = stat "local annex keys" $ json show $ - countKeys <$> cachedPresentData - -local_annex_size :: Stat -local_annex_size = stat "local annex size" $ json id $ - showSizeKeys <$> cachedPresentData - -known_annex_files :: Stat -known_annex_files = stat "annexed files in working tree" $ json show $ - countKeys <$> cachedReferencedData - -known_annex_size :: Stat -known_annex_size = stat "size of annexed files in working tree" $ json id $ - showSizeKeys <$> cachedReferencedData - -tmp_size :: Stat -tmp_size = staleSize "temporary directory size" gitAnnexTmpDir - -bad_data_size :: Stat -bad_data_size = staleSize "bad keys size" gitAnnexBadDir - -bloom_info :: Stat -bloom_info = stat "bloom filter size" $ json id $ do - localkeys <- countKeys <$> cachedPresentData - capacity <- fromIntegral <$> lift Command.Unused.bloomCapacity - let note = aside $ - if localkeys >= capacity - then "appears too small for this repository; adjust annex.bloomcapacity" - else showPercentage 1 (percentage capacity localkeys) ++ " full" - - -- Two bloom filters are used at the same time, so double the size - -- of one. - size <- roughSize memoryUnits False . (* 2) . fromIntegral . fst <$> - lift Command.Unused.bloomBitsHashes - - return $ size ++ note - -transfer_list :: Stat -transfer_list = stat "transfers in progress" $ nojson $ lift $ do - uuidmap <- Remote.remoteMap id - ts <- getTransfers - return $ if null ts - then "none" - else multiLine $ - map (uncurry $ line uuidmap) $ sort ts - where - line uuidmap t i = unwords - [ showLcDirection (transferDirection t) ++ "ing" - , fromMaybe (key2file $ transferKey t) (associatedFile i) - , if transferDirection t == Upload then "to" else "from" - , maybe (fromUUID $ transferUUID t) Remote.name $ - M.lookup (transferUUID t) uuidmap - ] - -disk_size :: Stat -disk_size = stat "available local disk space" $ json id $ lift $ - calcfree - <$> (annexDiskReserve <$> Annex.getGitConfig) - <*> inRepo (getDiskFree . gitAnnexDir) - where - calcfree reserve (Just have) = unwords - [ roughSize storageUnits False $ nonneg $ have - reserve - , "(+" ++ roughSize storageUnits False reserve - , "reserved)" - ] - calcfree _ _ = "unknown" - - nonneg x - | x >= 0 = x - | otherwise = 0 - -backend_usage :: Stat -backend_usage = stat "backend usage" $ nojson $ - calc - <$> (backendsKeys <$> cachedReferencedData) - <*> (backendsKeys <$> cachedPresentData) - where - calc x y = multiLine $ - map (\(n, b) -> b ++ ": " ++ show n) $ - reverse $ sort $ map swap $ M.toList $ - M.unionWith (+) x y - -numcopies_stats :: Stat -numcopies_stats = stat "numcopies stats" $ nojson $ - calc <$> (maybe M.empty numCopiesVarianceMap <$> cachedNumCopiesStats) - where - calc = multiLine - . map (\(variance, count) -> show variance ++ ": " ++ show count) - . reverse . sortBy (comparing snd) . M.toList - -cachedPresentData :: StatState KeyData -cachedPresentData = do - s <- get - case presentData s of - Just v -> return v - Nothing -> do - v <- foldKeys <$> lift getKeysPresent - put s { presentData = Just v } - return v - -cachedReferencedData :: StatState KeyData -cachedReferencedData = do - s <- get - case referencedData s of - Just v -> return v - Nothing -> do - !v <- lift $ Command.Unused.withKeysReferenced - emptyKeyData addKey - put s { referencedData = Just v } - return v - --- currently only available for local status -cachedNumCopiesStats :: StatState (Maybe NumCopiesStats) -cachedNumCopiesStats = numCopiesStats <$> get - -getLocalStatInfo :: FilePath -> Annex StatInfo -getLocalStatInfo dir = do - fast <- Annex.getState Annex.fast - matcher <- Limit.getMatcher - (presentdata, referenceddata, numcopiesstats) <- - Command.Unused.withKeysFilesReferencedIn dir initial - (update matcher fast) - return $ StatInfo (Just presentdata) (Just referenceddata) (Just numcopiesstats) - where - initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats) - update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) = - ifM (matcher $ FileInfo file file) - ( do - !presentdata' <- ifM (inAnnex key) - ( return $ addKey key presentdata - , return presentdata - ) - let !referenceddata' = addKey key referenceddata - !numcopiesstats' <- if fast - then return numcopiesstats - else updateNumCopiesStats key file numcopiesstats - return $! (presentdata', referenceddata', numcopiesstats') - , return vs - ) - -emptyKeyData :: KeyData -emptyKeyData = KeyData 0 0 0 M.empty - -emptyNumCopiesStats :: NumCopiesStats -emptyNumCopiesStats = NumCopiesStats M.empty - -foldKeys :: [Key] -> KeyData -foldKeys = foldl' (flip addKey) emptyKeyData - -addKey :: Key -> KeyData -> KeyData -addKey key (KeyData count size unknownsize backends) = - KeyData count' size' unknownsize' backends' - where - {- All calculations strict to avoid thunks when repeatedly - - applied to many keys. -} - !count' = count + 1 - !backends' = M.insertWith' (+) (keyBackendName key) 1 backends - !size' = maybe size (+ size) ks - !unknownsize' = maybe (unknownsize + 1) (const unknownsize) ks - ks = keySize key - -updateNumCopiesStats :: Key -> FilePath -> NumCopiesStats -> Annex NumCopiesStats -updateNumCopiesStats key file (NumCopiesStats m) = do - !variance <- Variance <$> numCopiesCheck file key (-) - let !m' = M.insertWith' (+) variance 1 m - let !ret = NumCopiesStats m' - return ret - -showSizeKeys :: KeyData -> String -showSizeKeys d = total ++ missingnote - where - total = roughSize storageUnits False $ sizeKeys d - missingnote - | unknownSizeKeys d == 0 = "" - | otherwise = aside $ - "+ " ++ show (unknownSizeKeys d) ++ - " unknown size" - -staleSize :: String -> (Git.Repo -> FilePath) -> Stat -staleSize label dirspec = go =<< lift (dirKeys dirspec) - where - go [] = nostat - go keys = onsize =<< sum <$> keysizes keys - onsize 0 = nostat - onsize size = stat label $ - json (++ aside "clean up with git-annex unused") $ - return $ roughSize storageUnits False size - keysizes keys = do - dir <- lift $ fromRepo dirspec - liftIO $ forM keys $ \k -> catchDefaultIO 0 $ - fromIntegral . fileSize - <$> getFileStatus (dir keyFile k) - -aside :: String -> String -aside s = " (" ++ s ++ ")" - -multiLine :: [String] -> String -multiLine = concatMap (\l -> "\n\t" ++ l) diff --git a/GitAnnex.hs b/GitAnnex.hs index b73cd9416..0bd48e0df 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -46,7 +46,7 @@ import qualified Command.Whereis import qualified Command.List import qualified Command.Log import qualified Command.Merge -import qualified Command.Status +import qualified Command.Info import qualified Command.Migrate import qualified Command.Uninit import qualified Command.Trust @@ -140,7 +140,7 @@ cmds = concat , Command.List.def , Command.Log.def , Command.Merge.def - , Command.Status.def + , Command.Info.def , Command.Migrate.def , Command.Map.def , Command.Direct.def diff --git a/debian/changelog b/debian/changelog index 740773fd8..1429f327c 100644 --- a/debian/changelog +++ b/debian/changelog @@ -6,6 +6,9 @@ git-annex (5.20131102) UNRELEASED; urgency=low * annex.version is now set to 5 for direct mode repositories. This upgrade is handled fully automatically, no need to run git annex upgrade + * The "status" command has been renamed to "info", to allow + "git annex status" to be used in direct mode repositories, now that + "git status" won't work in them. * The -c option now not only modifies the git configuration seen by git-annex, but it is passed along to every git command git-annex runs. diff --git a/doc/bare_repositories.mdwn b/doc/bare_repositories.mdwn index 7fa035985..975a638b8 100644 --- a/doc/bare_repositories.mdwn +++ b/doc/bare_repositories.mdwn @@ -39,7 +39,7 @@ Now configure the remote and do the initial push: git remote add origin example.com:bare-annex.git git push origin master git-annex -Now `git annex status` should show the configured bare remote. If it does not, you may have to pull from the remote first (older versions of `git-annex`) +Now `git annex info` should show the configured bare remote. If it does not, you may have to pull from the remote first (older versions of `git-annex`) If you wish to configure git such that you can push/pull without arguments, set the upstream branch: diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index fd22fc672..4aeeb8ad5 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -607,23 +607,23 @@ subdirectories). To generate output suitable for the gource visualisation program, specify `--gource`. -* `status [directory ...]` +* `info [directory ...]` Displays some statistics and other information, including how much data is in the annex and a list of all known repositories. To only show the data that can be gathered quickly, use `--fast`. - When a directory is specified, shows a differently formatted status + When a directory is specified, shows a differently formatted info display for that directory. In this mode, all of the file matching options can be used to filter the files that will be included in - the status. + the information. For example, suppose you want to run "git annex get .", but would first like to see how much disk space that will use. Then run: - git annex status --fast . --not --in here + git annex info --fast . --not --in here * `map` @@ -797,7 +797,7 @@ subdirectories). Rather than the normal output, generate JSON. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. Note that json output is only usable with some git-annex commands, - like status and find. + like info and find. * `--debug` @@ -1097,7 +1097,7 @@ Here are all the supported configuration settings. up to 500000 keys. If your repository is larger than that, you can adjust this to avoid `git annex unused` not noticing some unused data files. Increasing this will make `git-annex unused` consume more memory; - run `git annex status` for memory usage numbers. + run `git annex info` for memory usage numbers. * `annex.bloomaccuracy` @@ -1105,7 +1105,7 @@ Here are all the supported configuration settings. `git annex unused`. The default accuracy is 1000 -- 1 unused file out of 1000 will be missed by `git annex unused`. Increasing the accuracy will make `git annex unused` consume more memory; - run `git annex status` for memory usage numbers. + run `git annex info` for memory usage numbers. * `annex.sshcaching` diff --git a/doc/tips/Decentralized_repository_behind_a_Firewall.mdwn b/doc/tips/Decentralized_repository_behind_a_Firewall.mdwn index 6a9eb241b..9e347c73f 100644 --- a/doc/tips/Decentralized_repository_behind_a_Firewall.mdwn +++ b/doc/tips/Decentralized_repository_behind_a_Firewall.mdwn @@ -25,7 +25,7 @@ Now you can run normal annex operations, as long as the port forwarding shell is git annex sync git annex get on-the-go some/big/file - git annex status + git annex info You can add more computers by repeating with a different port, e.g. 2202 or 2203 (or any other). diff --git a/doc/tips/migrating_two_seperate_disconnected_directories_to_git_annex.mdwn b/doc/tips/migrating_two_seperate_disconnected_directories_to_git_annex.mdwn index 7bddd64b9..1209d1217 100644 --- a/doc/tips/migrating_two_seperate_disconnected_directories_to_git_annex.mdwn +++ b/doc/tips/migrating_two_seperate_disconnected_directories_to_git_annex.mdwn @@ -31,7 +31,7 @@ On `angela`, we want to synchronise the git annex metadata with `marcos`. We nee git init git remote add marcos marcos.example.com:/srv/mp3 git fetch marcos - git annex status # this should display the two repos + git annex info # this should display the two repos git annex add . This will, again, checksum all files and add them to git annex. Once that is done, you can verify that the files are really the same as marcos with `whereis`: diff --git a/doc/tips/yet_another_simple_disk_usage_like_utility/comment_1_41b212bde8bc88d2a5dea93bd0dc75f1._comment b/doc/tips/yet_another_simple_disk_usage_like_utility/comment_1_41b212bde8bc88d2a5dea93bd0dc75f1._comment index 3a88e855e..4c3e3c22b 100644 --- a/doc/tips/yet_another_simple_disk_usage_like_utility/comment_1_41b212bde8bc88d2a5dea93bd0dc75f1._comment +++ b/doc/tips/yet_another_simple_disk_usage_like_utility/comment_1_41b212bde8bc88d2a5dea93bd0dc75f1._comment @@ -4,6 +4,6 @@ subject="comment 1" date="2013-07-12T19:36:28Z" content=""" -Ah, I just found that git annex status can do the same :) +Ah, I just found that git annex info can do the same :) Disregard this. """]] -- cgit v1.2.3