fix hexadecimal string generation to be hopefully (much) safer.

This commit is contained in:
Vincent Hanquez 2015-05-02 05:40:14 +01:00
parent edc75500d3
commit cc26ce8ce4
2 changed files with 28 additions and 9 deletions

View File

@ -11,6 +11,7 @@
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Rank2Types #-}
module Crypto.Internal.Hex
( showHexadecimal
, toHexadecimal
@ -21,24 +22,42 @@ import Data.Word
import GHC.Prim
import GHC.Types
import GHC.Word
import Control.Monad
import Foreign.Storable
import Foreign.Ptr (Ptr)
showHexadecimal :: Ptr Word8 -> Int -> String
showHexadecimal ptr len = loop 0
showHexadecimal :: (forall a . (Ptr Word8 -> IO a) -> IO a) -> Int -> String
showHexadecimal withPtr = doChunks 0
where
loop i
| i == len = []
doChunks ofs len
| len < 4 = doUnique ofs len
| otherwise = do
let !(W8# a, W8# b, W8# c, W8# d) = unsafeDoIO $ withPtr (read4 ofs)
(# w1, w2 #) = convertByte a
(# w3, w4 #) = convertByte b
(# w5, w6 #) = convertByte c
(# w7, w8 #) = convertByte d
in wToChar w1 : wToChar w2 : wToChar w3 : wToChar w4
: wToChar w5 : wToChar w6 : wToChar w7 : wToChar w8
: doChunks (ofs + 4) (len - 4)
doUnique ofs len
| len == 0 = []
| otherwise =
let !(W8# b) = byteIndex i
let !(W8# b) = unsafeDoIO $ withPtr (byteIndex ofs)
(# w1, w2 #) = convertByte b
in wToChar w1 : wToChar w2 : loop (i+1)
in wToChar w1 : wToChar w2 : doUnique (ofs + 1) (len - 1)
read4 :: Int -> Ptr Word8 -> IO (Word8, Word8, Word8, Word8)
read4 ofs p =
liftM4 (,,,) (byteIndex ofs p) (byteIndex (ofs+1) p)
(byteIndex (ofs+2) p) (byteIndex (ofs+3) p)
wToChar :: Word# -> Char
wToChar w = toEnum (I# (word2Int# w))
byteIndex :: Int -> Word8
byteIndex i = unsafeDoIO (peekByteOff ptr i)
byteIndex :: Int -> Ptr Word8 -> IO Word8
byteIndex i p = peekByteOff p i
toHexadecimal :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toHexadecimal bout bin n = loop 0

View File

@ -123,5 +123,5 @@ bytesIndex (Bytes m) (I# i) = unsafeDoIO $ IO $ \s ->
{-# NOINLINE bytesIndex #-}
bytesShowHex :: Bytes -> String
bytesShowHex b = unsafeDoIO $ withPtr b $ \p -> return $ showHexadecimal p (bytesLength b)
bytesShowHex b = showHexadecimal (withPtr b) (bytesLength b)
{-# NOINLINE bytesShowHex #-}