1-- | 2-- Module : Data.ASN1.Serialize 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : unknown 7-- 8module Data.ASN1.Serialize (getHeader, putHeader) where 9 10import qualified Data.ByteString as B 11import Data.ASN1.Get 12import Data.ASN1.Internal 13import Data.ASN1.Types 14import Data.ASN1.Types.Lowlevel 15import Data.Bits 16import Data.Word 17import Control.Applicative ((<$>)) 18import Control.Monad 19 20-- | parse an ASN1 header 21getHeader :: Get ASN1Header 22getHeader = do 23 (cl,pc,t1) <- parseFirstWord <$> getWord8 24 tag <- if t1 == 0x1f then getTagLong else return t1 25 len <- getLength 26 return $ ASN1Header cl tag pc len 27 28-- | Parse the first word of an header 29parseFirstWord :: Word8 -> (ASN1Class, Bool, ASN1Tag) 30parseFirstWord w = (cl,pc,t1) 31 where cl = toEnum $ fromIntegral $ (w `shiftR` 6) 32 pc = testBit w 5 33 t1 = fromIntegral (w .&. 0x1f) 34 35{- when the first tag is 0x1f, the tag is in long form, where 36 - we get bytes while the 7th bit is set. -} 37getTagLong :: Get ASN1Tag 38getTagLong = do 39 t <- fromIntegral <$> getWord8 40 when (t == 0x80) $ fail "non canonical encoding of long tag" 41 if testBit t 7 42 then loop (clearBit t 7) 43 else return t 44 where loop n = do 45 t <- fromIntegral <$> getWord8 46 if testBit t 7 47 then loop (n `shiftL` 7 + clearBit t 7) 48 else return (n `shiftL` 7 + t) 49 50 51{- get the asn1 length which is either short form if 7th bit is not set, 52 - indefinite form is the 7 bit is set and every other bits clear, 53 - or long form otherwise, where the next bytes will represent the length 54 -} 55getLength :: Get ASN1Length 56getLength = do 57 l1 <- fromIntegral <$> getWord8 58 if testBit l1 7 59 then case clearBit l1 7 of 60 0 -> return LenIndefinite 61 len -> do 62 lw <- getBytes len 63 return (LenLong len $ uintbs lw) 64 else 65 return (LenShort l1) 66 where 67 {- uintbs return the unsigned int represented by the bytes -} 68 uintbs = B.foldl (\acc n -> (acc `shiftL` 8) + fromIntegral n) 0 69 70-- | putIdentifier encode an ASN1 Identifier into a marshalled value 71putHeader :: ASN1Header -> B.ByteString 72putHeader (ASN1Header cl tag pc len) = B.concat 73 [ B.singleton word1 74 , if tag < 0x1f then B.empty else tagBS 75 , lenBS] 76 where cli = shiftL (fromIntegral $ fromEnum cl) 6 77 pcval = shiftL (if pc then 0x1 else 0x0) 5 78 tag0 = if tag < 0x1f then fromIntegral tag else 0x1f 79 word1 = cli .|. pcval .|. tag0 80 lenBS = B.pack $ putLength len 81 tagBS = putVarEncodingIntegral tag 82 83{- | putLength encode a length into a ASN1 length. 84 - see getLength for the encoding rules -} 85putLength :: ASN1Length -> [Word8] 86putLength (LenShort i) 87 | i < 0 || i > 0x7f = error "putLength: short length is not between 0x0 and 0x80" 88 | otherwise = [fromIntegral i] 89putLength (LenLong _ i) 90 | i < 0 = error "putLength: long length is negative" 91 | otherwise = lenbytes : lw 92 where 93 lw = bytesOfUInt $ fromIntegral i 94 lenbytes = fromIntegral (length lw .|. 0x80) 95putLength (LenIndefinite) = [0x80] 96