_ Git - BearSSL/blob - src/x509/asn1.t0

   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
  46 preamble {
  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
 115 addr: 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
 123 err: ERR_X509_INVALID_VALUE
 124 err: ERR_X509_TRUNCATED
 125 err: ERR_X509_EMPTY_CHAIN
 126 err: ERR_X509_INNER_TRUNC
 127 err: ERR_X509_BAD_TAG_CLASS
 128 err: ERR_X509_BAD_TAG_VALUE
 129 err: ERR_X509_INDEFINITE_LENGTH
 130 err: ERR_X509_EXTRA_ELEMENT
 131 err: ERR_X509_UNEXPECTED
 132 err: ERR_X509_NOT_CONSTRUCTED
 133 err: ERR_X509_NOT_PRIMITIVE
 134 err: ERR_X509_PARTIAL_BYTE
 135 err: ERR_X509_BAD_BOOLEAN
 136 err: ERR_X509_OVERFLOW
 137 err: ERR_X509_BAD_DN
 138 err: ERR_X509_BAD_TIME
 139 err: ERR_X509_UNSUPPORTED
 140 err: ERR_X509_LIMIT_EXCEEDED
 141 err: ERR_X509_WRONG_KEY_TYPE
 142 err: ERR_X509_BAD_SIGNATURE
 143 err: ERR_X509_EXPIRED
 144 err: ERR_X509_DN_MISMATCH
 145 err: ERR_X509_BAD_SERVER_NAME
 146 err: ERR_X509_CRITICAL_EXTENSION
 147 err: ERR_X509_NOT_CA
 148 err: ERR_X509_FORBIDDEN_KEY_USAGE
 149 err: 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
 154 cc: 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
 194 cc: set8 ( val addr -- ) {
 195         uint32_t addr = T0_POP();
 196         *((unsigned char *)CTX + addr) = (unsigned char)T0_POP();
 197 }
 198
 199 cc: set16 ( val addr -- ) {
 200         uint32_t addr = T0_POP();
 201         *(uint16_t *)(void *)((unsigned char *)CTX + addr) = T0_POP();
 202 }
 203
 204 cc: set32 ( val addr -- ) {
 205         uint32_t addr = T0_POP();
 206         *(uint32_t *)(void *)((unsigned char *)CTX + addr) = T0_POP();
 207 }
 208
 209 cc: get8 ( addr -- val ) {
 210         uint32_t addr = T0_POP();
 211         T0_PUSH(*((unsigned char *)CTX + addr));
 212 }
 213
 214 cc: get16 ( addr -- val ) {
 215         uint32_t addr = T0_POP();
 216         T0_PUSH(*(uint16_t *)(void *)((unsigned char *)CTX + addr));
 217 }
 218
 219 cc: 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
 350 OID: rsaEncryption               1.2.840.113549.1.1.1
 351
 352 OID: sha1WithRSAEncryption       1.2.840.113549.1.1.5
 353 OID: sha224WithRSAEncryption     1.2.840.113549.1.1.14
 354 OID: sha256WithRSAEncryption     1.2.840.113549.1.1.11
 355 OID: sha384WithRSAEncryption     1.2.840.113549.1.1.12
 356 OID: sha512WithRSAEncryption     1.2.840.113549.1.1.13
 357
 358 OID: id-sha1                     1.3.14.3.2.26
 359 OID: id-sha224                   2.16.840.1.101.3.4.2.4
 360 OID: id-sha256                   2.16.840.1.101.3.4.2.1
 361 OID: id-sha384                   2.16.840.1.101.3.4.2.2
 362 OID: id-sha512                   2.16.840.1.101.3.4.2.3
 363
 364 OID: id-ecPublicKey              1.2.840.10045.2.1
 365
 366 OID: ansix9p256r1                1.2.840.10045.3.1.7
 367 OID: ansix9p384r1                1.3.132.0.34
 368 OID: ansix9p521r1                1.3.132.0.35
 369
 370 OID: ecdsa-with-SHA1             1.2.840.10045.4.1
 371 OID: ecdsa-with-SHA224           1.2.840.10045.4.3.1
 372 OID: ecdsa-with-SHA256           1.2.840.10045.4.3.2
 373 OID: ecdsa-with-SHA384           1.2.840.10045.4.3.3
 374 OID: ecdsa-with-SHA512           1.2.840.10045.4.3.4
 375
 376 OID: 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.
 582 cc: 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.
 597 cc: 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.
 628 data: month-to-days
 629 hexb| 001F 03FC 077F 0B5E 0F1F 12FE 16BF 1A9F 1E7E 223F 261E 29DF |
 630 hexb| 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.
 748 cc: 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 }