filter out control characters in warning messages

Converted warning and similar to use StringContainingQuotedPath. Most
warnings are static strings, some do refer to filepaths that need to be
quoted, and others don't need quoting.

Note that, since quote filters out control characters of even
UnquotedString, this makes all warnings safe, even when an attacker
sneaks in a control character in some other way.

When json is being output, no quoting is done, since json gets its own
quoting.

This does, as a side effect, make warning messages in json output not
be indented. The indentation is only needed to offset warning messages
underneath the display of the file they apply to, so that's ok.

Sponsored-by: Brett Eisenberg on Patreon
This commit is contained in:
Joey Hess 2023-04-10 14:47:32 -04:00
parent 007e302637
commit 3290a09a70
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
75 changed files with 259 additions and 229 deletions

View file

@ -25,7 +25,6 @@ import Messages.Progress
import Git.FilePath
import Git.Types
import Git.UpdateIndex
import Git.Filename
import Config.GitConfig
import Utility.OptParse
import Utility.InodeCache
@ -175,7 +174,7 @@ addFile smallorlarge file s = do
s' <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file
if maybe True (changed s) s'
then do
warning $ fromRawFilePath file ++ " changed while it was being added"
warning $ QuotedPath file <> " changed while it was being added"
return False
else do
case smallorlarge of

View file

@ -34,7 +34,6 @@ import Utility.Metered
import Utility.HtmlDetect
import Utility.Path.Max
import Utility.Url (parseURIPortable)
import Git.Filename
import qualified Utility.RawFilePath as R
import qualified Annex.Transfer as Transfer
@ -154,7 +153,7 @@ checkUrl addunlockedmatcher r o si u = do
where
go _ (Left e) = void $ commandAction $ startingAddUrl si u o $ do
warning (show e)
warning (UnquotedString (show e))
next $ return False
go deffile (Right (UrlContents sz mf)) = do
f <- maybe (pure deffile) (sanitizeOrPreserveFilePath o) mf
@ -234,7 +233,7 @@ startWeb addunlockedmatcher o si urlstring = go $ fromMaybe bad $ parseURIPortab
else Url.withUrlOptions (Url.getUrlInfo urlstring) >>= \case
Right urlinfo -> go' url urlinfo
Left err -> do
warning err
warning (UnquotedString err)
next $ return False
go' url urlinfo = do
pathmax <- liftIO $ fileNameLengthLimit "."
@ -306,7 +305,7 @@ addUrlChecked o url file u checkexistssize key =
logChange key u InfoPresent
next $ return True
| otherwise -> do
warning $ "while adding a new url to an already annexed file, " ++ if exists
warning $ UnquotedString $ "while adding a new url to an already annexed file, " ++ if exists
then "url does not have expected file size (use --relaxed to bypass this check) " ++ url
else "failed to verify url exists: " ++ url
stop
@ -347,7 +346,7 @@ downloadWeb addunlockedmatcher o url urlinfo file =
Right mediafile ->
let f = youtubeDlDestFile o file (toRawFilePath mediafile)
in lookupKey f >>= \case
Just k -> alreadyannexed (fromRawFilePath f) k
Just k -> alreadyannexed f k
Nothing -> dl f
Left err -> checkRaw (Just err) o Nothing (normalfinish tmp backend)
where
@ -366,7 +365,7 @@ downloadWeb addunlockedmatcher o url urlinfo file =
Right Nothing -> checkRaw Nothing o Nothing (normalfinish tmp backend)
Left msg -> do
cleanuptmp
warning msg
warning (UnquotedString msg)
return Nothing
mediaurl = setDownloader url YoutubeDownloader
mediakey = Backend.URL.fromUrl mediaurl Nothing
@ -377,13 +376,13 @@ downloadWeb addunlockedmatcher o url urlinfo file =
if mediaurl `elem` us
then return (Just k)
else do
warning $ dest ++ " already exists; not overwriting"
warning $ QuotedPath dest <> " already exists; not overwriting"
return Nothing
checkRaw :: (Maybe String) -> DownloadOptions -> a -> Annex a -> Annex a
checkRaw failreason o f a
| noRawOption o = do
warning $ "Unable to use youtube-dl or a special remote and --no-raw was specified" ++
warning $ UnquotedString $ "Unable to use youtube-dl or a special remote and --no-raw was specified" ++
case failreason of
Just msg -> ": " ++ msg
Nothing -> ""
@ -507,7 +506,7 @@ nodownloadWeb addunlockedmatcher o url urlinfo file
Right mediafile -> usemedia (toRawFilePath mediafile)
Left err -> checkRaw (Just err) o Nothing nomedia
| otherwise = do
warning $ "unable to access url: " ++ url
warning $ UnquotedString $ "unable to access url: " ++ url
return Nothing
where
nomedia = do
@ -565,11 +564,11 @@ data CanAddFile = CanAddFile
checkCanAdd :: DownloadOptions -> RawFilePath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a)
checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file))
( do
warning $ fromRawFilePath file ++ " already exists; not overwriting"
warning $ QuotedPath file <> " already exists; not overwriting"
return Nothing
, ifM (checkIgnored (checkGitIgnoreOption o) file)
( do
warning $ "not adding " ++ fromRawFilePath file ++ " which is .gitignored (use --no-check-gitignore to override)"
warning $ "not adding " <> QuotedPath file <> " which is .gitignored (use --no-check-gitignore to override)"
return Nothing
, a CanAddFile
)

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Command.DropUnused where
import Command

View file

@ -111,7 +111,7 @@ checkHiddenService = bracket setup cleanup go
-- we just want to know if the tor circuit works.
liftIO (tryNonAsync $ connectPeer g addr) >>= \case
Left e -> do
warning $ "Unable to connect to hidden service. It may not yet have propigated to the Tor network. (" ++ show e ++ ") Will retry.."
warning $ UnquotedString $ "Unable to connect to hidden service. It may not yet have propigated to the Tor network. (" ++ show e ++ ") Will retry.."
liftIO $ threadDelaySeconds (Seconds 2)
check (n-1) addrs
Right conn -> do

View file

@ -435,7 +435,7 @@ performRename r db ek src dest =
tryNonAsync (renameExport (exportActions r) ek src dest) >>= \case
Right (Just ()) -> next $ cleanupRename r db ek src dest
Left err -> do
warning $ "rename failed (" ++ show err ++ "); deleting instead"
warning $ UnquotedString $ "rename failed (" ++ show err ++ "); deleting instead"
fallbackdelete
-- remote does not support renaming
Right Nothing -> fallbackdelete

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Command.FromKey where
import Command
@ -130,7 +132,7 @@ perform matcher key file = lookupKeyNotHidden file >>= \case
| otherwise -> hasothercontent
where
hasothercontent = do
warning $ fromRawFilePath file ++ " already exists with different content"
warning $ QuotedPath file <> " already exists with different content"
next $ return False
linkunlocked = linkFromAnnex key file Nothing >>= \case

View file

@ -167,7 +167,7 @@ performRemote key afile backend numcopies remote =
Just (Right verification) -> go True (Just (tmpfile, verification))
Just (Left _) -> do
qp <- coreQuotePath <$> Annex.getGitConfig
warning (decodeBS (actionItemDesc qp ai) ++ ": failed to download file from remote")
warning $ UnquotedString (decodeBS (actionItemDesc qp ai)) <> ": failed to download file from remote"
void $ go True Nothing
return False
dispatch (Right False) = go False Nothing
@ -320,7 +320,7 @@ verifyLocationLog key keystatus ai = do
KeyLockedThin -> thawContent obj
_ -> freezeContent obj
checkContentWritePerm obj >>= \case
Nothing -> warning $ "** Unable to set correct write mode for " ++ fromRawFilePath obj ++ " ; perhaps you don't own that file, or perhaps it has an xattr or ACL set"
Nothing -> warning $ "** Unable to set correct write mode for " <> QuotedPath obj <> " ; perhaps you don't own that file, or perhaps it has an xattr or ACL set"
_ -> return ()
whenM (liftIO $ R.doesPathExist $ parentDir obj) $
freezeContentDir obj
@ -331,7 +331,7 @@ verifyLocationLog key keystatus ai = do
- config was set. -}
whenM (pure present <&&> (not <$> Backend.isCryptographicallySecure key)) $
whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $
warning $ "** Despite annex.securehashesonly being set, " ++ fromRawFilePath obj ++ " has content present in the annex using an insecure " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key"
warning $ "** Despite annex.securehashesonly being set, " <> QuotedPath obj <> " has content present in the annex using an insecure " <> UnquotedString (decodeBS (formatKeyVariety (fromKey keyVariety key))) <> " key"
verifyLocationLog' key ai present u (logChange key u)
@ -352,9 +352,9 @@ verifyLocationLog' key ai present u updatestatus = do
fix InfoMissing
qp <- coreQuotePath <$> Annex.getGitConfig
warning $
"** Based on the location log, " ++
decodeBS (actionItemDesc qp ai) ++
"\n** was expected to be present, " ++
"** Based on the location log, " <>
QuotedPath (actionItemDesc qp ai) <>
"\n** was expected to be present, " <>
"but its content is missing."
return False
(False, False) -> do
@ -393,10 +393,10 @@ verifyRequiredContent key ai@(ActionItemAssociatedFile afile _) = case afile of
qp <- coreQuotePath <$> Annex.getGitConfig
missingrequired <- Remote.prettyPrintUUIDs "missingrequired" missinglocs
warning $
"** Required content " ++
decodeBS (actionItemDesc qp ai) ++
" is missing from these repositories:\n" ++
missingrequired
"** Required content " <>
QuotedPath (actionItemDesc qp ai) <>
" is missing from these repositories:\n" <>
UnquotedString missingrequired
return False
verifyRequiredContent _ _ = return True
@ -468,13 +468,12 @@ checkKeySizeOr bad key file ai = case fromKey keySize key of
badsize a b = do
msg <- bad key
qp <- coreQuotePath <$> Annex.getGitConfig
warning $ concat
[ decodeBS (actionItemDesc qp ai)
, ": Bad file size ("
, compareSizes storageUnits True a b
, "); "
, msg
]
warning $
QuotedPath (actionItemDesc qp ai)
<> ": Bad file size ("
<> UnquotedString (compareSizes storageUnits True a b)
<> "); "
<> UnquotedString msg
{- Check for keys that are upgradable.
-
@ -487,13 +486,13 @@ checkKeyUpgrade backend key ai (AssociatedFile (Just file)) =
case Types.Backend.canUpgradeKey backend of
Just a | a key -> do
qp <- coreQuotePath <$> Annex.getGitConfig
warning $ concat
[ decodeBS (actionItemDesc qp ai)
, ": Can be upgraded to an improved key format. "
, "You can do so by running: git annex migrate --backend="
, decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " "
, decodeBS file
]
warning $
QuotedPath (actionItemDesc qp ai)
<> ": Can be upgraded to an improved key format. "
<> "You can do so by running: git annex migrate --backend="
<> UnquotedString (decodeBS (formatKeyVariety (fromKey keyVariety key)))
<> " "
<> QuotedPath file
return True
_ -> return True
checkKeyUpgrade _ _ _ (AssociatedFile Nothing) =
@ -539,11 +538,10 @@ checkBackendOr bad backend key file ai =
unless ok $ do
msg <- bad key
qp <- coreQuotePath <$> Annex.getGitConfig
warning $ concat
[ decodeBS (actionItemDesc qp ai)
, ": Bad file content; "
, msg
]
warning $
QuotedPath (actionItemDesc qp ai)
<> ": Bad file content; "
<> UnquotedString msg
return ok
Nothing -> return True
@ -568,17 +566,16 @@ checkInodeCache key content mic ai = case mic of
Nothing -> noop
Just ic' -> whenM (compareInodeCaches ic ic') $ do
qp <- coreQuotePath <$> Annex.getGitConfig
warning $ concat
[ decodeBS (actionItemDesc qp ai)
, ": Stale or missing inode cache; updating."
]
warning $
QuotedPath (actionItemDesc qp ai)
<> ": Stale or missing inode cache; updating."
Database.Keys.addInodeCaches key [ic]
checkKeyNumCopies :: Key -> AssociatedFile -> NumCopies -> Annex Bool
checkKeyNumCopies key afile numcopies = do
let (desc, hasafile) = case afile of
AssociatedFile Nothing -> (serializeKey key, False)
AssociatedFile (Just af) -> (fromRawFilePath af, True)
AssociatedFile Nothing -> (serializeKey' key, False)
AssociatedFile (Just af) -> (af, True)
locs <- loggedLocations key
(untrustedlocations, otherlocations) <- trustPartition UnTrusted locs
(deadlocations, safelocations) <- trustPartition DeadTrusted otherlocations
@ -598,21 +595,21 @@ checkKeyNumCopies key afile numcopies = do
)
else return True
missingNote :: String -> Int -> NumCopies -> String -> String -> String
missingNote :: RawFilePath -> Int -> NumCopies -> String -> String -> StringContainingQuotedPath
missingNote file 0 _ [] dead =
"** No known copies exist of " ++ file ++ honorDead dead
"** No known copies exist of " <> QuotedPath file <> UnquotedString (honorDead dead)
missingNote file 0 _ untrusted dead =
"Only these untrusted locations may have copies of " ++ file ++
"\n" ++ untrusted ++
"Back it up to trusted locations with git-annex copy." ++ honorDead dead
"Only these untrusted locations may have copies of " <> QuotedPath file <>
"\n" <> UnquotedString untrusted <>
"Back it up to trusted locations with git-annex copy." <> UnquotedString (honorDead dead)
missingNote file present needed [] _ =
"Only " ++ show present ++ " of " ++ show (fromNumCopies needed) ++
" trustworthy copies exist of " ++ file ++
"Only " <> UnquotedString (show present) <> " of " <> UnquotedString (show (fromNumCopies needed)) <>
" trustworthy copies exist of " <> QuotedPath file <>
"\nBack it up with git-annex copy."
missingNote file present needed untrusted dead =
missingNote file present needed [] dead ++
"\nThe following untrusted locations may also have copies: " ++
"\n" ++ untrusted
missingNote file present needed [] dead <>
"\nThe following untrusted locations may also have copies: " <>
"\n" <> UnquotedString untrusted
honorDead :: String -> String
honorDead dead

