contrib/bearssl/src/ssl/ssl_hs_client.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 \ Handshake processing code, for the client.
  25 \ The common T0 code (ssl_hs_common.t0) shall be read first.
  26
  27 preamble {
  28
  29 /*
  30  * This macro evaluates to a pointer to the client context, under that
  31  * specific name. It must be noted that since the engine context is the
  32  * first field of the br_ssl_client_context structure ('eng'), then
  33  * pointers values of both types are interchangeable, modulo an
  34  * appropriate cast. This also means that "addresses" computed as offsets
  35  * within the structure work for both kinds of context.
  36  */
  37 #define CTX  ((br_ssl_client_context *)ENG)
  38
  39 /*
  40  * Generate the pre-master secret for RSA key exchange, and encrypt it
  41  * with the server's public key. Returned value is either the encrypted
  42  * data length (in bytes), or -x on error, with 'x' being an error code.
  43  *
  44  * This code assumes that the public key has been already verified (it
  45  * was properly obtained by the X.509 engine, and it has the right type,
  46  * i.e. it is of type RSA and suitable for encryption).
  47  */
  48 static int
  49 make_pms_rsa(br_ssl_client_context *ctx, int prf_id)
  50 {
  51         const br_x509_class **xc;
  52         const br_x509_pkey *pk;
  53         const unsigned char *n;
  54         unsigned char *pms;
  55         size_t nlen, u;
  56
  57         xc = ctx->eng.x509ctx;
  58         pk = (*xc)->get_pkey(xc, NULL);
  59
  60         /*
  61          * Compute actual RSA key length, in case there are leading zeros.
  62          */
  63         n = pk->key.rsa.n;
  64         nlen = pk->key.rsa.nlen;
  65         while (nlen > 0 && *n == 0) {
  66                 n ++;
  67                 nlen --;
  68         }
  69
  70         /*
  71          * We need at least 59 bytes (48 bytes for pre-master secret, and
  72          * 11 bytes for the PKCS#1 type 2 padding). Note that the X.509
  73          * minimal engine normally blocks RSA keys shorter than 128 bytes,
  74          * so this is mostly for public keys provided explicitly by the
  75          * caller.
  76          */
  77         if (nlen < 59) {
  78                 return -BR_ERR_X509_WEAK_PUBLIC_KEY;
  79         }
  80         if (nlen > sizeof ctx->eng.pad) {
  81                 return -BR_ERR_LIMIT_EXCEEDED;
  82         }
  83
  84         /*
  85          * Make PMS.
  86          */
  87         pms = ctx->eng.pad + nlen - 48;
  88         br_enc16be(pms, ctx->eng.version_max);
  89         br_hmac_drbg_generate(&ctx->eng.rng, pms + 2, 46);
  90         br_ssl_engine_compute_master(&ctx->eng, prf_id, pms, 48);
  91
  92         /*
  93          * Apply PKCS#1 type 2 padding.
  94          */
  95         ctx->eng.pad[0] = 0x00;
  96         ctx->eng.pad[1] = 0x02;
  97         ctx->eng.pad[nlen - 49] = 0x00;
  98         br_hmac_drbg_generate(&ctx->eng.rng, ctx->eng.pad + 2, nlen - 51);
  99         for (u = 2; u < nlen - 49; u ++) {
 100                 while (ctx->eng.pad[u] == 0) {
 101                         br_hmac_drbg_generate(&ctx->eng.rng,
 102                                 &ctx->eng.pad[u], 1);
 103                 }
 104         }
 105
 106         /*
 107          * Compute RSA encryption.
 108          */
 109         if (!ctx->irsapub(ctx->eng.pad, nlen, &pk->key.rsa)) {
 110                 return -BR_ERR_LIMIT_EXCEEDED;
 111         }
 112         return (int)nlen;
 113 }
 114
 115 /*
 116  * OID for hash functions in RSA signatures.
 117  */
 118 static const unsigned char *HASH_OID[] = {
 119         BR_HASH_OID_SHA1,
 120         BR_HASH_OID_SHA224,
 121         BR_HASH_OID_SHA256,
 122         BR_HASH_OID_SHA384,
 123         BR_HASH_OID_SHA512
 124 };
 125
 126 /*
 127  * Check the RSA signature on the ServerKeyExchange message.
 128  *
 129  *   hash      hash function ID (2 to 6), or 0 for MD5+SHA-1 (with RSA only)
 130  *   use_rsa   non-zero for RSA signature, zero for ECDSA
 131  *   sig_len   signature length (in bytes); signature value is in the pad
 132  *
 133  * Returned value is 0 on success, or an error code.
 134  */
 135 static int
 136 verify_SKE_sig(br_ssl_client_context *ctx,
 137         int hash, int use_rsa, size_t sig_len)
 138 {
 139         const br_x509_class **xc;
 140         const br_x509_pkey *pk;
 141         br_multihash_context mhc;
 142         unsigned char hv[64], head[4];
 143         size_t hv_len;
 144
 145         xc = ctx->eng.x509ctx;
 146         pk = (*xc)->get_pkey(xc, NULL);
 147         br_multihash_zero(&mhc);
 148         br_multihash_copyimpl(&mhc, &ctx->eng.mhash);
 149         br_multihash_init(&mhc);
 150         br_multihash_update(&mhc,
 151                 ctx->eng.client_random, sizeof ctx->eng.client_random);
 152         br_multihash_update(&mhc,
 153                 ctx->eng.server_random, sizeof ctx->eng.server_random);
 154         head[0] = 3;
 155         head[1] = 0;
 156         head[2] = ctx->eng.ecdhe_curve;
 157         head[3] = ctx->eng.ecdhe_point_len;
 158         br_multihash_update(&mhc, head, sizeof head);
 159         br_multihash_update(&mhc,
 160                 ctx->eng.ecdhe_point, ctx->eng.ecdhe_point_len);
 161         if (hash) {
 162                 hv_len = br_multihash_out(&mhc, hash, hv);
 163                 if (hv_len == 0) {
 164                         return BR_ERR_INVALID_ALGORITHM;
 165                 }
 166         } else {
 167                 if (!br_multihash_out(&mhc, br_md5_ID, hv)
 168                         || !br_multihash_out(&mhc, br_sha1_ID, hv + 16))
 169                 {
 170                         return BR_ERR_INVALID_ALGORITHM;
 171                 }
 172                 hv_len = 36;
 173         }
 174         if (use_rsa) {
 175                 unsigned char tmp[64];
 176                 const unsigned char *hash_oid;
 177
 178                 if (hash) {
 179                         hash_oid = HASH_OID[hash - 2];
 180                 } else {
 181                         hash_oid = NULL;
 182                 }
 183                 if (!ctx->eng.irsavrfy(ctx->eng.pad, sig_len,
 184                         hash_oid, hv_len, &pk->key.rsa, tmp)
 185                         || memcmp(tmp, hv, hv_len) != 0)
 186                 {
 187                         return BR_ERR_BAD_SIGNATURE;
 188                 }
 189         } else {
 190                 if (!ctx->eng.iecdsa(ctx->eng.iec, hv, hv_len, &pk->key.ec,
 191                         ctx->eng.pad, sig_len))
 192                 {
 193                         return BR_ERR_BAD_SIGNATURE;
 194                 }
 195         }
 196         return 0;
 197 }
 198
 199 /*
 200  * Perform client-side ECDH (or ECDHE). The point that should be sent to
 201  * the server is written in the pad; returned value is either the point
 202  * length (in bytes), or -x on error, with 'x' being an error code.
 203  *
 204  * The point _from_ the server is taken from ecdhe_point[] if 'ecdhe'
 205  * is non-zero, or from the X.509 engine context if 'ecdhe' is zero
 206  * (for static ECDH).
 207  */
 208 static int
 209 make_pms_ecdh(br_ssl_client_context *ctx, unsigned ecdhe, int prf_id)
 210 {
 211         int curve;
 212         unsigned char key[66], point[133];
 213         const unsigned char *order, *point_src;
 214         size_t glen, olen, point_len, xoff, xlen;
 215         unsigned char mask;
 216
 217         if (ecdhe) {
 218                 curve = ctx->eng.ecdhe_curve;
 219                 point_src = ctx->eng.ecdhe_point;
 220                 point_len = ctx->eng.ecdhe_point_len;
 221         } else {
 222                 const br_x509_class **xc;
 223                 const br_x509_pkey *pk;
 224
 225                 xc = ctx->eng.x509ctx;
 226                 pk = (*xc)->get_pkey(xc, NULL);
 227                 curve = pk->key.ec.curve;
 228                 point_src = pk->key.ec.q;
 229                 point_len = pk->key.ec.qlen;
 230         }
 231         if ((ctx->eng.iec->supported_curves & ((uint32_t)1 << curve)) == 0) {
 232                 return -BR_ERR_INVALID_ALGORITHM;
 233         }
 234
 235         /*
 236          * We need to generate our key, as a non-zero random value which
 237          * is lower than the curve order, in a "large enough" range. We
 238          * force top bit to 0 and bottom bit to 1, which guarantees that
 239          * the value is in the proper range.
 240          */
 241         order = ctx->eng.iec->order(curve, &olen);
 242         mask = 0xFF;
 243         while (mask >= order[0]) {
 244                 mask >>= 1;
 245         }
 246         br_hmac_drbg_generate(&ctx->eng.rng, key, olen);
 247         key[0] &= mask;
 248         key[olen - 1] |= 0x01;
 249
 250         /*
 251          * Compute the common ECDH point, whose X coordinate is the
 252          * pre-master secret.
 253          */
 254         ctx->eng.iec->generator(curve, &glen);
 255         if (glen != point_len) {
 256                 return -BR_ERR_INVALID_ALGORITHM;
 257         }
 258
 259         memcpy(point, point_src, glen);
 260         if (!ctx->eng.iec->mul(point, glen, key, olen, curve)) {
 261                 return -BR_ERR_INVALID_ALGORITHM;
 262         }
 263
 264         /*
 265          * The pre-master secret is the X coordinate.
 266          */
 267         xoff = ctx->eng.iec->xoff(curve, &xlen);
 268         br_ssl_engine_compute_master(&ctx->eng, prf_id, point + xoff, xlen);
 269
 270         ctx->eng.iec->mulgen(point, key, olen, curve);
 271         memcpy(ctx->eng.pad, point, glen);
 272         return (int)glen;
 273 }
 274
 275 /*
 276  * Perform full static ECDH. This occurs only in the context of client
 277  * authentication with certificates: the server uses an EC public key,
 278  * the cipher suite is of type ECDH (not ECDHE), the server requested a
 279  * client certificate and accepts static ECDH, the client has a
 280  * certificate with an EC public key in the same curve, and accepts
 281  * static ECDH as well.
 282  *
 283  * Returned value is 0 on success, -1 on error.
 284  */
 285 static int
 286 make_pms_static_ecdh(br_ssl_client_context *ctx, int prf_id)
 287 {
 288         unsigned char point[133];
 289         size_t point_len;
 290         const br_x509_class **xc;
 291         const br_x509_pkey *pk;
 292
 293         xc = ctx->eng.x509ctx;
 294         pk = (*xc)->get_pkey(xc, NULL);
 295         point_len = pk->key.ec.qlen;
 296         if (point_len > sizeof point) {
 297                 return -1;
 298         }
 299         memcpy(point, pk->key.ec.q, point_len);
 300         if (!(*ctx->client_auth_vtable)->do_keyx(
 301                 ctx->client_auth_vtable, point, &point_len))
 302         {
 303                 return -1;
 304         }
 305         br_ssl_engine_compute_master(&ctx->eng,
 306                 prf_id, point, point_len);
 307         return 0;
 308 }
 309
 310 /*
 311  * Compute the client-side signature. This is invoked only when a
 312  * signature-based client authentication was selected. The computed
 313  * signature is in the pad; its length (in bytes) is returned. On
 314  * error, 0 is returned.
 315  */
 316 static size_t
 317 make_client_sign(br_ssl_client_context *ctx)
 318 {
 319         size_t hv_len;
 320
 321         /*
 322          * Compute hash of handshake messages so far. This "cannot" fail
 323          * because the list of supported hash functions provided to the
 324          * client certificate handler was trimmed to include only the
 325          * hash functions that the multi-hasher supports.
 326          */
 327         if (ctx->hash_id) {
 328                 hv_len = br_multihash_out(&ctx->eng.mhash,
 329                         ctx->hash_id, ctx->eng.pad);
 330         } else {
 331                 br_multihash_out(&ctx->eng.mhash,
 332                         br_md5_ID, ctx->eng.pad);
 333                 br_multihash_out(&ctx->eng.mhash,
 334                         br_sha1_ID, ctx->eng.pad + 16);
 335                 hv_len = 36;
 336         }
 337         return (*ctx->client_auth_vtable)->do_sign(
 338                 ctx->client_auth_vtable, ctx->hash_id, hv_len,
 339                 ctx->eng.pad, sizeof ctx->eng.pad);
 340 }
 341
 342 }
 343
 344 \ =======================================================================
 345
 346 : addr-ctx:
 347         next-word { field }
 348         "addr-" field + 0 1 define-word
 349         0 8191 "offsetof(br_ssl_client_context, " field + ")" + make-CX
 350         postpone literal postpone ; ;
 351
 352 addr-ctx: min_clienthello_len
 353 addr-ctx: hashes
 354 addr-ctx: auth_type
 355 addr-ctx: hash_id
 356
 357 \ Length of the Secure Renegotiation extension. This is 5 for the
 358 \ first handshake, 17 for a renegotiation (if the server supports the
 359 \ extension), or 0 if we know that the server does not support the
 360 \ extension.
 361 : ext-reneg-length ( -- n )
 362         addr-reneg get8 dup if 1 - 17 * else drop 5 then ;
 363
 364 \ Length of SNI extension.
 365 : ext-sni-length ( -- len )
 366         addr-server_name strlen dup if 9 + then ;
 367
 368 \ Length of Maximum Fragment Length extension.
 369 : ext-frag-length ( -- len )
 370         addr-log_max_frag_len get8 14 = if 0 else 5 then ;
 371
 372 \ Length of Signatures extension.
 373 : ext-signatures-length ( -- len )
 374         supported-hash-functions { num } drop 0
 375         supports-rsa-sign? if num + then
 376         supports-ecdsa? if num + then
 377         dup if 1 << 6 + then ;
 378
 379 \ Write supported hash functions ( sign -- )
 380 : write-hashes
 381         { sign }
 382         supported-hash-functions drop
 383         \ We advertise hash functions in the following preference order:
 384         \   SHA-256 SHA-224 SHA-384 SHA-512 SHA-1
 385         \ Rationale:
 386         \ -- SHA-256 and SHA-224 are more efficient on 32-bit architectures
 387         \ -- SHA-1 is less than ideally collision-resistant
 388         dup 0x10 and if 4 write8 sign write8 then
 389         dup 0x08 and if 3 write8 sign write8 then
 390         dup 0x20 and if 5 write8 sign write8 then
 391         dup 0x40 and if 6 write8 sign write8 then
 392         0x04 and if 2 write8 sign write8 then ;
 393
 394 \ Length of Supported Curves extension.
 395 : ext-supported-curves-length ( -- len )
 396         supported-curves dup if
 397                 0 { x }
 398                 begin dup while
 399                         dup 1 and x + >x
 400                         1 >>
 401                 repeat
 402                 drop x 1 << 6 +
 403         then ;
 404
 405 \ Length of Supported Point Formats extension.
 406 : ext-point-format-length ( -- len )
 407         supported-curves if 6 else 0 then ;
 408
 409 \ Length of ALPN extension.
 410 cc: ext-ALPN-length ( -- len ) {
 411         size_t u, len;
 412
 413         if (ENG->protocol_names_num == 0) {
 414                 T0_PUSH(0);
 415                 T0_RET();
 416         }
 417         len = 6;
 418         for (u = 0; u < ENG->protocol_names_num; u ++) {
 419                 len += 1 + strlen(ENG->protocol_names[u]);
 420         }
 421         T0_PUSH(len);
 422 }
 423
 424 \ Write handshake message: ClientHello
 425 : write-ClientHello ( -- )
 426         { ; total-ext-length }
 427
 428         \ Compute length for extensions (without the general two-byte header).
 429         \ This does not take padding extension into account.
 430         ext-reneg-length ext-sni-length + ext-frag-length +
 431         ext-signatures-length +
 432         ext-supported-curves-length + ext-point-format-length +
 433         ext-ALPN-length +
 434         >total-ext-length
 435
 436         \ ClientHello type
 437         1 write8
 438
 439         \ Compute and write length
 440         39 addr-session_id_len get8 + addr-suites_num get8 1 << +
 441         total-ext-length if 2+ total-ext-length + then
 442         \ Compute padding (if requested).
 443         addr-min_clienthello_len get16 over - dup 0> if
 444                 \ We well add a Pad ClientHello extension, which has its
 445                 \ own header (4 bytes) and might be the only extension
 446                 \ (2 extra bytes for the extension list header).
 447                 total-ext-length ifnot swap 2+ swap 2- then
 448                 \ Account for the extension header.
 449                 4 - dup 0< if drop 0 then
 450                 \ Adjust total extension length.
 451                 dup 4 + total-ext-length + >total-ext-length
 452                 \ Adjust ClientHello length.
 453                 swap 4 + over + swap
 454         else
 455                 drop
 456                 -1
 457         then
 458         { ext-padding-amount }
 459         write24
 460
 461         \ Protocol version
 462         addr-version_max get16 write16
 463
 464         \ Client random
 465         addr-client_random 4 bzero
 466         addr-client_random 4 + 28 mkrand
 467         addr-client_random 32 write-blob
 468
 469         \ Session ID
 470         addr-session_id addr-session_id_len get8 write-blob-head8
 471
 472         \ Supported cipher suites. We also check here that we indeed
 473         \ support all these suites.
 474         addr-suites_num get8 dup 1 << write16
 475         addr-suites_buf swap
 476         begin
 477                 dup while 1-
 478                 over get16
 479                 dup suite-supported? ifnot ERR_BAD_CIPHER_SUITE fail then
 480                 write16
 481                 swap 2+ swap
 482         repeat
 483         2drop
 484
 485         \ Compression methods (only "null" compression)
 486         1 write8 0 write8
 487
 488         \ Extensions
 489         total-ext-length if
 490                 total-ext-length write16
 491                 ext-reneg-length if
 492                         0xFF01 write16          \ extension type (0xFF01)
 493                         addr-saved_finished
 494                         ext-reneg-length 4 - dup write16 \ extension length
 495                         1- write-blob-head8              \ verify data
 496                 then
 497                 ext-sni-length if
 498                         0x0000 write16          \ extension type (0)
 499                         addr-server_name
 500                         ext-sni-length 4 - dup write16 \ extension length
 501                         2 - dup write16                \ ServerNameList length
 502                         0 write8                       \ name type: host_name
 503                         3 - write-blob-head16          \ the name itself
 504                 then
 505                 ext-frag-length if
 506                         0x0001 write16          \ extension type (1)
 507                         0x0001 write16          \ extension length
 508                         addr-log_max_frag_len get8 8 - write8
 509                 then
 510                 ext-signatures-length if
 511                         0x000D write16          \ extension type (13)
 512                         ext-signatures-length 4 - dup write16 \ extension length
 513                         2 - write16             \ list length
 514                         supports-ecdsa? if 3 write-hashes then
 515                         supports-rsa-sign? if 1 write-hashes then
 516                 then
 517                 \ TODO: add an API to specify preference order for curves.
 518                 \ Right now we send Curve25519 first, then other curves in
 519                 \ increasing ID values (hence P-256 in second).
 520                 ext-supported-curves-length dup if
 521                         0x000A write16          \ extension type (10)
 522                         4 - dup write16         \ extension length
 523                         2- write16              \ list length
 524                         supported-curves 0
 525                         dup 0x20000000 and if
 526                                 0xDFFFFFFF and 29 write16
 527                         then
 528                         begin dup 32 < while
 529                                 dup2 >> 1 and if dup write16 then
 530                                 1+
 531                         repeat
 532                         2drop
 533                 else
 534                         drop
 535                 then
 536                 ext-point-format-length if
 537                         0x000B write16          \ extension type (11)
 538                         0x0002 write16          \ extension length
 539                         0x0100 write16          \ value: 1 format: uncompressed
 540                 then
 541                 ext-ALPN-length dup if
 542                         0x0010 write16          \ extension type (16)
 543                         4 - dup write16         \ extension length
 544                         2- write16              \ list length
 545                         addr-protocol_names_num get16 0
 546                         begin
 547                                 dup2 > while
 548                                 dup copy-protocol-name
 549                                 dup write8 addr-pad swap write-blob
 550                                 1+
 551                         repeat
 552                         2drop
 553                 else
 554                         drop
 555                 then
 556                 ext-padding-amount 0< ifnot
 557                         0x0015 write16          \ extension value (21)
 558                         ext-padding-amount
 559                         dup write16             \ extension length
 560                         begin dup while
 561                         1- 0 write8 repeat      \ value (only zeros)
 562                         drop
 563                 then
 564         then
 565         ;
 566
 567 \ =======================================================================
 568
 569 \ Parse server SNI extension. If present, then it should be empty.
 570 : read-server-sni ( lim -- lim )
 571         read16 if ERR_BAD_SNI fail then ;
 572
 573 \ Parse server Max Fragment Length extension. If present, then it should
 574 \ advertise the same length as the client. Note that whether the server
 575 \ sends it or not changes nothing for us: we won't send any record larger
 576 \ than the advertised value anyway, and we will accept incoming records
 577 \ up to our input buffer length.
 578 : read-server-frag ( lim -- lim )
 579         read16 1 = ifnot ERR_BAD_FRAGLEN fail then
 580         read8 8 + addr-log_max_frag_len get8 = ifnot ERR_BAD_FRAGLEN fail then ;
 581
 582 \ Parse server Secure Renegotiation extension. This is called only if
 583 \ the client sent that extension, so we only have two cases to
 584 \ distinguish: first handshake, and renegotiation; in the latter case,
 585 \ we know that the server supports the extension, otherwise the client
 586 \ would not have sent it.
 587 : read-server-reneg ( lim -- lim )
 588         read16
 589         addr-reneg get8 ifnot
 590                 \ "reneg" is 0, so this is a first handshake. The server's
 591                 \ extension MUST be empty. We also learn that the server
 592                 \ supports the extension.
 593                 1 = ifnot ERR_BAD_SECRENEG fail then
 594                 read8 0 = ifnot ERR_BAD_SECRENEG fail then
 595                 2 addr-reneg set8
 596         else
 597                 \ "reneg" is non-zero, and we sent an extension, so it must
 598                 \ be 2 and this is a renegotiation. We must verify that
 599                 \ the extension contents have length exactly 24 bytes and
 600                 \ match the saved client and server "Finished".
 601                 25 = ifnot ERR_BAD_SECRENEG fail then
 602                 read8 24 = ifnot ERR_BAD_SECRENEG fail then
 603                 addr-pad 24 read-blob
 604                 addr-saved_finished addr-pad 24 memcmp ifnot
 605                         ERR_BAD_SECRENEG fail
 606                 then
 607         then ;
 608
 609 \ Read the ALPN extension from the server. It must contain a single name,
 610 \ and that name must match one of our names.
 611 : read-ALPN-from-server ( lim -- lim )
 612         \ Extension contents length.
 613         read16 open-elt
 614         \ Length of list of names.
 615         read16 open-elt
 616         \ There should be a single name.
 617         read8 addr-pad swap dup { len } read-blob
 618         close-elt
 619         close-elt
 620         len test-protocol-name dup 0< if
 621                 3 flag? if ERR_UNEXPECTED fail then
 622                 drop
 623         else
 624                 1+ addr-selected_protocol set16
 625         then ;
 626
 627 \ Save a value in a 16-bit field, or check it in case of session resumption.
 628 : check-resume ( val addr resume -- )
 629         if get16 = ifnot ERR_RESUME_MISMATCH fail then else set16 then ;
 630
 631 cc: DEBUG-BLOB ( addr len -- ) {
 632         extern int printf(const char *fmt, ...);
 633
 634         size_t len = T0_POP();
 635         unsigned char *buf = (unsigned char *)CTX + T0_POP();
 636         size_t u;
 637
 638         printf("BLOB:");
 639         for (u = 0; u < len; u ++) {
 640                 if (u % 16 == 0) {
 641                         printf("\n    ");
 642                 }
 643                 printf(" %02x", buf[u]);
 644         }
 645         printf("\n");
 646 }
 647
 648 \ Parse incoming ServerHello. Returned value is true (-1) on session
 649 \ resumption.
 650 : read-ServerHello ( -- bool )
 651         \ Get header, and check message type.
 652         read-handshake-header 2 = ifnot ERR_UNEXPECTED fail then
 653
 654         \ Get protocol version.
 655         read16 { version }
 656         version addr-version_min get16 < version addr-version_max get16 > or if
 657                 ERR_UNSUPPORTED_VERSION fail
 658         then
 659
 660         \ Enforce chosen version for subsequent records in both directions.
 661         version addr-version_in get16 <> if ERR_BAD_VERSION fail then
 662         version addr-version_out set16
 663
 664         \ Server random.
 665         addr-server_random 32 read-blob
 666
 667         \ The "session resumption" flag.
 668         0 { resume }
 669
 670         \ Session ID.
 671         read8 { idlen }
 672         idlen 32 > if ERR_OVERSIZED_ID fail then
 673         addr-pad idlen read-blob
 674         idlen addr-session_id_len get8 = idlen 0 > and if
 675                 addr-session_id addr-pad idlen memcmp if
 676                         \ Server session ID is non-empty and matches what
 677                         \ we sent, so this is a session resumption.
 678                         -1 >resume
 679                 then
 680         then
 681         addr-session_id addr-pad idlen memcpy
 682         idlen addr-session_id_len set8
 683
 684         \ Record version.
 685         version addr-version resume check-resume
 686
 687         \ Cipher suite. We check that it is part of the list of cipher
 688         \ suites that we advertised.
 689         read16
 690         dup scan-suite 0< if ERR_BAD_CIPHER_SUITE fail then
 691         \ Also check that the cipher suite is compatible with the
 692         \ announced version: suites that don't use HMAC/SHA-1 are
 693         \ for TLS-1.2 only, not older versions.
 694         dup use-tls12? version 0x0303 < and if ERR_BAD_CIPHER_SUITE fail then
 695         addr-cipher_suite resume check-resume
 696
 697         \ Compression method. Should be 0 (no compression).
 698         read8 if ERR_BAD_COMPRESSION fail then
 699
 700         \ Parse extensions (if any). If there is no extension, then the
 701         \ read limit (on the TOS) should be 0 at that point.
 702         dup if
 703                 \ Length of extension list.
 704                 \ message size.
 705                 read16 open-elt
 706
 707                 \ Enumerate extensions. For each of them, check that we
 708                 \ sent an extension of that type, and did not see it
 709                 \ yet; and then process it.
 710                 ext-sni-length { ok-sni }
 711                 ext-reneg-length { ok-reneg }
 712                 ext-frag-length { ok-frag }
 713                 ext-signatures-length { ok-signatures }
 714                 ext-supported-curves-length { ok-curves }
 715                 ext-point-format-length { ok-points }
 716                 ext-ALPN-length { ok-ALPN }
 717                 begin dup while
 718                         read16
 719                         case
 720                                 \ Server Name Indication. The server may
 721                                 \ send such an extension if it uses the SNI
 722                                 \ from the client, but that "response
 723                                 \ extension" is supposed to be empty.
 724                                 0x0000 of
 725                                         ok-sni ifnot
 726                                                 ERR_EXTRA_EXTENSION fail
 727                                         then
 728                                         0 >ok-sni
 729                                         read-server-sni
 730                                 endof
 731
 732                                 \ Max Frag Length. The contents shall be
 733                                 \ a single byte whose value matches the one
 734                                 \ sent by the client.
 735                                 0x0001 of
 736                                         ok-frag ifnot
 737                                                 ERR_EXTRA_EXTENSION fail
 738                                         then
 739                                         0 >ok-frag
 740                                         read-server-frag
 741                                 endof
 742
 743                                 \ Secure Renegotiation.
 744                                 0xFF01 of
 745                                         ok-reneg ifnot
 746                                                 ERR_EXTRA_EXTENSION fail
 747                                         then
 748                                         0 >ok-reneg
 749                                         read-server-reneg
 750                                 endof
 751
 752                                 \ Signature Algorithms.
 753                                 \ Normally, the server should never send this
 754                                 \ extension (so says RFC 5246 #7.4.1.4.1),
 755                                 \ but some existing servers do.
 756                                 0x000D of
 757                                         ok-signatures ifnot
 758                                                 ERR_EXTRA_EXTENSION fail
 759                                         then
 760                                         0 >ok-signatures
 761                                         read-ignore-16
 762                                 endof
 763
 764                                 \ Supported Curves.
 765                                 0x000A of
 766                                         ok-curves ifnot
 767                                                 ERR_EXTRA_EXTENSION fail
 768                                         then
 769                                         0 >ok-curves
 770                                         read-ignore-16
 771                                 endof
 772
 773                                 \ Supported Point Formats.
 774                                 0x000B of
 775                                         ok-points ifnot
 776                                                 ERR_EXTRA_EXTENSION fail
 777                                         then
 778                                         0 >ok-points
 779                                         read-ignore-16
 780                                 endof
 781
 782                                 \ ALPN.
 783                                 0x0010 of
 784                                         ok-ALPN ifnot
 785                                                 ERR_EXTRA_EXTENSION fail
 786                                         then
 787                                         0 >ok-ALPN
 788                                         read-ALPN-from-server
 789                                 endof
 790
 791                                 ERR_EXTRA_EXTENSION fail
 792                         endcase
 793                 repeat
 794
 795                 \ If we sent a secure renegotiation extension but did not
 796                 \ receive a response, then the server does not support
 797                 \ secure renegotiation. This is a hard failure if this
 798                 \ is a renegotiation.
 799                 ok-reneg if
 800                         ok-reneg 5 > if ERR_BAD_SECRENEG fail then
 801                         1 addr-reneg set8
 802                 then
 803                 close-elt
 804         else
 805                 \ No extension received at all, so the server does not
 806                 \ support secure renegotiation. This is a hard failure
 807                 \ if the server was previously known to support it (i.e.
 808                 \ this is a renegotiation).
 809                 ext-reneg-length 5 > if ERR_BAD_SECRENEG fail then
 810                 1 addr-reneg set8
 811         then
 812         close-elt
 813         resume
 814         ;
 815
 816 cc: set-server-curve ( -- ) {
 817         const br_x509_class *xc;
 818         const br_x509_pkey *pk;
 819
 820         xc = *(ENG->x509ctx);
 821         pk = xc->get_pkey(ENG->x509ctx, NULL);
 822         CTX->server_curve =
 823                 (pk->key_type == BR_KEYTYPE_EC) ? pk->key.ec.curve : 0;
 824 }
 825
 826 \ Read Certificate message from server.
 827 : read-Certificate-from-server ( -- )
 828         addr-cipher_suite get16 expected-key-type
 829         -1 read-Certificate
 830         dup 0< if neg fail then
 831         dup ifnot ERR_UNEXPECTED fail then
 832         over and <> if ERR_WRONG_KEY_USAGE fail then
 833
 834         \ Set server curve (used for static ECDH).
 835         set-server-curve ;
 836
 837 \ Verify signature on ECDHE point sent by the server.
 838 \   'hash' is the hash function to use (1 to 6, or 0 for RSA with MD5+SHA-1)
 839 \   'use-rsa' is 0 for ECDSA, -1 for for RSA
 840 \   'sig-len' is the signature length (in bytes)
 841 \ The signature itself is in the pad.
 842 cc: verify-SKE-sig ( hash use-rsa sig-len -- err ) {
 843         size_t sig_len = T0_POP();
 844         int use_rsa = T0_POPi();
 845         int hash = T0_POPi();
 846
 847         T0_PUSH(verify_SKE_sig(CTX, hash, use_rsa, sig_len));
 848 }
 849
 850 \ Parse ServerKeyExchange
 851 : read-ServerKeyExchange ( -- )
 852         \ Get header, and check message type.
 853         read-handshake-header 12 = ifnot ERR_UNEXPECTED fail then
 854
 855         \ We expect a named curve, and we must support it.
 856         read8 3 = ifnot ERR_INVALID_ALGORITHM fail then
 857         read16 dup addr-ecdhe_curve set8
 858         dup 32 >= if ERR_INVALID_ALGORITHM fail then
 859         supported-curves swap >> 1 and ifnot ERR_INVALID_ALGORITHM fail then
 860
 861         \ Read the server point.
 862         read8
 863         dup 133 > if ERR_INVALID_ALGORITHM fail then
 864         dup addr-ecdhe_point_len set8
 865         addr-ecdhe_point swap read-blob
 866
 867         \ If using TLS-1.2+, then the hash function and signature algorithm
 868         \ are explicitly provided; the signature algorithm must match what
 869         \ the cipher suite specifies. With TLS-1.0 and 1.1, the signature
 870         \ algorithm is inferred from the cipher suite, and the hash is
 871         \ either MD5+SHA-1 (for RSA signatures) or SHA-1 (for ECDSA).
 872         addr-version get16 0x0303 >= { tls1.2+ }
 873         addr-cipher_suite get16 use-rsa-ecdhe? { use-rsa }
 874         2 { hash }
 875         tls1.2+ if
 876                 \ Read hash function; accept only the SHA-* identifiers
 877                 \ (from SHA-1 to SHA-512, no MD5 here).
 878                 read8
 879                 dup dup 2 < swap 6 > or if ERR_INVALID_ALGORITHM fail then
 880                 >hash
 881                 read8
 882                 \ Get expected signature algorithm and compare with what
 883                 \ the server just sent. Expected value is 1 for RSA, 3
 884                 \ for ECDSA. Note that 'use-rsa' evaluates to -1 for RSA,
 885                 \ 0 for ECDSA.
 886                 use-rsa 1 << 3 + = ifnot ERR_INVALID_ALGORITHM fail then
 887         else
 888                 \ For MD5+SHA-1, we set 'hash' to 0.
 889                 use-rsa if 0 >hash then
 890         then
 891
 892         \ Read signature into the pad.
 893         read16 dup { sig-len }
 894
 895         dup 512 > if ERR_LIMIT_EXCEEDED fail then
 896         addr-pad swap read-blob
 897
 898         \ Verify signature.
 899         hash use-rsa sig-len verify-SKE-sig
 900         dup if fail then drop
 901
 902         close-elt ;
 903
 904 \ Client certificate: start processing of anchor names.
 905 cc: anchor-dn-start-name-list ( -- ) {
 906         if (CTX->client_auth_vtable != NULL) {
 907                 (*CTX->client_auth_vtable)->start_name_list(
 908                         CTX->client_auth_vtable);
 909         }
 910 }
 911
 912 \ Client certificate: start a new anchor DN (length is 16-bit).
 913 cc: anchor-dn-start-name ( length -- ) {
 914         size_t len;
 915
 916         len = T0_POP();
 917         if (CTX->client_auth_vtable != NULL) {
 918                 (*CTX->client_auth_vtable)->start_name(
 919                         CTX->client_auth_vtable, len);
 920         }
 921 }
 922
 923 \ Client certificate: push some data for current anchor DN.
 924 cc: anchor-dn-append-name ( length -- ) {
 925         size_t len;
 926
 927         len = T0_POP();
 928         if (CTX->client_auth_vtable != NULL) {
 929                 (*CTX->client_auth_vtable)->append_name(
 930                         CTX->client_auth_vtable, ENG->pad, len);
 931         }
 932 }
 933
 934 \ Client certificate: end current anchor DN.
 935 cc: anchor-dn-end-name ( -- ) {
 936         if (CTX->client_auth_vtable != NULL) {
 937                 (*CTX->client_auth_vtable)->end_name(
 938                         CTX->client_auth_vtable);
 939         }
 940 }
 941
 942 \ Client certificate: end list of anchor DN.
 943 cc: anchor-dn-end-name-list ( -- ) {
 944         if (CTX->client_auth_vtable != NULL) {
 945                 (*CTX->client_auth_vtable)->end_name_list(
 946                         CTX->client_auth_vtable);
 947         }
 948 }
 949
 950 \ Client certificate: obtain the client certificate chain.
 951 cc: get-client-chain ( auth_types -- ) {
 952         uint32_t auth_types;
 953
 954         auth_types = T0_POP();
 955         if (CTX->client_auth_vtable != NULL) {
 956                 br_ssl_client_certificate ux;
 957
 958                 (*CTX->client_auth_vtable)->choose(CTX->client_auth_vtable,
 959                         CTX, auth_types, &ux);
 960                 CTX->auth_type = (unsigned char)ux.auth_type;
 961                 CTX->hash_id = (unsigned char)ux.hash_id;
 962                 ENG->chain = ux.chain;
 963                 ENG->chain_len = ux.chain_len;
 964         } else {
 965                 CTX->hash_id = 0;
 966                 ENG->chain_len = 0;
 967         }
 968 }
 969
 970 \ Parse CertificateRequest. Header has already been read.
 971 : read-contents-CertificateRequest ( lim -- )
 972         \ Read supported client authentication types. We keep only
 973         \ RSA, ECDSA, and ECDH.
 974         0 { auth_types }
 975         read8 open-elt
 976         begin dup while
 977                 read8 case
 978                         1  of 0x0000FF endof
 979                         64 of 0x00FF00 endof
 980                         65 of 0x010000 endof
 981                         66 of 0x020000 endof
 982                         0 swap
 983                 endcase
 984                 auth_types or >auth_types
 985         repeat
 986         close-elt
 987
 988         \ Full static ECDH is allowed only if the cipher suite is ECDH
 989         \ (not ECDHE). It would be theoretically feasible to use static
 990         \ ECDH on the client side with an ephemeral key pair from the
 991         \ server, but RFC 4492 (section 3) forbids it because ECDHE suites
 992         \ are supposed to provide forward secrecy, and static ECDH would
 993         \ negate that property.
 994         addr-cipher_suite get16 use-ecdh? ifnot
 995                 auth_types 0xFFFF and >auth_types
 996         then
 997
 998         \ Note: if the cipher suite is ECDH, then the X.509 validation
 999         \ engine was invoked with the BR_KEYTYPE_EC | BR_KEYTYPE_KEYX
1000         \ combination, so the server's public key has already been
1001         \ checked to be fit for a key exchange.
1002
1003         \ With TLS 1.2:
1004         \  - rsa_fixed_ecdh and ecdsa_fixed_ecdh are synoymous.
1005         \  - There is an explicit list of supported sign+hash.
1006         \ With TLS 1.0,
1007         addr-version get16 0x0303 >= if
1008                 \ With TLS 1.2:
1009                 \  - There is an explicit list of supported sign+hash.
1010                 \  - The ECDH flags must be adjusted for RSA/ECDSA
1011                 \    support.
1012                 read-list-sign-algos dup addr-hashes set32
1013
1014                 \ Trim down the list depending on what hash functions
1015                 \ we support (since the hashing itself is done by the SSL
1016                 \ engine, not by the certificate handler).
1017                 supported-hash-functions drop dup 8 << or 0x030000 or and
1018
1019                 auth_types and
1020                 auth_types 0x030000 and if
1021                         dup 0x0000FF and if 0x010000 or then
1022                         dup 0x00FF00 and if 0x020000 or then
1023                 then
1024                 >auth_types
1025         else
1026                 \ TLS 1.0 or 1.1. The hash function is fixed for signatures
1027                 \ (MD5+SHA-1 for RSA, SHA-1 for ECDSA).
1028                 auth_types 0x030401 and >auth_types
1029         then
1030
1031         \ Parse list of anchor DN.
1032         anchor-dn-start-name-list
1033         read16 open-elt
1034         begin dup while
1035                 read16 open-elt
1036                 dup anchor-dn-start-name
1037
1038                 \ We read the DN by chunks through the pad, so
1039                 \ as to use the existing reading function (read-blob)
1040                 \ that also ensures proper hashing.
1041                 begin
1042                         dup while
1043                         dup 256 > if 256 else dup then { len }
1044                         addr-pad len read-blob
1045                         len anchor-dn-append-name
1046                 repeat
1047                 close-elt
1048                 anchor-dn-end-name
1049         repeat
1050         close-elt
1051         anchor-dn-end-name-list
1052
1053         \ We should have reached the message end.
1054         close-elt
1055
1056         \ Obtain the client chain.
1057         auth_types get-client-chain
1058         ;
1059
1060 \ (obsolete)
1061 \ Write an empty Certificate message.
1062 \ : write-empty-Certificate ( -- )
1063 \       11 write8 3 write24 0 write24 ;
1064
1065 cc: do-rsa-encrypt ( prf_id -- nlen ) {
1066         int x;
1067
1068         x = make_pms_rsa(CTX, T0_POP());
1069         if (x < 0) {
1070                 br_ssl_engine_fail(ENG, -x);
1071                 T0_CO();
1072         } else {
1073                 T0_PUSH(x);
1074         }
1075 }
1076
1077 cc: do-ecdh ( echde prf_id -- ulen ) {
1078         unsigned prf_id = T0_POP();
1079         unsigned ecdhe = T0_POP();
1080         int x;
1081
1082         x = make_pms_ecdh(CTX, ecdhe, prf_id);
1083         if (x < 0) {
1084                 br_ssl_engine_fail(ENG, -x);
1085                 T0_CO();
1086         } else {
1087                 T0_PUSH(x);
1088         }
1089 }
1090
1091 cc: do-static-ecdh ( prf-id -- ) {
1092         unsigned prf_id = T0_POP();
1093
1094         if (make_pms_static_ecdh(CTX, prf_id) < 0) {
1095                 br_ssl_engine_fail(ENG, BR_ERR_INVALID_ALGORITHM);
1096                 T0_CO();
1097         }
1098 }
1099
1100 cc: do-client-sign ( -- sig_len ) {
1101         size_t sig_len;
1102
1103         sig_len = make_client_sign(CTX);
1104         if (sig_len == 0) {
1105                 br_ssl_engine_fail(ENG, BR_ERR_INVALID_ALGORITHM);
1106                 T0_CO();
1107         }
1108         T0_PUSH(sig_len);
1109 }
1110
1111 \ Write ClientKeyExchange.
1112 : write-ClientKeyExchange ( -- )
1113         16 write8
1114         addr-cipher_suite get16
1115         dup use-rsa-keyx? if
1116                 prf-id do-rsa-encrypt
1117                 dup 2+ write24
1118                 dup write16
1119                 addr-pad swap write-blob
1120         else
1121                 dup use-ecdhe? swap prf-id do-ecdh
1122                 dup 1+ write24
1123                 dup write8
1124                 addr-pad swap write-blob
1125         then ;
1126
1127 \ Write CertificateVerify. This is invoked only if a client certificate
1128 \ was requested and sent, and the authentication is not full static ECDH.
1129 : write-CertificateVerify ( -- )
1130         do-client-sign
1131         15 write8 dup
1132         addr-version get16 0x0303 >= if
1133                 4 + write24
1134                 addr-hash_id get8 write8
1135                 addr-auth_type get8 write8
1136         else
1137                 2+ write24
1138         then
1139         dup write16 addr-pad swap write-blob ;
1140
1141 \ =======================================================================
1142
1143 \ Perform a handshake.
1144 : do-handshake ( -- )
1145         0 addr-application_data set8
1146         22 addr-record_type_out set8
1147         0 addr-selected_protocol set16
1148         multihash-init
1149
1150         write-ClientHello
1151         flush-record
1152         read-ServerHello
1153
1154         if
1155                 \ Session resumption.
1156                 -1 read-CCS-Finished
1157                 -1 write-CCS-Finished
1158
1159         else
1160
1161                 \ Not a session resumption.
1162
1163                 \ Read certificate; then check key type and usages against
1164                 \ cipher suite.
1165                 read-Certificate-from-server
1166
1167                 \ Depending on cipher suite, we may now expect a
1168                 \ ServerKeyExchange.
1169                 addr-cipher_suite get16 expected-key-type
1170                 CX 0 63 { BR_KEYTYPE_SIGN } and if
1171                         read-ServerKeyExchange
1172                 then
1173
1174                 \ Get next header.
1175                 read-handshake-header
1176
1177                 \ If this is a CertificateRequest, parse it, then read
1178                 \ next header.
1179                 dup 13 = if
1180                         drop read-contents-CertificateRequest
1181                         read-handshake-header
1182                         -1
1183                 else
1184                         0
1185                 then
1186                 { seen-CR }
1187
1188                 \ At that point, we should have a ServerHelloDone,
1189                 \ whose length must be 0.
1190                 14 = ifnot ERR_UNEXPECTED fail then
1191                 if ERR_BAD_HELLO_DONE fail then
1192
1193                 \ There should not be more bytes in the record at that point.
1194                 more-incoming-bytes? if ERR_UNEXPECTED fail then
1195
1196                 seen-CR if
1197                         \ If the server requested a client certificate, then
1198                         \ we must write a Certificate message (it may be
1199                         \ empty).
1200                         write-Certificate
1201
1202                         \ If using static ECDH, then the ClientKeyExchange
1203                         \ is empty, and there is no CertificateVerify.
1204                         \ Otherwise, there is a ClientKeyExchange; there
1205                         \ will then be a CertificateVerify if a client chain
1206                         \ was indeed sent.
1207                         addr-hash_id get8 0xFF = if
1208                                 drop
1209                                 16 write8 0 write24
1210                                 addr-cipher_suite get16 prf-id do-static-ecdh
1211                         else
1212                                 write-ClientKeyExchange
1213                                 if write-CertificateVerify then
1214                         then
1215                 else
1216                         write-ClientKeyExchange
1217                 then
1218
1219                 -1 write-CCS-Finished
1220                 -1 read-CCS-Finished
1221         then
1222
1223         \ Now we should be invoked only in case of renegotiation.
1224         1 addr-application_data set8
1225         23 addr-record_type_out set8 ;
1226
1227 \ Read a HelloRequest message.
1228 : read-HelloRequest ( -- )
1229         \ A HelloRequest has length 0 and type 0.
1230         read-handshake-header-core
1231         if ERR_UNEXPECTED fail then
1232         if ERR_BAD_HANDSHAKE fail then ;
1233
1234 \ Entry point.
1235 : main ( -- ! )
1236         \ Perform initial handshake.
1237         do-handshake
1238
1239         begin
1240                 \ Wait for further invocation. At that point, we should
1241                 \ get either an explicit call for renegotiation, or
1242                 \ an incoming HelloRequest handshake message.
1243                 wait-co
1244                 dup 0x07 and case
1245                         0x00 of
1246                                 0x10 and if
1247                                         do-handshake
1248                                 then
1249                         endof
1250                         0x01 of
1251                                 drop
1252                                 0 addr-application_data set8
1253                                 read-HelloRequest
1254                                 \ Reject renegotiations if the peer does not
1255                                 \ support secure renegotiation, or if the
1256                                 \ "no renegotiation" flag is set.
1257                                 addr-reneg get8 1 = 1 flag? or if
1258                                         flush-record
1259                                         begin can-output? not while
1260                                                 wait-co drop
1261                                         repeat
1262                                         100 send-warning
1263                                         \ We rejected the renegotiation,
1264                                         \ but the connection is not dead.
1265                                         \ We must set back things into
1266                                         \ working "application data" state.
1267                                         1 addr-application_data set8
1268                                         23 addr-record_type_out set8
1269                                 else
1270                                         do-handshake
1271                                 then
1272                         endof
1273                         ERR_UNEXPECTED fail
1274                 endcase
1275         again
1276         ;