diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Kei Hibino + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Kei Hibino nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/automitive-cse.cabal b/automitive-cse.cabal new file mode 100644 --- /dev/null +++ b/automitive-cse.cabal @@ -0,0 +1,55 @@ + +name: automitive-cse +version: 0.0.1.0 +synopsis: Automotive CSE emulation +description: This package includes Cryptography Security Engine (CSE) + codec emulation for automotive things. +license: BSD3 +license-file: LICENSE +author: Kei Hibino +maintainer: ex8k.hibino@gmail.com +copyright: Copyright (c) 2016 Kei Hibino +category: Codec +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + exposed-modules: Codec.Automotive.CSE + + other-modules: + Backport.Crypto.MAC.CMAC + Backport.Crypto.ConstructHash.MiyaguchiPreneel + + other-extensions: GeneralizedNewtypeDeriving + build-depends: base >=4.6 && <5 + , bytestring + , cereal + , memory + , cryptonite + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + +test-suite exTrue + build-depends: base <5 + , quickcheck-simple + , automitive-cse + + , bytestring + , cryptonite + + type: exitcode-stdio-1.0 + main-is: expectTrue.hs + -- other-modules: + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: -Wall + +source-repository head + type: git + location: https://github.com/khibino/haskell-automotive-cse + +source-repository head + type: mercurial + location: https://bitbucket.org/khibino/haskell-automotive-cse diff --git a/src/Backport/Crypto/ConstructHash/MiyaguchiPreneel.hs b/src/Backport/Crypto/ConstructHash/MiyaguchiPreneel.hs new file mode 100644 --- /dev/null +++ b/src/Backport/Crypto/ConstructHash/MiyaguchiPreneel.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Backport.Crypto.ConstructHash.MiyaguchiPreneel + ( mp, mp' + , MiyaguchiPreneel(..) + , cipherInit' + ) where + +import Data.List (foldl') + +import Crypto.Cipher.Types +import Crypto.Error (eitherCryptoError) +import Data.ByteArray (ByteArrayAccess, ByteArray, Bytes) +import qualified Data.ByteArray as B + + +newtype MiyaguchiPreneel a = MP { chashGetBytes :: Bytes } + deriving ByteArrayAccess + +instance Eq (MiyaguchiPreneel a) where + MP b1 == MP b2 = B.constEq b1 b2 + + +-- | Compute Miyaguchi-Preneel one way compress using the supplied block cipher. +mp' :: (ByteArrayAccess bin, BlockCipher cipher) + => (Bytes -> cipher) -- ^ key build function to compute Miyaguchi-Preneel. care about block-size and key-size + -> bin -- ^ input message + -> MiyaguchiPreneel cipher -- ^ output tag +mp' g = MP . foldl' (step $ g) (B.replicate bsz 0) . chunks . B.convert + where + bsz = blockSize ( g B.empty {- dummy to get block size -} ) + chunks msg + | B.null tl = [hd :: Bytes] + | otherwise = hd : chunks tl + where + (hd, tl) = B.splitAt bsz msg + +-- | Simple key build function, which may raise size error. +cipherInit' :: (ByteArray ba, Cipher k) => ba -> k +cipherInit' = either (error . show) id . eitherCryptoError . cipherInit + +-- | Compute Miyaguchi-Preneel one way compress using the infered block cipher. +-- Only safe when KEY-SIZE equals to BLOCK-SIZE. +-- +-- Simple usage /mp' msg :: MiyaguchiPreneel AES128/ +mp :: (ByteArrayAccess bin, BlockCipher cipher) + => bin -- ^ input message + -> MiyaguchiPreneel cipher -- ^ output tag +mp = mp' cipherInit' + +-- | computation step of Miyaguchi-Preneel +step :: (ByteArray ba, BlockCipher k) + => (ba -> k) + -> ba + -> ba + -> ba +step g iv msg = + ecbEncrypt k pmsg `bxor` iv `bxor` pmsg + where + k = g iv + pmsg = pad0 k msg + +pad0 :: (ByteArray ba, BlockCipher k) => k -> ba -> ba +pad0 k s = s `B.append` B.replicate (blockSize k - B.length s) 0 + +bxor :: ByteArray ba => ba -> ba -> ba +bxor = B.xor diff --git a/src/Backport/Crypto/MAC/CMAC.hs b/src/Backport/Crypto/MAC/CMAC.hs new file mode 100644 --- /dev/null +++ b/src/Backport/Crypto/MAC/CMAC.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Backport.Crypto.MAC.CMAC + ( cmac + , CMAC(..) + , subKeys + ) where + +import Data.Word +import Data.Bits (setBit, testBit, shiftL) +import Data.List (foldl') + +import Crypto.Cipher.Types +import Data.ByteArray (ByteArrayAccess, ByteArray, Bytes) +import qualified Data.ByteArray as B + + +newtype CMAC a = CMAC { cmacGetBytes :: Bytes } + deriving ByteArrayAccess + +instance Eq (CMAC a) where + CMAC b1 == CMAC b2 = B.constEq b1 b2 + +-- | compute a MAC using the supplied cipher +cmac :: (ByteArrayAccess bin, BlockCipher cipher) + => cipher -- ^ key to compute CMAC with + -> bin -- ^ input message + -> CMAC cipher -- ^ output tag +cmac k msg = + CMAC $ foldl' (\c m -> ecbEncrypt k $ bxor c m) zeroV ms + where + bytes = blockSize k + zeroV = B.replicate bytes 0 :: Bytes + (k1, k2) = subKeys k + ms = cmacChunks k k1 k2 $ B.convert msg + +cmacChunks :: (BlockCipher k, ByteArray ba) => k -> ba -> ba -> ba -> [ba] +cmacChunks k k1 k2 = rec' where + rec' msg + | B.null tl = if lack == 0 + then [bxor k1 hd] + else [bxor k2 $ hd `B.append` B.pack (0x80 : replicate (lack - 1) 0)] + | otherwise = hd : rec' tl + where + bytes = blockSize k + (hd, tl) = B.splitAt bytes msg + lack = bytes - B.length hd + +-- | make sub-keys used in CMAC +subKeys :: (BlockCipher k, ByteArray ba) + => k -- ^ key to compute CMAC with + -> (ba, ba) -- ^ sub-keys to compute CMAC +subKeys k = (k1, k2) where + ipt = cipherIPT k + k0 = ecbEncrypt k $ B.replicate (blockSize k) 0 + k1 = subKey ipt k0 + k2 = subKey ipt k1 + +-- polynomial multiply operation to culculate subkey +subKey :: (ByteArray ba) => [Word8] -> ba -> ba +subKey ipt ws = case B.unpack ws of + [] -> B.empty + w:_ | testBit w 7 -> B.pack ipt `bxor` shiftL1 ws + | otherwise -> shiftL1 ws + +shiftL1 :: (ByteArray ba) => ba -> ba +shiftL1 = B.pack . shiftL1W . B.unpack + +shiftL1W :: [Word8] -> [Word8] +shiftL1W [] = [] +shiftL1W ws@(_:ns) = rec' $ zip ws (ns ++ [0]) where + rec' [] = [] + rec' ((x,y):ps) = w : rec' ps + where + w | testBit y 7 = setBit sl1 0 + | otherwise = sl1 + where sl1 = shiftL x 1 + +bxor :: ByteArray ba => ba -> ba -> ba +bxor = B.xor + + +----- + + +cipherIPT :: BlockCipher k => k -> [Word8] +cipherIPT = expandIPT . blockSize where + +-- Data type which represents the smallest irreducibule binary polynomial +-- against specified degree. +-- +-- Maximum degree bit and degree 0 bit are omitted. +-- For example, The value /Q 7 2 1/ corresponds to the degree /128/. +-- It represents that the smallest irreducible binary polynomial of degree 128 +-- is x^128 + x^7 + x^2 + x^1 + 1. +data IPolynomial + = Q Int Int Int +--- | T Int + +iPolynomial :: Int -> Maybe IPolynomial +iPolynomial = d where + d 64 = Just $ Q 4 3 1 + d 128 = Just $ Q 7 2 1 + d _ = Nothing + +-- Expand a tail bit pattern of irreducible binary polynomial +expandIPT :: Int -> [Word8] +expandIPT bytes = expandIPT' bytes ipt where + ipt = maybe (error $ "Irreducible binary polynomial not defined against " ++ show nb ++ " bit") id + $ iPolynomial nb + nb = bytes * 8 + +-- Expand a tail bit pattern of irreducible binary polynomial +expandIPT' :: Int -- ^ width in byte + -> IPolynomial -- ^ irreducible binary polynomial definition + -> [Word8] -- ^ result bit pattern +expandIPT' bytes (Q x y z) = + reverse . setB x . setB y . setB z . setB 0 $ replicate bytes 0 + where + setB i ws = hd ++ setBit (head tl) r : tail tl where + (q, r) = i `quotRem` 8 + (hd, tl) = splitAt q ws diff --git a/src/Codec/Automotive/CSE.hs b/src/Codec/Automotive/CSE.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Automotive/CSE.hs @@ -0,0 +1,165 @@ + +-- CSE (Cryptographic Service Engine) emulation implementation +module Codec.Automotive.CSE ( + M1 (M1), M2 (M2), M3 (M3), M4 (M4), M5 (M5), + makeM1, makeM2, makeM3, makeM4, makeM5, + + K1, K2, K3, K4, + makeK1, makeK2, makeK3, makeK4, + + Derived, kdf, + + DerivedCipher, derivedCipher, + + KeyAuthUse (..), Auth, NotAuth, + ) where + +import Control.Applicative ((<$>)) +import Data.Monoid ((<>)) +import Data.Bits (shiftL, (.|.)) +import Data.Word (Word8, Word32) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Serialize.Put (runPut, putWord64be) + +import qualified Data.ByteArray as B +import Crypto.Cipher.Types (cipherInit, ecbEncrypt, cbcEncrypt, nullIV) +import Crypto.Cipher.AES (AES128) +import Crypto.Error (CryptoError, eitherCryptoError) +import Backport.Crypto.MAC.CMAC (CMAC(..), cmac) +import Backport.Crypto.ConstructHash.MiyaguchiPreneel (MiyaguchiPreneel(..), mp) + + +data Enc +data Mac + +newtype UpdateC c = + UpdateC ByteString + deriving Eq + +keyUpdateEncC :: UpdateC Enc +keyUpdateEncC = + UpdateC . runPut $ + putWord64be 0x0101534845008000 >> + putWord64be 0x00000000000000B0 + --- 0x010153484500800000000000000000B0 + +keyUpdateMacC :: UpdateC Mac +keyUpdateMacC = + UpdateC . runPut $ + putWord64be 0x0102534845008000 >> + putWord64be 0x00000000000000B0 + -- 0x010253484500800000000000000000B0 + +data Auth +data NotAuth + +newtype KeyAuthUse k = + KeyAuthUse ByteString + deriving Eq + +newtype Derived k c = + Derived ByteString + deriving Eq + +kdf :: KeyAuthUse k -> UpdateC c -> Derived k c +kdf (KeyAuthUse k) (UpdateC c) = Derived . B.convert $ chashGetBytes (mp $ k <> c :: MiyaguchiPreneel AES128) + +kdfEnc :: KeyAuthUse k -> Derived k Enc +kdfEnc = (`kdf` keyUpdateEncC) + +kdfMac :: KeyAuthUse k -> Derived k Mac +kdfMac = (`kdf` keyUpdateMacC) + +newtype DerivedCipher k c = DerivedCipher AES128 + +derivedCipher :: Derived k c -> Either CryptoError (DerivedCipher k c) +derivedCipher (Derived k) = DerivedCipher <$> (eitherCryptoError $ cipherInit k) + +type K1' = Derived Auth Enc +type K1 = DerivedCipher Auth Enc + +makeK1 :: KeyAuthUse Auth -- ^ AuthKey Data + -> K1' -- ^ Result Hash value +makeK1 = kdfEnc + +type K2' = Derived Auth Mac +type K2 = DerivedCipher Auth Mac + +makeK2 :: KeyAuthUse Auth -- ^ AuthKey Data + -> K2' -- ^ Result Hash value +makeK2 = kdfMac + +type K3' = Derived NotAuth Enc +type K3 = DerivedCipher NotAuth Enc + +makeK3 :: KeyAuthUse NotAuth -- ^ Key Data + -> K3' -- ^ Result Hash value +makeK3 = kdfEnc + +type K4' = Derived NotAuth Mac +type K4 = DerivedCipher NotAuth Mac + +makeK4 :: KeyAuthUse NotAuth -- ^ Key Data + -> K4' -- ^ Result Hash value +makeK4 = kdfMac + + +newtype M1 = M1 ByteString deriving Eq + +makeM1 :: ByteString -- ^ UID - 15 octet + -> Word8 -- ^ Key ID - 4 bit + -> Word8 -- ^ Auth key ID - 4 bit + -> M1 +makeM1 uid kid akid = M1 $ uid <> BS.singleton (kid `shiftL` 4 .|. akid) + +newtype M2 = M2 ByteString deriving Eq + +makeM2 :: K1 -- ^ K1 value + -> Word32 -- ^ Counter - 28 bit + -> Word8 -- ^ Key Flag - 6 bit + -> KeyAuthUse NotAuth -- ^ Key Data for AES128 + -> M2 +makeM2 (DerivedCipher k1) counter flags (KeyAuthUse keyData) = + M2 $ cbcEncrypt k1 nullIV plain + where + plain = (runPut $ do + putWord64be $ + fromIntegral counter `shiftL` 36 .|. + fromIntegral flags `shiftL` 30 + --- fromIntegral (flags `shiftR` 1) `shiftL` 31 --- SHE standard + putWord64be 0) + <> keyData + +newtype M3 = M3 ByteString deriving Eq + +makeM3 :: K2 + -> M1 + -> M2 + -> M3 +makeM3 (DerivedCipher k2) (M1 m1) (M2 m2) = M3 . B.convert . cmacGetBytes . cmac k2 $ m1 <> m2 + +newtype M4 = M4 ByteString deriving Eq + +makeM4 :: ByteString + -> Word8 + -> Word8 + -> K3 + -> Word32 + -> M4 +makeM4 uid kid akid (DerivedCipher k3) counter = + M4 $ p1 <> ecbEncrypt k3 p2 + where + M1 p1 = makeM1 uid kid akid + p2 = runPut $ do + putWord64be $ + fromIntegral counter `shiftL` 36 .|. + 1 `shiftL` 35 + putWord64be 0 + +newtype M5 = M5 ByteString deriving Eq + +makeM5 :: K4 + -> M4 + -> M5 +makeM5 (DerivedCipher k4) (M4 m4) = M5 . B.convert . cmacGetBytes $ cmac k4 m4 diff --git a/test/expectTrue.hs b/test/expectTrue.hs new file mode 100644 --- /dev/null +++ b/test/expectTrue.hs @@ -0,0 +1,117 @@ + +import Test.QuickCheck.Simple (Test, boolTest, defaultMain) + +import Codec.Automotive.CSE + (M1(M1), makeM1, + M2(M2), makeM2, + M3(M3), makeM3, + M4(M4), makeM4, + M5(M5), makeM5, + KeyAuthUse (..), Auth, NotAuth, derivedCipher, + makeK1, makeK2, makeK3, makeK4) + +import Numeric (showHex, showInt) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Char (digitToInt) +import Data.Word (Word8, Word32) +import Crypto.Error (CryptoError) + + +testAuthKey :: KeyAuthUse Auth +testAuthKey = KeyAuthUse $ hxs "00010203_04050607_08090a0b_0c0d0e0f" + +testKey :: KeyAuthUse NotAuth +testKey = KeyAuthUse $ hxs "0f0e0d0c_0b0a0908_07060504_03020100" + +testAuthKeyID :: Word8 +testAuthKeyID = 1 + +testKeyID :: Word8 +testKeyID = 4 + +testUID :: ByteString +testUID = hxs "000000000000000000000000000001" + +testCounter :: Word32 +testCounter = 1 + +testFlags :: Word8 +testFlags = 0 + + +testM1 :: M1 +testM1 = makeM1 testUID testKeyID testAuthKeyID + +expectM1 :: Bool +expectM1 = + testM1 == M1 (hxs "00000000000000000000000000000141") + +testM2 :: Either CryptoError M2 +testM2 = do + k1 <- derivedCipher $ makeK1 testAuthKey + return $ makeM2 k1 testCounter testFlags testKey + +expectM2 :: Bool +expectM2 = + testM2 == Right (M2 $ hxs "2b111e2d93f486566bcbba1d7f7a9797_c94643b050fc5d4d7de14cff682203c3") + +testM3 :: Either CryptoError M3 +testM3 = do + k2 <- derivedCipher $ makeK2 testAuthKey + m2 <- testM2 + return $ makeM3 k2 testM1 m2 + +expectM3 :: Bool +expectM3 = + testM3 == Right (M3 $ hxs "b9d745e5ace7d41860bc63c2b9f5bb46") + +testM4 :: Either CryptoError M4 +testM4 = do + k3 <- derivedCipher $ makeK3 testKey + return $ makeM4 testUID testKeyID testAuthKeyID k3 testCounter + +expectM4 :: Bool +expectM4 = + testM4 == Right (M4 $ hxs "00000000000000000000000000000141_b472e8d8727d70d57295e74849a27917") + +testM5 :: Either CryptoError M5 +testM5 = do + k4 <- derivedCipher $ makeK4 testKey + m4 <- testM4 + return $ makeM5 k4 m4 + +expectM5 :: Bool +expectM5 = + testM5 == Right (M5 $ hxs "820d8d95dc11b4668878160cb2a4e23e") + +hxs :: String -> ByteString +hxs = BS.pack . rec' where + dtoW8 = fromIntegral . digitToInt + rec' (' ':xs) = rec' xs + rec' ('_':xs) = rec' xs + rec' (x:y:xs) = dtoW8 x * 16 + dtoW8 y : rec' xs + rec' [_] = error "hxs: invalid hex pattern." + rec' [] = [] + +_dump :: ByteString -> String +_dump = (`rec'` []) . BS.unpack where + rec' [] = id + rec' (w:ws) = (if w < 16 then ('0' :) . showHex w else showHex w) . rec' ws + +_dumpD :: ByteString -> String +_dumpD = (`rec'` []) . BS.unpack where + rec' [] = id + rec' (w:ws) = showInt w . ("," ++) . rec' ws + + +tests :: [Test] +tests = [ boolTest "M1" expectM1 + , boolTest "M2" expectM2 + , boolTest "M3" expectM3 + , boolTest "M4" expectM4 + , boolTest "M5" expectM5 + ] + +main :: IO () +main = defaultMain tests