View file

@ -31,7 +31,6 @@ import Annex.RemoteTrackingBranch
import Utility.InodeCache
import Logs.Location
import Git.FilePath
import Git.Filename
import Git.Types
import Types.Import
import Utility.Metered
@ -171,7 +170,7 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
ignored <- checkIgnored (checkGitIgnoreOption o) destfile
if ignored
then do
warning $ "not importing " ++ fromRawFilePath destfile ++ " which is .gitignored (use --no-check-gitignore to override)"
warning $ "not importing " <> QuotedPath destfile <> " which is .gitignored (use --no-check-gitignore to override)"
stop
else do
existing <- liftIO (catchMaybeIO $ R.getSymbolicLinkStatus destfile)
@ -199,7 +198,7 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
Just s
| isDirectory s -> cont
| otherwise -> do
warning $ "not importing " ++ fromRawFilePath destfile ++ " because " ++ fromRawFilePath destdir ++ " is not a directory"
warning $ "not importing " <> QuotedPath destfile <> " because " <> QuotedPath destdir <> " is not a directory"
stop
importfilechecked ld k = do
@ -257,7 +256,7 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
, Command.Add.addSmall (DryRun False) destfile s
)
notoverwriting why = do
warning $ "not overwriting existing " ++ fromRawFilePath destfile ++ " " ++ why
warning $ "not overwriting existing " <> QuotedPath destfile <> " " <> UnquotedString why
stop
lockdown a = do
let mi = MatchingFile $ FileInfo
@ -335,7 +334,7 @@ seekRemote remote branch msubdir importcontent ci = do
liftIO (atomically (readTVar importabletvar)) >>= \case
Nothing -> return ()
Just importable -> importKeys remote importtreeconfig importcontent False importable >>= \case
Nothing -> warning $ concat
Nothing -> warning $ UnquotedString $ concat
[ "Failed to import some files from "
, Remote.name remote
, ". Re-run command to resume import."
@ -388,5 +387,5 @@ commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig
setRemoteTrackingBranch tb c
return True
Nothing -> do
warning $ "Nothing to import and " ++ fromRef branch ++ " does not exist."
warning $ UnquotedString $ "Nothing to import and " ++ fromRef branch ++ " does not exist."
return False

View file

@ -228,7 +228,7 @@ performDownload' started addunlockedmatcher opts cache todownload = case locatio
else Url.withUrlOptions (Url.getUrlInfo url) >>= \case
Right urlinfo -> go urlinfo
Left err -> do
warning err
warning (UnquotedString err)
return (Just [])
else do
res <- tryNonAsync $ maybe
@ -349,7 +349,7 @@ performDownload' started addunlockedmatcher opts cache todownload = case locatio
-- an enclosure.
Right Nothing -> Just <$> downloadlink True
Left msg -> do
warning $ linkurl ++ ": " ++ msg
warning $ UnquotedString $ linkurl ++ ": " ++ msg
return Nothing
return (fromMaybe False r)
, downloadlink False
@ -477,10 +477,10 @@ noneValue = "none"
feedProblem :: URLString -> String -> Annex Bool
feedProblem url message = ifM (checkFeedBroken url)
( do
warning $ message ++ " (having repeated problems with feed: " ++ url ++ ")"
warning $ UnquotedString $ message ++ " (having repeated problems with feed: " ++ url ++ ")"
return False
, do
warning $ "warning: " ++ message
warning $ UnquotedString $ "warning: " ++ message
return True
)

View file

@ -5,7 +5,7 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP, OverloadedStrings #-}
module Command.Multicast where
@ -211,7 +211,7 @@ storeReceived :: FilePath -> Annex ()
storeReceived f = do
case deserializeKey (takeFileName f) of
Nothing -> do
warning $ "Received a file " ++ f ++ " that is not a git-annex key. Deleting this file."
warning $ "Received a file " <> QuotedPath (toRawFilePath f) <> " that is not a git-annex key. Deleting this file."
liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
Just k -> void $ logStatusAfter k $
getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $

View file

@ -152,7 +152,7 @@ performPairing remotename addrs = do
warning "Failed receiving data from pair."
return False
LinkFailed e -> do
warning $ "Failed linking to pair: " ++ e
warning $ UnquotedString $ "Failed linking to pair: " ++ e
return False
where
ui observer producer = do

View file

@ -19,7 +19,6 @@ import Annex.ReplaceFile
import Logs.Location
import Annex.InodeSentinal
import Annex.WorkTree
import Git.Filename
import Utility.InodeCache
import qualified Utility.RawFilePath as R
@ -118,7 +117,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
ic <- withTSDelta (liftIO . genInodeCache file)
case v of
Left e -> do
warning (show e)
warning (UnquotedString (show e))
return False
Right () -> do
r <- linkToAnnex newkey file ic

View file

@ -18,7 +18,6 @@ import Utility.Metered
import Annex.WorkTree
import qualified Git
import qualified Annex
import Git.Filename
cmd :: Command
cmd = withAnnexOptions [backendOption] $

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Command.Smudge where
import Command
@ -142,7 +144,7 @@ clean' file mk passthrough discardreststdin emitpointer =
Right Nothing -> notpointer
Left InvalidAppendedPointerFile -> do
toplevelWarning False $
"The file \"" ++ fromRawFilePath file ++ "\" looks like git-annex pointer file that has had other content appended to it"
"The file " <> QuotedPath file <> " looks like git-annex pointer file that has had other content appended to it"
notpointer
notpointer = inRepo (Git.Ref.fileRef file) >>= \case
@ -329,5 +331,5 @@ updateSmudged restage = streamSmudged $ \k topf -> do
else Database.Keys.addInodeCaches k [ic]
Nothing -> liftIO (isPointerFile f) >>= \case
Just k' | k' == k -> toplevelWarning False $
"unable to populate worktree file " ++ fromRawFilePath f
"unable to populate worktree file " <> QuotedPath f
_ -> noop

View file

@ -403,7 +403,7 @@ mergeLocal' _ _ currbranch@(Nothing, _) = inRepo Git.Branch.currentUnsafe >>= \c
let ai = ActionItemOther (Just $ UnquotedString $ Git.Ref.describe syncbranch)
let si = SeekInput []
starting "merge" ai si $ do
warning $ "There are no commits yet to branch " ++ Git.fromRef branch ++ ", so cannot merge " ++ Git.fromRef syncbranch ++ " into it."
warning $ UnquotedString $ "There are no commits yet to branch " ++ Git.fromRef branch ++ ", so cannot merge " ++ Git.fromRef syncbranch ++ " into it."
next $ return False
Nothing -> stop
@ -533,7 +533,7 @@ importRemote importcontent o remote currbranch
-- mergeing it.
mc <- mergeConfig True
void $ mergeRemote remote currbranch mc o
else warning $ "Cannot import from " ++ Remote.name remote ++ " when not syncing content."
else warning $ UnquotedString $ "Cannot import from " ++ Remote.name remote ++ " when not syncing content."
where
wantpull = remoteAnnexPull (Remote.gitconfig remote)
@ -604,7 +604,7 @@ pushRemote o remote (Just branch, _) = do
if ok
then postpushupdate repo
else do
warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ]
warning $ UnquotedString $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ]
return ok
where
ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))

