addurl --preserve-filename: reject control characters

As well as escape sequences, control characters seem unlikely to be desired when
doing addurl, and likely to trip someone up. So disallow them as well.

I did consider going the other way and allowing filenames with control characters
and escape sequences, since git-annex is in the process of escaping display
of all filenames. Might still be a better idea?

Also display the illegal filename git quoted when it rejects it.

Sponsored-by: Nicholas Golder-Manning on Patreon

Annex/UntrustedFilePath.hs

@@ -52,8 +52,8 @@ sanitizeLeadingFilePathCharacter ('-':s) = '_':s
 sanitizeLeadingFilePathCharacter ('/':s) = '_':s
 sanitizeLeadingFilePathCharacter s = s
 
-escapeSequenceInFilePath :: FilePath -> Bool
-escapeSequenceInFilePath f = '\ESC' `elem` f
+controlCharacterInFilePath :: FilePath -> Bool
+controlCharacterInFilePath = any isControl
 
 {- ../ is a path traversal, no matter where it appears.
  -

CHANGELOG

@@ -4,6 +4,8 @@ git-annex (10.20230408) UNRELEASED; urgency=medium
     same way that git does, to avoid exposing control characters to the terminal.
   * Support core.quotePath, which can be set to false to display utf8
     characters as-is in filenames.
+  * addurl --preserve-filename now rejects filenames that contain other
+    control characters, besides the escape sequences it already rejected.
 
  -- Joey Hess <id@joeyh.name>  Sat, 08 Apr 2023 13:57:18 -0400
 

Command/AddUrl.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Command.AddUrl where
 
 import Command
@@ -32,6 +34,7 @@ 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
 
@@ -262,16 +265,18 @@ sanitizeOrPreserveFilePath o f
 -- (and probably others, but at least this catches the most egrarious ones).
 checkPreserveFileNameSecurity :: FilePath -> Annex ()
 checkPreserveFileNameSecurity f = do
-	checksecurity escapeSequenceInFilePath False "escape sequence"
-	checksecurity pathTraversalInFilePath True "path traversal"
-	checksecurity gitDirectoryInFilePath True "contains a .git directory"
+	checksecurity controlCharacterInFilePath "control character"
+	checksecurity pathTraversalInFilePath "path traversal"
+	checksecurity gitDirectoryInFilePath "contains a .git directory"
   where
-	checksecurity p canshow d = when (p f) $
-		giveup $ concat
-			[ "--preserve-filename was used, but the filename "
-			, if canshow then "(" ++ f ++ ") " else ""
-			, "has a security problem (" ++ d ++ "), not adding."
-			]
+	checksecurity p d = when (p f) $ do
+		qp <- coreQuotePath <$> Annex.getGitConfig
+		giveup $ decodeBS $ quote qp $
+			"--preserve-filename was used, but the filename ("
+				<> QuotedPath (toRawFilePath f)
+				<> ") has a security problem ("
+				<> d
+				<> "), not adding."
 
 performWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> RawFilePath -> Url.UrlInfo -> CommandPerform
 performWeb addunlockedmatcher o url file urlinfo = lookupKey file >>= \case

doc/git-annex-addurl.mdwn

@@ -70,7 +70,7 @@ be used to get better filenames.
    other modifications.
 
    git-annex will still check the filename for safety, and if the filename
-   has a security problem such as path traversal or an escape sequence,
+   has a security problem such as path traversal or a control character,
    it will refuse to add it.
 
 * `--pathdepth=N`