setpresentkey: A new plumbing-level command.
This commit is contained in:
parent
589a048a7d
commit
43dc7f678f
5 changed files with 50 additions and 4 deletions
|
@ -27,6 +27,7 @@ import qualified Command.FromKey
|
||||||
import qualified Command.DropKey
|
import qualified Command.DropKey
|
||||||
import qualified Command.TransferKey
|
import qualified Command.TransferKey
|
||||||
import qualified Command.TransferKeys
|
import qualified Command.TransferKeys
|
||||||
|
import qualified Command.SetPresentKey
|
||||||
import qualified Command.ReKey
|
import qualified Command.ReKey
|
||||||
import qualified Command.MetaData
|
import qualified Command.MetaData
|
||||||
import qualified Command.View
|
import qualified Command.View
|
||||||
|
@ -150,6 +151,7 @@ cmds = concat
|
||||||
, Command.DropKey.cmd
|
, Command.DropKey.cmd
|
||||||
, Command.TransferKey.cmd
|
, Command.TransferKey.cmd
|
||||||
, Command.TransferKeys.cmd
|
, Command.TransferKeys.cmd
|
||||||
|
, Command.SetPresentKey.cmd
|
||||||
, Command.ReKey.cmd
|
, Command.ReKey.cmd
|
||||||
, Command.MetaData.cmd
|
, Command.MetaData.cmd
|
||||||
, Command.View.cmd
|
, Command.View.cmd
|
||||||
|
|
36
Command/SetPresentKey.hs
Normal file
36
Command/SetPresentKey.hs
Normal file
|
@ -0,0 +1,36 @@
|
||||||
|
{- git-annex command
|
||||||
|
-
|
||||||
|
- Copyright 2014 Joey Hess <joey@kitenet.net>
|
||||||
|
-
|
||||||
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Command.SetPresentKey where
|
||||||
|
|
||||||
|
import Common.Annex
|
||||||
|
import Command
|
||||||
|
import qualified Annex
|
||||||
|
import Logs.Location
|
||||||
|
import Logs.Presence.Pure
|
||||||
|
import Types.Key
|
||||||
|
|
||||||
|
cmd :: [Command]
|
||||||
|
cmd = [noCommit $ command "setpresentkey" (paramPair paramKey "[1|0]") seek
|
||||||
|
SectionPlumbing "change records of where key is present"]
|
||||||
|
|
||||||
|
seek :: CommandSeek
|
||||||
|
seek = withWords start
|
||||||
|
|
||||||
|
start :: [String] -> CommandStart
|
||||||
|
start (ks:us:vs:[]) = do
|
||||||
|
showStart' "setpresentkey" k Nothing
|
||||||
|
next $ perform k (toUUID us) status
|
||||||
|
where
|
||||||
|
k = fromMaybe (error "bad key") (file2key ks)
|
||||||
|
status = fromMaybe (error "bad value") (parseStatus vs)
|
||||||
|
start _ = error "Wrong number of parameters"
|
||||||
|
|
||||||
|
perform :: Key -> UUID -> LogStatus -> CommandPerform
|
||||||
|
perform k u status = next $ do
|
||||||
|
logChange k u status
|
||||||
|
return True
|
|
@ -30,14 +30,16 @@ parseLog = mapMaybe parseline . lines
|
||||||
where
|
where
|
||||||
parseline l = LogLine
|
parseline l = LogLine
|
||||||
<$> (utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" d)
|
<$> (utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" d)
|
||||||
<*> parsestatus s
|
<*> parseStatus s
|
||||||
<*> pure rest
|
<*> pure rest
|
||||||
where
|
where
|
||||||
(d, pastd) = separate (== ' ') l
|
(d, pastd) = separate (== ' ') l
|
||||||
(s, rest) = separate (== ' ') pastd
|
(s, rest) = separate (== ' ') pastd
|
||||||
parsestatus "1" = Just InfoPresent
|
|
||||||
parsestatus "0" = Just InfoMissing
|
parseStatus :: String -> Maybe LogStatus
|
||||||
parsestatus _ = Nothing
|
parseStatus "1" = Just InfoPresent
|
||||||
|
parseStatus "0" = Just InfoMissing
|
||||||
|
parseStatus _ = Nothing
|
||||||
|
|
||||||
{- Generates a log file. -}
|
{- Generates a log file. -}
|
||||||
showLog :: [LogLine] -> String
|
showLog :: [LogLine] -> String
|
||||||
|
|
1
debian/changelog
vendored
1
debian/changelog
vendored
|
@ -3,6 +3,7 @@ git-annex (5.20141220) UNRELEASED; urgency=medium
|
||||||
* vicfg: Avoid crashing on badly encoded config data.
|
* vicfg: Avoid crashing on badly encoded config data.
|
||||||
* Work around statfs() overflow on some XFS systems.
|
* Work around statfs() overflow on some XFS systems.
|
||||||
* sync: Now supports remote groups, the same way git remote update does.
|
* sync: Now supports remote groups, the same way git remote update does.
|
||||||
|
* setpresentkey: A new plumbing-level command.
|
||||||
|
|
||||||
-- Joey Hess <id@joeyh.name> Mon, 22 Dec 2014 15:16:38 -0400
|
-- Joey Hess <id@joeyh.name> Mon, 22 Dec 2014 15:16:38 -0400
|
||||||
|
|
||||||
|
|
|
@ -948,6 +948,11 @@ subdirectories).
|
||||||
stdio protocol, which is intentionally not documented (as it may change
|
stdio protocol, which is intentionally not documented (as it may change
|
||||||
at any time).
|
at any time).
|
||||||
|
|
||||||
|
* `setpresentkey key uuid [1|0]`
|
||||||
|
|
||||||
|
This plumbing-level command changes git-annex's records about whether
|
||||||
|
the specified key is present in a remote with the specified uuid.
|
||||||
|
|
||||||
* `rekey [file key ...]`
|
* `rekey [file key ...]`
|
||||||
|
|
||||||
This plumbing-level command is similar to migrate, but you specify
|
This plumbing-level command is similar to migrate, but you specify
|
||||||
|
|
Loading…
Reference in a new issue