cd544e548bgiveup changed to filter out control characters. (It is too low level to make it use StringContainingQuotedPath.) error still does not, but it should only be used for internal errors, where the message is not attacker-controlled. Changed a lot of existing error to giveup when it is not strictly an internal error. Of course, other exceptions can still be thrown, either by code in git-annex, or a library, that include some attacker-controlled value. This does not guard against those. Sponsored-by: Noam Kremen on Patreon
52 lines
1.4 KiB
Haskell
52 lines
1.4 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010, 2015 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.SetKey where
|
|
|
|
import Command
|
|
import Logs.Location
|
|
import Annex.Content
|
|
|
|
cmd :: Command
|
|
cmd = command "setkey" SectionPlumbing "sets annexed content for a key"
|
|
(paramPair paramKey paramPath)
|
|
(withParams seek)
|
|
|
|
seek :: CmdParams -> CommandSeek
|
|
seek = withWords (commandAction . start)
|
|
|
|
start :: [String] -> CommandStart
|
|
start ps@(keyname:file:[]) = starting "setkey" ai si $
|
|
perform file' (keyOpt keyname)
|
|
where
|
|
ai = ActionItemOther (Just (QuotedPath file'))
|
|
si = SeekInput ps
|
|
file' = toRawFilePath file
|
|
start _ = giveup "specify a key and a content file"
|
|
|
|
keyOpt :: String -> Key
|
|
keyOpt = fromMaybe (giveup "bad key") . deserializeKey
|
|
|
|
perform :: RawFilePath -> Key -> CommandPerform
|
|
perform file key = do
|
|
-- the file might be on a different filesystem, so moveFile is used
|
|
-- rather than simply calling moveAnnex; disk space is also
|
|
-- checked this way.
|
|
ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key (AssociatedFile Nothing) $ \dest -> unVerified $
|
|
if dest /= file
|
|
then liftIO $ catchBoolIO $ do
|
|
moveFile file dest
|
|
return True
|
|
else return True
|
|
if ok
|
|
then next $ cleanup key
|
|
else giveup "move failed!"
|
|
|
|
cleanup :: Key -> CommandCleanup
|
|
cleanup key = do
|
|
logStatus key InfoPresent
|
|
return True
|