diff --git a/automotive-cse.cabal b/automotive-cse.cabal --- a/automotive-cse.cabal +++ b/automotive-cse.cabal @@ -1,6 +1,6 @@ name: automotive-cse -version: 0.1.2.0 +version: 0.1.3.0 synopsis: Automotive CSE emulation description: This package includes Cryptography Security Engine (CSE) codec emulation for automotive things. @@ -20,7 +20,9 @@ cabal-version: >=1.10 library - exposed-modules: Codec.Automotive.CSE + exposed-modules: + Codec.Automotive.CSE + Codec.Automotive.CSE.Internal other-modules: Backport.Crypto.MAC.CMAC diff --git a/src/Codec/Automotive/CSE.hs b/src/Codec/Automotive/CSE.hs --- a/src/Codec/Automotive/CSE.hs +++ b/src/Codec/Automotive/CSE.hs @@ -1,285 +1,6 @@ --- CSE (Cryptographic Service Engine) emulation implementation module Codec.Automotive.CSE ( - M1, unM1, makeM1, extractM1, - M2, unM2, makeM2, - M3, unM3, makeM3, - M4, unM4, makeM4, extractM4, makeM4', extractM4', - M5, unM5, makeM5, - - K1, K1', makeK1, - K2, K2', makeK2, - K3, K3', makeK3, - K4, K4', makeK4, - - UID, unUID, makeUID, - - Derived, unDerived, - kdf, keyUpdateEncC, keyUpdateMacC, - - DerivedCipher, derivedCipher, - - KeyAuthUse, Auth, NotAuth, - makeKeyAuthUse, unKeyAuthUse, - - UpdateC, Enc, Mac, + module Codec.Automotive.CSE.Internal ) where -import Control.Monad (MonadPlus, guard) -import Data.Monoid ((<>), mconcat, Endo (..)) -import Data.Bits (shiftL, shiftR, (.&.), (.|.)) -import Data.Word (Word8, Word32) -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.ByteString.Short (ShortByteString) -import qualified Data.ByteString.Short as Short -import Data.Serialize.Get (runGet, getWord64be) -import Data.Serialize.Put (runPut, putWord64be) -import Numeric (showHex) - -import qualified Data.ByteArray as B -import Crypto.Cipher.Types (cipherInit, ecbEncrypt, cbcEncrypt, nullIV, ecbDecrypt) -import Crypto.Cipher.AES (AES128) -import Crypto.Error (eitherCryptoError) - -import Backport.Crypto.MAC.CMAC (CMAC(..), cmac) -import Backport.Crypto.ConstructHash.MiyaguchiPreneel (MiyaguchiPreneel(..), mp) - - -dump8 :: [Word8] -> String -dump8 = (`appEndo` "") . mconcat . map (Endo . showW8) - where - showW8 w - | w < 16 = ('0' :) . showHex w - | otherwise = showHex w - -hdump :: ByteString -> String -hdump = dump8 . BS.unpack - -hdump' :: ShortByteString -> String -hdump' = dump8 . Short.unpack - - -data Enc -data Mac - -newtype UpdateC c = - UpdateC ByteString - deriving Eq - -instance Show (UpdateC c) where - show (UpdateC c) = unwords ["UpdateC", hdump c] - -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 ShortByteString - deriving Eq - -makeKeyAuthUse :: MonadPlus m => ByteString -> m (KeyAuthUse k) -makeKeyAuthUse k = do - guard $ BS.length k == 16 - return . KeyAuthUse $ Short.toShort k - -unKeyAuthUse :: KeyAuthUse k -> ByteString -unKeyAuthUse (KeyAuthUse bs) = Short.fromShort bs - -newtype Derived k c = - Derived ShortByteString - deriving Eq - -instance Show (Derived k c) where - show (Derived k) = unwords ["DerivedCipher", hdump' k] - -unDerived :: Derived k c -> ByteString -unDerived (Derived k) = Short.fromShort k - -kdf :: KeyAuthUse k -> UpdateC c -> Derived k c -kdf k (UpdateC c) = - Derived . Short.toShort . B.convert - $ chashGetBytes (mp $ unKeyAuthUse 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 -> DerivedCipher k c -derivedCipher k = - DerivedCipher - . either (error . ("Codec.Automotive.CSE.derivedCipher: internal error: " ++) . show) id - -- assume refined length (16 byte) of miyaguchi-preneel AES128 result - . eitherCryptoError . cipherInit $ unDerived 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 UID = UID ShortByteString deriving (Eq, Ord) - -instance Show UID where - show (UID s) = unwords ["UID", hdump' s] - -unUID :: UID -> ByteString -unUID (UID u) = Short.fromShort u - -makeUID :: MonadPlus m => ByteString -> m UID -makeUID s = do - guard $ BS.length s == 15 - return . UID $ Short.toShort s - -newtype M1 = M1 ByteString deriving Eq - -instance Show M1 where - show (M1 s) = unwords ["M1", hdump s] - -makeM1 :: UID -- ^ UID - 15 octet - -> Word8 -- ^ Key ID - 4 bit - -> Word8 -- ^ Auth key ID - 4 bit - -> M1 -makeM1 uid kid akid = M1 $ unUID uid <> BS.singleton (kid `shiftL` 4 .|. akid) - -unM1 :: M1 -> ByteString -unM1 (M1 m1) = m1 - -extractM1 :: M1 -> (UID, Word8, Word8) -extractM1 (M1 m1) = (UID $ Short.toShort uid, lw `shiftR` 4, lw .&. 0x0F) - where - (uid, x) = BS.splitAt 15 m1 - lw = head $ BS.unpack x - -- assume refined M1 - -newtype M2 = M2 ByteString deriving Eq - -instance Show M2 where - show (M2 s) = unwords ["M2", hdump s] - -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 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) - <> unKeyAuthUse keyData - -unM2 :: M2 -> ByteString -unM2 (M2 m2) = m2 - -newtype M3 = M3 ByteString deriving Eq - -instance Show M3 where - show (M3 s) = unwords ["M3", hdump s] - -makeM3 :: K2 - -> M1 - -> M2 - -> M3 -makeM3 (DerivedCipher k2) (M1 m1) (M2 m2) = M3 . B.convert . cmacGetBytes . cmac k2 $ m1 <> m2 - -unM3 :: M3 -> ByteString -unM3 (M3 m3) = m3 - -newtype M4 = M4 ByteString deriving Eq - -instance Show M4 where - show (M4 s) = unwords ["M4", hdump s] - -makeM4' :: K3 - -> M1 - -> Word32 - -> M4 -makeM4' (DerivedCipher k3) (M1 m1) counter = - M4 $ m1 <> ecbEncrypt k3 p2 - where - p2 = runPut $ do - putWord64be $ - fromIntegral counter `shiftL` 36 .|. - 1 `shiftL` 35 - putWord64be 0 - -makeM4 :: K3 - -> UID - -> Word8 - -> Word8 - -> Word32 - -> M4 -makeM4 k3 uid kid akid counter = - makeM4' k3 (makeM1 uid kid akid) counter - -unM4 :: M4 -> ByteString -unM4 (M4 m4) = m4 - -extractM4' :: K3 -> M4 -> (M1, Word32) -extractM4' (DerivedCipher k3) (M4 m4) = (M1 m1, fromIntegral $ w64 `shiftR` 36) - where - (m1, m4') = BS.splitAt 16 m4 - w64 = either (error . ("Codec.Automotive.CSE.extractM4: internal error: " ++)) id - . runGet getWord64be $ ecbDecrypt k3 m4' - -extractM4 :: K3 -> M4 -> ((UID, Word8, Word8), Word32) -extractM4 k3 m4 = (extractM1 m1, counter) - where (m1, counter) = extractM4' k3 m4 - -newtype M5 = M5 ByteString deriving Eq - -instance Show M5 where - show (M5 s) = unwords ["M5", hdump s] - -makeM5 :: K4 - -> M4 - -> M5 -makeM5 (DerivedCipher k4) (M4 m4) = M5 . B.convert . cmacGetBytes $ cmac k4 m4 - -unM5 :: M5 -> ByteString -unM5 (M5 m4) = m4 +import Codec.Automotive.CSE.Internal hiding (unsafeMakeDerived, unsafeMakeDerivedCipher) diff --git a/src/Codec/Automotive/CSE/Internal.hs b/src/Codec/Automotive/CSE/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Automotive/CSE/Internal.hs @@ -0,0 +1,296 @@ + +-- CSE (Cryptographic Service Engine) emulation implementation +module Codec.Automotive.CSE.Internal ( + M1, unM1, makeM1, extractM1, + M2, unM2, makeM2, + M3, unM3, makeM3, + M4, unM4, makeM4, extractM4, makeM4', extractM4', + M5, unM5, makeM5, + + K1, K1', makeK1, + K2, K2', makeK2, + K3, K3', makeK3, + K4, K4', makeK4, + + UID, unUID, makeUID, + + Derived, unDerived, + kdf, keyUpdateEncC, keyUpdateMacC, + + DerivedCipher, derivedCipher, + + KeyAuthUse, Auth, NotAuth, + makeKeyAuthUse, unKeyAuthUse, + + UpdateC, Enc, Mac, + + unsafeMakeDerived, unsafeMakeDerivedCipher, + ) where + +import Control.Monad (MonadPlus, guard, liftM) +import Data.Monoid ((<>), mconcat, Endo (..)) +import Data.Bits (shiftL, shiftR, (.&.), (.|.)) +import Data.Word (Word8, Word32) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.ByteString.Short (ShortByteString) +import qualified Data.ByteString.Short as Short +import Data.Serialize.Get (runGet, getWord64be) +import Data.Serialize.Put (runPut, putWord64be) +import Numeric (showHex) + +import qualified Data.ByteArray as B +import Crypto.Cipher.Types (cipherInit, ecbEncrypt, cbcEncrypt, nullIV, ecbDecrypt) +import Crypto.Cipher.AES (AES128) +import Crypto.Error (eitherCryptoError) + +import Backport.Crypto.MAC.CMAC (CMAC(..), cmac) +import Backport.Crypto.ConstructHash.MiyaguchiPreneel (MiyaguchiPreneel(..), mp) + + +dump8 :: [Word8] -> String +dump8 = (`appEndo` "") . mconcat . map (Endo . showW8) + where + showW8 w + | w < 16 = ('0' :) . showHex w + | otherwise = showHex w + +hdump :: ByteString -> String +hdump = dump8 . BS.unpack + +hdump' :: ShortByteString -> String +hdump' = dump8 . Short.unpack + + +data Enc +data Mac + +newtype UpdateC c = + UpdateC ByteString + deriving Eq + +instance Show (UpdateC c) where + show (UpdateC c) = unwords ["UpdateC", hdump c] + +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 ShortByteString + deriving Eq + +makeKeyAuthUse :: MonadPlus m => ByteString -> m (KeyAuthUse k) +makeKeyAuthUse k = do + guard $ BS.length k == 16 + return . KeyAuthUse $ Short.toShort k + +unKeyAuthUse :: KeyAuthUse k -> ByteString +unKeyAuthUse (KeyAuthUse bs) = Short.fromShort bs + +newtype Derived k c = + Derived ShortByteString + deriving Eq + +instance Show (Derived k c) where + show (Derived k) = unwords ["DerivedCipher", hdump' k] + +-- | Specifying derived key directly. +unsafeMakeDerived :: MonadPlus m => ByteString -> m (Derived k c) +unsafeMakeDerived k = do + guard $ BS.length k == 16 + return . Derived $ Short.toShort k + +unDerived :: Derived k c -> ByteString +unDerived (Derived k) = Short.fromShort k + +kdf :: KeyAuthUse k -> UpdateC c -> Derived k c +kdf k (UpdateC c) = + Derived . Short.toShort . B.convert + $ chashGetBytes (mp $ unKeyAuthUse 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 -> DerivedCipher k c +derivedCipher k = + DerivedCipher + . either (error . ("Codec.Automotive.CSE.derivedCipher: internal error: " ++) . show) id + -- assume refined length (16 byte) of miyaguchi-preneel AES128 result + . eitherCryptoError . cipherInit $ unDerived k + +unsafeMakeDerivedCipher :: MonadPlus m => ByteString -> m (DerivedCipher k c) +unsafeMakeDerivedCipher = liftM derivedCipher . unsafeMakeDerived + +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 UID = UID ShortByteString deriving (Eq, Ord) + +instance Show UID where + show (UID s) = unwords ["UID", hdump' s] + +unUID :: UID -> ByteString +unUID (UID u) = Short.fromShort u + +makeUID :: MonadPlus m => ByteString -> m UID +makeUID s = do + guard $ BS.length s == 15 + return . UID $ Short.toShort s + +newtype M1 = M1 ByteString deriving Eq + +instance Show M1 where + show (M1 s) = unwords ["M1", hdump s] + +makeM1 :: UID -- ^ UID - 15 octet + -> Word8 -- ^ Key ID - 4 bit + -> Word8 -- ^ Auth key ID - 4 bit + -> M1 +makeM1 uid kid akid = M1 $ unUID uid <> BS.singleton (kid `shiftL` 4 .|. akid) + +unM1 :: M1 -> ByteString +unM1 (M1 m1) = m1 + +extractM1 :: M1 -> (UID, Word8, Word8) +extractM1 (M1 m1) = (UID $ Short.toShort uid, lw `shiftR` 4, lw .&. 0x0F) + where + (uid, x) = BS.splitAt 15 m1 + lw = head $ BS.unpack x + -- assume refined M1 + +newtype M2 = M2 ByteString deriving Eq + +instance Show M2 where + show (M2 s) = unwords ["M2", hdump s] + +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 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) + <> unKeyAuthUse keyData + +unM2 :: M2 -> ByteString +unM2 (M2 m2) = m2 + +newtype M3 = M3 ByteString deriving Eq + +instance Show M3 where + show (M3 s) = unwords ["M3", hdump s] + +makeM3 :: K2 + -> M1 + -> M2 + -> M3 +makeM3 (DerivedCipher k2) (M1 m1) (M2 m2) = M3 . B.convert . cmacGetBytes . cmac k2 $ m1 <> m2 + +unM3 :: M3 -> ByteString +unM3 (M3 m3) = m3 + +newtype M4 = M4 ByteString deriving Eq + +instance Show M4 where + show (M4 s) = unwords ["M4", hdump s] + +makeM4' :: K3 + -> M1 + -> Word32 + -> M4 +makeM4' (DerivedCipher k3) (M1 m1) counter = + M4 $ m1 <> ecbEncrypt k3 p2 + where + p2 = runPut $ do + putWord64be $ + fromIntegral counter `shiftL` 36 .|. + 1 `shiftL` 35 + putWord64be 0 + +makeM4 :: K3 + -> UID + -> Word8 + -> Word8 + -> Word32 + -> M4 +makeM4 k3 uid kid akid counter = + makeM4' k3 (makeM1 uid kid akid) counter + +unM4 :: M4 -> ByteString +unM4 (M4 m4) = m4 + +extractM4' :: K3 -> M4 -> (M1, Word32) +extractM4' (DerivedCipher k3) (M4 m4) = (M1 m1, fromIntegral $ w64 `shiftR` 36) + where + (m1, m4') = BS.splitAt 16 m4 + w64 = either (error . ("Codec.Automotive.CSE.extractM4: internal error: " ++)) id + . runGet getWord64be $ ecbDecrypt k3 m4' + +extractM4 :: K3 -> M4 -> ((UID, Word8, Word8), Word32) +extractM4 k3 m4 = (extractM1 m1, counter) + where (m1, counter) = extractM4' k3 m4 + +newtype M5 = M5 ByteString deriving Eq + +instance Show M5 where + show (M5 s) = unwords ["M5", hdump s] + +makeM5 :: K4 + -> M4 + -> M5 +makeM5 (DerivedCipher k4) (M4 m4) = M5 . B.convert . cmacGetBytes $ cmac k4 m4 + +unM5 :: M5 -> ByteString +unM5 (M5 m4) = m4