2015-07-02 21:44:25 +00:00
|
|
|
{- git-annex command
|
|
|
|
-
|
|
|
|
- Copyright 2010, 2015 Joey Hess <joey@kitenet.net>
|
|
|
|
-
|
2019-03-13 19:48:14 +00:00
|
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
2015-07-02 21:44:25 +00:00
|
|
|
-}
|
|
|
|
|
|
|
|
module Command.SetKey where
|
|
|
|
|
|
|
|
import Command
|
|
|
|
import Logs.Location
|
|
|
|
import Annex.Content
|
|
|
|
|
2015-07-08 16:33:27 +00:00
|
|
|
cmd :: Command
|
2015-07-08 19:08:02 +00:00
|
|
|
cmd = command "setkey" SectionPlumbing "sets annexed content for a key"
|
|
|
|
(paramPair paramKey paramPath)
|
|
|
|
(withParams seek)
|
2015-07-02 21:44:25 +00:00
|
|
|
|
2015-07-08 19:08:02 +00:00
|
|
|
seek :: CmdParams -> CommandSeek
|
2018-10-01 18:12:06 +00:00
|
|
|
seek = withWords (commandAction . start)
|
2015-07-02 21:44:25 +00:00
|
|
|
|
|
|
|
start :: [String] -> CommandStart
|
2020-09-14 20:49:33 +00:00
|
|
|
start ps@(keyname:file:[]) = starting "setkey" ai si $
|
2023-04-08 19:48:32 +00:00
|
|
|
perform file' (keyOpt keyname)
|
2020-09-14 20:49:33 +00:00
|
|
|
where
|
2023-04-08 19:48:32 +00:00
|
|
|
ai = ActionItemOther (Just (QuotedPath file'))
|
2020-09-14 20:49:33 +00:00
|
|
|
si = SeekInput ps
|
2023-04-08 19:48:32 +00:00
|
|
|
file' = toRawFilePath file
|
2016-11-16 01:29:54 +00:00
|
|
|
start _ = giveup "specify a key and a content file"
|
2015-07-02 21:44:25 +00:00
|
|
|
|
2019-11-22 20:24:04 +00:00
|
|
|
keyOpt :: String -> Key
|
|
|
|
keyOpt = fromMaybe (giveup "bad key") . deserializeKey
|
2015-07-02 21:44:25 +00:00
|
|
|
|
2020-11-02 20:31:28 +00:00
|
|
|
perform :: RawFilePath -> Key -> CommandPerform
|
2015-07-02 21:44:25 +00:00
|
|
|
perform file key = do
|
2015-07-07 18:48:23 +00:00
|
|
|
-- the file might be on a different filesystem, so moveFile is used
|
2015-07-02 21:44:25 +00:00
|
|
|
-- rather than simply calling moveAnnex; disk space is also
|
|
|
|
-- checked this way.
|
disk free checking for unsized keys
Improve disk free space checking when transferring unsized keys to
local git remotes. Since the size of the object file is known, can
check that instead.
Getting unsized keys from local git remotes does not check the actual
object size. It would be harder to handle that direction because the size
check is run locally, before anything involving the remote is done. So it
doesn't know the size of the file on the remote.
Also, transferring unsized keys to other remotes, including ssh remotes and
p2p remotes don't do disk size checking for unsized keys. This would need a
change in protocol.
(It does seem like it would be possible to implement the same thing for
directory special remotes though.)
In some sense, it might be better to not ever do disk free checking for
unsized keys, than to do it only sometimes. A user might notice this
direction working and consider it a bug that the other direction does not.
On the other hand, disk reserve checking is not implemented for most
special remotes at all, and yet it is implemented for a few, which is also
inconsistent, but best effort. And so doing this best effort seems to make
some sense. Fundamentally, if the user wants the size to always be checked,
they should not use unsized keys.
Sponsored-by: Brock Spratlen on Patreon
2024-01-16 18:29:10 +00:00
|
|
|
ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key (AssociatedFile Nothing) Nothing $ \dest -> unVerified $
|
2015-07-02 21:44:25 +00:00
|
|
|
if dest /= file
|
2015-07-07 18:48:23 +00:00
|
|
|
then liftIO $ catchBoolIO $ do
|
2022-06-22 20:47:34 +00:00
|
|
|
moveFile file dest
|
2015-07-07 18:48:23 +00:00
|
|
|
return True
|
2015-07-02 21:44:25 +00:00
|
|
|
else return True
|
|
|
|
if ok
|
|
|
|
then next $ cleanup key
|
2023-04-10 17:38:14 +00:00
|
|
|
else giveup "move failed!"
|
2015-07-02 21:44:25 +00:00
|
|
|
|
|
|
|
cleanup :: Key -> CommandCleanup
|
|
|
|
cleanup key = do
|
2024-08-23 20:35:12 +00:00
|
|
|
logStatus NoLiveUpdate key InfoPresent
|
2015-07-02 21:44:25 +00:00
|
|
|
return True
|