diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,17 @@ +# 1.0.0.2 + +* Fixed a write past allocated memory in joinWith (potential security + issue). + +# 0.1.1.0 - 1.0.0.1 + +* Changelog not recorded for these versions. + +# 0.1.0.3 + +* Fixed: wrong encoding table on big-endian systems. +* Fixed: too big indices in encoding table construction. + +# 0.1.0.2 + +* Changelog not recorded up to this version. diff --git a/Data/ByteString/Base64.hs b/Data/ByteString/Base64.hs --- a/Data/ByteString/Base64.hs +++ b/Data/ByteString/Base64.hs @@ -33,16 +33,16 @@ encode :: ByteString -> ByteString encode s = encodeWith (mkEncodeTable alphabet) s --- | Decode a base64-encoded string. This function strictly follows --- the specification in RFC 4648, --- . +-- | Decode a base64-encoded string. This function strictly follows +-- the specification in +-- . decode :: ByteString -> Either String ByteString decode s = decodeWithTable decodeFP s -- | Decode a base64-encoded string. This function is lenient in --- following the specification from RFC 4648, --- , and will not generate --- parse errors no matter how poor its input. +-- following the specification from +-- , and will not +-- generate parse errors no matter how poor its input. decodeLenient :: ByteString -> ByteString decodeLenient s = decodeLenientWithTable decodeFP s diff --git a/Data/ByteString/Base64/Internal.hs b/Data/ByteString/Base64/Internal.hs --- a/Data/ByteString/Base64/Internal.hs +++ b/Data/ByteString/Base64/Internal.hs @@ -28,6 +28,7 @@ import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy, unsafeCreate) import Data.Word (Word8, Word16, Word32) +import Control.Exception (assert) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, castForeignPtr) import Foreign.Ptr (Ptr, castPtr, minusPtr, plusPtr) import Foreign.Storable (peek, peekElemOff, poke) @@ -117,8 +118,8 @@ -> Int -- ^ Interval at which to intersperse, in bytes -> ByteString -- ^ String to transform -> ByteString -joinWith brk@(PS bfp boff blen) every bs@(PS sfp soff slen) - | every <= 0 = error "invalid interval" +joinWith brk@(PS bfp boff blen) every' bs@(PS sfp soff slen) + | every' <= 0 = error "invalid interval" | blen <= 0 = bs | B.null bs = brk | otherwise = @@ -127,26 +128,28 @@ withForeignPtr sfp $ \sptr -> do let bp = bptr `plusPtr` boff sp0 = sptr `plusPtr` soff - sLast = sp0 `plusPtr` (every * numBreaks) - loop !dp !sp - | sp == sLast = do - let n = sp0 `plusPtr` slen `minusPtr` sp - memcpy dp sp (fromIntegral n) - memcpy (dp `plusPtr` n) bp (fromIntegral blen) + sEnd = sp0 `plusPtr` slen + dLast = dptr `plusPtr` dlen + loop !dp !sp !written + | dp == dLast = return () | otherwise = do - memcpy dp sp (fromIntegral every) - let dp' = dp `plusPtr` every + let chunkSize = min every (sEnd `minusPtr` sp) + memcpy dp sp (fromIntegral chunkSize) + let dp' = dp `plusPtr` chunkSize memcpy dp' bp (fromIntegral blen) - loop (dp' `plusPtr` blen) (sp `plusPtr` every) - loop dptr sp0 + let written' = written + chunkSize + blen + assert (written' <= dlen) $ + loop (dp' `plusPtr` blen) (sp `plusPtr` chunkSize) written' + loop dptr sp0 0 where dlast = slen + blen * numBreaks - dlen | slen `mod` every > 0 = dlast + blen - | otherwise = dlast - numBreaks = slen `div` every + every = min slen every' + dlen | rmndr > 0 = dlast + blen + | otherwise = dlast + (numBreaks, rmndr) = slen `divMod` every -- | Decode a base64-encoded string. This function strictly follows --- the specification in RFC 4648, --- . +-- the specification in +-- . -- This function takes the decoding table (for @base64@ or @base64url@) as -- the first paramert. decodeWithTable :: ForeignPtr Word8 -> ByteString -> Either String ByteString @@ -198,11 +201,11 @@ dlen = di * 3 -- | Decode a base64-encoded string. This function is lenient in --- following the specification from RFC 4648, --- , and will not generate --- parse errors no matter how poor its input. --- This function takes the decoding table (for @base64@ or @base64url@) as --- the first paramert. +-- following the specification from +-- , and will not +-- generate parse errors no matter how poor its input. This function +-- takes the decoding table (for @base64@ or @base64url@) as the first +-- paramert. decodeLenientWithTable :: ForeignPtr Word8 -> ByteString -> ByteString decodeLenientWithTable decodeFP (PS sfp soff slen) | dlen <= 0 = B.empty diff --git a/Data/ByteString/Base64/Lazy.hs b/Data/ByteString/Base64/Lazy.hs --- a/Data/ByteString/Base64/Lazy.hs +++ b/Data/ByteString/Base64/Lazy.hs @@ -35,8 +35,8 @@ encode = L.fromChunks . map B64.encode . reChunkIn 3 . L.toChunks -- | Decode a base64-encoded string. This function strictly follows --- the specification in RFC 4648, --- . +-- the specification in +-- . decode :: L.ByteString -> Either String L.ByteString decode b = -- Returning an Either type means that the entire result will -- need to be in memory at once anyway, so we may as well @@ -49,8 +49,8 @@ Right b' -> Right $ L.fromChunks [b'] -- | Decode a base64-encoded string. This function is lenient in --- following the specification from RFC 4648, --- , and will not generate +-- following the specification from +-- , and will not generate -- parse errors no matter how poor its input. decodeLenient :: L.ByteString -> L.ByteString decodeLenient = L.fromChunks . map B64.decodeLenient . reChunkIn 4 . L.toChunks @@ -58,4 +58,3 @@ where -- We filter out and '=' padding here, but B64.decodeLenient -- handles that goodChar c = isAlphaNum c || c == '+' || c == '/' - diff --git a/Data/ByteString/Base64/URL.hs b/Data/ByteString/Base64/URL.hs --- a/Data/ByteString/Base64/URL.hs +++ b/Data/ByteString/Base64/URL.hs @@ -34,15 +34,15 @@ encode = encodeWith (mkEncodeTable alphabet) -- | Decode a base64url-encoded string. This function strictly follows --- the specification in RFC 4648, --- . +-- the specification in +-- . decode :: ByteString -> Either String ByteString decode = decodeWithTable decodeFP -- | Decode a base64url-encoded string. This function is lenient in --- following the specification from RFC 4648, --- , and will not generate --- parse errors no matter how poor its input. +-- following the specification from +-- , and will not +-- generate parse errors no matter how poor its input. decodeLenient :: ByteString -> ByteString decodeLenient = decodeLenientWithTable decodeFP diff --git a/Data/ByteString/Base64/URL/Lazy.hs b/Data/ByteString/Base64/URL/Lazy.hs --- a/Data/ByteString/Base64/URL/Lazy.hs +++ b/Data/ByteString/Base64/URL/Lazy.hs @@ -35,8 +35,8 @@ encode = L.fromChunks . map B64.encode . reChunkIn 3 . L.toChunks -- | Decode a base64-encoded string. This function strictly follows --- the specification in RFC 4648, --- . +-- the specification in +-- . decode :: L.ByteString -> Either String L.ByteString decode b = -- Returning an Either type means that the entire result will -- need to be in memory at once anyway, so we may as well @@ -49,8 +49,8 @@ Right b' -> Right $ L.fromChunks [b'] -- | Decode a base64-encoded string. This function is lenient in --- following the specification from RFC 4648, --- , and will not generate +-- following the specification from +-- , and will not generate -- parse errors no matter how poor its input. decodeLenient :: L.ByteString -> L.ByteString decodeLenient = L.fromChunks . map B64.decodeLenient . reChunkIn 4 . L.toChunks @@ -58,4 +58,3 @@ where -- We filter out and '=' padding here, but B64.decodeLenient -- handles that goodChar c = isAlphaNum c || c == '-' || c == '_' - diff --git a/README.markdown b/README.markdown deleted file mode 100644 --- a/README.markdown +++ /dev/null @@ -1,37 +0,0 @@ -# Fast base64 support - -This package provides a Haskell library for working with base64-encoded -data quickly and efficiently, using the ByteString type. - - -# Performance - -This library is written in pure Haskell, and it's fast: - -* 250 MB/sec encoding - -* 200 MB/sec strict decoding (per RFC 4648) - -* 100 MB/sec lenient decoding - - -# Get involved! - -Please report bugs via the -[github issue tracker](https://github.com/bos/base64-bytestring). - -Master [git repository](https://github.com/bos/base64-bytestring): - -* `git clone git://github.com/bos/base64-bytestring.git` - -And a [Mercurial mirror](https://bitbucket.org/bos/base64-bytestring): - -* `hg clone https://bitbucket.org/bos/base64-bytestring` - -(You can create and contribute changes using either Mercurial or git.) - - -# Authors - -This library is written and maintained by Bryan O'Sullivan, -. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,32 @@ +# Fast base64 support [![Hackage version](https://img.shields.io/hackage/v/base64-bytestring.svg?label=Hackage)](https://hackage.haskell.org/package/base64-bytestring) [![Stackage version](https://www.stackage.org/package/base64-bytestring/badge/lts?label=Stackage)](https://www.stackage.org/package/base64-bytestring) [![Build Status](https://secure.travis-ci.org/haskell/base64-bytestring.svg?branch=master)](http://travis-ci.org/haskell/base64-bytestring) + +This package provides a Haskell library for working with base64-encoded +data quickly and efficiently, using the `ByteString` type. + + +# Performance + +This library is written in pure Haskell, and it's fast: + +* 250 MB/sec encoding + +* 200 MB/sec strict decoding (per RFC 4648) + +* 100 MB/sec lenient decoding + + +# Get involved! + +Please report bugs via the +[GitHub issue tracker](https://github.com/haskell/base64-bytestring). + +Master [Git repository](https://github.com/haskell/base64-bytestring): + +* `git clone git://github.com/haskell/base64-bytestring.git` + + +# Authors + +This library is written by [Bryan O'Sullivan](mailto:bos@serpentine.com). It +is maintained by [Herbert Valerio Riedel](mailto:hvr@gnu.org) and [Mikhail +Glushenkov](mailto:mikhail.glushenkov@gmail.com). diff --git a/base64-bytestring.cabal b/base64-bytestring.cabal --- a/base64-bytestring.cabal +++ b/base64-bytestring.cabal @@ -1,23 +1,28 @@ name: base64-bytestring -version: 1.0.0.1 +version: 1.0.0.2 synopsis: Fast base64 encoding and decoding for ByteStrings -description: Fast base64 encoding and decoding for ByteStrings -homepage: https://github.com/bos/base64-bytestring -bug-reports: https://github.com/bos/base64-bytestring/issues +description: This package provides support for encoding and decoding binary data according to @base64@ (see also ) 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 -maintainer: Bryan O'Sullivan -copyright: 2010-2012 Bryan O'Sullivan +maintainer: Herbert Valerio Riedel , + Mikhail Glushenkov +copyright: 2010-2018 Bryan O'Sullivan et al. category: Data build-type: Simple cabal-version: >=1.8 +tested-with: GHC==8.6.2, 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 extra-source-files: - README.markdown - benchmarks/BM.hs - tests/Transcode.hs - tests/transcode.py + README.md + CHANGELOG.md + utils/Transcode.hs + utils/transcode.py library exposed-modules: @@ -25,7 +30,7 @@ Data.ByteString.Base64.URL Data.ByteString.Base64.Lazy Data.ByteString.Base64.URL.Lazy - + other-modules: Data.ByteString.Base64.Internal @@ -34,7 +39,6 @@ bytestring >= 0.9.0 ghc-options: -Wall -funbox-strict-fields - ghc-prof-options: -auto-all test-suite tests type: exitcode-stdio-1.0 @@ -51,9 +55,26 @@ base, containers, bytestring, + split, test-framework, test-framework-quickcheck2, test-framework-hunit + +benchmark benchmarks + 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 source-repository head type: git diff --git a/benchmarks/BM.hs b/benchmarks/BM.hs --- a/benchmarks/BM.hs +++ b/benchmarks/BM.hs @@ -1,14 +1,19 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -import Control.DeepSeq (NFData(rnf)) import Criterion.Main import qualified Data.ByteString.Base64 as B import qualified Data.ByteString.Base64.Lazy as L import qualified Data.ByteString.Base64.URL as U import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as L + +#if !MIN_VERSION_bytestring(0,10,0) +import Control.DeepSeq (NFData(rnf)) import qualified Data.ByteString.Lazy.Internal as L +#endif +strict :: String -> B.ByteString -> Benchmark strict name orig = bgroup name [ bgroup "normal" [ @@ -24,10 +29,13 @@ ] where enc = U.encode orig +#if !MIN_VERSION_bytestring(0,10,0) instance NFData L.ByteString where rnf L.Empty = () rnf (L.Chunk _ ps) = rnf ps +#endif +lazy :: String -> L.ByteString -> Benchmark lazy name orig = bgroup name [ bench "decode" $ nf L.decode enc diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -18,6 +18,7 @@ import Data.ByteString.Char8 () import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L +import qualified Data.List.Split as List import Data.String import Test.HUnit hiding (Test) @@ -35,6 +36,7 @@ testGroup "joinWith" [ testProperty "all_endsWith" joinWith_all_endsWith , testProperty "endsWith" joinWith_endsWith + , testProperty "pureImpl" joinWith_pureImpl ] , testsRegular $ Impl "Base64" Base64.encode Base64.decode Base64.decodeLenient , testsRegular $ Impl "LBase64" LBase64.encode LBase64.decode LBase64.decodeLenient @@ -68,6 +70,15 @@ -- arbitrary content instance Arbitrary L.ByteString where arbitrary = liftM L.pack arbitrary + +joinWith_pureImpl :: ByteString -> Positive Int -> ByteString -> Bool +joinWith_pureImpl brk (Positive int) str = pureImpl == Base64.joinWith brk int str + where + pureImpl | B.null brk = str + | B.null str = brk + | otherwise = + B.pack . concat $ + [ s ++ (B.unpack brk) | s <- List.chunksOf int (B.unpack str) ] joinWith_endsWith :: ByteString -> Positive Int -> ByteString -> Bool joinWith_endsWith brk (Positive int) str = diff --git a/tests/Transcode.hs b/tests/Transcode.hs deleted file mode 100644 --- a/tests/Transcode.hs +++ /dev/null @@ -1,16 +0,0 @@ -import qualified Data.ByteString as B -import System.Environment -import Data.ByteString.Base64 - -main = do - (kind:files) <- getArgs - let xcode bs = case kind of - "decode" -> case decode bs of - Left err -> putStrLn err - Right p -> B.putStr p - "decodeLenient" -> B.putStr (decodeLenient bs) - "encode" -> B.putStr (encode bs) - "read" -> B.putStr bs - case files of - [] -> B.getContents >>= xcode - fs -> mapM_ (\f -> B.readFile f >>= xcode) fs diff --git a/tests/transcode.py b/tests/transcode.py deleted file mode 100644 --- a/tests/transcode.py +++ /dev/null @@ -1,14 +0,0 @@ -#!/usr/bin/env python - -import binascii, sys - -funcs = { - 'decode': binascii.a2b_base64, - 'encode': binascii.b2a_base64, - 'read': lambda x:x, - } - -f = funcs[sys.argv[1]] - -for n in sys.argv[2:]: - sys.stdout.write(f(open(n).read())) diff --git a/utils/Transcode.hs b/utils/Transcode.hs new file mode 100644 --- /dev/null +++ b/utils/Transcode.hs @@ -0,0 +1,16 @@ +import qualified Data.ByteString as B +import System.Environment +import Data.ByteString.Base64 + +main = do + (kind:files) <- getArgs + let xcode bs = case kind of + "decode" -> case decode bs of + Left err -> putStrLn err + Right p -> B.putStr p + "decodeLenient" -> B.putStr (decodeLenient bs) + "encode" -> B.putStr (encode bs) + "read" -> B.putStr bs + case files of + [] -> B.getContents >>= xcode + fs -> mapM_ (\f -> B.readFile f >>= xcode) fs diff --git a/utils/transcode.py b/utils/transcode.py new file mode 100644 --- /dev/null +++ b/utils/transcode.py @@ -0,0 +1,14 @@ +#!/usr/bin/env python + +import binascii, sys + +funcs = { + 'decode': binascii.a2b_base64, + 'encode': binascii.b2a_base64, + 'read': lambda x:x, + } + +f = funcs[sys.argv[1]] + +for n in sys.argv[2:]: + sys.stdout.write(f(open(n).read()))