xref: /freebsd/contrib/bearssl/src/x509/asn1.t0 (revision 7fdf597e96a02165cfe22ff357b857d5fa15ed8a)
1\ Copyright (c) 2016 Thomas Pornin <pornin@bolet.org>
2\
3\ Permission is hereby granted, free of charge, to any person obtaining
4\ a copy of this software and associated documentation files (the
5\ "Software"), to deal in the Software without restriction, including
6\ without limitation the rights to use, copy, modify, merge, publish,
7\ distribute, sublicense, and/or sell copies of the Software, and to
8\ permit persons to whom the Software is furnished to do so, subject to
9\ the following conditions:
10\
11\ The above copyright notice and this permission notice shall be
12\ included in all copies or substantial portions of the Software.
13\
14\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
15\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
16\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
17\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
18\ BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
19\ ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20\ CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21\ SOFTWARE.
22
23\ =======================================================================
24
25\ This file contains code which is common to all engines that do some
26\ ASN.1 decoding. It should not be compiled on its own, but only along
27\ with another file (e.g. x509_minimal.t0) which uses it.
28\
29\ Users must define several things:
30\
31\ -- In the preamble, a macro called "CTX" that evaluates to the current
32\ context structure.
33\
34\ -- In the preamble, a macro called "CONTEXT_NAME" that evaluates to the
35\ context structure type. This will be invoked during compilation.
36\
37\ -- A word called "read8-low" ( -- x ) that reads the next byte, or -1
38\ if the input buffer is empty. That word is usually written in C.
39\
40\ -- A word called "read-blob-inner" ( addr len -- addr len ) that is
41\ the multi-byte version of read8-low.
42\
43\ -- A word called "skip-remaining-inner" ( lim -- lim ) which reads but
44\ drops some input bytes.
45
46preamble {
47
48#include "inner.h"
49
50}
51
52\ Read next source character, skipping blanks.
53: skip-blanks begin char dup 32 > if ret then drop again ;
54
55: fail-oid
56	"Invalid OID" puts cr exitvm ;
57
58\ Read a decimal integer, followed by either a dot or whitespace.
59\ Note: this does not check for overflows.
60: parse-number ( -- val nextchar )
61	char decval
62	begin
63		char
64		dup dup `. = swap 32 <= or if ret then
65		decval swap 10 * +
66	again ;
67
68\ Encode a number in unsigned 7E format.
69: encode7E ( val -- )
70	0 encode7E-inner ;
71
72: encode7E-inner ( val eb -- )
73	swap dup 0x7F > if
74		dup 7 u>> 0x80 encode7E-inner 0x7F and
75	then
76	or data-add8 ;
77
78\ Decode an OID from source, and encode it. First byte is length,
79\ followed by encoded ASN.1 DER value. The OID is encoded in the
80\ current data block.
81: OID
82	\ Get current data address, and push a 0 for length.
83	current-data 0 data-add8
84	\ Skip blanks and get first digit, which must be 0, 1 or 2.
85	skip-blanks decval dup 2 > if fail-oid then
86	40 *
87	\ Next character must be a dot.
88	char `. <> if fail-oid then
89	\ Second group must be one or two digits.
90	parse-number { nextchar }
91	dup 40 >= if fail-oid then
92	+ encode7E
93	\ While next character is a dot, keep encoding numbers.
94	begin nextchar `. = while
95		parse-number >nextchar
96		encode7E
97	repeat
98	\ Write back length in the first byte.
99	dup current-data swap - 1- swap data-set8
100	; immediate
101
102\ Define a new data word for an encoded OID. The OID is read from the
103\ source.
104: OID:
105	new-data-block next-word define-data-word postpone OID ;
106
107\ Define a word that evaluates to the address of a field within the
108\ context.
109: addr:
110	next-word { field }
111	"addr-" field + 0 1 define-word
112	0 8191 "offsetof(CONTEXT_NAME, " field + ")" + make-CX
113	postpone literal postpone ; ;
114
115addr: pad
116
117\ Define a word that evaluates to an error code through a macro name.
118: err:
119	next-word { name }
120	name 0 1 define-word
121	0 63 "BR_" name + make-CX postpone literal postpone ; ;
122
123err: ERR_X509_INVALID_VALUE
124err: ERR_X509_TRUNCATED
125err: ERR_X509_EMPTY_CHAIN
126err: ERR_X509_INNER_TRUNC
127err: ERR_X509_BAD_TAG_CLASS
128err: ERR_X509_BAD_TAG_VALUE
129err: ERR_X509_INDEFINITE_LENGTH
130err: ERR_X509_EXTRA_ELEMENT
131err: ERR_X509_UNEXPECTED
132err: ERR_X509_NOT_CONSTRUCTED
133err: ERR_X509_NOT_PRIMITIVE
134err: ERR_X509_PARTIAL_BYTE
135err: ERR_X509_BAD_BOOLEAN
136err: ERR_X509_OVERFLOW
137err: ERR_X509_BAD_DN
138err: ERR_X509_BAD_TIME
139err: ERR_X509_UNSUPPORTED
140err: ERR_X509_LIMIT_EXCEEDED
141err: ERR_X509_WRONG_KEY_TYPE
142err: ERR_X509_BAD_SIGNATURE
143err: ERR_X509_EXPIRED
144err: ERR_X509_DN_MISMATCH
145err: ERR_X509_BAD_SERVER_NAME
146err: ERR_X509_CRITICAL_EXTENSION
147err: ERR_X509_NOT_CA
148err: ERR_X509_FORBIDDEN_KEY_USAGE
149err: ERR_X509_WEAK_PUBLIC_KEY
150
151: KEYTYPE_RSA     CX 0 15 { BR_KEYTYPE_RSA } ;
152: KEYTYPE_EC      CX 0 15 { BR_KEYTYPE_EC } ;
153
154cc: fail ( err -- ! ) {
155	CTX->err = T0_POPi();
156	T0_CO();
157}
158
159\ Read one byte from the stream.
160: read8-nc ( -- x )
161	begin
162		read8-low dup 0 >= if ret then
163		drop co
164	again ;
165
166\ Read one byte, enforcing current read limit.
167: read8 ( lim -- lim x )
168	dup ifnot ERR_X509_INNER_TRUNC fail then
169	1- read8-nc ;
170
171\ Read a 16-bit value, big-endian encoding.
172: read16be ( lim -- lim x )
173	read8 8 << swap read8 rot + ;
174
175\ Read a 16-bit value, little-endian encoding.
176: read16le ( lim -- lim x )
177	read8 swap read8 8 << rot + ;
178
179\ Read all bytes from the current element, then close it (i.e. drop the
180\ limit). Destination address is an offset within the context.
181: read-blob ( lim addr -- )
182	swap
183	begin dup while read-blob-inner dup if co then repeat
184	2drop ;
185
186\ Skip remaining bytes in the current structure, but do not close it
187\ (thus, this leaves the value 0 on the stack).
188: skip-remaining ( lim -- lim )
189	begin dup while skip-remaining-inner dup if co then repeat ;
190
191: skip-remaining-inner ( lim -- lim )
192	0 over read-blob-inner -rot 2drop ;
193
194cc: set8 ( val addr -- ) {
195	uint32_t addr = T0_POP();
196	*((unsigned char *)CTX + addr) = (unsigned char)T0_POP();
197}
198
199cc: set16 ( val addr -- ) {
200	uint32_t addr = T0_POP();
201	*(uint16_t *)(void *)((unsigned char *)CTX + addr) = T0_POP();
202}
203
204cc: set32 ( val addr -- ) {
205	uint32_t addr = T0_POP();
206	*(uint32_t *)(void *)((unsigned char *)CTX + addr) = T0_POP();
207}
208
209cc: get8 ( addr -- val ) {
210	uint32_t addr = T0_POP();
211	T0_PUSH(*((unsigned char *)CTX + addr));
212}
213
214cc: get16 ( addr -- val ) {
215	uint32_t addr = T0_POP();
216	T0_PUSH(*(uint16_t *)(void *)((unsigned char *)CTX + addr));
217}
218
219cc: get32 ( addr -- val ) {
220	uint32_t addr = T0_POP();
221	T0_PUSH(*(uint32_t *)(void *)((unsigned char *)CTX + addr));
222}
223
224\ Read an ASN.1 tag. This function returns the "constructed" status
225\ and the tag value. The constructed status is a boolean (-1 for
226\ constructed, 0 for primitive). The tag value is either 0 to 31 for
227\ a universal tag, or 32+x for a contextual tag of value x. Tag classes
228\ "application" and "private" are rejected. Universal tags beyond 30
229\ are rejected. Contextual tags beyond 30 are rejected. Thus, accepted
230\ tags will necessarily fit on exactly one byte. This does not support
231\ the whole of ASN.1/BER, but is sufficient for certificate parsing.
232: read-tag ( lim -- lim constructed value )
233	read8 { fb }
234
235	\ Constructed flag is bit 5.
236	fb 5 >> 0x01 and neg
237
238	\ Class is in bits 6 and 7. Accepted classes are 00 (universal)
239	\ and 10 (context). We check that bit 6 is 0, and shift back
240	\ bit 7 so that we get 0 (universal) or 32 (context).
241	fb 6 >> dup 0x01 and if ERR_X509_BAD_TAG_CLASS fail then
242	4 <<
243
244	\ Tag value is in bits 0..4. If the value is 31, then this is
245	\ an extended tag, encoded over subsequent bytes, and we do
246	\ not support that.
247	fb 0x1F and dup 0x1F = if ERR_X509_BAD_TAG_VALUE fail then
248	+ ;
249
250\ Read a tag, but only if not at the end of the current object. If there
251\ is no room for another element (limit is zero), then this will push a
252\ synthetic "no tag" value (primitive, with value -1).
253: read-tag-or-end ( lim -- lim constructed value )
254	dup ifnot 0 -1 ret then
255	read-tag ;
256
257\ Compare the read tag with the provided value. If equal, then the
258\ element is skipped, and a new tag is read (or end of object).
259: iftag-skip ( lim constructed value ref -- lim constructed value )
260	over = if
261		2drop
262		read-length-open-elt skip-close-elt
263		read-tag-or-end
264	then ;
265
266\ Read an ASN.1 length. This supports only definite lengths (theoretically,
267\ certificates may use an indefinite length for the outer structure, using
268\ DER only in the TBS, but this never happens in practice, except in a
269\ single example certificate from 15 years ago that also fails to decode
270\ properly for other reasons).
271: read-length ( lim -- lim length )
272	read8
273	\ Lengths in 0x00..0x7F get encoded as a single byte.
274	dup 0x80 < if ret then
275
276	\ If the byte is 0x80 then this is an indefinite length, and we
277	\ do not support that.
278	0x80 - dup ifnot ERR_X509_INDEFINITE_LENGTH fail then
279
280	\ Masking out bit 7, this yields the number of bytes over which
281	\ the value is encoded. Since the total certificate length must
282	\ fit over 3 bytes (this is a consequence of SSL/TLS message
283	\ format), we can reject big lengths and keep the length in a
284	\ single integer.
285	{ n } 0
286	begin n 0 > while n 1- >n
287		dup 0x7FFFFF > if ERR_X509_INNER_TRUNC fail then
288		8 << swap read8 rot +
289	repeat ;
290
291\ Open a sub-structure. This subtracts the length from the limit, and
292\ pushes the length back as new limit.
293: open-elt ( lim length -- lim_outer lim_inner )
294	dup2 < if ERR_X509_INNER_TRUNC fail then
295	dup { len } - len ;
296
297\ Read a length and open the value as a sub-structure.
298: read-length-open-elt ( lim -- lim_outer lim_inner )
299	read-length open-elt ;
300
301\ Close a sub-structure. This verifies that there is no remaining
302\ element to read.
303: close-elt ( lim -- )
304	if ERR_X509_EXTRA_ELEMENT fail then ;
305
306\ Skip remaining bytes in the current structure, then close it.
307: skip-close-elt ( lim -- )
308	skip-remaining drop ;
309
310\ Read a length and then skip the value.
311: read-length-skip ( lim -- lim )
312	read-length-open-elt skip-close-elt ;
313
314\ Check that a given tag is constructed and has the expected value.
315: check-tag-constructed ( constructed value refvalue -- )
316	= ifnot ERR_X509_UNEXPECTED fail then
317	check-constructed ;
318
319\ Check that the top value is true; report a "not constructed"
320\ error otherwise.
321: check-constructed ( constructed -- )
322	ifnot ERR_X509_NOT_CONSTRUCTED fail then ;
323
324\ Check that a given tag is primitive and has the expected value.
325: check-tag-primitive ( constructed value refvalue -- )
326	= ifnot ERR_X509_UNEXPECTED fail then
327	check-primitive ;
328
329\ Check that the top value is true; report a "not primitive"
330\ error otherwise.
331: check-primitive ( constructed -- )
332	if ERR_X509_NOT_PRIMITIVE fail then ;
333
334\ Check that the tag is for a constructed SEQUENCE.
335: check-sequence ( constructed value -- )
336	0x10 check-tag-constructed ;
337
338\ Read a tag, check that it is for a constructed SEQUENCE, and open
339\ it as a sub-element.
340: read-sequence-open ( lim -- lim_outer lim_inner )
341	read-tag check-sequence read-length-open-elt ;
342
343\ Read the next element as a BIT STRING with no ignore bits, and open
344\ it as a sub-element.
345: read-bits-open ( lim -- lim_outer lim_inner )
346	read-tag 0x03 check-tag-primitive
347	read-length-open-elt
348	read8 if ERR_X509_PARTIAL_BYTE fail then ;
349
350OID: rsaEncryption               1.2.840.113549.1.1.1
351
352OID: sha1WithRSAEncryption       1.2.840.113549.1.1.5
353OID: sha224WithRSAEncryption     1.2.840.113549.1.1.14
354OID: sha256WithRSAEncryption     1.2.840.113549.1.1.11
355OID: sha384WithRSAEncryption     1.2.840.113549.1.1.12
356OID: sha512WithRSAEncryption     1.2.840.113549.1.1.13
357
358OID: id-sha1                     1.3.14.3.2.26
359OID: id-sha224                   2.16.840.1.101.3.4.2.4
360OID: id-sha256                   2.16.840.1.101.3.4.2.1
361OID: id-sha384                   2.16.840.1.101.3.4.2.2
362OID: id-sha512                   2.16.840.1.101.3.4.2.3
363
364OID: id-ecPublicKey              1.2.840.10045.2.1
365
366OID: ansix9p256r1                1.2.840.10045.3.1.7
367OID: ansix9p384r1                1.3.132.0.34
368OID: ansix9p521r1                1.3.132.0.35
369
370OID: ecdsa-with-SHA1             1.2.840.10045.4.1
371OID: ecdsa-with-SHA224           1.2.840.10045.4.3.1
372OID: ecdsa-with-SHA256           1.2.840.10045.4.3.2
373OID: ecdsa-with-SHA384           1.2.840.10045.4.3.3
374OID: ecdsa-with-SHA512           1.2.840.10045.4.3.4
375
376OID: id-at-commonName            2.5.4.3
377
378\ Read a "small value". This assumes that the tag has just been read
379\ and processed, but not the length. The first pad byte is set to the
380\ value length; the encoded value itself follows. If the value length
381\ exceeds 255 bytes, then a single 0 is written in the pad, and this
382\ method returns false (0). Otherwise, it returns true (-1).
383\ Either way, the element is fully read.
384: read-small-value ( lim -- lim bool )
385	read-length-open-elt
386	dup 255 > if skip-close-elt 0 addr-pad set8 0 ret then
387	dup addr-pad set8
388	addr-pad 1+ read-blob
389	-1 ;
390
391\ Read an OID as a "small value" (tag, length and value). A boolean
392\ value is returned, which is true (-1) if the OID value fits on the pad,
393\ false (0) otherwise.
394: read-OID ( lim -- lim bool )
395	read-tag 0x06 check-tag-primitive read-small-value ;
396
397\ Read a UTF-8 code point. On error, return 0. Reading a code point of
398\ value 0 is considered to be an error.
399: read-UTF8 ( lim -- lim val )
400	read8
401	choice
402		dup 0x80 < uf ret enduf
403		dup 0xC0 < uf drop 0 ret enduf
404		dup 0xE0 < uf 0x1F and 1 read-UTF8-next 0x80 0x7FF enduf
405		dup 0xF0 < uf 0x0F and 2 read-UTF8-next 0x800 0xFFFF enduf
406		dup 0xF8 < uf 0x07 and 3 read-UTF8-next 0x10000 0x10FFFF enduf
407		drop 0 ret
408	endchoice
409	between? ifnot drop 0 then
410	;
411
412\ Read n subsequent bytes to complete the provided first byte. The final
413\ value is -1 on error, or the code point numerical value. The final
414\ value is duplicated.
415: read-UTF8-next ( lim val n -- lim val val )
416	begin dup while
417		-rot
418		read-UTF8-chunk
419		rot 1-
420	repeat
421	drop dup ;
422
423\ Read one byte, that should be a trailing UTF-8 byte, and complement the
424\ current value. On error, value is set to -1.
425: read-UTF8-chunk ( lim val -- lim val )
426	swap
427	\ If we are at the end of the value, report an error but don't fail.
428	dup ifnot 2drop 0 -1 ret then
429	read8 rot
430	dup 0< if swap drop ret then 6 <<
431	swap dup 6 >> 2 <> if 2drop -1 ret then
432	0x3F and + ;
433
434: high-surrogate? ( x -- x bool )
435	dup 0xD800 0xDBFF between? ;
436
437: low-surrogate? ( x -- x bool )
438	dup 0xDC00 0xDFFF between? ;
439
440: assemble-surrogate-pair ( hi lim lo -- lim val )
441	low-surrogate? ifnot rot 2drop 0 ret then
442	rot 10 << + 0x35FDC00 - ;
443
444\ Read a UTF-16 code point (big-endian). Returned value is 0 on error.
445: read-UTF16BE ( lim -- lim val )
446	read16be
447	choice
448		high-surrogate? uf
449			swap dup ifnot 2drop 0 0 ret then
450			read16be assemble-surrogate-pair
451		enduf
452		low-surrogate? uf
453			drop 0
454		enduf
455	endchoice ;
456
457\ Read a UTF-16 code point (little-endian). Returned value is 0 on error.
458: read-UTF16LE ( lim -- lim val )
459	read16le
460	choice
461		high-surrogate? uf
462			swap dup ifnot 2drop 0 0 ret then
463			read16le assemble-surrogate-pair
464		enduf
465		low-surrogate? uf
466			drop 0
467		enduf
468	endchoice ;
469
470\ Add byte to current pad value. Offset is updated, or set to 0 on error.
471: pad-append ( off val -- off )
472	over dup 0= swap 256 >= or if 2drop 0 ret then
473	over addr-pad + set8 1+ ;
474
475\ Add UTF-8 chunk byte to the pad. The 'nn' parameter is the shift count.
476: pad-append-UTF8-chunk ( off val nn -- off )
477	>> 0x3F and 0x80 or pad-append ;
478
479\ Test whether a code point is invalid when encoding. This rejects the
480\ 66 noncharacters, and also the surrogate range; this function does NOT
481\ check that the value is in the 0..10FFFF range.
482: valid-unicode? ( val -- bool )
483	dup 0xFDD0 0xFDEF between? if drop 0 ret then
484	dup 0xD800 0xDFFF between? if drop 0 ret then
485	0xFFFF and 0xFFFE < ;
486
487\ Encode a code point in UTF-8. Offset is in the pad; it is updated, or
488\ set to 0 on error. Leading BOM are ignored.
489: encode-UTF8 ( val off -- off )
490	\ Skip leading BOM (U+FEFF when off is 1).
491	dup2 1 = swap 0xFEFF = and if swap drop ret then
492
493	swap dup { val }
494	dup valid-unicode? ifnot 2drop 0 ret then
495	choice
496		dup 0x80 < uf pad-append enduf
497		dup 0x800 < uf
498			6 >> 0xC0 or pad-append
499			val 0 pad-append-UTF8-chunk
500		enduf
501		dup 0xFFFF < uf
502			12 >> 0xE0 or pad-append
503			val 6 pad-append-UTF8-chunk
504			val 0 pad-append-UTF8-chunk
505		enduf
506		18 >> 0xF0 or pad-append
507		val 12 pad-append-UTF8-chunk
508		val 6 pad-append-UTF8-chunk
509		val 0 pad-append-UTF8-chunk
510	endchoice ;
511
512\ Read a string value into the pad; this function checks that the source
513\ characters are UTF-8 and non-zero. The string length (in bytes) is
514\ written in the first pad byte. Returned value is true (-1) on success,
515\ false (0) on error.
516: read-value-UTF8 ( lim -- lim bool )
517	read-length-open-elt
518	1 { off }
519	begin dup while
520		read-UTF8 dup ifnot drop skip-close-elt 0 ret then
521		off encode-UTF8 >off
522	repeat
523	drop off dup ifnot ret then 1- addr-pad set8 -1 ;
524
525\ Decode a UTF-16 string into the pad. The string is converted to UTF-8,
526\ and the length is written in the first pad byte. A leading BOM is
527\ honoured (big-endian is assumed if there is no BOM). A code point of
528\ value 0 is an error. Returned value is true (-1) on success, false (0)
529\ on error.
530: read-value-UTF16 ( lim -- lim bool )
531	read-length-open-elt
532	dup ifnot addr-pad set8 -1 ret then
533	1 { off }
534	read-UTF16BE dup 0xFFFE = if
535		\ Leading BOM, and indicates little-endian.
536		drop
537		begin dup while
538			read-UTF16LE dup ifnot drop skip-close-elt 0 ret then
539			off encode-UTF8 >off
540		repeat
541	else
542		dup ifnot drop skip-close-elt 0 ret then
543		\ Big-endian BOM, or no BOM.
544		begin
545			off encode-UTF8 >off
546			dup while
547			read-UTF16BE dup ifnot drop skip-close-elt 0 ret then
548		repeat
549	then
550	drop off dup ifnot ret then 1- addr-pad set8 -1 ;
551
552\ Decode a latin-1 string into the pad. The string is converted to UTF-8,
553\ and the length is written in the first pad byte. A source byte of
554\ value 0 is an error. Returned value is true (-1) on success, false (0)
555\ on error.
556: read-value-latin1 ( lim -- lim bool )
557	read-length-open-elt
558	1 { off }
559	begin dup while
560		read8 dup ifnot drop skip-close-elt 0 ret then
561		off encode-UTF8 >off
562	repeat
563	drop off dup ifnot ret then 1- addr-pad set8 -1 ;
564
565\ Read a value and interpret it as an INTEGER or ENUMERATED value. If
566\ the integer value does not fit on an unsigned 32-bit value, an error
567\ is reported. This function assumes that the tag has just been read
568\ and processed, but not the length.
569: read-small-int-value ( lim -- lim x )
570	read-length-open-elt
571	dup ifnot ERR_X509_OVERFLOW fail then
572	read8 dup 0x80 >= if ERR_X509_OVERFLOW fail then
573	{ x }
574	begin dup while
575		read8 x dup 0xFFFFFF >= if ERR_X509_OVERFLOW fail then
576		8 << + >x
577	repeat
578	drop x ;
579
580\ Compare the OID in the pad with an OID in the constant data block.
581\ Returned value is -1 on equality, 0 otherwise.
582cc: eqOID ( addrConst -- bool ) {
583	const unsigned char *a2 = &t0_datablock[T0_POP()];
584	const unsigned char *a1 = &CTX->pad[0];
585	size_t len = a1[0];
586	int x;
587	if (len == a2[0]) {
588		x = -(memcmp(a1 + 1, a2 + 1, len) == 0);
589	} else {
590		x = 0;
591	}
592	T0_PUSH((uint32_t)x);
593}
594
595\ Compare two blobs in the context. Returned value is -1 on equality, 0
596\ otherwise.
597cc: eqblob ( addr1 addr2 len -- bool ) {
598	size_t len = T0_POP();
599	const unsigned char *a2 = (const unsigned char *)CTX + T0_POP();
600	const unsigned char *a1 = (const unsigned char *)CTX + T0_POP();
601	T0_PUSHi(-(memcmp(a1, a2, len) == 0));
602}
603
604\ Check that a value is in a given range (inclusive).
605: between? ( x min max -- bool )
606	{ min max } dup min >= swap max <= and ;
607
608\ Convert the provided byte value into a number in the 0..9 range,
609\ assuming that it is an ASCII digit. A non-digit triggers an error
610\ (a "bad time" error since this is used in date/time decoding).
611: digit-dec ( char -- value )
612	`0 - dup 0 9 between? ifnot ERR_X509_BAD_TIME fail then ;
613
614\ Read two ASCII digits and return the value in the 0..99 range. An
615\ error is reported if the characters are not ASCII digits.
616: read-dec2 ( lim -- lim x )
617	read8 digit-dec 10 * { x } read8 digit-dec x + ;
618
619\ Read two ASCII digits and check that the value is in the provided
620\ range (inclusive).
621: read-dec2-range ( lim min max -- lim x )
622	{ min max }
623	read-dec2 dup min max between? ifnot ERR_X509_BAD_TIME fail then ;
624
625\ Maximum days in a month and accumulated day count. Each
626\ 16-bit value contains the month day count in its lower 5 bits. The first
627\ 12 values are for a normal year, the other 12 for a leap year.
628data: month-to-days
629hexb| 001F 03FC 077F 0B5E 0F1F 12FE 16BF 1A9F 1E7E 223F 261E 29DF |
630hexb| 001F 03FD 079F 0B7E 0F3F 131E 16DF 1ABF 1E9E 225F 263E 29FF |
631
632\ Read a date (UTCTime or GeneralizedTime). The date value is converted
633\ to a day count and a second count. The day count starts at 0 for
634\ January 1st, 0 AD (that's they year before 1 AD, also known as 1 BC)
635\ in a proleptic Gregorian calendar (i.e. Gregorian rules are assumed to
636\ extend indefinitely in the past). The second count is between 0 and
637\ 86400 (inclusive, in case of a leap second).
638: read-date ( lim -- lim days seconds )
639	\ Read tag; must be UTCTime or GeneralizedTime. Year count is
640	\ 4 digits with GeneralizedTime, 2 digits with UTCTime.
641	read-tag
642	dup 0x17 0x18 between? ifnot ERR_X509_BAD_TIME fail then
643	0x18 = { y4d }
644	check-primitive
645	read-length-open-elt
646
647	\ We compute the days and seconds counts during decoding, in
648	\ order to minimize the number of needed temporary variables.
649	{ ; days seconds x }
650
651	\ Year is 4-digit with GeneralizedTime. With UTCTime, the year
652	\ is in the 1950..2049 range, and only the last two digits are
653	\ present in the encoding.
654	read-dec2
655	y4d if
656		100 * >x read-dec2 x +
657	else
658		dup 50 < if 100 + then 1900 +
659	then
660	>x
661	x 365 * x 3 + 4 / + x 99 + 100 / - x 399 + 400 / + >days
662
663	\ Month is 1..12. Number of days in a months depend on the
664	\ month and on the year (year count is in x at that point).
665	1 12 read-dec2-range
666	1- 1 <<
667	x 4 % 0= x 100 % 0<> x 400 % 0= or and if 24 + then
668	month-to-days + data-get16
669	dup 5 >> days + >days
670	0x1F and
671
672	\ Day. At this point, the TOS contains the maximum day count for
673	\ the current month.
674	1 swap read-dec2-range
675	days + 1- >days
676
677	\ Hour, minute and seconds. Count of seconds is allowed to go to
678	\ 60 in case of leap seconds (in practice, leap seconds really
679	\ occur only at the very end of the day, so this computation is
680	\ exact for a real leap second, and a spurious leap second only
681	\ implies a one-second shift that we can ignore).
682	0 23 read-dec2-range 3600 * >seconds
683	0 59 read-dec2-range 60 * seconds + >seconds
684	0 60 read-dec2-range seconds + >seconds
685
686	\ At this point, we may have fractional seconds. This should
687	\ happen only with GeneralizedTime, but we accept it for UTCTime
688	\ too (and, anyway, we ignore these fractional seconds).
689	read8 dup `. = if
690		drop
691		begin read8 dup `0 `9 between? while drop repeat
692	then
693
694	\ The time zone should be 'Z', not followed by anything. Other
695	\ time zone indications are not DER and thus not supposed to
696	\ appear in certificates.
697	`Z <> if ERR_X509_BAD_TIME fail then
698	close-elt
699	days seconds ;
700
701\ Read an INTEGER (tag, length and value). The INTEGER is supposed to be
702\ positive; its unsigned big-endian encoding is stored in the provided
703\ in-context buffer. Returned value is the decoded length. If the integer
704\ did not fit, or the value is negative, then an error is reported.
705: read-integer ( lim addr len -- lim dlen )
706	rot read-tag 0x02 check-tag-primitive -rot
707	read-integer-next ;
708
709\ Identical to read-integer, but the tag has already been read and checked.
710: read-integer-next ( lim addr len -- lim dlen )
711	dup { addr len origlen }
712	read-length-open-elt
713	\ Read first byte; sign bit must be 0.
714	read8 dup 0x80 >= if ERR_X509_OVERFLOW fail then
715	\ Skip leading bytes of value 0. If there are only bytes of
716	\ value 0, then return.
717	begin dup 0 = while
718		drop dup ifnot drop 0 ret then
719		read8
720	repeat
721	\ At that point, we have the first non-zero byte on the stack.
722	begin
723		len dup ifnot ERR_X509_LIMIT_EXCEEDED fail then 1- >len
724		addr set8 addr 1+ >addr
725		dup while read8
726	repeat
727	drop origlen len - ;
728
729\ Read a BOOLEAN value. This should be called immediately after reading
730\ the tag.
731: read-boolean ( lim constructed value -- lim bool )
732	0x01 check-tag-primitive
733	read-length 1 <> if ERR_X509_BAD_BOOLEAN fail then
734	read8 0<> ;
735
736\ Identify an elliptic curve: read the OID, then check it against the
737\ known curve OID.
738: read-curve-ID ( lim -- lim curve )
739	read-OID ifnot ERR_X509_UNSUPPORTED fail then
740	choice
741		ansix9p256r1 eqOID uf 23 enduf
742		ansix9p384r1 eqOID uf 24 enduf
743		ansix9p521r1 eqOID uf 25 enduf
744		ERR_X509_UNSUPPORTED fail
745	endchoice ;
746
747\ A convenient debug word: print the current data stack contents.
748cc: DEBUG ( -- ) {
749	extern int printf(const char *fmt, ...);
750	uint32_t *p;
751
752	printf("<stack:");
753	for (p = &CTX->dp_stack[0]; p != dp; p ++) {
754		printf(" %lu", (unsigned long)*p);
755	}
756	printf(" >\n");
757}
758