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
parent
007e302637
commit
3290a09a70
75 changed files with 259 additions and 229 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
)
|
||||
|
|
|
|||
|
|
@ -5,6 +5,8 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Command.DropUnused where
|
||||
|
||||
import Command
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
)
|
||||
|
||||
|
|
|
|||
|
|
@ -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 $
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -18,7 +18,6 @@ import Utility.Metered
|
|||
import Annex.WorkTree
|
||||
import qualified Git
|
||||
import qualified Annex
|
||||
import Git.Filename
|
||||
|
||||
cmd :: Command
|
||||
cmd = withAnnexOptions [backendOption] $
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -5,6 +5,8 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Command.View where
|
||||
|
||||
import Command
|
||||
|
|
|
|||
|
|
@ -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:"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue