summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Command/Info.hs48
-rw-r--r--Remote/Bup.hs1
-rw-r--r--Remote/Ddar.hs1
-rw-r--r--Remote/Directory.hs3
-rw-r--r--Remote/External.hs1
-rw-r--r--Remote/GCrypt.hs1
-rw-r--r--Remote/Git.hs1
-rw-r--r--Remote/Glacier.hs3
-rw-r--r--Remote/Helper/Chunked.hs9
-rw-r--r--Remote/Helper/Encryptable.hs8
-rw-r--r--Remote/Helper/Git.hs5
-rw-r--r--Remote/Helper/Special.hs6
-rw-r--r--Remote/Hook.hs3
-rw-r--r--Remote/Rsync.hs1
-rw-r--r--Remote/S3.hs3
-rw-r--r--Remote/Tahoe.hs3
-rw-r--r--Remote/Web.hs3
-rw-r--r--Remote/WebDAV.hs3
-rw-r--r--Types/Remote.hs4
-rw-r--r--doc/git-annex.mdwn4
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