1(*
2    Title:      ASN1 support.
3    Author:     David Matthews
4    Copyright   David Matthews 2015-16
5
6    This library is free software; you can redistribute it and/or
7    modify it under the terms of the GNU Lesser General Public
8    License version 2.1 as published by the Free Software Foundation.
9    
10    This library is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13    Lesser General Public License for more details.
14    
15    You should have received a copy of the GNU Lesser General Public
16    License along with this library; if not, write to the Free Software
17    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
18*)
19
20(*
21These functions provide assistance in the encoding and decoding of ASN1
22binary encoding.
23*)
24
25signature ASN1 =
26sig
27    datatype form = Primitive | Constructed
28
29    datatype tagType =
30        Universal of int * form
31    |   Application of int * form
32    |   Context of int * form
33    |   Private of int * form
34
35    val asn1Boolean: tagType  and asn1Integer: tagType
36    and asn1BitString: tagType and asn1OctetString: tagType
37
38    (* Parse the tag and length information to extract the first tag/value pair from the
39       input.  Returns with the reader pointing at the start of the data. *)
40    val readHeader: (Word8.word, 'a) StringCvt.reader -> ((tagType * int), 'a) StringCvt.reader
41
42    (* Parse the tag and length information to extract the first tag/value pair from the
43       input.  Returns the remainder of the input. *)
44    val decodeItem: Word8VectorSlice.slice ->
45        {tag: tagType, data: Word8VectorSlice.slice, remainder: Word8VectorSlice.slice} option
46
47    val decodeInt: Word8VectorSlice.slice -> int
48    and decodeString: Word8VectorSlice.slice -> string
49    and decodeBool: Word8VectorSlice.slice -> bool
50
51    (* Encode a tag/value pair. *)
52    val encodeItem: tagType * Word8Vector.vector list -> Word8Vector.vector list
53    
54    val encodeInt: int -> Word8Vector.vector
55    and encodeString: string -> Word8Vector.vector
56    and encodeBool: bool -> Word8Vector.vector
57end;
58
59structure Asn1: ASN1 =
60struct
61    datatype form = Primitive | Constructed
62
63    datatype tagType =
64        Universal of int * form
65    |   Application of int * form
66    |   Context of int * form
67    |   Private of int * form
68
69    (* A few standard tags *)
70    val asn1Boolean = Universal(1, Primitive)
71    and asn1Integer = Universal(2, Primitive)
72    and asn1BitString = Universal(3, Primitive) (* Could also be constructed *)
73    and asn1OctetString = Universal(4, Primitive) (* Could also be constructed *)
74
75    open Word8VectorSlice
76    (* Convert the length data.  The first byte is either the length itself, if it
77       is less than 128 otherwise it is the number of bytes containing the length. *)
78
79    fun getLength getNext p =
80        case getNext p of
81            SOME (n, t) =>
82            if n < 0wx80 then SOME(Word8.toInt n, t)
83            else
84            let
85                fun getL(0w0, m, l) = SOME(m, l)
86                |   getL(n, m, t) =
87                        case getNext t of
88                            SOME (hd, tl) => getL(n-0w1, m * 256 + Word8.toInt hd, tl)
89                        |   NONE => NONE
90                val lengthOfLength = Word8.andb(n, 0wx7f)
91            in
92                if lengthOfLength = 0w0
93                then raise Fail "Indefinite length is not implemented"
94                else getL(lengthOfLength, 0, t)
95            end
96        |   NONE => NONE
97
98    fun readHeader getNext input =
99        case getNext input of
100            SOME (code, t) =>
101                let
102                    (* The type is encoded in the top two bits of the first byte. *)
103                    val tagType: int * form -> tagType =
104                        case Word8.andb(code, 0wxc0) of
105                            0wx00 => Universal
106                        |   0wx40 => Application
107                        |   0wx80 => Context
108                        |   _     => Private
109
110                    val sc = if Word8.andb(code, 0wx20) = 0w0 then Primitive else Constructed
111
112                    (* The tag is the bottom five bits except that if it is 0x1f
113                       the tag is encoded in subsequent bytes. *)
114                    val tagRest =
115                        case Word8.andb(code, 0w31) of
116                            0w31 => (* This is a long-format tag *)
117                                let
118                                    fun decode (acc, seq) =
119                                        case getNext seq of
120                                            SOME(code, seq') =>
121                                            let
122                                                (* Keep accumulating the tags until we find a byte with the
123                                                   top bit clear. *)
124                                                val tag' = acc * 128 + Word8.toInt(Word8.andb(code, 0wx7f))
125                                            in
126                                                if Word8.andb(code, 0wx80) = 0w0
127                                                then SOME(tag', seq')
128                                                else decode(tag', seq')
129                                            end
130                                        |   NONE => NONE
131                                in
132                                    decode(0, t)
133                                end
134                        |   firstTag => SOME(Word8.toInt firstTag, t)
135
136                in
137                    case tagRest of
138                        SOME(tag, rest) =>
139                        (
140                            case getLength getNext rest of
141                                SOME(len, tail) => SOME((tagType(tag, sc), len), tail)
142                            |   NONE => NONE
143                        )
144                    |   NONE => NONE
145                end
146        |   NONE => NONE
147
148    (* Decode Word8VectorSlice.slice input. *)
149    local
150        fun getNext n =
151            if length n = 0 then NONE
152            else SOME(sub(n, 0), subslice(n, 1, NONE))
153    in
154        fun decodeItem input =
155            case readHeader getNext input of
156                SOME((tag, len), tail) =>
157                    SOME{tag = tag,
158                        data = Word8VectorSlice.subslice(tail, 0, SOME len),
159                        remainder = Word8VectorSlice.subslice(tail, len, NONE)
160                    }
161            |   NONE => NONE
162
163        fun decodeInt p =
164            case getNext p of
165                NONE => 0
166            |   SOME(h, tl) =>
167                let
168                    fun parseRest(n, p) =
169                        case getNext p of
170                            NONE => n
171                        |   SOME (hd, tl) => parseRest(n * 256 + Word8.toInt hd, tl)
172                in
173                    parseRest(Word8.toIntX h, tl)
174                end
175    end
176
177    fun decodeString t = Byte.bytesToString(vector t)
178    
179    and decodeBool p = decodeInt p <> 0
180
181
182    fun encodeItem (tag, value) =
183    let
184        open Word8Vector
185
186        fun encodeTag(tagType, tagValue) =
187            if tagValue < 31
188            then [Word8.orb(tagType, Word8.fromInt tagValue)]
189            else
190            let
191                (* Set the top bit on all bytes except the last. *)
192                fun addToList(n, []) = [Word8.fromInt n]
193                |   addToList(n, t) = Word8.fromInt(128 + n) :: t
194
195                fun encode(n, t) =
196                    if n < 128
197                    then addToList(n, t)
198                    else encode(n div 128, addToList(n mod 128, t))
199            in
200                Word8.orb(tagType, 0w31) :: encode(tagValue, [])
201            end
202
203        val tagCode =
204            case tag of
205                Universal (t, Primitive)       => encodeTag(0wx00, t)
206            |   Universal (t, Constructed)     => encodeTag(0wx20, t)
207            |   Application (t, Primitive)     => encodeTag(0wx40, t)
208            |   Application (t, Constructed)   => encodeTag(0wx60, t)
209            |   Context (t, Primitive)         => encodeTag(0wx80, t)
210            |   Context (t, Constructed)       => encodeTag(0wxa0, t)
211            |   Private (t, Primitive)         => encodeTag(0wxc0, t)
212            |   Private (t, Constructed)       => encodeTag(0wxe0, t)
213
214        (* Encode the length the argument. *)
215        val length = List.foldl(fn (a, b) => length a + b) 0 value
216        
217        val lengthCode =
218            if length < 128
219            then [Word8.fromInt length]
220            else
221            let
222                fun encodeLength (0, t) = t
223                |   encodeLength (v, t) = encodeLength(v div 256, Word8.fromInt(v mod 256) :: t)
224
225                val encodedLength = encodeLength(length, [])
226            in
227                Word8.orb(0wx80, Word8.fromInt(List.length encodedLength)) :: encodedLength
228            end
229    in
230        fromList(tagCode @ lengthCode) :: value
231    end
232
233    fun encodeInt n =
234    let
235        fun encode (n, t) =
236        let
237            val lo = Word8.fromInt n (* Bottom byte *)
238            val hi = n div 256
239        in
240            (* If the high byte is 0 or -1 and the sign bit is already
241               correct we've finished. *)
242            if hi = 0 andalso lo < 0w128 orelse hi = ~1 andalso lo >= 0w128
243            then lo :: t
244            else encode(hi, lo :: t)
245        end
246    in
247        Word8Vector.fromList(encode(n, []))
248    end
249
250    val encodeString = Byte.stringToBytes
251    
252    fun encodeBool b = encodeInt(if b then 1 else 0)
253end;
254