mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

add per-remote-type info

Browse source 
Now `git annex info $remote` shows info specific to the type of the remote,
for example, it shows the rsync url.

Remote types that support encryption or chunking also include that in their
info.

This commit was sponsored by Ævar Arnfjörð Bjarmason.
This commit is contained in:
Joey Hess 2014-10-21 14:36:09 -04:00
parent aafaa363e3
commit a0297915c1
20 changed files with 82 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
Command/Info.hs
View file

@ -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)

1
Remote/Bup.hs
View file

@ -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)

1
Remote/Ddar.hs
View file

@ -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)

3
Remote/Directory.hs
View file

@ -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

1
Remote/External.hs
View file

@ -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)

1
Remote/GCrypt.hs
View file

@ -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)

1
Remote/Git.hs
View file

@ -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)

3
Remote/Glacier.hs
View file

@ -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.

9
Remote/Helper/Chunked.hs
View file

@ -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

8
Remote/Helper/Encryptable.hs
View file

@ -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 ++ ")"

5
Remote/Helper/Git.hs
View file

@ -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)
]

6
Remote/Helper/Special.hs
View file

@ -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

3
Remote/Hook.hs
View file

@ -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

1
Remote/Rsync.hs
View file

@ -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)

3
Remote/S3.hs
View file

@ -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)

3
Remote/Tahoe.hs
View file

@ -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)

3
Remote/Web.hs
View file

@ -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

3
Remote/WebDAV.hs
View file

@ -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

4
Types/Remote.hs
View file

@ -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

4
doc/git-annex.mdwn
View file

@ -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