base64-bytestring 1.1.0.0 → 1.2.0.0
raw patch · 4 files changed
+239/−118 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +9/−0
- Data/ByteString/Base64/Internal.hs +98/−37
- base64-bytestring.cabal +64/−58
- tests/Tests.hs +68/−23
CHANGELOG.md view
@@ -1,5 +1,14 @@ See also http://pvp.haskell.org/faq +# 1.2.0.0++* Security fix: reject non-canonical base64 encoded values - ([#38](https://github.com/haskell/base64-bytestring/pull/38)) fixing issue [#24](https://github.com/haskell/base64-bytestring/issues/24).++* Security fix: reject bytestrings with improper padding that can be "completed" by the unpadded-Base64url workflow, and homogenize error messages ([#33](https://github.com/haskell/base64-bytestring/pull/33))++* Test coverage expanded to 98% of the library. All critical paths covered.++ # 1.1.0.0 * `joinWith` has been removed ([#32](https://github.com/haskell/base64-bytestring/pull/32))
Data/ByteString/Base64/Internal.hs view
@@ -28,7 +28,7 @@ import Data.Word (Word8, Word16, Word32) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, castForeignPtr) import Foreign.Ptr (Ptr, castPtr, minusPtr, plusPtr)-import Foreign.Storable (peek, peekElemOff, poke, peekByteOff)+import Foreign.Storable (peek, peekElemOff, poke) import System.IO.Unsafe (unsafePerformIO) peek8 :: Ptr Word8 -> IO Word8@@ -121,51 +121,46 @@ table = B.pack $ concat $ [ [ix j, ix k] | j <- [0..63], k <- [0..63] ] -- | Decode a base64-encoded string. This function strictly follows--- the specification in--- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>.+-- the specification in <http://tools.ietf.org/rfc/rfc4648 RFC 4648>.+-- -- This function takes the decoding table (for @base64@ or @base64url@) as--- the first paramert.+-- the first parameter.+--+-- For validation of padding properties, see note: $Validation+-- decodeWithTable :: Padding -> ForeignPtr Word8 -> ByteString -> Either String ByteString decodeWithTable _ _ (PS _ _ 0) = Right B.empty-decodeWithTable padding decodeFP bs@(PS !fp !o !l) = unsafePerformIO $+decodeWithTable padding decodeFP bs = case padding of Padded- | r == 1 -> err "Base64-encoded bytestring has invalid size"- | r /= 0 -> err "Base64-encoded bytestring required to be padded"- | otherwise -> go bs+ | r == 0 -> unsafePerformIO $ go bs+ | r == 1 -> Left "Base64-encoded bytestring has invalid size"+ | otherwise -> Left "Base64-encoded bytestring is unpadded or has invalid padding" Don'tCare- | r == 0 -> go bs- | r == 2 -> go (B.append bs (B.replicate 2 0x3d))- | r == 3 -> go (B.append bs (B.replicate 1 0x3d))- | otherwise -> err "Base64-encoded bytestring has invalid size"+ | r == 0 -> unsafePerformIO $ go bs+ | r == 2 -> unsafePerformIO $ go (B.append bs (B.replicate 2 0x3d))+ | r == 3 -> validateLastPad bs invalidPad $ go (B.append bs (B.replicate 1 0x3d))+ | otherwise -> Left "Base64-encoded bytestring has invalid size" Unpadded- | r == 0 -> validateUnpadded (go bs)- | r == 2 -> validateUnpadded (go (B.append bs (B.replicate 2 0x3d)))- | r == 3 -> validateUnpadded (go (B.append bs (B.replicate 1 0x3d)))- | otherwise -> err "Base64-encoded bytestring has invalid size"+ | r == 0 -> validateLastPad bs noPad $ go bs+ | r == 2 -> validateLastPad bs noPad $ go (B.append bs (B.replicate 2 0x3d))+ | r == 3 -> validateLastPad bs noPad $ go (B.append bs (B.replicate 1 0x3d))+ | otherwise -> Left "Base64-encoded bytestring has invalid size" where- err = return . Left-- (q, r) = (B.length bs) `divMod` 4-- dlen = q * 3+ (!q, !r) = (B.length bs) `divMod` 4 - validateUnpadded io = withForeignPtr fp $ \p -> do- let !end = l + o- a <- peek (plusPtr p (end - 1))- b <- peek (plusPtr p (end - 2))+ noPad = "Base64-encoded bytestring required to be unpadded"+ invalidPad = "Base64-encoded bytestring has invalid padding" - let !pad = 0x3d :: Word8- if a == pad || b == pad- then err "Base64-encoded bytestring required to be unpadded"- else io+ !dlen = q * 3 go (PS !sfp !soff !slen) = do dfp <- mallocByteString dlen withForeignPtr decodeFP $ \ !decptr -> withForeignPtr sfp $ \sptr -> withForeignPtr dfp $ \dptr ->- decodeLoop decptr (plusPtr sptr soff) dptr (sptr `plusPtr` (slen + soff)) dfp+ decodeLoop decptr (plusPtr sptr soff) dptr+ (sptr `plusPtr` (slen + soff)) dfp decodeLoop :: Ptr Word8@@ -185,14 +180,18 @@ $ "invalid character at offset: " ++ show (p `minusPtr` sptr) - padErr p = return . Left+ padErr p = return . Left $ "invalid padding at offset: " ++ show (p `minusPtr` sptr) + canonErr p = return . Left+ $ "non-canonical encoding detected at offset: "+ ++ show (p `minusPtr` sptr)+ look :: Ptr Word8 -> IO Word32 look !p = do- !i <- peekByteOff p 0 :: IO Word8- !v <- peekByteOff dtable (fromIntegral i) :: IO Word8+ !i <- peek p+ !v <- peekElemOff dtable (fromIntegral i) return (fromIntegral v) go !dst !src@@ -255,11 +254,17 @@ poke8 dst (fromIntegral (shiftR w 16)) if c == 0x63 && d == 0x63- then return $ Right $ PS dfp 0 (1 + (dst `minusPtr` dptr))+ then+ if sanityCheckPos b mask_4bits+ then return $ Right $ PS dfp 0 (1 + (dst `minusPtr` dptr))+ else canonErr (plusPtr src 1) else if d == 0x63- then do- poke8 (plusPtr dst 1) (fromIntegral (shiftR w 8))- return $ Right $ PS dfp 0 (2 + (dst `minusPtr` dptr))+ then+ if sanityCheckPos c mask_2bits+ then do+ poke8 (plusPtr dst 1) (fromIntegral (shiftR w 8))+ return $ Right $ PS dfp 0 (2 + (dst `minusPtr` dptr))+ else canonErr (plusPtr src 2) else do poke8 (plusPtr dst 1) (fromIntegral (shiftR w 8)) poke8 (plusPtr dst 2) (fromIntegral w)@@ -351,3 +356,59 @@ in acc' : go zs' else -- suffix must be null fixup acc' zs++-- $Validation+--+-- This function checks that the last char of a bytestring is '='+-- and, if true, fails with a message or completes some io action.+--+-- This is necessary to check when decoding permissively (i.e. filling in padding chars).+-- Consider the following 4 cases of a string of length l:+--+-- l = 0 mod 4: No pad chars are added, since the input is assumed to be good.+-- l = 1 mod 4: Never an admissible length in base64+-- l = 2 mod 4: 2 padding chars are added. If padding chars are present in the last 4 chars of the string,+-- they will fail to decode as final quanta.+-- l = 3 mod 4: 1 padding char is added. In this case a string is of the form <body> + <padchar>. If adding the+-- pad char "completes" the string so that it is `l = 0 mod 4`, then this may possibly form corrupted data.+-- This case is degenerate and should be disallowed.+--+-- Hence, permissive decodes should only fill in padding chars when it makes sense to add them. That is,+-- if an input is degenerate, it should never succeed when we add padding chars. We need the following invariant to hold:+--+-- @+-- B64U.decodeUnpadded <|> B64U.decodePadded ~ B64U.decodePadded+-- @+--+-- This means the only char we need to check is the last one, and only to disallow `l = 3 mod 4`.+--+validateLastPad+ :: ByteString+ -- ^ input to validate+ -> String+ -- ^ error msg+ -> IO (Either String ByteString)+ -> Either String ByteString+validateLastPad bs err io+ | B.last bs == 0x3d = Left err+ | otherwise = unsafePerformIO io+{-# INLINE validateLastPad #-}++-- | Sanity check an index against a bitmask to make sure+-- it's coherent. If pos & mask == 0, we're good. If not, we should fail.+--+sanityCheckPos :: Word32 -> Word8 -> Bool+sanityCheckPos pos mask = ((fromIntegral pos) .&. mask) == 0+{-# INLINE sanityCheckPos #-}++-- | Mask 2 bits+--+mask_2bits :: Word8+mask_2bits = 3 -- (1 << 2) - 1+{-# NOINLINE mask_2bits #-}++-- | Mask 4 bits+--+mask_4bits :: Word8+mask_4bits = 15 -- (1 << 4) - 1+{-# NOINLINE mask_4bits #-}
base64-bytestring.cabal view
@@ -1,24 +1,39 @@-cabal-version: 1.12-name: base64-bytestring-version: 1.1.0.0-synopsis: Fast base64 encoding and decoding for ByteStrings-description: This package provides support for encoding and decoding binary data according to @base64@ (see also <https://tools.ietf.org/html/rfc4648 RFC 4648>) for strict and lazy ByteStrings.-homepage: https://github.com/haskell/base64-bytestring-bug-reports: https://github.com/haskell/base64-bytestring/issues-license: BSD3-license-file: LICENSE-author: Bryan O'Sullivan <bos@serpentine.com>-maintainer: Herbert Valerio Riedel <hvr@gnu.org>,- Mikhail Glushenkov <mikhail.glushenkov@gmail.com>,- Emily Pillmore <emilypi@cohomolo.gy>-copyright: 2010-2020 Bryan O'Sullivan et al.-category: Data-build-type: Simple-tested-with: GHC==8.10.1, GHC==8.8.3, GHC==8.6.5,- GHC==8.4.4, GHC==8.2.2, GHC==8.0.2,- GHC==7.10.3, GHC==7.8.4, GHC==7.6.3,- GHC==7.4.2, GHC==7.2.2, GHC==7.0.4+cabal-version: 1.12+name: base64-bytestring+version: 1.2.0.0+synopsis: Fast base64 encoding and decoding for ByteStrings+description:+ This package provides support for encoding and decoding binary data according to @base64@ (see also <https://tools.ietf.org/html/rfc4648 RFC 4648>) for strict and lazy ByteStrings+ .+ For a fuller-featured and better-performing Base64 library, see the <https://hackage.haskell.org/package/base64 base64> package. +homepage: https://github.com/haskell/base64-bytestring+bug-reports: https://github.com/haskell/base64-bytestring/issues+license: BSD3+license-file: LICENSE+author: Bryan O'Sullivan <bos@serpentine.com>+maintainer:+ Herbert Valerio Riedel <hvr@gnu.org>,+ Mikhail Glushenkov <mikhail.glushenkov@gmail.com>,+ Emily Pillmore <emilypi@cohomolo.gy>++copyright: 2010-2020 Bryan O'Sullivan et al.+category: Data+build-type: Simple+tested-with:+ GHC ==7.0.4+ || ==7.2.2+ || ==7.4.2+ || ==7.6.3+ || ==7.8.4+ || ==7.10.3+ || ==8.0.2+ || ==8.2.2+ || ==8.4.4+ || ==8.6.5+ || ==8.8.3+ || ==8.10.1+ extra-source-files: README.md CHANGELOG.md@@ -28,58 +43,49 @@ library exposed-modules: Data.ByteString.Base64- Data.ByteString.Base64.URL Data.ByteString.Base64.Lazy+ Data.ByteString.Base64.URL Data.ByteString.Base64.URL.Lazy - other-modules:- Data.ByteString.Base64.Internal-+ other-modules: Data.ByteString.Base64.Internal build-depends:- base == 4.*,- bytestring >= 0.9 && < 0.11-- ghc-options: -Wall -funbox-strict-fields+ base >=4 && <5+ , bytestring >=0.9 && <0.11 + ghc-options: -Wall -funbox-strict-fields default-language: Haskell2010 test-suite tests- type: exitcode-stdio-1.0- hs-source-dirs: tests- main-is: Tests.hs-- ghc-options:- -Wall -threaded -rtsopts-+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Tests.hs+ ghc-options: -Wall -threaded -rtsopts build-depends:- QuickCheck,- HUnit,- base64-bytestring,- base,- containers,- bytestring,- split,- test-framework,- test-framework-quickcheck2,- test-framework-hunit+ base+ , base64-bytestring+ , bytestring+ , containers+ , HUnit+ , QuickCheck+ , split+ , test-framework+ , test-framework-hunit+ , test-framework-quickcheck2 default-language: Haskell2010 benchmark benchmarks- type: exitcode-stdio-1.0- hs-source-dirs: benchmarks- main-is: BM.hs-- ghc-options:- -Wall -threaded -rtsopts-+ type: exitcode-stdio-1.0+ hs-source-dirs: benchmarks+ main-is: BM.hs+ ghc-options: -Wall -threaded -rtsopts build-depends:- base,- bytestring,- containers,- deepseq,- base64-bytestring,- criterion+ base+ , base64-bytestring+ , bytestring+ , containers+ , criterion+ , deepseq default-language: Haskell2010
tests/Tests.hs view
@@ -36,24 +36,52 @@ , _lenient :: bs -> bs } +data UrlImpl bs = UrlImpl+ { _labelUrl :: String+ , _encodeUrl :: bs -> bs+ , _decodeUrl :: bs -> Either String bs+ , _encodeUrlNopad :: bs -> bs+ , _decodeUrlNopad :: bs -> Either String bs+ , _decodeUrlPad :: bs -> Either String bs+ , _lenientUrl :: bs -> bs+ }+ tests :: [Test] tests = [ testGroup "property tests"- [ testsRegular $ Impl "Base64" Base64.encode Base64.decode Base64.decodeLenient- , testsRegular $ Impl "LBase64" LBase64.encode LBase64.decode LBase64.decodeLenient- , testsURL $ Impl "Base64URL" Base64URL.encode Base64URL.decode Base64URL.decodeLenient- , testsURL $ Impl "Base64URLPadded" Base64URL.encode Base64URL.decodePadded Base64URL.decodeLenient- , testsURLNopad $ Impl "Base64URLUnpadded" Base64URL.encodeUnpadded Base64URL.decodeUnpadded Base64URL.decodeLenient- , testsURL $ Impl "LBase64URL" LBase64URL.encode LBase64URL.decode LBase64URL.decodeLenient- , testsURL $ Impl "LBase64URLPadded" LBase64URL.encode LBase64URL.decodePadded LBase64URL.decodeLenient- , testsURLNopad $ Impl "LBase64URLUnpadded" LBase64URL.encodeUnpadded LBase64URL.decodeUnpadded LBase64URL.decodeLenient+ [ testsRegular b64impl+ , testsRegular lb64impl+ , testsURL b64uimpl+ , testsURL lb64uimpl ] , testGroup "unit tests" [ base64UrlUnitTests , lazyBase64UrlUnitTests ] ]+ where+ b64impl = Impl "Base64" Base64.encode Base64.decode Base64.decodeLenient+ lb64impl = Impl "LBase64" LBase64.encode LBase64.decode LBase64.decodeLenient + b64uimpl = UrlImpl+ "Base64URL"+ Base64URL.encode+ Base64URL.decode+ Base64URL.encodeUnpadded+ Base64URL.decodeUnpadded+ Base64URL.decodePadded+ Base64URL.decodeLenient++ lb64uimpl = UrlImpl+ "LBase64URL"+ LBase64URL.encode+ LBase64URL.decode+ LBase64URL.encodeUnpadded+ LBase64URL.decodeUnpadded+ LBase64URL.decodePadded+ LBase64URL.decodeLenient++ testsRegular :: ( IsString bs , AllRepresentations bs@@ -72,20 +100,17 @@ , Eq bs , Arbitrary bs )- => Impl bs- -> Test-testsURL = testsWith base64url_testData--testsURLNopad- :: ( IsString bs- , AllRepresentations bs- , Show bs- , Eq bs- , Arbitrary bs- )- => Impl bs+ => UrlImpl bs -> Test-testsURLNopad = testsWith base64url_testData_nopad+testsURL (UrlImpl l e d eu du dp dl) = testGroup l+ [ testsWith base64url_testData (Impl "Arbitrary Padding" e d dl)+ , testsWith base64url_testData (Impl "Required Padding" e dp dl)+ , testsWith base64url_testData_nopad (Impl "No padding" eu du dl)+ , testProperty "prop_url_pad_roundtrip" $ \bs -> Right bs == dp (e bs)+ , testProperty "prop_url_nopad_roundtrip" $ \bs -> Right bs == du (eu bs)+ , testProperty "prop_url_decode_invariant" $ \bs ->+ ((du (eu bs)) == (d (e bs))) || ((dp (e bs)) == d (e bs))+ ] testsWith :: ( IsString bs@@ -149,6 +174,7 @@ where decodeLenient' = liftM Right decodeLenient + base64_testData :: IsString bs => [(bs, bs)] base64_testData = [("", "") ,("\0", "AA==")@@ -272,7 +298,26 @@ Base64.decode "eAoe=Ao=" @=? Left "invalid padding at offset: 4" Base64.decode "eAoeA=o=" @=? Left "invalid padding at offset: 5" ]+ , testGroup "Non-canonical encodings fail and canonical encodings succeed"+ [ testCase "roundtrip for d ~ ZA==" $ do+ Base64.decode "ZE==" @=? Left "non-canonical encoding detected at offset: 1"+ Base64.decode "ZK==" @=? Left "non-canonical encoding detected at offset: 1"+ Base64.decode "ZA==" @=? Right "d"+ , testCase "roundtrip for f` ~ ZmA=" $ do+ Base64.decode "ZmC=" @=? Left "non-canonical encoding detected at offset: 2"+ Base64.decode "ZmD=" @=? Left "non-canonical encoding detected at offset: 2"+ Base64.decode "ZmA=" @=? Right "f`" + , testCase "roundtrip for foo` ~ Zm9vYA==" $ do+ Base64.decode "Zm9vYE==" @=? Left "non-canonical encoding detected at offset: 5"+ Base64.decode "Zm9vYK==" @=? Left "non-canonical encoding detected at offset: 5"+ Base64.decode "Zm9vYA==" @=? Right "foo`"++ , testCase "roundtrip for foob` ~ Zm9vYmA=" $ do+ Base64.decode "Zm9vYmC=" @=? Left "non-canonical encoding detected at offset: 6"+ Base64.decode "Zm9vYmD=" @=? Left "non-canonical encoding detected at offset: 6"+ Base64.decode "Zm9vYmA=" @=? Right "foob`"+ ] , testGroup "Base64URL padding case unit tests" [ testCase "stress arbitarily padded URL strings" $ do Base64URL.decode "P" @=? Left "Base64-encoded bytestring has invalid size"@@ -342,7 +387,7 @@ Right s else do assertEqual "Unpadded required: padding fails" u $- Left "Base64-encoded bytestring required to be padded"+ Left "Base64-encoded bytestring is unpadded or has invalid padding" assertEqual "Unpadded required: unpadding succeeds" v $ Right s@@ -446,7 +491,7 @@ Right s else do assertEqual "Unpadded required: padding fails" u $- Left "Base64-encoded bytestring required to be padded"+ Left "Base64-encoded bytestring is unpadded or has invalid padding" assertEqual "Unpadded required: unpadding succeeds" v $ Right s