{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Windll -- Copyright : (c) Tamar Christina 2009 - 2010 -- License : BSD3 -- -- Maintainer : tamar@zhox.com -- Stability : experimental -- Portability : portable -- -- Generates the .lib file for use in c++ compilers. -- This version can only read and generate the short version of -- the Import Library format. The Compiler should be able to generate -- the rest. Or you can use libtool or lib yourself to generate one. -- http://kishorekumar.net/pecoff_v8.1.htm -- ----------------------------------------------------------------------------- module WinDll.COFF.Lib where import Control.Applicative (many) import Control.Monad (replicateM) import Control.Monad (when, replicateM) import Control.Monad.Trans (liftIO) import Data.Bits import Data.Char (ord, chr) import Data.Serialize import Data.Time.Clock (UTCTime) import Data.Time.Format (formatTime, readTime) import Data.Word import System.Locale (defaultTimeLocale) -- | The structure of a .LIB file in Haskell format data LibFile = LibFile { fstLinker :: Section FirstMember -- ^ @entries@ First linker object , sndLinker :: Section SecondMember -- ^ @entries@ second linker object , long :: Section LongNames -- ^ @long@ Definition of Longnames ember , objfiles :: [Section ImportLibrary] -- ^ @objfiles@ A list of OBJ File contents (COFF Format) } -- | The header file of a .LIB COFF format data Header = Header { hdName :: Either String Int -- ^ 0 16 Name The name of the archive member, with a slash (/) appended -- to terminate the name. If the first character is a slash, -- the name has a special interpretation, as described in the -- following table. , hdDate :: UTCTime -- ^ 16 12 Date The date and time that the archive member was created: This -- is the ASCII decimal representation of the number of seconds -- since 1/1/1970 UCT. , hdUserID :: String -- ^ 28 6 User ID An ASCII decimal representation of the user ID. This field -- does not contain a meaningful value on Windows platforms because -- Microsoft tools emit all blanks. , hdGroupID :: String -- ^ 34 6 Group ID An ASCII decimal representation of the group ID. This field -- does not contain a meaningful value on Windows platforms because -- Microsoft tools emit all blanks. , hdMode :: String -- ^ 40 8 Mode An ASCII octal representation of the member’s file mode. This is -- the ST_MODE value from the C run-time function _wstat. , hdSize :: Int -- ^ 48 10 Size An ASCII decimal representation of the total size of the archive -- member, not including the size of the header. } -- | The first COFF linker member data FirstMember = FirstMember { flkOffsets :: [Int] -- ^ 4 4*n Offsets An array of file offsets to archive member headers, in which n is equal -- to the Number of Symbols field. Each number in the array is an unsigned -- long stored in big-endian format. For each symbol that is named in the -- string table, the corresponding element in the offsets array gives the -- location of the archive member that contains the symbol. , flkStrTbl :: [String] -- ^ * * String Table A series of null-terminated strings that name all the symbols in -- the directory. Each string begins immediately after the null character -- in the previous string. The number of strings must be equal to the -- value of the Number of Symbols field. } data SecondMember = SecondMember { slkOffsets :: [Int] -- ^ 4 4*m Offsets An array of file offsets to archive member headers, arranged in -- ascending order. Each offset is an unsigned long. The number m -- is equal to the value of the Number of Members field. , slkIndices :: [Int] -- ^ * 2*n Indices An array of 1-based indexes (unsigned short) that map symbol names -- to archive member offsets. The number n is equal to the Number of -- Symbols field. For each symbol that is named in the string table, -- the corresponding element in the Indices array gives an index into -- the offsets array. The offsets array, in turn, gives the location -- of the archive member that contains the symbol. , slkStrTbl :: [String] -- ^ * * String Table A series of null-terminated strings that name all of the symbols -- in the directory. Each string begins immediately after the null -- byte in the previous string. The number of strings must be equal -- to the value of the Number of Symbols field. This table lists all -- the symbol names in ascending lexical order. } -- | List of long names, These will be stored as a null-terminated string newtype LongNames = LongNames { lnNames :: [String] } -- | The import library declaration. This version only allows the short version -- of the specification. and nothing more. The long version requires me to write -- a symbol table and calculate some data from the dll. This is something best done -- by vc++ so I'm not going to do it. data ImportLibrary = ShortImport { siHeader :: ImportHeader , siImportName :: String -- ^ Null-terminated import name string , siDLLName :: String -- ^ Null-terminated DLL name string } -- | COFF Import Headers data ImportHeader = ImportHeader { ihSig1 :: MachineType -- ^ 0 2 Sig1 Must be IMAGE_FILE_MACHINE_UNKNOWN. For more information, see section 3.3.1, "Machine Types." , ihSig2 :: Int -- ^ 2 2 Sig2 Must be 0xFFFF. , ihVersion :: (Int, Int) -- ^ 4 2 Version The structure version. , ihMachine :: MachineType -- ^ 6 2 Machine The number that identifies the type of target machine. For more information, see section 3.3.1, "Machine Types." , ihDateTime :: UTCTime -- ^ 8 4 Time-Date Stamp The time and date that the file was created. , ihSize :: Int -- ^ 12 4 Size Of Data The size of the strings that follow the header. , ihHint :: String -- ^ 16 2 Ordinal/Hint Either the ordinal or the hint for the import, determined by the value in the Name Type field. , ihType :: ImportType -- ^ 18 2 bits Type The import type. For specific values and descriptions, see section 8.2, "Import Type." , ihNameType :: ImportNameType -- ^ 3 bits Name Type The import name type. For specific values and descriptions, see section "8.3. Import Name Type." , ihReserved :: Word16 -- ^ 11 bits Reserved Reserved, must be 0. } instance Serialize ImportHeader where put ih = do put (ihSig1 ih) put (toWord16 $ ihSig2 ih) let (major,minor) = ihVersion ih put (toWord8 major) put (toWord8 minor) put (ihMachine ih) let time = formatTime defaultTimeLocale "%s" (ihDateTime ih) put (read time :: Word32) put (toWord32 $ ihSize ih) mapM_ put (take 2 $ ihHint ih) let bits0 = ihReserved ih bits1 = case ihType ih of IMPORT_CODE -> bits0 IMPORT_DATA -> bits0 `setBit` 14 IMPORT_CONST -> bits0 `setBit` 15 bits2 = case ihNameType ih of IMPORT_ORDINAL -> bits1 IMPORT_NAME -> bits1 `setBit` 11 IMPORT_NAME_NOPREFIX -> bits1 `setBit` 12 IMPORT_NAME_UNDECORATE -> bits1 `setBit` 11 `setBit` 12 put bits2 get = do sig1 <- get when (sig1 /= IMAGE_FILE_MACHINE_UNKNOWN) $ error "Import header sig1 error, expected IMAGE_FILE_MACHINE_UNKNOWN" sig2 <- get :: Get Word16 when (sig2 /= 0xFFFF) $ error "Import Header bit signature mismatch" major <- get :: Get Word8 minor <- get :: Get Word8 machine <- get time <- get :: Get Word32 let time' = readTime defaultTimeLocale "%s" (show time) size <- get :: Get Word32 hint <- get >>= \a -> get >>= \b -> return [a,b] bits0 <- get :: Get Word16 let itype = case (bits0 `testBit` 14, bits0 `testBit` 15) of (False, False) -> IMPORT_CODE (True , False) -> IMPORT_DATA (False, True ) -> IMPORT_CONST iname = case (bits0 `testBit` 11, bits0 `testBit` 12) of (False, False) -> IMPORT_ORDINAL (True , False) -> IMPORT_NAME (False, True ) -> IMPORT_NAME_NOPREFIX (True , True ) -> IMPORT_NAME_UNDECORATE return $ ImportHeader sig1 (fromWord16 sig2) (fromWord8 major, fromWord8 minor) machine time' (fromWord32 size) hint itype iname 0 -- | The Machine field has one of the following values that specifies its CPU type. -- An image file can be run only on the specified machine or on a system that emulates -- the specified machine. data MachineType = IMAGE_FILE_MACHINE_UNKNOWN -- ^ 0x0 The contents of this field are assumed to be applicable to any machine type | IMAGE_FILE_MACHINE_AM33 -- ^ 0x1d3 Matsushita AM33 | IMAGE_FILE_MACHINE_AMD64 -- ^ 0x8664 x64 | IMAGE_FILE_MACHINE_ARM -- ^ 0x1c0 ARM little endian | IMAGE_FILE_MACHINE_EBC -- ^ 0xebc EFI byte code | IMAGE_FILE_MACHINE_I386 -- ^ 0x14c Intel 386 or later processors and compatible processors | IMAGE_FILE_MACHINE_IA64 -- ^ 0x200 Intel Itanium processor family | IMAGE_FILE_MACHINE_M32R -- ^ 0x9041 Mitsubishi M32R little endian | IMAGE_FILE_MACHINE_MIPS16 -- ^ 0x266 MIPS16 | IMAGE_FILE_MACHINE_MIPSFPU -- ^ 0x366 MIPS with FPU | IMAGE_FILE_MACHINE_MIPSFPU16 -- ^ 0x466 MIPS16 with FPU | IMAGE_FILE_MACHINE_POWERPC -- ^ 0x1f0 Power PC little endian | IMAGE_FILE_MACHINE_POWERPCFP -- ^ 0x1f1 Power PC with floating point support | IMAGE_FILE_MACHINE_R4000 -- ^ 0x166 MIPS little endian | IMAGE_FILE_MACHINE_SH3 -- ^ 0x1a2 Hitachi SH3 | IMAGE_FILE_MACHINE_SH3DSP -- ^ 0x1a3 Hitachi SH3 DSP | IMAGE_FILE_MACHINE_SH4 -- ^ 0x1a6 Hitachi SH4 | IMAGE_FILE_MACHINE_SH5 -- ^ 0x1a8 Hitachi SH5 | IMAGE_FILE_MACHINE_THUMB -- ^ 0x1c2 Thumb | IMAGE_FILE_MACHINE_WCEMIPSV2 -- ^ 0x169 MIPS little-endian WCE v2 deriving (Show, Eq) -- | The following values are defined for the Type field in the import header. data ImportType = IMPORT_CODE -- ^ 0 Executable code. | IMPORT_DATA -- ^ 1 Data. | IMPORT_CONST -- ^ 2 Specified as CONST in the .def file. -- | The null-terminated import symbol name immediately follows its associated import header. -- The following values are defined for the Name Type field in the import header. -- They indicate how the name is to be used to generate the correct symbols that represent the import. data ImportNameType = IMPORT_ORDINAL -- ^ 0 The import is by ordinal. This indicates that the value in -- the Ordinal/Hint field of the import header is the import’s -- ordinal. If this constant is not specified, then the Ordinal/Hint -- field should always be interpreted as the import’s hint. | IMPORT_NAME -- ^ 1 The import name is identical to the public symbol name. | IMPORT_NAME_NOPREFIX -- ^ 2 The import name is the public symbol name, but skipping the -- leading ?, @, or optionally _. | IMPORT_NAME_UNDECORATE -- ^ 3 The import name is the public symbol name, but skipping the -- leading ?, @, or optionally _, and truncating at the first @. -- | Puts the string of length i. If the string is -- too short the string is padded, if it's too long -- the string is truncated. putString :: Int -> String -> Put putString i str = let nm = take i (str ++ repeat ' ') in mapM_ put nm -- | Reads a fixed length string back in. The string is post -- processed to removed paddings getString :: Int -> Get String getString i = do str <- replicateM i get return $ trim str -- | Remove leading and trailing whitespace trim :: String -> String trim = reverse . dropWhile (==' ') . reverse . dropWhile (==' ') -- | Write a NULL terminated string out writeNullString :: String -> Put writeNullString str = do mapM_ put str put '\0' -- | Read a NULL terminated string readNullString :: Get String readNullString = do x <- get if x == '\0' then return [] else do xs <- readNullString return (x:xs) -- * Some extra utilities function toInt :: Functor f => f Word32 -> f Int toInt = fmap fromIntegral mapInt :: [Word32] -> [Int] mapInt = map (fromIntegral :: Word32 -> Int) toWord8 :: Integral a => a -> Word8 toWord8 = fromIntegral toWord16 :: Integral a => a -> Word16 toWord16 = fromIntegral toWord32 :: Integral a => a -> Word32 toWord32 = fromIntegral fromWord8 :: Integral a => Word8 -> a fromWord8 = fromIntegral fromWord16 :: Integral a => Word16 -> a fromWord16 = fromIntegral fromWord32 :: Integral a => Word32 -> a fromWord32 = fromIntegral instance Serialize LibFile where put lib = do mapM_ put "!\n" put (fstLinker lib) put (sndLinker lib) put (long lib) mapM_ put (objfiles lib) get = do sig <- getString 08 when (sig /= "!\n") $ error "header value mismatched" fstObj <- get sndObj <- get lngObj <- get objFls <- many get return $ LibFile fstObj sndObj lngObj objFls instance Serialize Header where put hd = do let name = case hdName hd of Left str -> str ++ "/" Right loc -> '/' : show loc putString 16 name let time = formatTime defaultTimeLocale "%s" (hdDate hd) putString 12 time putString 06 (hdUserID hd) putString 06 (hdGroupID hd) putString 08 (hdMode hd) putString 10 (show (hdSize hd)) put (toWord8 0x60) put (toWord8 0x0A) get = do name <- getString 16 time <- getString 12 user <- getString 06 group <- getString 06 mode <- getString 08 size <- getString 10 byte1 <- get :: Get Word8 byte2 <- get :: Get Word8 let name' = case name of '/':str -> Right (read str) str -> Left str let time' = readTime defaultTimeLocale "%s" time when (byte1 /= 0x60 || byte2 /= 0x0A) $ error "signature bytes mismatch" return $ Header name' time' user group mode (read size) instance Serialize FirstMember where put fm = do put (fromIntegral $ length $ flkOffsets fm :: Word32) mapM_ (put . (fromIntegral :: Int -> Word32)) (flkOffsets fm) mapM_ writeNullString (flkStrTbl fm) get = do size <- toInt get offsets <- replicateM size get :: Get [Word32] strTble <- replicateM size readNullString return $ FirstMember (mapInt offsets) strTble instance Serialize SecondMember where put fm = do put (fromIntegral $ length $ slkOffsets fm :: Word32) mapM_ (put . (fromIntegral :: Int -> Word32)) (slkOffsets fm) put (fromIntegral $ length $ slkIndices fm :: Word32) mapM_ (put . (fromIntegral :: Int -> Word32)) (slkIndices fm) mapM_ writeNullString (slkStrTbl fm) get = do size1 <- toInt get offsets <- replicateM size1 get :: Get [Word32] size2 <- toInt get indices <- replicateM size2 get :: Get [Word32] strTble <- replicateM size2 readNullString return $ SecondMember (mapInt offsets) (mapInt indices) strTble instance Serialize LongNames where put = mapM_ writeNullString . lnNames get = fmap LongNames $ many readNullString instance Serialize ImportLibrary where put im = do put (siHeader im) writeNullString (siImportName im) writeNullString (siDLLName im) get = do header <- get impname <- readNullString dllname <- readNullString return $ ShortImport header impname dllname instance Serialize ImportType where put IMPORT_CODE = put (toWord8 0) put IMPORT_DATA = put (toWord8 1) put IMPORT_CONST = put (toWord8 2) get = do val <- get :: Get Word8 return $ case val of 0 -> IMPORT_CODE 1 -> IMPORT_DATA 2 -> IMPORT_CONST instance Serialize ImportNameType where put IMPORT_ORDINAL = put (toWord8 0) put IMPORT_NAME = put (toWord8 1) put IMPORT_NAME_NOPREFIX = put (toWord8 2) put IMPORT_NAME_UNDECORATE = put (toWord8 3) get = do val <- get :: Get Word8 return $ case val of 0 -> IMPORT_ORDINAL 1 -> IMPORT_NAME 2 -> IMPORT_NAME_NOPREFIX 3 -> IMPORT_NAME_UNDECORATE instance Serialize MachineType where put IMAGE_FILE_MACHINE_UNKNOWN = put (toWord16 0x0 ) put IMAGE_FILE_MACHINE_AM33 = put (toWord16 0x1d3 ) put IMAGE_FILE_MACHINE_AMD64 = put (toWord16 0x8664) put IMAGE_FILE_MACHINE_ARM = put (toWord16 0x1c0 ) put IMAGE_FILE_MACHINE_EBC = put (toWord16 0xebc ) put IMAGE_FILE_MACHINE_I386 = put (toWord16 0x14c ) put IMAGE_FILE_MACHINE_IA64 = put (toWord16 0x200 ) put IMAGE_FILE_MACHINE_M32R = put (toWord16 0x9041) put IMAGE_FILE_MACHINE_MIPS16 = put (toWord16 0x266 ) put IMAGE_FILE_MACHINE_MIPSFPU = put (toWord16 0x366 ) put IMAGE_FILE_MACHINE_MIPSFPU16 = put (toWord16 0x466 ) put IMAGE_FILE_MACHINE_POWERPC = put (toWord16 0x1f0 ) put IMAGE_FILE_MACHINE_POWERPCFP = put (toWord16 0x1f1 ) put IMAGE_FILE_MACHINE_R4000 = put (toWord16 0x166 ) put IMAGE_FILE_MACHINE_SH3 = put (toWord16 0x1a2 ) put IMAGE_FILE_MACHINE_SH3DSP = put (toWord16 0x1a3 ) put IMAGE_FILE_MACHINE_SH4 = put (toWord16 0x1a6 ) put IMAGE_FILE_MACHINE_SH5 = put (toWord16 0x1a8 ) put IMAGE_FILE_MACHINE_THUMB = put (toWord16 0x1c2 ) put IMAGE_FILE_MACHINE_WCEMIPSV2 = put (toWord16 0x169 ) get = do val <- get :: Get Word16 return $ case val of 0x0 -> IMAGE_FILE_MACHINE_UNKNOWN 0x1d3 -> IMAGE_FILE_MACHINE_AM33 0x8664 -> IMAGE_FILE_MACHINE_AMD64 0x1c0 -> IMAGE_FILE_MACHINE_ARM 0xebc -> IMAGE_FILE_MACHINE_EBC 0x14c -> IMAGE_FILE_MACHINE_I386 0x200 -> IMAGE_FILE_MACHINE_IA64 0x9041 -> IMAGE_FILE_MACHINE_M32R 0x266 -> IMAGE_FILE_MACHINE_MIPS16 0x366 -> IMAGE_FILE_MACHINE_MIPSFPU 0x466 -> IMAGE_FILE_MACHINE_MIPSFPU16 0x1f0 -> IMAGE_FILE_MACHINE_POWERPC 0x1f1 -> IMAGE_FILE_MACHINE_POWERPCFP 0x166 -> IMAGE_FILE_MACHINE_R4000 0x1a2 -> IMAGE_FILE_MACHINE_SH3 0x1a3 -> IMAGE_FILE_MACHINE_SH3DSP 0x1a6 -> IMAGE_FILE_MACHINE_SH4 0x1a8 -> IMAGE_FILE_MACHINE_SH5 0x1c2 -> IMAGE_FILE_MACHINE_THUMB 0x169 -> IMAGE_FILE_MACHINE_WCEMIPSV2