top page > computer > web > rfc > x_690 > 8_1_common > coding > existential > ber_only_encode.html
更新日:
文責: 重城良国

X.690: ASN.1のBER方式の共通部分の存在型を利用したコーディング: エンコード

動機

たいていにおいてデコードよりもエンコードの方が簡単だ。しかし、エンコード後のデータの形を指定しようとすると、エンコードはとたんに難しくなる。デコードのついでにエンコードなんて「ちょいちょい」と作ってしまおうと考えていたが、そうもいかないようなので、本腰を入れて作ることにした。

encodeTag, encodeLength

まずは前に定義したencodeTagとencodeLengthを別モジュールに分けておく。

Asn1Tag.hs BasicEncoder.hs

encodeLengthのほうは最小桁数を示すMaybe Integerを引数として取るように、変更する必要がある。

encodeLengthの変更

長さについては何通りかの選択子がある。

長さを指定するかしないかについては長さの値をMaybe Integerとすることで対応する。「全体を1バイトで表現」を0とし、長さを表す値の桁数を別に引数として与える。それを最低限の桁数として扱う。

与えた値が0ならばもともとのencodeLengthと同じような動作とする。

そうでない場合は以下のような動作をさせる。まずはIntegerをバイト列で表現する。そのバイト列の長さと引数として与えた値とを比較して、長いほうを採用し、引数として与えた値のほうが大きければ、適切にパディングする。

encodeLength :: Int -> Maybe Integer -> ByteString
encodeLength _ (Just l)
	| l < 0 = error "No negative length"
encodeLength 0 (Just l)
	| l < 128 = pack [fromIntegral l]
	| otherwise = pack $
		(0x80 .|. fromIntegral (length ws)) : ws
	where
	ws = reverse $ integerToWord8s l
encodeLength n (Just l)
	| ln >= n = pack $
		(0x80 .|. fromIntegral ln) : ws
	| otherwise = pack $ (0x80 .|. fromIntegral n) :
		replicate (n - ln) 0x00 ++ ws
	where
	ws = reverse $ integerToWord8s l
	ln = length ws
encodeLength _ _ = "\x80"
integerToWord8s :: Integer -> [Word8]
integerToWord8s 0 = []
integerToWord8s n = fromIntegral (n .&. 0xff) :
	integerToWord8s (n `shiftR` 8)

注意点

CER方式では1000バイトを越えるかどうかで、PrimitiveかConstructedかを決定するアルゴリズムが必要な箇所がある。

形式の指定子を表すデータ型

以下のどれを選択するかを決める必要がある。

また、これは樹構造を取れる必要がある。以下のような指定子を定義してみる。

type TypeNumber = Integer
data Sel
	= SelPrimitive
	| SelConstructed (Maybe Int) [Selector]
data Selector = Selector (TypeNumber -> Integer -> Sel)

リストは子要素に対して適用する指定子を示す。

BerEncodeクラスの定義

Encoder.hs

class BerEncode b where
	encode :: Selector -> b -> ByteString

Bool型のエンコード

インスタンス宣言

instance BerEncode Bool where
	encode _ b = encodeTag
			(Asn1Tag Universal Primitive 1)
		`append` encodeLength 0 (Just 1)
		`append` (if b then "\xff" else "\x00")

試してみる

% ghci Encoder.hs
Encoder> encode Undefined True
"\SOH\SOH\255"
Encoder> encode Undefined False
"\SOH\SOH\NUL"

Integer型のエンコード

インスタンス宣言

instance BerEncode Integer where
	encode _ n = encodeTag
			(Asn1 Universal Primitive 2)
		`append` encodeLength 0
			(Just . fromIntegral $ length bs)
		`append` bs
		where
		bs = integerToBS n
integerToBS :: Integer -> ByteString
integerToBS n = BS.pack $ if testBit b 7 then 0 : s else s
	where
	s@(b : _) | 0 <- n = [0] | otherwise =
		reverse $ integerToWord8s n

試してみる

ghci Encoder.hs
Encoder> encode undefined 0x7f
"\STX\SOH\DEL"
Encoder> encode undefined 0x80
"\STX\STX\NUL\128"
Encoder> encode undefined 0x8080
"\STX\ETX\NUL\128\128"

リストのエンコード

インスタンス宣言

instance BerEncode b => BerEncode [b] where
	encode (Selector sel) cs = encodeTag
			(Asn1Tag Universal Constructed 16)
		`append` case sel 16 undefined of
			SelConstructed (Just n) sels ->
				encodeSequenceD n sels cs
			SelConstructed _ sels ->
				encodeSequenceU sels cs
			_ -> error "Bad selector"
encodeSequenceD :: BerEncode b =>
	Int -> [Selector] -> [b] -> BS.ByteString
encodeSequencdD n sels cs = encodeLength n
	(Just . formIntegral $ length bs) `append` bs
	where
	bs = concat $ zipWith encode sels cs
encodeSequenceU :: BerEncode b =>
	[Selector] -> [b] -> BS.ByteString
encodeSequenceU sels cs = encodeLength 0 Nothing
	`append` bs `append` "\x00\x00"
	where
	bs = concat $ zipWith encode sels cs

テスト用の指定子の定義

testSel, testSel2 :: Selector
testSel = Selector $ \t _ -> case t of
	1 -> SelPrimitive
	2 -> SelPrimitive
	16 -> SelConstructed (Just 0) $ repeat testSel
	_ -> error "not yet defined"
testSel2 = Selector $ \t _ -> case t of
	1 -> SelPrimitive
	2 -> SelPrimitive
	16 -> SelConstructed Nothing $ repeat testSel2
	_ -> error "not yet defined"

試してみる

ghci Encoder.hs
Encoder> encode testSel [0x7e, 0x7f]
"0\ACK\STX\SOH~\STX\SOH\DEL"
Encoder> encode testSel2 [0x7e, 0x7f]
"0\128\STX\SOH~\STX\SOH\DEL\NUL\NUL"
Encoder> encode testSel [True, False]
"0\ACK\SOH\SOH\255\SOH\SOH\NUL"
Encoder> encode testSel2 [True, False]
"0\128\SOH\SOH\255\SOH\SOH\NUL\NUL\NUL"

BerEncodeBoxの定義

インスタンス宣言

data BerEncodeBox =
	forall b . (Typeable b, BerEncode b) => BerEncodeBox b
instance BerEncode BerEncodeBox where
	encode s (BerEncodeBox b) = encode s b

試してみる

% ghci Encoder.hs
Encoder> encode testSel [BerEncodeBox 0x7f, BerEncodeBox True]
"0\ACK\STX\SOH\DEL\SOH\SOH\255"

「存在型を利用」トップへ

正当なCSSです! HTML5 Powered with CSS3 / styling, and Semantics