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

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

出来上がったコード: Asnable.hs

decodeTag, decodeLength関数

decodeTag, decodeLength関数は存在型を使わないデコード関数と同じ。

復号のルール

復号関数に引数として与える復号のルールの型を定義する。再帰的に同じ型を引数として取る必要があるので代数的データ型とする。

data Rule = Rule { runRule :: RuleType }
type RuleType = [Rule] -> Asn1Tag -> Maybe Integer ->
	Maybe (Analyzer ByteString AsnableBox)

復号のルールは再帰的に中身を復号していく場合に渡すためにルール自体を第一引数として取る。第二、第三引数はデータの型と長さであり、返り値は中身に適用する復号ルーチンである。

復号関数

復号のルールを取って復号ルーチンを返す関数である。実際の復号は復号ルーチンをrunAnalyzerで走らせることで行われる。

decodeWith :: [Rule] -> Analyzer ByteString AsnableBox
decodeWith rl = do
	t <- decodeTag
	l <- decodeLength
	fromJust . fromJust . find isJust $
		map (($ l) . ($ t) . ($ rl) . runRule) rl

タグを復号し長さを復号したうえで、複数のルールのなかからJustになるものを選び実行する。

基本的なルール

表面のみを復号するルール

rawRule :: RuleType
rawRule _ t (Just l) =
	Just $ AsnableBox . Raw t <$> tokens l
rawRule _ _ _ = Just $ fail "Raw needs length"

再帰的にPrimitiveなデータにまで復号するルール

まずはend-of-contentsが長さ0でなかった場合をエラーにする。

recRule :: RuleType
recRule _ (Asn1Tag Universal Primitive 0) (Just l)
	| l /= 0 = fail "Bad end-of-contents"
recRule _ (Asn1Tag Universal Primitive 0) Nothing =
	fail "Bad end-of-contents"

Primitiveで長さの指定があった場合にはRawを返す。

recRule _ t@(Asn1Tag _ Primitive _) (Just l) =
	Just $ AsnableBox . Raw t <$> tokens l

Constructedで長さの指定があった場合には、その長さぶん切り出してから、再帰的に復号する。

recRule r t (Just l) = Just $ do
	s <- tokens l
	let eas = runAnalyzer (listAll $ decodeWith r) s
	case eas of
		Left em -> fail em
		Right (as, "") -> return .
			AsnableBox $ RawConstructed t as
		_ -> error "never occur"

Constructedで長さの指定がなかった場合には、end-of-contentsに到るまで復号を続ける。loopWhileMとnotEndOfContentsについては後述する。

recRule r t@(Asn1Tag _ Constructed _) _ = Just $ do
	as <- loopWhileM notEndOfContents $ decodeWith r
	return . AsnableBox $ RawConstructed t as

Primitiveで長さの指定がなかった場合にはエラーとなる。

recRule _ _ _ = fail "Primitive needs length"

Constructedで長さの指定なしの場合の補助関数

loopWhileM関数

返り値が条件を満たすあいだモナドをくりかえし実行する。条件を満たさなくなった場合にモナドを終了する。

loopWhileM :: Monad m => (a -> Bool) -> m a -> m [a]
loopWhileM p m = m >>= \x -> if p x
	then (x :) `liftM` loopWhileM p m
	else return []

notEndOfContents関数

AsnableBoxがend-of-contentsではないことをチェックする。

notEndOfContents :: AsnableBox -> Bool
notEndOfContents =
	(/= Asn1Tag Universal Primitive 0) . getAsn1Tag

試してみる

テスト用の証明書を用意する

作成の仕方は「X.690: テスト用のファイルの作成」を参照。

test_ASN_1_cert.der(16進ダンプ)

テスト用のMainモジュールを用意する

testAsnable.hs

テスト用のファイルを読み込む等。また、テストのためにRawやRawConstructedを含むAsnableBoxを表示しやすいRw型に変換する関数を定義した。

data Rw = RC Asn1Tag [Rw] | RP Asn1Tag ByteString
	deriving Show
toRw :: AsnableBox -> Rw
toRw ab = case getAsn1Tag ab of
	t@(Asn1Tag _ Constructed _) -> let
		Just (RawConstructed _ as) = getAsnable ab in
		RC t $ map toRw as
	t -> let
		Just (Raw _ bs) = getAsnable ab in
		RP t bs

ghciで試してみる

% ghci testAsnable.hs
Main> :set -XOverloadedStrings
Main> Right (ab, "") = runAnalyzer (decodeWith [recRule]) cert
Main> toRw ab
RC (Asn1Tag Universal Constructed 16) [RC (Asn1Tag Universal
Constructed 16) [RC (Asn1Tag ContextSpecific Constructed 0) [
...
\DEL\220\EM\228\193\189\144\172\248f\176\236\141\236\200h\156
\&2\\M\239\200\155\186\ACK\172"]
Main> Right (ab, "") = runAnalyzer (decodeWith [recRule]) ind_test
Main> toRw ab
RC (Asn1Tag Universal Constructed 16) [RP (Asn1Tag Universal
Primitive 1) "\136"]

「データ型」へもどる 「デコードルール例の追加」へ

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