View file

@ -32,7 +32,6 @@ import Annex.SpecialRemote.Config (exportTreeField)
import Remote.Helper.Chunked
import Remote.Helper.Encryptable (encryptionField, highRandomQualityField)
import Git.Types
import Git.Filename
import Test.Tasty
import Test.Tasty.Runners

View file

@ -57,7 +57,7 @@ toPerform key file remote = go Upload file $
Remote.logStatus remote key InfoPresent
return True
Left e -> do
warning (show e)
warning (UnquotedString (show e))
return False
fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
@ -67,7 +67,7 @@ fromPerform key file remote = go Upload file $
tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p vc) >>= \case
Right v -> return (True, v)
Left e -> do
warning (show e)
warning (UnquotedString (show e))
return (False, UnVerified)
where
vc = RemoteVerify remote

View file

@ -43,7 +43,7 @@ start = do
upload' (Remote.uuid remote) key file Nothing stdRetry $ \p -> do
tryNonAsync (Remote.storeKey remote key file p) >>= \case
Left e -> do
warning (show e)
warning (UnquotedString (show e))
return False
Right () -> do
Remote.logStatus remote key InfoPresent
@ -53,7 +53,7 @@ start = do
logStatusAfter key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t -> do
r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote)) >>= \case
Left e -> do
warning (show e)
warning (UnquotedString (show e))
return (False, UnVerified)
Right v -> return (True, v)
-- Make sure we get the current

