diff --git a/Data/ASN1/Pretty.hs b/Data/ASN1/Pretty.hs new file mode 100644 --- /dev/null +++ b/Data/ASN1/Pretty.hs @@ -0,0 +1,78 @@ +-- | +-- Module : Data.ASN1.Pretty +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +module Data.ASN1.Pretty + ( pretty + , PrettyType(..) + ) where + +import Data.ASN1.Types +import Data.ASN1.BitArray +import Data.ByteArray.Encoding (convertToBase, Base(..)) +import Data.ByteString (ByteString) +import Numeric (showHex) + +data PrettyType = Multiline Int -- Offset where to start + | SingleLine + deriving (Show,Eq) + +-- | Pretty Print a list of ASN.1 element +pretty :: PrettyType -- ^ indent level in space character + -> [ASN1] -- ^ stream of ASN1 + -> String +pretty (Multiline at) = prettyPrint at + where + indent n = replicate n ' ' + + prettyPrint _ [] = "" + prettyPrint n (x@(Start _) : xs) = indent n ++ p id x ++ prettyPrint (n+1) xs + prettyPrint n (x@(End _) : xs) = indent (n-1) ++ p id x ++ prettyPrint (n-1) xs + prettyPrint n (x : xs) = indent n ++ p id x ++ prettyPrint n xs + +pretty SingleLine = prettyPrint + where + prettyPrint [] = "" + prettyPrint (x@(Start _) : xs) = p id x ++ "," ++ prettyPrint xs + prettyPrint (x@(End _) : xs) = p id x ++ "," ++ prettyPrint xs + prettyPrint (x : xs) = p id x ++ "," ++ prettyPrint xs + +p :: ([Char] -> t) -> ASN1 -> t +p put (Boolean b) = put ("bool: " ++ show b) +p put (IntVal i) = put ("int: " ++ showHex i "") +p put (BitString bits) = put ("bitstring: " ++ (hexdump $ bitArrayGetData bits)) +p put (OctetString bs) = put ("octetstring: " ++ hexdump bs) +p put (Null) = put "null" +p put (OID is) = put ("OID: " ++ show is) +p put (Real d) = put ("real: " ++ show d) +p put (Enumerated _) = put "enum" +p put (Start Sequence) = put "{" +p put (End Sequence) = put "}" +p put (Start Set) = put "[" +p put (End Set) = put "]" +p put (Start (Container x y)) = put ("< " ++ show x ++ " " ++ show y) +p put (End (Container x y)) = put ("> " ++ show x ++ " " ++ show y) +p put (ASN1String cs) = putCS put cs +p put (ASN1Time TimeUTC time tz) = put ("utctime: " ++ show time ++ " " ++ show tz) +p put (ASN1Time TimeGeneralized time tz) = put ("generalizedtime: " ++ show time ++ " " ++ show tz) +p put (Other tc tn x) = put ("other(" ++ show tc ++ "," ++ show tn ++ "," ++ show x ++ ")") + +putCS :: ([Char] -> t) -> ASN1CharacterString -> t +putCS put (ASN1CharacterString UTF8 t) = put ("utf8string:" ++ show t) +putCS put (ASN1CharacterString Numeric bs) = put ("numericstring:" ++ hexdump bs) +putCS put (ASN1CharacterString Printable t) = put ("printablestring: " ++ show t) +putCS put (ASN1CharacterString T61 bs) = put ("t61string:" ++ show bs) +putCS put (ASN1CharacterString VideoTex bs) = put ("videotexstring:" ++ hexdump bs) +putCS put (ASN1CharacterString IA5 bs) = put ("ia5string:" ++ show bs) +putCS put (ASN1CharacterString Graphic bs) = put ("graphicstring:" ++ hexdump bs) +putCS put (ASN1CharacterString Visible bs) = put ("visiblestring:" ++ hexdump bs) +putCS put (ASN1CharacterString General bs) = put ("generalstring:" ++ hexdump bs) +putCS put (ASN1CharacterString UTF32 t) = put ("universalstring:" ++ show t) +putCS put (ASN1CharacterString Character bs) = put ("characterstring:" ++ hexdump bs) +putCS put (ASN1CharacterString BMP t) = put ("bmpstring: " ++ show t) + +hexdump :: ByteString -> String +hexdump bs = show (convertToBase Base16 bs :: ByteString) diff --git a/Data/ASN1/Types.hs b/Data/ASN1/Types.hs --- a/Data/ASN1/Types.hs +++ b/Data/ASN1/Types.hs @@ -20,8 +20,7 @@ , module Data.ASN1.OID ) where -import Data.Time.Clock (UTCTime) -import Data.Time.LocalTime (TimeZone) +import Data.Hourglass import Data.ASN1.BitArray import Data.ASN1.OID import Data.ASN1.Types.Lowlevel @@ -50,7 +49,7 @@ | Real Double | Enumerated Integer | ASN1String ASN1CharacterString - | ASN1Time ASN1TimeType UTCTime (Maybe TimeZone) + | ASN1Time ASN1TimeType DateTime (Maybe TimezoneOffset) | Other ASN1Class ASN1Tag ByteString | Start ASN1ConstructionType | End ASN1ConstructionType diff --git a/Data/ASN1/Types/String.hs b/Data/ASN1/Types/String.hs --- a/Data/ASN1/Types/String.hs +++ b/Data/ASN1/Types/String.hs @@ -123,7 +123,7 @@ , toCont (e `shiftR` 6) , toCont e] | otherwise = error "not a valid value" - toCont v = fromIntegral (0xc0 .&. (v .&. 0x3f)) + toCont v = fromIntegral (0x80 .|. (v .&. 0x3f)) decodeASCII :: ByteString -> String decodeASCII = BC.unpack @@ -134,7 +134,13 @@ decodeBMP :: ByteString -> String decodeBMP b | odd (B.length b) = error "not a valid BMP string" - | otherwise = undefined + | otherwise = fromUCS2 $ B.unpack b + where fromUCS2 [] = [] + fromUCS2 (b0:b1:l) = + let v :: Word16 + v = (fromIntegral b0 `shiftL` 8) .|. fromIntegral b1 + in toEnum (fromIntegral v) : fromUCS2 l + fromUCS2 _ = error "decodeBMP: internal error" encodeBMP :: String -> ByteString encodeBMP s = B.pack $ concatMap (toUCS2 . fromEnum) s where toUCS2 v = [b0,b1] @@ -142,9 +148,23 @@ b1 = fromIntegral (v .&. 0xff) decodeUTF32 :: ByteString -> String -decodeUTF32 b - | (B.length b `mod` 4) /= 0 = error "not a valid UTF32 string" - | otherwise = undefined +decodeUTF32 bs + | (B.length bs `mod` 4) /= 0 = error "not a valid UTF32 string" + | otherwise = fromUTF32 0 + where w32ToChar :: Word32 -> Char + w32ToChar = toEnum . fromIntegral + fromUTF32 ofs + | ofs == B.length bs = [] + | otherwise = + let a = B.index bs ofs + b = B.index bs (ofs+1) + c = B.index bs (ofs+2) + d = B.index bs (ofs+3) + v = (fromIntegral a `shiftL` 24) .|. + (fromIntegral b `shiftL` 16) .|. + (fromIntegral c `shiftL` 8) .|. + (fromIntegral d) + in w32ToChar v : fromUTF32 (ofs+4) encodeUTF32 :: String -> ByteString encodeUTF32 s = B.pack $ concatMap (toUTF32 . fromEnum) s where toUTF32 v = [b0,b1,b2,b3] diff --git a/asn1-types.cabal b/asn1-types.cabal --- a/asn1-types.cabal +++ b/asn1-types.cabal @@ -1,5 +1,5 @@ Name: asn1-types -Version: 0.2.3 +Version: 0.3.4 Description: ASN.1 standard types License: BSD3 License-file: LICENSE @@ -11,15 +11,17 @@ Category: Data stability: experimental Cabal-Version: >=1.6 -Homepage: http://github.com/vincenthz/hs-asn1-types +Homepage: http://github.com/vincenthz/hs-asn1 Library Build-Depends: base >= 3 && < 5 , bytestring - , time + , memory + , hourglass Exposed-modules: Data.ASN1.BitArray Data.ASN1.OID + Data.ASN1.Pretty Data.ASN1.Types Data.ASN1.Types.String Data.ASN1.Types.Lowlevel @@ -27,4 +29,4 @@ source-repository head type: git - location: git://github.com/vincenthz/hs-asn1-types + location: git://github.com/vincenthz/hs-asn1