1(*
2    Title:      ASN1 support.
3    Author:     David Matthews
4    Copyright   David Matthews 2015-16, 2019, 2020
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 decodeLargeInt: Word8VectorSlice.slice -> LargeInt.int
49    and decodeString: Word8VectorSlice.slice -> string
50    and decodeBool: Word8VectorSlice.slice -> bool
51
52    (* Encode a tag/value pair. *)
53    val encodeItem: tagType * Word8Vector.vector list -> Word8Vector.vector list
54    
55    val encodeInt: int -> Word8Vector.vector
56    and encodeString: string -> Word8Vector.vector
57    and encodeBool: bool -> Word8Vector.vector
58end;
59
60structure Asn1: ASN1 =
61struct
62    datatype form = Primitive | Constructed
63
64    datatype tagType =
65        Universal of int * form
66    |   Application of int * form
67    |   Context of int * form
68    |   Private of int * form
69
70    (* A few standard tags *)
71    val asn1Boolean = Universal(1, Primitive)
72    and asn1Integer = Universal(2, Primitive)
73    and asn1BitString = Universal(3, Primitive) (* Could also be constructed *)
74    and asn1OctetString = Universal(4, Primitive) (* Could also be constructed *)
75
76    open Word8VectorSlice
77    (* Convert the length data.  The first byte is either the length itself, if it
78       is less than 128 otherwise it is the number of bytes containing the length. *)
79
80    fun getLength getNext p =
81        case getNext p of
82            SOME (n, t) =>
83            if n < 0wx80 then SOME(Word8.toInt n, t)
84            else
85            let
86                fun getL(0w0, m, l) = SOME(m, l)
87                |   getL(n, m, t) =
88                        case getNext t of
89                            SOME (hd, tl) => getL(n-0w1, m * 256 + Word8.toInt hd, tl)
90                        |   NONE => NONE
91                val lengthOfLength = Word8.andb(n, 0wx7f)
92            in
93                if lengthOfLength = 0w0
94                then raise Fail "Indefinite length is not implemented"
95                else getL(lengthOfLength, 0, t)
96            end
97        |   NONE => NONE
98
99    fun readHeader getNext input =
100        case getNext input of
101            SOME (code, t) =>
102                let
103                    (* The type is encoded in the top two bits of the first byte. *)
104                    val tagType: int * form -> tagType =
105                        case Word8.andb(code, 0wxc0) of
106                            0wx00 => Universal
107                        |   0wx40 => Application
108                        |   0wx80 => Context
109                        |   _     => Private
110
111                    val sc = if Word8.andb(code, 0wx20) = 0w0 then Primitive else Constructed
112
113                    (* The tag is the bottom five bits except that if it is 0x1f
114                       the tag is encoded in subsequent bytes. *)
115                    val tagRest =
116                        case Word8.andb(code, 0w31) of
117                            0w31 => (* This is a long-format tag *)
118                                let
119                                    fun decode (acc, seq) =
120                                        case getNext seq of
121                                            SOME(code, seq') =>
122                                            let
123                                                (* Keep accumulating the tags until we find a byte with the
124                                                   top bit clear. *)
125                                                val tag' = acc * 128 + Word8.toInt(Word8.andb(code, 0wx7f))
126                                            in
127                                                if Word8.andb(code, 0wx80) = 0w0
128                                                then SOME(tag', seq')
129                                                else decode(tag', seq')
130                                            end
131                                        |   NONE => NONE
132                                in
133                                    decode(0, t)
134                                end
135                        |   firstTag => SOME(Word8.toInt firstTag, t)
136
137                in
138                    case tagRest of
139                        SOME(tag, rest) =>
140                        (
141                            case getLength getNext rest of
142                                SOME(len, tail) => SOME((tagType(tag, sc), len), tail)
143                            |   NONE => NONE
144                        )
145                    |   NONE => NONE
146                end
147        |   NONE => NONE
148
149    (* Decode Word8VectorSlice.slice input. *)
150    local
151        fun getNext n =
152            if length n = 0 then NONE
153            else SOME(sub(n, 0), subslice(n, 1, NONE))
154    in
155        fun decodeItem input =
156            case readHeader getNext input of
157                SOME((tag, len), tail) =>
158                    SOME{tag = tag,
159                        data = Word8VectorSlice.subslice(tail, 0, SOME len),
160                        remainder = Word8VectorSlice.subslice(tail, len, NONE)
161                    }
162            |   NONE => NONE
163
164        fun decodeLargeInt p =
165            case getNext p of
166                NONE => 0
167            |   SOME(h, tl) =>
168                let
169                    fun parseRest(n, p) =
170                        case getNext p of
171                            NONE => n
172                        |   SOME (hd, tl) => parseRest(n * 256 + Word8.toLargeInt hd, tl)
173                in
174                    parseRest(Word8.toLargeIntX h, tl)
175                end
176
177        val decodeInt = LargeInt.toInt o decodeLargeInt
178    end
179
180    fun decodeString t = Byte.bytesToString(vector t)
181    
182    and decodeBool p = decodeInt p <> 0
183
184
185    fun encodeItem (tag, value) =
186    let
187        open Word8Vector
188
189        fun encodeTag(tagType, tagValue) =
190            if tagValue < 31
191            then [Word8.orb(tagType, Word8.fromInt tagValue)]
192            else
193            let
194                (* Set the top bit on all bytes except the last. *)
195                fun addToList(n, []) = [Word8.fromInt n]
196                |   addToList(n, t) = Word8.fromInt(128 + n) :: t
197
198                fun encode(n, t) =
199                    if n < 128
200                    then addToList(n, t)
201                    else encode(n div 128, addToList(n mod 128, t))
202            in
203                Word8.orb(tagType, 0w31) :: encode(tagValue, [])
204            end
205
206        val tagCode =
207            case tag of
208                Universal (t, Primitive)       => encodeTag(0wx00, t)
209            |   Universal (t, Constructed)     => encodeTag(0wx20, t)
210            |   Application (t, Primitive)     => encodeTag(0wx40, t)
211            |   Application (t, Constructed)   => encodeTag(0wx60, t)
212            |   Context (t, Primitive)         => encodeTag(0wx80, t)
213            |   Context (t, Constructed)       => encodeTag(0wxa0, t)
214            |   Private (t, Primitive)         => encodeTag(0wxc0, t)
215            |   Private (t, Constructed)       => encodeTag(0wxe0, t)
216
217        (* Encode the length the argument. *)
218        val length = List.foldl(fn (a, b) => length a + b) 0 value
219        
220        val lengthCode =
221            if length < 128
222            then [Word8.fromInt length]
223            else
224            let
225                fun encodeLength (0, t) = t
226                |   encodeLength (v, t) = encodeLength(v div 256, Word8.fromInt(v mod 256) :: t)
227
228                val encodedLength = encodeLength(length, [])
229            in
230                Word8.orb(0wx80, Word8.fromInt(List.length encodedLength)) :: encodedLength
231            end
232    in
233        fromList(tagCode @ lengthCode) :: value
234    end
235
236    fun encodeInt n =
237    let
238        fun encode (n, t) =
239        let
240            val lo = Word8.fromInt n (* Bottom byte *)
241            val hi = n div 256
242        in
243            (* If the high byte is 0 or -1 and the sign bit is already
244               correct we've finished. *)
245            if hi = 0 andalso lo < 0w128 orelse hi = ~1 andalso lo >= 0w128
246            then lo :: t
247            else encode(hi, lo :: t)
248        end
249    in
250        Word8Vector.fromList(encode(n, []))
251    end
252
253    val encodeString = Byte.stringToBytes
254    
255    fun encodeBool b = encodeInt(if b then 1 else 0)
256end;
257