View file

@ -64,7 +64,7 @@ start = do
upload' (Remote.uuid remote) key file Nothing stdRetry $ \p -> do
tryNonAsync (Remote.storeKey remote key file p) >>= \case
Left e -> do
warning (show e)
warning (UnquotedString (show e))
return False
Right () -> do
Remote.logStatus remote key InfoPresent
@ -75,7 +75,7 @@ start = do
logStatusAfter key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t -> do
r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote)) >>= \case
Left e -> do
warning (show e)
warning (UnquotedString (show e))
return (False, UnVerified)
Right v -> return (True, v)
-- Make sure we get the current

View file

@ -40,7 +40,7 @@ trustCommand c level ps = withStrings (commandAction . start) ps
groupSet uuid S.empty
l <- lookupTrust uuid
when (l /= level) $
warning $ "This remote's trust level is overridden to " ++ showTrustLevel l ++ "."
warning $ UnquotedString $ "This remote's trust level is overridden to " ++ showTrustLevel l ++ "."
next $ return True
trustedNeedsForce :: String -> String

View file

@ -14,7 +14,6 @@ import Git.DiffTree
import Git.FilePath
import Git.UpdateIndex
import Git.Sha
import Git.Filename
import qualified Annex
import qualified Git.LsFiles as LsFiles
import qualified Git.Command as Git

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Command.View where
import Command

View file

@ -142,7 +142,7 @@ getRemoteUrls key remote
Just w -> tryNonAsync (w key) >>= \case
Right l -> pure l
Left e -> do
warning $ unwords
warning $ UnquotedString $ unwords
[ "unable to query remote"
, name remote
, "for urls:"