diff options
-rw-r--r-- | Command/Info.hs | 48 | ||||
-rw-r--r-- | Remote/Bup.hs | 1 | ||||
-rw-r--r-- | Remote/Ddar.hs | 1 | ||||
-rw-r--r-- | Remote/Directory.hs | 3 | ||||
-rw-r--r-- | Remote/External.hs | 1 | ||||
-rw-r--r-- | Remote/GCrypt.hs | 1 | ||||
-rw-r--r-- | Remote/Git.hs | 1 | ||||
-rw-r--r-- | Remote/Glacier.hs | 3 | ||||
-rw-r--r-- | Remote/Helper/Chunked.hs | 9 | ||||
-rw-r--r-- | Remote/Helper/Encryptable.hs | 8 | ||||
-rw-r--r-- | Remote/Helper/Git.hs | 5 | ||||
-rw-r--r-- | Remote/Helper/Special.hs | 6 | ||||
-rw-r--r-- | Remote/Hook.hs | 3 | ||||
-rw-r--r-- | Remote/Rsync.hs | 1 | ||||
-rw-r--r-- | Remote/S3.hs | 3 | ||||
-rw-r--r-- | Remote/Tahoe.hs | 3 | ||||
-rw-r--r-- | Remote/Web.hs | 3 | ||||
-rw-r--r-- | Remote/WebDAV.hs | 3 | ||||
-rw-r--r-- | Types/Remote.hs | 4 | ||||
-rw-r--r-- | doc/git-annex.mdwn | 4 |
20 files changed, 82 insertions, 29 deletions
diff --git a/Command/Info.hs b/Command/Info.hs index 5cac2954a..96b7eb6d7 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -125,7 +125,8 @@ fileInfo file k = showCustom (unwords ["info", file]) $ do remoteInfo :: Remote -> Annex () remoteInfo r = showCustom (unwords ["info", Remote.name r]) $ do - evalStateT (mapM_ showStat (remote_stats r)) emptyStatInfo + info <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r + evalStateT (mapM_ showStat (remote_stats r ++ info)) emptyStatInfo return True selStats :: [Stat] -> [Stat] -> Annex [Stat] @@ -179,16 +180,21 @@ file_stats f k = ] remote_stats :: Remote -> [Stat] -remote_stats r = - [ remote_name r - , remote_description r - , remote_uuid r - , remote_cost r +remote_stats r = map (\s -> s r) + [ remote_name + , remote_description + , remote_uuid + , remote_cost + , remote_type ] stat :: String -> (String -> StatState String) -> Stat stat desc a = return $ Just (desc, a desc) +-- The json simply contains the same string that is displayed. +simpleStat :: String -> StatState String -> Stat +simpleStat desc getval = stat desc $ json id getval + nostat :: Stat nostat = return Nothing @@ -209,7 +215,7 @@ showStat s = maybe noop calc =<< s lift . showRaw =<< a repository_mode :: Stat -repository_mode = stat "repository mode" $ json id $ lift $ +repository_mode = simpleStat "repository mode" $ lift $ ifM isDirect ( return "direct", return "indirect" ) @@ -223,32 +229,36 @@ remote_list level = stat n $ nojson $ lift $ do n = showTrustLevel level ++ " repositories" dir_name :: FilePath -> Stat -dir_name dir = stat "directory" $ json id $ pure dir +dir_name dir = simpleStat "directory" $ pure dir file_name :: FilePath -> Stat -file_name file = stat "file" $ json id $ pure file +file_name file = simpleStat "file" $ pure file remote_name :: Remote -> Stat -remote_name r = stat "remote" $ json id $ pure (Remote.name r) +remote_name r = simpleStat "remote" $ pure (Remote.name r) remote_description :: Remote -> Stat -remote_description r = stat "description" $ json id $ lift $ +remote_description r = simpleStat "description" $ lift $ Remote.prettyUUID (Remote.uuid r) remote_uuid :: Remote -> Stat -remote_uuid r = stat "uuid" $ json id $ pure $ +remote_uuid r = simpleStat "uuid" $ pure $ fromUUID $ Remote.uuid r remote_cost :: Remote -> Stat -remote_cost r = stat "cost" $ json id $ pure $ +remote_cost r = simpleStat "cost" $ pure $ show $ Remote.cost r +remote_type :: Remote -> Stat +remote_type r = simpleStat "type" $ pure $ + Remote.typename $ Remote.remotetype r + 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 $ +local_annex_size = simpleStat "local annex size" $ showSizeKeys <$> cachedPresentData known_annex_files :: Stat @@ -256,7 +266,7 @@ 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 $ +known_annex_size = simpleStat "size of annexed files in working tree" $ showSizeKeys <$> cachedReferencedData tmp_size :: Stat @@ -266,13 +276,13 @@ bad_data_size :: Stat bad_data_size = staleSize "bad keys size" gitAnnexBadDir key_size :: Key -> Stat -key_size k = stat "size" $ json id $ pure $ showSizeKeys $ foldKeys [k] +key_size k = simpleStat "size" $ pure $ showSizeKeys $ foldKeys [k] key_name :: Key -> Stat -key_name k = stat "key" $ json id $ pure $ key2file k +key_name k = simpleStat "key" $ pure $ key2file k bloom_info :: Stat -bloom_info = stat "bloom filter size" $ json id $ do +bloom_info = simpleStat "bloom filter size" $ do localkeys <- countKeys <$> cachedPresentData capacity <- fromIntegral <$> lift Command.Unused.bloomCapacity let note = aside $ @@ -305,7 +315,7 @@ transfer_list = stat "transfers in progress" $ nojson $ lift $ do ] disk_size :: Stat -disk_size = stat "available local disk space" $ json id $ lift $ +disk_size = simpleStat "available local disk space" $ lift $ calcfree <$> (annexDiskReserve <$> Annex.getGitConfig) <*> inRepo (getDiskFree . gitAnnexDir) diff --git a/Remote/Bup.hs b/Remote/Bup.hs index cc64d6ff5..4f2ddf35a 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -73,6 +73,7 @@ gen r u c gc = do , availability = if bupLocal buprepo then LocallyAvailable else GloballyAvailable , readonly = False , mkUnavailable = return Nothing + , getInfo = return [("repo", buprepo)] } return $ Just $ specialRemote' specialcfg c (simplyPrepare $ store this buprepo) diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs index 1db482b47..d73919bfd 100644 --- a/Remote/Ddar.hs +++ b/Remote/Ddar.hs @@ -70,6 +70,7 @@ gen r u c gc = do , availability = if ddarLocal ddarrepo then LocallyAvailable else GloballyAvailable , readonly = False , mkUnavailable = return Nothing + , getInfo = return [("repo", ddarrepo)] } ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc specialcfg = (specialRemoteCfg c) diff --git a/Remote/Directory.hs b/Remote/Directory.hs index fa4d027ae..2e9e013ab 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -67,7 +67,8 @@ gen r u c gc = do availability = LocallyAvailable, remotetype = remote, mkUnavailable = gen r u c $ - gc { remoteAnnexDirectory = Just "/dev/null" } + gc { remoteAnnexDirectory = Just "/dev/null" }, + getInfo = return [("directory", dir)] } where dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc diff --git a/Remote/External.hs b/Remote/External.hs index d40972412..e907ab0cf 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -68,6 +68,7 @@ gen r u c gc = do remotetype = remote, mkUnavailable = gen r u c $ gc { remoteAnnexExternalType = Just "!dne!" } + , getInfo = return [("externaltype", externaltype)] } where externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc) diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index fc7718a2a..995c3e838 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -121,6 +121,7 @@ gen' r u c gc = do , availability = availabilityCalc r , remotetype = remote , mkUnavailable = return Nothing + , getInfo = return $ gitRepoInfo r } return $ Just $ specialRemote' specialcfg c (simplyPrepare $ store this rsyncopts) diff --git a/Remote/Git.hs b/Remote/Git.hs index a249f43b2..50c34a2bb 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -159,6 +159,7 @@ gen r u c gc , availability = availabilityCalc r , remotetype = remote , mkUnavailable = unavailable r u c gc + , getInfo = return $ gitRepoInfo r } unavailable :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 70bcec33f..0e2796da2 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -66,7 +66,8 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost readonly = False, availability = GloballyAvailable, remotetype = remote, - mkUnavailable = return Nothing + mkUnavailable = return Nothing, + getInfo = return [("glacier vault", getVault c)] } specialcfg = (specialRemoteCfg c) -- Disabled until jobList gets support for chunks. diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs index eb5dbc793..806fab542 100644 --- a/Remote/Helper/Chunked.hs +++ b/Remote/Helper/Chunked.hs @@ -8,6 +8,7 @@ module Remote.Helper.Chunked ( ChunkSize, ChunkConfig(..), + describeChunkConfig, getChunkConfig, storeChunks, removeChunks, @@ -34,6 +35,14 @@ data ChunkConfig | LegacyChunks ChunkSize deriving (Show) +describeChunkConfig :: ChunkConfig -> String +describeChunkConfig NoChunks = "none" +describeChunkConfig (UnpaddedChunks sz) = describeChunkSize sz ++ "chunks" +describeChunkConfig (LegacyChunks sz) = describeChunkSize sz ++ " chunks (old style)" + +describeChunkSize :: ChunkSize -> String +describeChunkSize sz = roughSize storageUnits False (fromIntegral sz) + noChunks :: ChunkConfig -> Bool noChunks NoChunks = True noChunks _ = False diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 9a8e9ba5b..5e342803d 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -16,6 +16,7 @@ module Remote.Helper.Encryptable ( cipherKey, storeCipher, extractCipher, + describeEncryption, ) where import qualified Data.Map as M @@ -157,3 +158,10 @@ extractCipher c = case (M.lookup "cipher" c, _ -> Nothing where readkeys = KeyIds . split "," + +describeEncryption :: RemoteConfig -> String +describeEncryption c = case extractCipher c of + Nothing -> "not encrypted" + (Just (SharedCipher _)) -> "encrypted (encryption key stored in git repository)" + (Just (EncryptedCipher _ _ (KeyIds { keyIds = ks }))) -> + "encrypted (to gpg keys: " ++ unwords ks ++ ")" diff --git a/Remote/Helper/Git.hs b/Remote/Helper/Git.hs index b405fd358..156d7ac28 100644 --- a/Remote/Helper/Git.hs +++ b/Remote/Helper/Git.hs @@ -30,3 +30,8 @@ guardUsable :: Git.Repo -> Annex a -> Annex a -> Annex a guardUsable r fallback a | Git.repoIsLocalUnknown r = fallback | otherwise = a + +gitRepoInfo :: Git.Repo -> [(String, String)] +gitRepoInfo r = + [ ("repository location", Git.repoLocation r) + ] diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs index 4738180a8..181d7548f 100644 --- a/Remote/Helper/Special.hs +++ b/Remote/Helper/Special.hs @@ -168,6 +168,12 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp (cost baser) (const $ cost baser + encryptedRemoteCostAdj) (extractCipher c) + , getInfo = do + l <- getInfo baser + return $ l ++ + [ ("encryption", describeEncryption c) + , ("chunking", describeChunkConfig (chunkConfig cfg)) + ] } cip = cipherKey c gpgopts = getGpgEncParams encr diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 707e2cb75..f7c428e99 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -60,7 +60,8 @@ gen r u c gc = do availability = GloballyAvailable, remotetype = remote, mkUnavailable = gen r u c $ - gc { remoteAnnexHookType = Just "!dne!" } + gc { remoteAnnexHookType = Just "!dne!" }, + getInfo = return [("hooktype", hooktype)] } where hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 7a965aa9d..a87d05a33 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -83,6 +83,7 @@ gen r u c gc = do , availability = if islocal then LocallyAvailable else GloballyAvailable , remotetype = remote , mkUnavailable = return Nothing + , getInfo = return [("url", url)] } where specialcfg = (specialRemoteCfg c) diff --git a/Remote/S3.hs b/Remote/S3.hs index 4fc13f390..154fb1ed4 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -71,7 +71,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost readonly = False, availability = GloballyAvailable, remotetype = remote, - mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc + mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc, + getInfo = return [("bucket", fromMaybe "unknown" (getBucket c))] } s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs index 5c1729448..7dd231c06 100644 --- a/Remote/Tahoe.hs +++ b/Remote/Tahoe.hs @@ -84,7 +84,8 @@ gen r u c gc = do readonly = False, availability = GloballyAvailable, remotetype = remote, - mkUnavailable = return Nothing + mkUnavailable = return Nothing, + getInfo = return [] } tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) diff --git a/Remote/Web.hs b/Remote/Web.hs index ef7d2b39a..4d4b43c41 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -62,7 +62,8 @@ gen r _ c gc = readonly = True, availability = GloballyAvailable, remotetype = remote, - mkUnavailable = return Nothing + mkUnavailable = return Nothing, + getInfo = return [] } downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index d90686608..0981c4373 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -71,7 +71,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost readonly = False, availability = GloballyAvailable, remotetype = remote, - mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc + mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc, + getInfo = return [("url", fromMaybe "unknown" (M.lookup "url" c))] } chunkconfig = getChunkConfig c diff --git a/Types/Remote.hs b/Types/Remote.hs index e166d7090..795121763 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -98,7 +98,9 @@ data RemoteA a = Remote { remotetype :: RemoteTypeA a, -- For testing, makes a version of this remote that is not -- available for use. All its actions should fail. - mkUnavailable :: a (Maybe (RemoteA a)) + mkUnavailable :: a (Maybe (RemoteA a)), + -- Information about the remote, for git annex info to display. + getInfo :: a [(String, String)] } instance Show (RemoteA a) where diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 7df4ecb3f..b22ff3881 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -679,8 +679,8 @@ subdirectories). * `info [directory|file|remote ...]` Displays statistics and other information for the specified item, - which can be a directory, or a file, or a remote (specified by name or - UUID). When no item is specified, displays statistics and information + which can be a directory, or a file, or a remote. + When no item is specified, displays statistics and information for the repository as a whole. When a directory is specified, the file matching options can be used |