SQSERVICES-1232 Prevent CSV Injection

changelog.d/3-bug-fixes/pr-2096

@@ -0,0 +1 @@
+Escape disallowed characters at the beginning of CSV cells to prevent CSV injection vulnerability.

libs/wire-api/package.yaml

@@ -105,6 +105,7 @@ tests:
     - base
     - bytestring
     - bytestring-conversion
+    - bytestring-arbitrary >=0.1.3
     - cassava
     - currency-codes
     - directory

libs/wire-api/src/Wire/API/Team/Export.hs

@@ -15,11 +15,12 @@
 -- You should have received a copy of the GNU Affero General Public License along
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
-module Wire.API.Team.Export (TeamExportUser (..)) where
+module Wire.API.Team.Export (TeamExportUser (..), quoted, unquoted) where
 
 import qualified Data.Aeson as Aeson
 import Data.Attoparsec.ByteString.Lazy (parseOnly)
-import Data.ByteString.Conversion (FromByteString (..), toByteString')
+import qualified Data.ByteString.Char8 as C
+import Data.ByteString.Conversion (FromByteString (..), ToByteString, toByteString')
 import Data.Csv (DefaultOrdered (..), FromNamedRecord (..), Parser, ToNamedRecord (..), namedRecord, (.:))
 import Data.Handle (Handle)
 import Data.Id (UserId)
@@ -56,20 +57,23 @@ data TeamExportUser = TeamExportUser
 instance ToNamedRecord TeamExportUser where
   toNamedRecord row =
     namedRecord
-      [ ("display_name", toByteString' (tExportDisplayName row)),
-        ("handle", maybe "" toByteString' (tExportHandle row)),
-        ("email", maybe "" toByteString' (tExportEmail row)),
-        ("role", maybe "" toByteString' (tExportRole row)),
-        ("created_on", maybe "" toByteString' (tExportCreatedOn row)),
-        ("invited_by", maybe "" toByteString' (tExportInvitedBy row)),
-        ("idp_issuer", maybe "" toByteString' (tExportIdpIssuer row)),
-        ("managed_by", toByteString' (tExportManagedBy row)),
-        ("saml_name_id", toByteString' (tExportSAMLNamedId row)),
-        ("scim_external_id", toByteString' (tExportSCIMExternalId row)),
+      [ ("display_name", secureCsvFieldToByteString (tExportDisplayName row)),
+        ("handle", maybe "" secureCsvFieldToByteString (tExportHandle row)),
+        ("email", maybe "" secureCsvFieldToByteString (tExportEmail row)),
+        ("role", maybe "" secureCsvFieldToByteString (tExportRole row)),
+        ("created_on", maybe "" secureCsvFieldToByteString (tExportCreatedOn row)),
+        ("invited_by", maybe "" secureCsvFieldToByteString (tExportInvitedBy row)),
+        ("idp_issuer", maybe "" secureCsvFieldToByteString (tExportIdpIssuer row)),
+        ("managed_by", secureCsvFieldToByteString (tExportManagedBy row)),
+        ("saml_name_id", secureCsvFieldToByteString (tExportSAMLNamedId row)),
+        ("scim_external_id", secureCsvFieldToByteString (tExportSCIMExternalId row)),
         ("scim_rich_info", maybe "" (cs . Aeson.encode) (tExportSCIMRichInfo row)),
-        ("user_id", toByteString' (tExportUserId row))
+        ("user_id", secureCsvFieldToByteString (tExportUserId row))
       ]
 
+secureCsvFieldToByteString :: forall a. ToByteString a => a -> ByteString
+secureCsvFieldToByteString = quoted . toByteString'
+
 instance DefaultOrdered TeamExportUser where
   headerOrder =
     const $
@@ -94,7 +98,7 @@ allowEmpty p str = Just <$> p str
 
 parseByteString :: forall a. FromByteString a => ByteString -> Parser a
 parseByteString bstr =
-  case parseOnly (parser @a) bstr of
+  case parseOnly (parser @a) (unquoted bstr) of
     Left err -> fail err
     Right thing -> pure thing
 
@@ -113,3 +117,24 @@ instance FromNamedRecord TeamExportUser where
       <*> (nrec .: "scim_external_id" >>= parseByteString)
       <*> (nrec .: "scim_rich_info" >>= allowEmpty (maybe (fail "failed to decode RichInfo") pure . Aeson.decode . cs))
       <*> (nrec .: "user_id" >>= parseByteString)
+
+quoted :: ByteString -> ByteString
+quoted bs = case C.uncons bs of
+  -- fields that begin with a disallowed character are prepended with a single quote
+  Just ('=', _) -> '\'' `C.cons` bs
+  Just ('+', _) -> '\'' `C.cons` bs
+  Just ('-', _) -> '\'' `C.cons` bs
+  Just ('@', _) -> '\'' `C.cons` bs
+  -- tab
+  Just ('\x0009', _) -> '\'' `C.cons` bs
+  -- carriage return
+  Just ('\x000D', _) -> '\'' `C.cons` bs
+  -- if a field begins with a single quote we have to prepend another single quote to be able to decode back correctly
+  Just ('\'', _) -> '\'' `C.cons` bs
+  -- everything else is fine
+  _ -> bs
+
+unquoted :: ByteString -> ByteString
+unquoted bstr = case C.uncons bstr of
+  Just ('\'', t) -> t
+  _ -> bstr

libs/wire-api/test/unit/Main.hs

@@ -29,6 +29,7 @@ import qualified Test.Wire.API.Roundtrip.ByteString as Roundtrip.ByteString
 import qualified Test.Wire.API.Roundtrip.CSV as Roundtrip.CSV
 import qualified Test.Wire.API.Routes as Routes
 import qualified Test.Wire.API.Swagger as Swagger
+import qualified Test.Wire.API.Team.Export as Team.Export
 import qualified Test.Wire.API.Team.Member as Team.Member
 import qualified Test.Wire.API.User as User
 import qualified Test.Wire.API.User.RichInfo as User.RichInfo
@@ -41,6 +42,7 @@ main =
       "Tests"
       [ Call.Config.tests,
         Team.Member.tests,
+        Team.Export.tests,
         User.tests,
         User.Search.tests,
         User.RichInfo.tests,

libs/wire-api/test/unit/Test/Wire/API/Team/Export.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2022 Wire Swiss GmbH <[email protected]>
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- You should have received a copy of the GNU Affero General Public License along
+-- with this program. If not, see <https://www.gnu.org/licenses/>.
+
+module Test.Wire.API.Team.Export where
+
+import Data.ByteString.Arbitrary
+import qualified Data.ByteString.Char8 as C
+import Imports
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.QuickCheck (conjoin, counterexample, testProperty, (.||.), (===))
+import Wire.API.Team.Export
+
+tests :: TestTree
+tests =
+  testGroup
+    "Export"
+    [ testTrivialExamples,
+      testRoundTrip,
+      testUnquotedProp,
+      testQuotedProp
+    ]
+
+testTrivialExamples :: TestTree
+testTrivialExamples = testCase "quoted/unquoted examples" $ do
+  unquoted "'foobar" @?= "foobar"
+  unquoted "foobar" @?= "foobar"
+  unquoted "" @?= ""
+  quoted "" @?= ""
+  quoted "foobar" @?= "foobar"
+  quoted "=1+2" @?= "'=1+2"
+
+testRoundTrip :: TestTree
+testRoundTrip = testProperty "quoted roundtrip" prop
+  where
+    prop (ABS bs) = counterexample (show $ quoted bs) $ bs === (unquoted . quoted) bs
+
+testUnquotedProp :: TestTree
+testUnquotedProp = testProperty "unquoted arbitrary" prop
+  where
+    prop (ABS bs) = counterexample (show $ unquoted bs) $ (bs === unquoted bs) .||. startsWithSingleQuote bs
+    startsWithSingleQuote bs = case C.uncons bs of
+      Just ('\'', _) -> True
+      _ -> False
+
+testQuotedProp :: TestTree
+testQuotedProp = testProperty "quoted" prop
+  where
+    prop (ABS bs) = counterexample (show $ quoted bs) $ conjoin (checkQuoted bs <$> disallowedChars)
+    checkQuoted bs char = quoted (char `C.cons` bs) === '\'' `C.cons` char `C.cons` bs
+    disallowedChars = ['@', '+', '-', '=', '\'', '\x0009', '\x000D']

libs/wire-api/wire-api.cabal

@@ -559,6 +559,7 @@ test-suite wire-api-tests
       Test.Wire.API.Roundtrip.CSV
       Test.Wire.API.Routes
       Test.Wire.API.Swagger
+      Test.Wire.API.Team.Export
       Test.Wire.API.Team.Member
       Test.Wire.API.User
       Test.Wire.API.User.RichInfo
@@ -614,6 +615,7 @@ test-suite wire-api-tests
     , aeson-qq
     , base
     , bytestring
+    , bytestring-arbitrary >=0.1.3
     , bytestring-conversion
     , case-insensitive
     , cassava

stack.yaml

@@ -77,6 +77,7 @@ nix:
 allow-newer: true
 
 extra-deps:
+- bytestring-arbitrary-0.1.3@sha256:14db64d4fe126fbad2eb8d3601bfd80a693f3131e2db0e76891feffe44f10df8,1773
 - git: https://github.com/fimad/prometheus-haskell
   commit: 2e3282e5fb27ba8d989c271a0a989823fad7ec43
   subdirs: