From 9b051e636a631c7fce4eb986ecdf70a6b3fdf806 Mon Sep 17 00:00:00 2001 From: Ryan Newton Date: Wed, 2 Feb 2011 11:47:05 -0500 Subject: [PATCH] Implemented the wrapper that picks AESNI or portable software implementation at runtime by checking CPU id. --- CHANGELOG | 10 ++ Codec/Crypto/ConvertRNG.hs | 6 +- Codec/Crypto/GladmanAES.hsc | 32 ++++- Codec/Crypto/IntelAES.hs | 128 ++++++++++++------ Codec/Crypto/IntelAES/AESNI.hs | 4 +- Codec/Crypto/IntelAES/GladmanAES.hsc | 185 --------------------------- SimpleRNGBench.hs | 10 +- TODO.txt | 5 +- 8 files changed, 145 insertions(+), 235 deletions(-) delete mode 100644 Codec/Crypto/IntelAES/GladmanAES.hsc diff --git a/CHANGELOG b/CHANGELOG index a7c4d7c..d97af17 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -202,3 +202,13 @@ Ok... I tried rebuilding the library by hand to get a .so gcc -shared -dynamic -o lib/x64/libintel_aes64.so obj/x64/*.o + + +[2011.02.02] {Annoying link problems} + +In commit 4bf79dfe55.. I reverted some recent refactorings to fix the weird link problem. + + Linking dist/build/benchmark-intel-aes-rng/benchmark-intel-aes-rng ... + /home/newton/Dropbox/working_copies/intel-aes/dist/build/libHSintel-aes-0.1.1.a(GladmanAES.o): In function `s3iP_info': + (.text+0x34c3): undefined reference to `__stginit_intelzmaeszm0zi1zi1_CodecziCryptoziConvertRNG_' + collect2: ld returned 1 exit status diff --git a/Codec/Crypto/ConvertRNG.hs b/Codec/Crypto/ConvertRNG.hs index c6c5414..eee2a7d 100644 --- a/Codec/Crypto/ConvertRNG.hs +++ b/Codec/Crypto/ConvertRNG.hs @@ -138,7 +138,7 @@ instance BlockCipher x => CryptoRandomGen (BCtoCRG x) where Just x -> Right (BCtoCRG x 0) genSeedLength = Tagged 128 - -- If this is called for less than blockSize data + -- If this is called for less than blockSize data there's some waste but it should work. genBytes req (BCtoCRG (bcgen :: k) counter) = -- What's the most efficient way to do this? unsafePerformIO $ do -- Potentially heavyweight... not allowing dupable. @@ -162,8 +162,8 @@ instance BlockCipher x => CryptoRandomGen (BCtoCRG x) where if req==total then return$ Right (cipher, newgen) else return$ Right (B.take req cipher, newgen) --- reseed bs gen = newGen bs -reseed bs (BCtoCRG k _) = newGen (xorExtendBS (encode k) bs) + reseed bs (BCtoCRG k _) = newGen (xorExtendBS (encode k) bs) + xorExtendBS a b = B.append (B.pack$ B.zipWith Data.Bits.xor a b) rem where al = B.length a diff --git a/Codec/Crypto/GladmanAES.hsc b/Codec/Crypto/GladmanAES.hsc index 99bec90..1585fe4 100644 --- a/Codec/Crypto/GladmanAES.hsc +++ b/Codec/Crypto/GladmanAES.hsc @@ -2,7 +2,9 @@ -- Svein Ove Aas (University of Tromsø), though it is heavily modified -- and any bugs should be blamed on me, Thomas M. DuBuisson. {-# LANGUAGE FlexibleInstances, EmptyDataDecls, FlexibleContexts, - ForeignFunctionInterface, ViewPatterns #-} + ForeignFunctionInterface, ViewPatterns, + ScopedTypeVariables + #-} {-# CFILES cbits/gladman/aescrypt.c cbits/gladman/aeskey.c cbits/gladman/aestab.c cbits/gladman/aes_modes.c #-} module Codec.Crypto.GladmanAES ( AES @@ -22,6 +24,14 @@ import Foreign import Control.Applicative import Control.Monad +-- import Crypto.Random (CryptoRandomGen(newGen)) +-- The following line will cause a link problem currently [2011.02.02]: + -- Linking dist/build/benchmark-intel-aes-rng/benchmark-intel-aes-rng ... + -- /home/newton/Dropbox/working_copies/intel-aes/dist/build/libHSintel-aes-0.1.1.a(GladmanAES.o): In function `s3ho_info': + -- (.text+0x34c3): undefined reference to `__stginit_intelzmaeszm0zi1zi1_CodecziCryptoziConvertRNG_' + -- collect2: ld returned 1 exit status +-- import qualified Codec.Crypto.ConvertRNG as CR + #include "gladman/aesopt.h" #include "gladman/aes.h" #include "gladman/aestab.h" @@ -37,6 +47,26 @@ data AES n = AES , decCtx :: DecryptCtxP , aesKeyRaw :: B.ByteString } + +-- Because of the above link problem I can't move these: +{- +mkAESGen :: Int -> CR.CRGtoRG (CR.BCtoCRG (AES N128)) +mkAESGen int = CR.convertCRG gen + where + Right (gen :: CR.BCtoCRG (AES N128)) = newGen (B.append halfseed halfseed ) + halfseed = encode word64 + word64 = fromIntegral int :: Word64 + +mkAESGen0 :: Int -> CR.CRGtoRG0 (CR.BCtoCRG (AES N128)) +mkAESGen0 int = CR.CRGtoRG0 gen + where + Right (gen :: CR.BCtoCRG (AES N128)) = newGen (B.append halfseed halfseed ) + halfseed = encode word64 + word64 = fromIntegral int :: Word64 + -} + +-------------------------------------------------------------------------------- + -- | Create an encryption/decryption context for incremental -- encryption/decryption -- diff --git a/Codec/Crypto/IntelAES.hs b/Codec/Crypto/IntelAES.hs index 24b51fa..ac30b1e 100644 --- a/Codec/Crypto/IntelAES.hs +++ b/Codec/Crypto/IntelAES.hs @@ -10,53 +10,101 @@ -} {-# OPTIONS_GHC -fwarn-unused-imports #-} -{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE ForeignFunctionInterface, CPP, ScopedTypeVariables #-} module Codec.Crypto.IntelAES ( mkAESGen -- Plus, instances exported of course. + , testIntelAES ) where import qualified Codec.Crypto.IntelAES.AESNI as NI --- import qualified Codec.Crypto.IntelAES.GladmanAES as GL +import qualified Codec.Crypto.GladmanAES as GA +import GHC.IO (unsafeDupablePerformIO) +import Data.Tagged +import Data.Word +import Data.Serialize +import qualified Data.ByteString as B +import Crypto.Random (CryptoRandomGen(..), GenError(..), splitGen, genBytes) +import Crypto.Types +import Codec.Crypto.ConvertRNG +import Debug.Trace + +newtype CompoundCRG = + CompoundCRG + (Either (BCtoCRG (NI.IntelAES NI.N128)) + (BCtoCRG (GA.AES GA.N128))) + +type CompoundAESRNG = CRGtoRG CompoundCRG + +mkAESGen :: Int -> CompoundAESRNG +mkAESGen int = convertCRG gen + where + Right (gen :: CompoundCRG) = newGen (B.append halfseed halfseed ) + halfseed = encode word64 + word64 = fromIntegral int :: Word64 + + +-- foreign import ccall unsafe "iaesni.h" check_for_aes_instructions :: IO Bool +foreign import ccall unsafe "iaesni.h" check_for_aes_instructions :: Bool + + +{-# INLINE mapRight #-} +mapRight fn x@(Left _) = x +mapRight fn (Right x) = Right$ fn x + +{-# INLINE mapSnd #-} +mapSnd fn (x,y) = (x,fn y) + + +instance CryptoRandomGen CompoundCRG where + +-- newGen :: B.ByteString -> Either GenError CompoundCRG + newGen = +-- if unsafeDupablePerformIO check_for_aes_instructions + trace ("Checked for AES instructions: "++ show check_for_aes_instructions)$ + if check_for_aes_instructions + -- Ick, boilerplate: + then \bytes -> case newGen bytes of Left err -> Left err + Right gen -> Right$ CompoundCRG$ Left gen + else \bytes -> case newGen bytes of Left err -> Left err + Right gen -> Right$ CompoundCRG$ Right gen + + genSeedLength = Tagged 128 + + + -- ByteLength -> CompoundCRG -> Either GenError (B.ByteString, CompoundCRG) + genBytes req (CompoundCRG (Left gen)) = +#if 0 + mapRight (mapSnd (CompoundCRG . Left) ) $ genBytes req gen +#else + case genBytes req gen of + Left err -> Left err + Right (bytes,gen') -> Right (bytes, CompoundCRG (Left gen')) +#endif + +-- OUCH + genBytes req (CompoundCRG (Right gen)) = + case genBytes req gen of + Left err -> Left err + Right (bytes,gen') -> Right (bytes, CompoundCRG (Right gen')) + reseed bs (CompoundCRG (Left gen)) = + case reseed bs gen of + Left err -> Left err + Right gen' -> Right (CompoundCRG (Left gen')) + reseed bs (CompoundCRG (Right gen)) = + case reseed bs gen of + Left err -> Left err + Right gen' -> Right (CompoundCRG (Right gen')) +-- + + + +testIntelAES = do + putStrLn$ "Running crude tests." +-- b <- check_for_aes_instructions + let b = check_for_aes_instructions + putStrLn$ "Machine supports AESNI: "++ show b --- import System.Random --- import System.IO.Unsafe (unsafePerformIO) --- import GHC.IO (unsafeDupablePerformIO) - --- import Data.List --- import Data.Word --- import Data.Tagged --- import Data.Serialize - --- import qualified Data.Bits --- import qualified Data.ByteString as B --- import qualified Data.ByteString.Char8 as BC --- import qualified Data.ByteString.Internal as BI - --- import Crypto.Random.DRBG () --- import Crypto.Modes - --- import Crypto.Random (CryptoRandomGen(..), GenError(..), splitGen, genBytes) --- import Crypto.Classes (BlockCipher(..), blockSizeBytes) --- import Crypto.Types - --- import Control.Monad --- import Foreign.Ptr --- import qualified Foreign.ForeignPtr as FP --- import Foreign.Storable - - --- type CompoundAESRNG = (LiftCRG (BCtoCRG (IntelAES N128))) --- Either (LiftCRG (BCtoCRG (IntelAES N128))) --- () - ---mkAESGen :: Int -> CompoundAESRNG ---mkAESGen = undecidable - -mkAESGen = NI.mkAESGen - --- int check_for_aes_instructions() -foreign import ccall unsafe "iaesni.h" check_for_aes_instructions :: IO Bool diff --git a/Codec/Crypto/IntelAES/AESNI.hs b/Codec/Crypto/IntelAES/AESNI.hs index a5d907b..852e7f7 100644 --- a/Codec/Crypto/IntelAES/AESNI.hs +++ b/Codec/Crypto/IntelAES/AESNI.hs @@ -16,7 +16,7 @@ module Codec.Crypto.IntelAES.AESNI ( - testIntelAES + testAESNI , mkAESGen, SimpleAESRNG -- Inefficient version for testing: @@ -199,7 +199,7 @@ unpack_ptr ptr len = loop len [] loop (i-1) (x:acc) -- This is not a meaningful test yet... one option would be to reproduce the tests in aessample.c -testIntelAES = do +testAESNI = do let bytes = 256 plaintext <- calloc bytes 1 diff --git a/Codec/Crypto/IntelAES/GladmanAES.hsc b/Codec/Crypto/IntelAES/GladmanAES.hsc deleted file mode 100644 index 45b11ea..0000000 --- a/Codec/Crypto/IntelAES/GladmanAES.hsc +++ /dev/null @@ -1,185 +0,0 @@ --- | ECB AES operation. This code is based on the "AES" package from --- Svein Ove Aas (University of Tromsø), though it is heavily modified --- and any bugs should be blamed on me, Thomas M. DuBuisson. -{-# LANGUAGE FlexibleInstances, EmptyDataDecls, FlexibleContexts, - ForeignFunctionInterface, ViewPatterns, ScopedTypeVariables #-} -{-# CFILES cbits/gladman/aescrypt.c cbits/gladman/aeskey.c cbits/gladman/aestab.c cbits/gladman/aes_modes.c #-} -module Codec.Crypto.IntelAES.GladmanAES - ( AES - , N128, N192, N256 - , mkAESGen, mkAESGen0 - , module Crypto.Classes - , module Crypto.Modes - ) where - -import qualified Codec.Crypto.ConvertRNG as CR -import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as BI -import Crypto.Modes -import Crypto.Classes -import Crypto.Types -import Crypto.Random (CryptoRandomGen(..)) -import Data.Tagged -import Data.Serialize - -import Foreign -import Control.Applicative -import Control.Monad - -#include "gladman/aesopt.h" -#include "gladman/aes.h" -#include "gladman/aestab.h" -#include "gladman/brg_endian.h" -#include "gladman/ctr_inc.h" - -data N128 -data N192 -data N256 - -data AES n = AES - { encCtx :: EncryptCtxP - , decCtx :: DecryptCtxP - , aesKeyRaw :: B.ByteString } - - -mkAESGen :: Int -> CR.CRGtoRG (CR.BCtoCRG (AES N128)) -mkAESGen int = CR.convertCRG gen - where - Right (gen :: CR.BCtoCRG (AES N128)) = newGen (B.append halfseed halfseed ) - halfseed = encode word64 - word64 = fromIntegral int :: Word64 - -mkAESGen0 :: Int -> CR.CRGtoRG0 (CR.BCtoCRG (AES N128)) -mkAESGen0 int = CR.CRGtoRG0 gen - where - Right (gen :: CR.BCtoCRG (AES N128)) = newGen (B.append halfseed halfseed ) - halfseed = encode word64 - word64 = fromIntegral int :: Word64 - ----------------------------------------------------------------------------------------------------- - --- | Create an encryption/decryption context for incremental --- encryption/decryption --- --- You may create an ECB context this way, in which case you may pass --- undefined for the IV -newCtx :: B.ByteString -> IO (AES n) -newCtx key = do - e <- (encryptCtx key) - d <- (decryptCtx key) - return $ AES e d key - -instance BlockCipher (AES N128) where - blockSize = Tagged 128 - encryptBlock = aesEnc - decryptBlock = aesDec - buildKey = aesBK 128 - keyLength = aesKL - -instance BlockCipher (AES N192) where - blockSize = Tagged 128 - encryptBlock = aesEnc - decryptBlock = aesDec - buildKey = aesBK 192 - keyLength = aesKL - -instance BlockCipher (AES N256) where - blockSize = Tagged 128 - encryptBlock = aesEnc - decryptBlock = aesDec - buildKey = aesBK 256 - keyLength = aesKL - - -aesEnc :: AES n -> B.ByteString -> B.ByteString -aesEnc k m = unsafePerformIO $ call _aes_ecb_encrypt (encCtx k) m - -aesDec :: AES n -> B.ByteString -> B.ByteString -aesDec k m = unsafePerformIO $ call _aes_ecb_decrypt (decCtx k) m - -aesBK :: Int -> B.ByteString -> Maybe (AES n) -aesBK n bs - | B.length bs == n `div` 8 = Just $ unsafePerformIO (newCtx bs) - | otherwise = Nothing - -aesKL :: AES n -> BitLength -aesKL = (*8) . B.length . aesKeyRaw - -instance Serialize (AES N128) where - get = getGeneral 16 - put = putByteString . aesKeyRaw - -instance Serialize (AES N192) where - get = getGeneral 24 - put = putByteString . aesKeyRaw - -instance Serialize (AES N256) where - get = getGeneral 32 - put = putByteString . aesKeyRaw - -getGeneral :: BlockCipher (AES n) => Int -> Get (AES n) -getGeneral n = do - bs <- getByteString n - case buildKey bs of - Nothing -> fail "Could not build key from serialized bytestring" - Just x -> return x - -call :: (Ptr b -> Ptr Word8 -> Int -> Ptr a -> IO Int) - -> ForeignPtr a -> B.ByteString -> IO B.ByteString -call f ctx (BI.toForeignPtr -> (bs,offset,len)) = - withForeignPtr ctx $ \ctxp -> - withForeignPtr bs $ \bsp -> - BI.create len $ \obuf -> - ensure $ f (bsp `plusPtr` offset) obuf len ctxp - -foreign import ccall unsafe "aes_ecb_encrypt" _aes_ecb_encrypt - :: Ptr Word8 -> Ptr Word8 -> Int -> Ptr EncryptCtxStruct -> IO Int -foreign import ccall unsafe "aes_ecb_decrypt" _aes_ecb_decrypt - :: Ptr Word8 -> Ptr Word8 -> Int -> Ptr DecryptCtxStruct -> IO Int - -type EncryptCtxP = ForeignPtr EncryptCtxStruct - -type DecryptCtxP = ForeignPtr DecryptCtxStruct - -data EncryptCtxStruct -instance Storable EncryptCtxStruct where - sizeOf _ = #size aes_encrypt_ctx - alignment _ = 16 -- FIXME: Maybe overkill, maybe underkill, definitely iffy - -data DecryptCtxStruct -instance Storable DecryptCtxStruct where - sizeOf _ = #size aes_decrypt_ctx - alignment _ = 16 - -wrap :: Int -> Bool -wrap r | r == (#const EXIT_SUCCESS) = True - | otherwise = False - -ensure :: IO Int -> IO () -ensure act = do - r <- wrap <$> act - unless r (fail "AES function failed") - -foreign import ccall unsafe "aes_encrypt_key" _aes_encrypt_key - :: Ptr Word8 -> Int -> Ptr EncryptCtxStruct -> IO Int - -encryptCtx :: B.ByteString -> IO EncryptCtxP -encryptCtx bs = do - ctx <- mallocForeignPtr - let (key,offset,len) = BI.toForeignPtr bs - withForeignPtr ctx $ \ctx' -> - withForeignPtr key $ \key' -> - ensure $ _aes_encrypt_key (key' `plusPtr` offset) len ctx' - return ctx - -foreign import ccall unsafe "aes_decrypt_key" _aes_decrypt_key - :: Ptr Word8 -> Int -> Ptr DecryptCtxStruct -> IO Int - -decryptCtx :: B.ByteString -> IO DecryptCtxP -decryptCtx bs = do - ctx <- mallocForeignPtr - let (key,offset,len) = BI.toForeignPtr bs - withForeignPtr ctx $ \ctx' -> - withForeignPtr key $ \key' -> - ensure $ _aes_decrypt_key (key' `plusPtr` offset) len ctx' - return ctx diff --git a/SimpleRNGBench.hs b/SimpleRNGBench.hs index fcae3c0..d2f2a1b 100755 --- a/SimpleRNGBench.hs +++ b/SimpleRNGBench.hs @@ -10,7 +10,7 @@ module Main where import qualified Codec.Encryption.BurtonRNGSlow as BS --import qualified Codec.Crypto.IntelAES.GladmanAES as GA -import qualified Codec.Crypto.GladmanAES as GA +import qualified Codec.Crypto.GladmanAES as GA import qualified Codec.Crypto.IntelAES.AESNI as NI import qualified Codec.Crypto.IntelAES as IA import qualified Codec.Crypto.ConvertRNG as CR @@ -303,7 +303,8 @@ main = do let (opts,_,other) = getOpt Permute options argv when (Test `elem` opts)$ do - NI.testIntelAES + IA.testIntelAES + NI.testAESNI exitSuccess when (not$ null other) $ do @@ -334,10 +335,13 @@ main = do timeit th freq "PureHaskell" BS.mkBurtonGen -- timeit th freq "Gladman inefficient" GA.mkAESGen0 -- timeit th freq "Gladman" GA.mkAESGen + timeit th freq "Gladman inefficient" mkAESGen_gladman0 + timeit th freq "Gladman" mkAESGen_gladman + timeit th freq "Compound gladman/intel" IA.mkAESGen -- timeit th freq "Svein's Gladman package" (const svein) timeit th freq "IntelAES inefficient" NI.mkAESGen0 timeit th freq "IntelAES" NI.mkAESGen - timeit th freq "Compound gladman/intel" IA.mkAESGen + when (not$ NoC `elem` opts) $ do putStrLn$ " Comparison to C's rand():" diff --git a/TODO.txt b/TODO.txt index 1efbd4e..7921f86 100644 --- a/TODO.txt +++ b/TODO.txt @@ -8,4 +8,7 @@ Here are the major TODO items: * Include the Intel AES sample library! - + * Use template haskell or quasiquoting to check whether to use AESNI + at INSTALL TIME not at runtime. + +