contrib/bearssl/src/ssl/ssl_hs_server.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 server.
  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 server context, under that
  31  * specific name. It must be noted that since the engine context is the
  32  * first field of the br_ssl_server_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_server_context *)ENG)
  38
  39 /*
  40  * Decrypt the pre-master secret (RSA key exchange).
  41  */
  42 static void
  43 do_rsa_decrypt(br_ssl_server_context *ctx, int prf_id,
  44         unsigned char *epms, size_t len)
  45 {
  46         uint32_t x;
  47         unsigned char rpms[48];
  48
  49         /*
  50          * Decrypt the PMS.
  51          */
  52         x = (*ctx->policy_vtable)->do_keyx(ctx->policy_vtable, epms, &len);
  53
  54         /*
  55          * Set the first two bytes to the maximum supported client
  56          * protocol version. These bytes are used for version rollback
  57          * detection; forceing the two bytes will make the master secret
  58          * wrong if the bytes are not correct. This process is
  59          * recommended by RFC 5246 (section 7.4.7.1).
  60          */
  61         br_enc16be(epms, ctx->client_max_version);
  62
  63         /*
  64          * Make a random PMS and copy it above the decrypted value if the
  65          * decryption failed. Note that we use a constant-time conditional
  66          * copy.
  67          */
  68         br_hmac_drbg_generate(&ctx->eng.rng, rpms, sizeof rpms);
  69         br_ccopy(x ^ 1, epms, rpms, sizeof rpms);
  70
  71         /*
  72          * Compute master secret.
  73          */
  74         br_ssl_engine_compute_master(&ctx->eng, prf_id, epms, 48);
  75
  76         /*
  77          * Clear the pre-master secret from RAM: it is normally a buffer
  78          * in the context, hence potentially long-lived.
  79          */
  80         memset(epms, 0, len);
  81 }
  82
  83 /*
  84  * Common part for ECDH and ECDHE.
  85  */
  86 static void
  87 ecdh_common(br_ssl_server_context *ctx, int prf_id,
  88         unsigned char *xcoor, size_t xcoor_len, uint32_t ctl)
  89 {
  90         unsigned char rpms[80];
  91
  92         if (xcoor_len > sizeof rpms) {
  93                 xcoor_len = sizeof rpms;
  94                 ctl = 0;
  95         }
  96
  97         /*
  98          * Make a random PMS and copy it above the decrypted value if the
  99          * decryption failed. Note that we use a constant-time conditional
 100          * copy.
 101          */
 102         br_hmac_drbg_generate(&ctx->eng.rng, rpms, xcoor_len);
 103         br_ccopy(ctl ^ 1, xcoor, rpms, xcoor_len);
 104
 105         /*
 106          * Compute master secret.
 107          */
 108         br_ssl_engine_compute_master(&ctx->eng, prf_id, xcoor, xcoor_len);
 109
 110         /*
 111          * Clear the pre-master secret from RAM: it is normally a buffer
 112          * in the context, hence potentially long-lived.
 113          */
 114         memset(xcoor, 0, xcoor_len);
 115 }
 116
 117 /*
 118  * Do the ECDH key exchange (not ECDHE).
 119  */
 120 static void
 121 do_ecdh(br_ssl_server_context *ctx, int prf_id,
 122         unsigned char *cpoint, size_t cpoint_len)
 123 {
 124         uint32_t x;
 125
 126         /*
 127          * Finalise the key exchange.
 128          */
 129         x = (*ctx->policy_vtable)->do_keyx(ctx->policy_vtable,
 130                 cpoint, &cpoint_len);
 131         ecdh_common(ctx, prf_id, cpoint, cpoint_len, x);
 132 }
 133
 134 /*
 135  * Do the full static ECDH key exchange. When this function is called,
 136  * it has already been verified that the cipher suite uses ECDH (not ECDHE),
 137  * and the client's public key (from its certificate) has type EC and is
 138  * apt for key exchange.
 139  */
 140 static void
 141 do_static_ecdh(br_ssl_server_context *ctx, int prf_id)
 142 {
 143         unsigned char cpoint[133];
 144         size_t cpoint_len;
 145         const br_x509_class **xc;
 146         const br_x509_pkey *pk;
 147
 148         xc = ctx->eng.x509ctx;
 149         pk = (*xc)->get_pkey(xc, NULL);
 150         cpoint_len = pk->key.ec.qlen;
 151         if (cpoint_len > sizeof cpoint) {
 152                 /*
 153                  * If the point is larger than our buffer then we need to
 154                  * restrict it. Length 2 is not a valid point length, so
 155                  * the ECDH will fail.
 156                  */
 157                 cpoint_len = 2;
 158         }
 159         memcpy(cpoint, pk->key.ec.q, cpoint_len);
 160         do_ecdh(ctx, prf_id, cpoint, cpoint_len);
 161 }
 162
 163 static size_t
 164 hash_data(br_ssl_server_context *ctx,
 165         void *dst, int hash_id, const void *src, size_t len)
 166 {
 167         const br_hash_class *hf;
 168         br_hash_compat_context hc;
 169
 170         if (hash_id == 0) {
 171                 unsigned char tmp[36];
 172
 173                 hf = br_multihash_getimpl(&ctx->eng.mhash, br_md5_ID);
 174                 if (hf == NULL) {
 175                         return 0;
 176                 }
 177                 hf->init(&hc.vtable);
 178                 hf->update(&hc.vtable, src, len);
 179                 hf->out(&hc.vtable, tmp);
 180                 hf = br_multihash_getimpl(&ctx->eng.mhash, br_sha1_ID);
 181                 if (hf == NULL) {
 182                         return 0;
 183                 }
 184                 hf->init(&hc.vtable);
 185                 hf->update(&hc.vtable, src, len);
 186                 hf->out(&hc.vtable, tmp + 16);
 187                 memcpy(dst, tmp, 36);
 188                 return 36;
 189         } else {
 190                 hf = br_multihash_getimpl(&ctx->eng.mhash, hash_id);
 191                 if (hf == NULL) {
 192                         return 0;
 193                 }
 194                 hf->init(&hc.vtable);
 195                 hf->update(&hc.vtable, src, len);
 196                 hf->out(&hc.vtable, dst);
 197                 return (hf->desc >> BR_HASHDESC_OUT_OFF) & BR_HASHDESC_OUT_MASK;
 198         }
 199 }
 200
 201 /*
 202  * Do the ECDHE key exchange (part 1: generation of transient key, and
 203  * computing of the point to send to the client). Returned value is the
 204  * signature length (in bytes), or -x on error (with x being an error
 205  * code). The encoded point is written in the ecdhe_point[] context buffer
 206  * (length in ecdhe_point_len).
 207  */
 208 static int
 209 do_ecdhe_part1(br_ssl_server_context *ctx, int curve)
 210 {
 211         unsigned algo_id;
 212         unsigned mask;
 213         const unsigned char *order;
 214         size_t olen, glen;
 215         size_t hv_len, sig_len;
 216
 217         if (!((ctx->eng.iec->supported_curves >> curve) & 1)) {
 218                 return -BR_ERR_INVALID_ALGORITHM;
 219         }
 220         ctx->eng.ecdhe_curve = curve;
 221
 222         /*
 223          * Generate our private key. We need a non-zero random value
 224          * which is lower than the curve order, in a "large enough"
 225          * range. We force the top bit to 0 and bottom bit to 1, which
 226          * does the trick. Note that contrary to what happens in ECDSA,
 227          * this is not a problem if we do not cover the full range of
 228          * possible values.
 229          */
 230         order = ctx->eng.iec->order(curve, &olen);
 231         mask = 0xFF;
 232         while (mask >= order[0]) {
 233                 mask >>= 1;
 234         }
 235         br_hmac_drbg_generate(&ctx->eng.rng, ctx->ecdhe_key, olen);
 236         ctx->ecdhe_key[0] &= mask;
 237         ctx->ecdhe_key[olen - 1] |= 0x01;
 238         ctx->ecdhe_key_len = olen;
 239
 240         /*
 241          * Compute our ECDH point.
 242          */
 243         glen = ctx->eng.iec->mulgen(ctx->eng.ecdhe_point,
 244                 ctx->ecdhe_key, olen, curve);
 245         ctx->eng.ecdhe_point_len = glen;
 246
 247         /*
 248          * Assemble the message to be signed, and possibly hash it.
 249          */
 250         memcpy(ctx->eng.pad, ctx->eng.client_random, 32);
 251         memcpy(ctx->eng.pad + 32, ctx->eng.server_random, 32);
 252         ctx->eng.pad[64 + 0] = 0x03;
 253         ctx->eng.pad[64 + 1] = 0x00;
 254         ctx->eng.pad[64 + 2] = curve;
 255         ctx->eng.pad[64 + 3] = ctx->eng.ecdhe_point_len;
 256         memcpy(ctx->eng.pad + 64 + 4,
 257                 ctx->eng.ecdhe_point, ctx->eng.ecdhe_point_len);
 258         hv_len = 64 + 4 + ctx->eng.ecdhe_point_len;
 259         algo_id = ctx->sign_hash_id;
 260         if (algo_id >= (unsigned)0xFF00) {
 261                 hv_len = hash_data(ctx, ctx->eng.pad, algo_id & 0xFF,
 262                         ctx->eng.pad, hv_len);
 263                 if (hv_len == 0) {
 264                         return -BR_ERR_INVALID_ALGORITHM;
 265                 }
 266         }
 267
 268         sig_len = (*ctx->policy_vtable)->do_sign(ctx->policy_vtable,
 269                 algo_id, ctx->eng.pad, hv_len, sizeof ctx->eng.pad);
 270         return sig_len ? (int)sig_len : -BR_ERR_INVALID_ALGORITHM;
 271 }
 272
 273 /*
 274  * Do the ECDHE key exchange (part 2: computation of the shared secret
 275  * from the point sent by the client).
 276  */
 277 static void
 278 do_ecdhe_part2(br_ssl_server_context *ctx, int prf_id,
 279         unsigned char *cpoint, size_t cpoint_len)
 280 {
 281         int curve;
 282         uint32_t ctl;
 283         size_t xoff, xlen;
 284
 285         curve = ctx->eng.ecdhe_curve;
 286
 287         /*
 288          * Finalise the key exchange.
 289          */
 290         ctl = ctx->eng.iec->mul(cpoint, cpoint_len,
 291                 ctx->ecdhe_key, ctx->ecdhe_key_len, curve);
 292         xoff = ctx->eng.iec->xoff(curve, &xlen);
 293         ecdh_common(ctx, prf_id, cpoint + xoff, xlen, ctl);
 294
 295         /*
 296          * Clear the ECDHE private key. Forward Secrecy is achieved insofar
 297          * as that key does not get stolen, so we'd better destroy it
 298          * as soon as it ceases to be useful.
 299          */
 300         memset(ctx->ecdhe_key, 0, ctx->ecdhe_key_len);
 301 }
 302
 303 /*
 304  * Offset for hash value within the pad (when obtaining all hash values,
 305  * in preparation for verification of the CertificateVerify message).
 306  * Order is MD5, SHA-1, SHA-224, SHA-256, SHA-384, SHA-512; last value
 307  * is used to get the total length.
 308  */
 309 static const unsigned char HASH_PAD_OFF[] = { 0, 16, 36, 64, 96, 144, 208 };
 310
 311 /*
 312  * OID for hash functions in RSA signatures.
 313  */
 314 static const unsigned char HASH_OID_SHA1[] = {
 315         0x05, 0x2B, 0x0E, 0x03, 0x02, 0x1A
 316 };
 317
 318 static const unsigned char HASH_OID_SHA224[] = {
 319         0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x04
 320 };
 321
 322 static const unsigned char HASH_OID_SHA256[] = {
 323         0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x01
 324 };
 325
 326 static const unsigned char HASH_OID_SHA384[] = {
 327         0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x02
 328 };
 329
 330 static const unsigned char HASH_OID_SHA512[] = {
 331         0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x03
 332 };
 333
 334 static const unsigned char *HASH_OID[] = {
 335         HASH_OID_SHA1,
 336         HASH_OID_SHA224,
 337         HASH_OID_SHA256,
 338         HASH_OID_SHA384,
 339         HASH_OID_SHA512
 340 };
 341
 342 /*
 343  * Verify the signature in CertificateVerify. Returned value is 0 on
 344  * success, or a non-zero error code. Lack of implementation of the
 345  * designated signature algorithm is reported as a "bad signature"
 346  * error (because it means that the peer did not honour our advertised
 347  * set of supported signature algorithms).
 348  */
 349 static int
 350 verify_CV_sig(br_ssl_server_context *ctx, size_t sig_len)
 351 {
 352         const br_x509_class **xc;
 353         const br_x509_pkey *pk;
 354         int id;
 355
 356         id = ctx->hash_CV_id;
 357         xc = ctx->eng.x509ctx;
 358         pk = (*xc)->get_pkey(xc, NULL);
 359         if (pk->key_type == BR_KEYTYPE_RSA) {
 360                 unsigned char tmp[64];
 361                 const unsigned char *hash_oid;
 362
 363                 if (id == 0) {
 364                         hash_oid = NULL;
 365                 } else {
 366                         hash_oid = HASH_OID[id - 2];
 367                 }
 368                 if (ctx->eng.irsavrfy == 0) {
 369                         return BR_ERR_BAD_SIGNATURE;
 370                 }
 371                 if (!ctx->eng.irsavrfy(ctx->eng.pad, sig_len,
 372                         hash_oid, ctx->hash_CV_len, &pk->key.rsa, tmp)
 373                         || memcmp(tmp, ctx->hash_CV, ctx->hash_CV_len) != 0)
 374                 {
 375                         return BR_ERR_BAD_SIGNATURE;
 376                 }
 377         } else {
 378                 if (ctx->eng.iecdsa == 0) {
 379                         return BR_ERR_BAD_SIGNATURE;
 380                 }
 381                 if (!ctx->eng.iecdsa(ctx->eng.iec,
 382                         ctx->hash_CV, ctx->hash_CV_len,
 383                         &pk->key.ec, ctx->eng.pad, sig_len))
 384                 {
 385                         return BR_ERR_BAD_SIGNATURE;
 386                 }
 387         }
 388         return 0;
 389 }
 390
 391 }
 392
 393 \ =======================================================================
 394
 395 : addr-ctx:
 396         next-word { field }
 397         "addr-" field + 0 1 define-word
 398         0 8191 "offsetof(br_ssl_server_context, " field + ")" + make-CX
 399         postpone literal postpone ; ;
 400
 401 addr-ctx: client_max_version
 402 addr-ctx: client_suites
 403 addr-ctx: client_suites_num
 404 addr-ctx: hashes
 405 addr-ctx: curves
 406 addr-ctx: sign_hash_id
 407
 408 \ Get address and length of the client_suites[] buffer. Length is expressed
 409 \ in bytes.
 410 : addr-len-client_suites ( -- addr len )
 411         addr-client_suites
 412         CX 0 1023 { BR_MAX_CIPHER_SUITES * sizeof(br_suite_translated) } ;
 413
 414 \ Read the client SNI extension.
 415 : read-client-sni ( lim -- lim )
 416         \ Open extension value.
 417         read16 open-elt
 418
 419         \ Open ServerNameList.
 420         read16 open-elt
 421
 422         \ Find if there is a name of type 0 (host_name) with a length
 423         \ that fits in our dedicated buffer.
 424         begin dup while
 425                 read8 if
 426                         read-ignore-16
 427                 else
 428                         read16
 429                         dup 255 <= if
 430                                 dup addr-server_name + 0 swap set8
 431                                 addr-server_name swap read-blob
 432                         else
 433                                 skip-blob
 434                         then
 435                 then
 436         repeat
 437
 438         \ Close ServerNameList.
 439         close-elt
 440
 441         \ Close extension value.
 442         close-elt ;
 443
 444 \ Set the new maximum fragment length. BEWARE: this shall be called only
 445 \ after reading the ClientHello and before writing the ServerHello.
 446 cc: set-max-frag-len ( len -- ) {
 447         size_t max_frag_len = T0_POP();
 448
 449         br_ssl_engine_new_max_frag_len(ENG, max_frag_len);
 450
 451         /*
 452          * We must adjust our own output limit. Since we call this only
 453          * after receiving a ClientHello and before beginning to send
 454          * the ServerHello, the next output record should be empty at
 455          * that point, so we can use max_frag_len as a limit.
 456          */
 457         if (ENG->hlen_out > max_frag_len) {
 458                 ENG->hlen_out = max_frag_len;
 459         }
 460 }
 461
 462 \ Read the client Max Frag Length extension.
 463 : read-client-frag ( lim -- lim )
 464         \ Extension value must have length exactly 1 byte.
 465         read16 1 <> if ERR_BAD_FRAGLEN fail then
 466         read8
 467
 468         \ The byte value must be 1, 2, 3 or 4.
 469         dup dup 0= swap 5 >= or if ERR_BAD_FRAGLEN fail then
 470
 471         \ If our own maximum fragment length is greater, then we reduce
 472         \ our length.
 473         8 + dup addr-log_max_frag_len get8 < if
 474                 dup 1 swap << set-max-frag-len
 475                 dup addr-log_max_frag_len set8
 476                 addr-peer_log_max_frag_len set8
 477         else
 478                 drop
 479         then ;
 480
 481 \ Read the Secure Renegotiation extension from the client.
 482 : read-client-reneg ( lim -- lim )
 483         \ Get value length.
 484         read16
 485
 486         \ The "reneg" value is one of:
 487         \   0   on first handshake, client support is unknown
 488         \   1   client does not support secure renegotiation
 489         \   2   client supports secure renegotiation
 490         addr-reneg get8 case
 491                 0 of
 492                         \ First handshake, value length shall be 1.
 493                         1 = ifnot ERR_BAD_SECRENEG fail then
 494                         read8 if ERR_BAD_SECRENEG fail then
 495                         2 addr-reneg set8
 496                 endof
 497                 2 of
 498                         \ Renegotiation, value shall consist of 13 bytes
 499                         \ (header + copy of the saved client "Finished").
 500                         13 = ifnot ERR_BAD_SECRENEG fail then
 501                         read8 12 = ifnot ERR_BAD_SECRENEG fail then
 502                         addr-pad 12 read-blob
 503                         addr-saved_finished addr-pad 12 memcmp ifnot
 504                                 ERR_BAD_SECRENEG fail
 505                         then
 506                 endof
 507
 508                 \ If "reneg" is 1 then the client is not supposed to support
 509                 \ the extension, and it sends it nonetheless, which means
 510                 \ foul play.
 511                 ERR_BAD_SECRENEG fail
 512         endcase ;
 513
 514 \ Read the Signature Algorithms extension.
 515 : read-signatures ( lim -- lim )
 516         \ Open extension value.
 517         read16 open-elt
 518
 519         read-list-sign-algos addr-hashes set32
 520
 521         \ Close extension value.
 522         close-elt ;
 523
 524 \ Read the Supported Curves extension.
 525 : read-supported-curves ( lim -- lim )
 526         \ Open extension value.
 527         read16 open-elt
 528
 529         \ Open list of curve identifiers.
 530         read16 open-elt
 531
 532         \ Get all supported curves.
 533         0 addr-curves set32
 534         begin dup while
 535                 read16 dup 32 < if
 536                         1 swap << addr-curves get32 or addr-curves set32
 537                 else
 538                         drop
 539                 then
 540         repeat
 541         close-elt
 542         close-elt ;
 543
 544 \ Read the ALPN extension from client.
 545 : read-ALPN-from-client ( lim -- lim )
 546         \ If we do not have configured names, then we just ignore the
 547         \ extension.
 548         addr-protocol_names_num get16 ifnot read-ignore-16 ret then
 549
 550         \ Open extension value.
 551         read16 open-elt
 552
 553         \ Open list of protocol names.
 554         read16 open-elt
 555
 556         \ Get all names and test for their support. We keep the one with
 557         \ the lowest index (because we apply server's preferences, as
 558         \ recommended by RFC 7301, section 3.2. We set the 'found' variable
 559         \ to -2 and use an unsigned comparison, making -2 a huge value.
 560         -2 { found }
 561         begin dup while
 562                 read8 dup { len } addr-pad swap read-blob
 563                 len test-protocol-name dup found u< if
 564                         >found
 565                 else
 566                         drop
 567                 then
 568         repeat
 569
 570         \ End of extension.
 571         close-elt
 572         close-elt
 573
 574         \ Write back found name index (or not). If no match was found,
 575         \ then we write -1 (0xFFFF) in the index value, not 0, so that
 576         \ the caller knows that we tried to match, and failed.
 577         found 1+ addr-selected_protocol set16 ;
 578
 579 \ Call policy handler to get cipher suite, hash function identifier and
 580 \ certificate chain. Returned value is 0 (false) on failure.
 581 cc: call-policy-handler ( -- bool ) {
 582         int x;
 583         br_ssl_server_choices choices;
 584
 585         x = (*CTX->policy_vtable)->choose(
 586                 CTX->policy_vtable, CTX, &choices);
 587         ENG->session.cipher_suite = choices.cipher_suite;
 588         CTX->sign_hash_id = choices.algo_id;
 589         ENG->chain = choices.chain;
 590         ENG->chain_len = choices.chain_len;
 591         T0_PUSHi(-(x != 0));
 592 }
 593
 594 \ Check for a remembered session.
 595 cc: check-resume ( -- bool ) {
 596         if (ENG->session.session_id_len == 32
 597                 && CTX->cache_vtable != NULL && (*CTX->cache_vtable)->load(
 598                         CTX->cache_vtable, CTX, &ENG->session))
 599         {
 600                 T0_PUSHi(-1);
 601         } else {
 602                 T0_PUSH(0);
 603         }
 604 }
 605
 606 \ Save the current session.
 607 cc: save-session ( -- ) {
 608         if (CTX->cache_vtable != NULL) {
 609                 (*CTX->cache_vtable)->save(
 610                         CTX->cache_vtable, CTX, &ENG->session);
 611         }
 612 }
 613
 614 \ Read and drop ClientHello. This is used when a client-triggered
 615 \ renegotiation attempt is rejected.
 616 : skip-ClientHello ( -- )
 617         read-handshake-header-core
 618         1 = ifnot ERR_UNEXPECTED fail then
 619         dup skip-blob drop ;
 620
 621 \ Read ClientHello. If the session is resumed, then -1 is returned.
 622 : read-ClientHello ( -- resume )
 623         \ Get header, and check message type.
 624         read-handshake-header 1 = ifnot ERR_UNEXPECTED fail then
 625
 626         \ Get maximum protocol version from client.
 627         read16 dup { client-version-max } addr-client_max_version set16
 628
 629         \ Client random.
 630         addr-client_random 32 read-blob
 631
 632         \ Client session ID.
 633         read8 dup 32 > if ERR_OVERSIZED_ID fail then
 634         dup addr-session_id_len set8
 635         addr-session_id swap read-blob
 636
 637         \ Lookup session for resumption. We should do that here because
 638         \ we need to verify that the remembered cipher suite is still
 639         \ matched by this ClientHello.
 640         check-resume { resume }
 641
 642         \ Cipher suites. We read all cipher suites from client, each time
 643         \ matching against our own list. We accumulate suites in the
 644         \ client_suites[] context buffer: we keep suites that are
 645         \ supported by both the client and the server (so the list size
 646         \ cannot exceed that of the server list), and we keep them in
 647         \ either client or server preference order (depending on the
 648         \ relevant flag).
 649         \
 650         \ We also need to identify the pseudo cipher suite for secure
 651         \ renegotiation here.
 652         read16 open-elt
 653         0 { reneg-scsv }
 654         0 { resume-suite }
 655         addr-len-client_suites dup2 bzero
 656         over + { css-off css-max }
 657         begin
 658                 dup while
 659                 read16 dup { suite }
 660
 661                 \ Check that when resuming a session, the requested
 662                 \ suite is still valid.
 663                 resume if
 664                         dup addr-cipher_suite get16 = if
 665                                 -1 >resume-suite
 666                         then
 667                 then
 668
 669                 \ Special handling for TLS_EMPTY_RENEGOTIATION_INFO_SCSV.
 670                 \ This fake cipher suite may occur only in the first
 671                 \ handshake.
 672                 dup 0x00FF = if
 673                         addr-reneg get8 if ERR_BAD_SECRENEG fail then
 674                         -1 >reneg-scsv
 675                 then
 676
 677                 \ Special handling for TLS_FALLBACK_SCSV. If the client
 678                 \ maximum version is less than our own maximum version,
 679                 \ then this is an undue downgrade. We mark it by setting
 680                 \ the client max version to 0x10000.
 681                 dup 0x5600 = if
 682                         client-version-max addr-version_min get16 >=
 683                         client-version-max addr-version_max get16 < and if
 684                                 -1 >client-version-max
 685                         then
 686                 then
 687
 688                 \ Test whether the suite is supported by the server.
 689                 scan-suite dup 0< if
 690                         \ We do not support this cipher suite. Note
 691                         \ that this also covers the case of pseudo
 692                         \ cipher suites.
 693                         drop
 694                 else
 695                         \ If we use server order, then we place the
 696                         \ suite at the computed offset; otherwise, we
 697                         \ append it to the list at the current place.
 698                         0 flag? if
 699                                 2 << addr-client_suites + suite swap set16
 700                         else
 701                                 drop
 702                                 \ We need to test for list length because
 703                                 \ the client list may have duplicates,
 704                                 \ that we do not filter. Duplicates are
 705                                 \ invalid so this is not a problem if we
 706                                 \ reject such clients.
 707                                 css-off css-max >= if
 708                                         ERR_BAD_HANDSHAKE fail
 709                                 then
 710                                 suite css-off set16
 711                                 css-off 4 + >css-off
 712                         then
 713                 then
 714         repeat
 715         drop
 716
 717         \ Compression methods. We need method 0 (no compression).
 718         0 { ok-compression }
 719         read8 open-elt
 720         begin dup while
 721                 read8 ifnot -1 >ok-compression then
 722         repeat
 723         close-elt
 724
 725         \ Set default values for parameters that may be affected by
 726         \ extensions:
 727         \ -- server name is empty
 728         \ -- client is reputed to know RSA and ECDSA, both with SHA-1
 729         \ -- the default elliptic curve is P-256 (secp256r1, id = 23)
 730         0 addr-server_name set8
 731         0x0404 addr-hashes set32
 732         0x800000 addr-curves set32
 733
 734         \ Process extensions, if any.
 735         dup if
 736                 read16 open-elt
 737                 begin dup while
 738                         read16 case
 739                                 \ Server Name Indication.
 740                                 0x0000 of
 741                                         read-client-sni
 742                                 endof
 743                                 \ Max Frag Length.
 744                                 0x0001 of
 745                                         read-client-frag
 746                                 endof
 747                                 \ Secure Renegotiation.
 748                                 0xFF01 of
 749                                         read-client-reneg
 750                                 endof
 751                                 \ Signature Algorithms.
 752                                 0x000D of
 753                                         read-signatures
 754                                 endof
 755                                 \ Supported Curves.
 756                                 0x000A of
 757                                         read-supported-curves
 758                                 endof
 759                                 \ Supported Point Formats.
 760                                 \ We only support "uncompressed", that all
 761                                 \ implementations are supposed to support,
 762                                 \ so we can simply ignore that extension.
 763                                 \ 0x000B of
 764                                 \       read-ignore-16
 765                                 \ endof
 766
 767                                 \ ALPN
 768                                 0x0010 of
 769                                         read-ALPN-from-client
 770                                 endof
 771
 772                                 \ Other extensions are ignored.
 773                                 drop read-ignore-16 0
 774                         endcase
 775                 repeat
 776                 close-elt
 777         then
 778
 779         \ Close message.
 780         close-elt
 781
 782         \ Cancel session resumption if the cipher suite was not found.
 783         resume resume-suite and >resume
 784
 785         \ Now check the received data. Since the client is expecting an
 786         \ answer, we can send an appropriate fatal alert on any error.
 787
 788         \ Compute protocol version as the minimum of our maximum version,
 789         \ and the maximum version sent by the client. If that is less than
 790         \ 0x0300 (SSL-3.0), then fail. Otherwise, we may at least send an
 791         \ alert with that version. We still reject versions lower than our
 792         \ configured minimum.
 793         \ As a special case, in case of undue downgrade, we send a specific
 794         \ alert (see RFC 7507). Note that this case may happen only if
 795         \ we would otherwise accept the client's version.
 796         client-version-max 0< if
 797                 addr-client_max_version get16 addr-version_out set16
 798                 86 fail-alert
 799         then
 800         addr-version_max get16
 801         dup client-version-max > if drop client-version-max then
 802         dup 0x0300 < if ERR_BAD_VERSION fail then
 803         client-version-max addr-version_min get16 < if
 804                 70 fail-alert
 805         then
 806         \ If resuming the session, then enforce the previously negotiated
 807         \ version (if still possible).
 808         resume if
 809                 addr-version get16 client-version-max <= if
 810                         drop addr-version get16
 811                 else
 812                         0 >resume
 813                 then
 814         then
 815         dup addr-version set16
 816         dup addr-version_in set16
 817         dup addr-version_out set16
 818         0x0303 >= { can-tls12 }
 819
 820         \ If the client sent TLS_EMPTY_RENEGOTIATION_INFO_SCSV, then
 821         \ we should mark the client as "supporting secure renegotiation".
 822         reneg-scsv if 2 addr-reneg set8 then
 823
 824         \ If, at that point, the 'reneg' value is still 0, then the client
 825         \ did not send the extension or the SCSV, so we have to assume
 826         \ that secure renegotiation is not supported by that client.
 827         addr-reneg get8 ifnot 1 addr-reneg set8 then
 828
 829         \ Check compression.
 830         ok-compression ifnot 40 fail-alert then
 831
 832         \ Filter hash function support by what the server also supports.
 833         \ If no common hash function remains with RSA and/or ECDSA, then
 834         \ the corresponding ECDHE suites are not possible.
 835         supported-hash-functions drop 257 * 0xFFFF0000 or
 836         addr-hashes get32 and dup addr-hashes set32
 837         \ In 'can-ecdhe', bit 12 is set if ECDHE_RSA is possible, bit 13 is
 838         \ set if ECDHE_ECDSA is possible.
 839         dup 0xFF and 0<> neg
 840         swap 8 >> 0<> 2 and or 12 << { can-ecdhe }
 841
 842         \ Filter supported curves. If there is no common curve between
 843         \ client and us, then ECDHE suites cannot be used. Note that we
 844         \ may still allow ECDH, depending on the EC key handler.
 845         addr-curves get32 supported-curves and dup addr-curves set32
 846         ifnot 0 >can-ecdhe then
 847
 848         \ If resuming a session, then the next steps are not necessary;
 849         \ we won't invoke the policy handler.
 850         resume if -1 ret then
 851
 852         \ We are not resuming, so a new session ID should be generated.
 853         \ We don't check that the new ID is distinct from the one sent
 854         \ by the client because probability of such an event is 2^(-256),
 855         \ i.e. much (much) lower than that of an undetected transmission
 856         \ error or hardware miscomputation, and with similar consequences
 857         \ (handshake simply fails).
 858         addr-session_id 32 mkrand
 859         32 addr-session_id_len set8
 860
 861         \ Translate common cipher suites, then squeeze out holes: there
 862         \ may be holes because of the way we fill the list when the
 863         \ server preference order is enforced, and also in case some
 864         \ suites are filtered out. In particular:
 865         \ -- ECDHE suites are removed if there is no common hash function
 866         \    (for the relevant signature algorithm) or no common curve.
 867         \ -- TLS-1.2-only suites are removed if the negotiated version is
 868         \    TLS-1.1 or lower.
 869         addr-client_suites dup >css-off
 870         begin dup css-max < while
 871                 dup get16 dup cipher-suite-to-elements
 872                 dup 12 >> dup 1 = swap 2 = or if
 873                         dup can-ecdhe and ifnot
 874                                 2drop 0 dup
 875                         then
 876                 then
 877                 can-tls12 ifnot
 878                         \ Suites compatible with TLS-1.0 and TLS-1.1 are
 879                         \ exactly the ones that use HMAC/SHA-1.
 880                         dup 0xF0 and 0x20 <> if
 881                                 2drop 0 dup
 882                         then
 883                 then
 884                 dup if
 885                         css-off 2+ set16 css-off set16
 886                         css-off 4 + >css-off
 887                 else
 888                         2drop
 889                 then
 890                 4 +
 891         repeat
 892         drop
 893         css-off addr-client_suites - 2 >>
 894         dup ifnot
 895                 \ No common cipher suite: handshake failure.
 896                 40 fail-alert
 897         then
 898         addr-client_suites_num set8
 899
 900         \ Check ALPN.
 901         addr-selected_protocol get16 0xFFFF = if
 902                 3 flag? if 120 fail-alert then
 903                 0 addr-selected_protocol set16
 904         then
 905
 906         \ Call policy handler to obtain the cipher suite and other
 907         \ parameters.
 908         call-policy-handler ifnot 40 fail-alert then
 909
 910         \ We are not resuming a session.
 911         0 ;
 912
 913 \ Write ServerHello.
 914 : write-ServerHello ( initial -- )
 915         { initial }
 916         \ Compute ServerHello length.
 917         2 write8 70
 918
 919         \ Compute length of Secure Renegotiation extension.
 920         addr-reneg get8 2 = if
 921                 initial if 5 else 29 then
 922         else
 923                 0
 924         then
 925         { ext-reneg-len }
 926
 927         \ Compute length of Max Fragment Length extension.
 928         addr-peer_log_max_frag_len get8 if 5 else 0 then
 929         { ext-max-frag-len }
 930
 931         \ Compute length of ALPN extension. This also copy the
 932         \ selected protocol name into the pad.
 933         addr-selected_protocol get16 dup if 1- copy-protocol-name 7 + then
 934         { ext-ALPN-len }
 935
 936         \ Adjust ServerHello length to account for the extensions.
 937         ext-reneg-len ext-max-frag-len + ext-ALPN-len + dup if 2 + then +
 938         write24
 939
 940         \ Protocol version
 941         addr-version get16 write16
 942
 943         \ Server random
 944         addr-server_random 4 bzero
 945         addr-server_random 4 + 28 mkrand
 946         addr-server_random 32 write-blob
 947
 948         \ Session ID
 949         \ TODO: if we have no session cache at all, we might send here
 950         \ an empty session ID. This would save a bit of network
 951         \ bandwidth.
 952         32 write8
 953         addr-session_id 32 write-blob
 954
 955         \ Cipher suite
 956         addr-cipher_suite get16 write16
 957
 958         \ Compression method
 959         0 write8
 960
 961         \ Extensions
 962         ext-reneg-len ext-max-frag-len + ext-ALPN-len + dup if
 963                 write16
 964                 ext-reneg-len dup if
 965                         0xFF01 write16
 966                         4 - dup write16
 967                         1- addr-saved_finished swap write-blob-head8
 968                 else
 969                         drop
 970                 then
 971                 ext-max-frag-len if
 972                         0x0001 write16
 973                         1 write16 addr-peer_log_max_frag_len get8 8 - write8
 974                 then
 975                 ext-ALPN-len dup if
 976                         \ Note: the selected protocol name was previously
 977                         \ copied into the pad.
 978                         0x0010 write16
 979                         4 - dup write16
 980                         2- dup write16
 981                         1- addr-pad swap write-blob-head8
 982                 else
 983                         drop
 984                 then
 985         else
 986                 drop
 987         then ;
 988
 989 \ Do the first part of ECDHE. Returned value is the computed signature
 990 \ length, or a negative error code on error.
 991 cc: do-ecdhe-part1 ( curve -- len ) {
 992         int curve = T0_POPi();
 993         T0_PUSHi(do_ecdhe_part1(CTX, curve));
 994 }
 995
 996 \ Get index of first bit set to 1 (in low to high order).
 997 : lowest-1 ( bits -- n )
 998         dup ifnot drop -1 ret then
 999         0 begin dup2 >> 1 and 0= while 1+ repeat
1000         swap drop ;
1001
1002 \ Write the Server Key Exchange message (if applicable).
1003 : write-ServerKeyExchange ( -- )
1004         addr-cipher_suite get16 use-ecdhe? ifnot ret then
1005
1006         \ We must select an appropriate curve among the curves that
1007         \ are supported both by us and the peer. Right now, we apply
1008         \ a fixed preference order: Curve25519, P-256, P-384, P-521,
1009         \ then the common curve with the lowest ID.
1010         \ (TODO: add some option to make that behaviour configurable.)
1011         \
1012         \ This loop always terminates because previous processing made
1013         \ sure that ECDHE suites are not selectable if there is no common
1014         \ curve.
1015         addr-curves get32
1016         dup 0x20000000 and if
1017                 drop 29
1018         else
1019                 dup 0x38000000 and dup if swap then
1020                 drop lowest-1
1021         then
1022         { curve-id }
1023
1024         \ Compute the signed curve point to send.
1025         curve-id do-ecdhe-part1 dup 0< if neg fail then { sig-len }
1026
1027         \ If using TLS-1.2+, then the hash function and signature
1028         \ algorithm are explicitly encoded in the message.
1029         addr-version get16 0x0303 >= { tls1.2+ }
1030
1031         12 write8
1032         sig-len addr-ecdhe_point_len get8 + tls1.2+ 2 and + 6 + write24
1033
1034         \ Curve parameters: named curve with 16-bit ID.
1035         3 write8 curve-id write16
1036
1037         \ Public point.
1038         addr-ecdhe_point addr-ecdhe_point_len get8 write-blob-head8
1039
1040         \ If TLS-1.2+, write hash and signature identifiers.
1041         tls1.2+ if
1042                 \ sign_hash_id contains either a hash identifier,
1043                 \ or the complete 16-bit value to write.
1044                 addr-sign_hash_id get16
1045                 dup 0xFF00 < if
1046                         write16
1047                 else
1048                         0xFF and write8
1049                         \ 'use-rsa-ecdhe?' returns -1 for RSA, 0 for
1050                         \ ECDSA. The byte on the wire shall be 1 for RSA,
1051                         \ 3 for ECDSA.
1052                         addr-cipher_suite get16 use-rsa-ecdhe? 1 << 3 + write8
1053                 then
1054         then
1055
1056         \ Signature.
1057         sig-len write16
1058         addr-pad sig-len write-blob ;
1059
1060 \ Get length of the list of anchor names to send to the client. The length
1061 \ includes the per-name 2-byte header, but _not_ the 2-byte header for
1062 \ the list itself. If no client certificate is requested, then this
1063 \ returns 0.
1064 cc: ta-names-total-length ( -- len ) {
1065         size_t u, len;
1066
1067         len = 0;
1068         if (CTX->ta_names != NULL) {
1069                 for (u = 0; u < CTX->num_tas; u ++) {
1070                         len += CTX->ta_names[u].len + 2;
1071                 }
1072         } else if (CTX->tas != NULL) {
1073                 for (u = 0; u < CTX->num_tas; u ++) {
1074                         len += CTX->tas[u].dn.len + 2;
1075                 }
1076         }
1077         T0_PUSH(len);
1078 }
1079
1080 \ Compute length and optionally write the contents of the list of
1081 \ supported client authentication methods.
1082 : write-list-auth ( do_write -- len )
1083         0
1084         addr-cipher_suite get16 use-ecdh? if
1085                 2+ over if 65 write8 66 write8 then
1086         then
1087         supports-rsa-sign? if 1+ over if 1 write8 then then
1088         supports-ecdsa? if 1+ over if 64 write8 then then
1089         swap drop ;
1090
1091 : write-signhash-inner2 ( dow algo hashes len id -- dow algo hashes len )
1092         { id }
1093         over 1 id << and ifnot ret then
1094         2+
1095         3 pick if id write8 2 pick write8 then ;
1096
1097 : write-signhash-inner1 ( dow algo hashes -- dow len )
1098         0
1099         4 write-signhash-inner2
1100         5 write-signhash-inner2
1101         6 write-signhash-inner2
1102         3 write-signhash-inner2
1103         2 write-signhash-inner2
1104         -rot 2drop ;
1105
1106 \ Compute length and optionally write the contents of the list of
1107 \ supported sign+hash algorithms.
1108 : write-list-signhash ( do_write -- len )
1109         0 { len }
1110         \ If supporting neither RSA nor ECDSA in the engine, then we
1111         \ will do only static ECDH, and thus we claim support for
1112         \ everything (for the X.509 validator).
1113         supports-rsa-sign? supports-ecdsa? or ifnot
1114                 1 0x7C write-signhash-inner1 >len
1115                 3 0x7C write-signhash-inner1 len +
1116                 swap drop ret
1117         then
1118         supports-rsa-sign? if
1119                 1 supported-hash-functions drop
1120                 write-signhash-inner1 >len
1121         then
1122         supports-ecdsa? if
1123                 3 supported-hash-functions drop
1124                 write-signhash-inner1 len + >len
1125         then
1126         drop len ;
1127
1128 \ Initialise index for sending the list of anchor DN.
1129 cc: begin-ta-name-list ( -- ) {
1130         CTX->cur_dn_index = 0;
1131 }
1132
1133 \ Switch to next DN in the list. Returned value is the DN length, or -1
1134 \ if the end of the list was reached.
1135 cc: begin-ta-name ( -- len ) {
1136         const br_x500_name *dn;
1137         if (CTX->cur_dn_index >= CTX->num_tas) {
1138                 T0_PUSHi(-1);
1139         } else {
1140                 if (CTX->ta_names == NULL) {
1141                         dn = &CTX->tas[CTX->cur_dn_index].dn;
1142                 } else {
1143                         dn = &CTX->ta_names[CTX->cur_dn_index];
1144                 }
1145                 CTX->cur_dn_index ++;
1146                 CTX->cur_dn = dn->data;
1147                 CTX->cur_dn_len = dn->len;
1148                 T0_PUSH(CTX->cur_dn_len);
1149         }
1150 }
1151
1152 \ Copy a chunk of the current DN into the pad. Returned value is the
1153 \ chunk length; this is 0 when the end of the current DN is reached.
1154 cc: copy-dn-chunk ( -- len ) {
1155         size_t clen;
1156
1157         clen = CTX->cur_dn_len;
1158         if (clen > sizeof ENG->pad) {
1159                 clen = sizeof ENG->pad;
1160         }
1161         memcpy(ENG->pad, CTX->cur_dn, clen);
1162         CTX->cur_dn += clen;
1163         CTX->cur_dn_len -= clen;
1164         T0_PUSH(clen);
1165 }
1166
1167 \ Write a CertificateRequest message.
1168 : write-CertificateRequest ( -- )
1169         \ The list of client authentication types includes:
1170         \    rsa_sign (1)
1171         \    ecdsa_sign (64)
1172         \    rsa_fixed_ecdh (65)
1173         \    ecdsa_fixed_ecdh (66)
1174         \ rsa_sign and ecdsa_sign require, respectively, RSA and ECDSA
1175         \ support. Static ECDH requires that the cipher suite is ECDH.
1176         \ When we ask for static ECDH, we always send both rsa_fixed_ecdh
1177         \ and ecdsa_fixed_ecdh because what matters there is what the
1178         \ X.509 engine may support, and we do not control that.
1179         \
1180         \ With TLS 1.2, we must also send a list of supported signature
1181         \ and hash algorithms. That list is supposed to qualify both
1182         \ the engine itself, and the X.509 validator, which are separate
1183         \ in BearSSL. There again, we use the engine capabilities in that
1184         \ list, and resort to a generic all-support list if only
1185         \ static ECDH is accepted.
1186         \
1187         \ (In practice, client implementations tend to have at most one
1188         \ or two certificates, and send the chain regardless of what
1189         \ algorithms are used in it.)
1190
1191         0 write-list-auth
1192         addr-version get16 0x0303 >= if
1193                 2+ 0 write-list-signhash +
1194         then
1195         ta-names-total-length + 3 +
1196
1197         \ Message header
1198         13 write8 write24
1199
1200         \ List of authentication methods
1201         0 write-list-auth write8 1 write-list-auth drop
1202
1203         \ For TLS 1.2+, list of sign+hash
1204         addr-version get16 0x0303 >= if
1205                 0 write-list-signhash write16 1 write-list-signhash drop
1206         then
1207
1208         \ Trust anchor names
1209         ta-names-total-length write16
1210         begin-ta-name-list
1211         begin
1212                 begin-ta-name
1213                 dup 0< if drop ret then write16
1214                 begin copy-dn-chunk dup while
1215                         addr-pad swap write-blob
1216                 repeat
1217                 drop
1218         again ;
1219
1220 \ Write the Server Hello Done message.
1221 : write-ServerHelloDone ( -- )
1222         14 write8 0 write24 ;
1223
1224 \ Perform RSA decryption of the client-sent pre-master secret. The value
1225 \ is in the pad, and its length is provided as parameter.
1226 cc: do-rsa-decrypt ( len prf_id -- ) {
1227         int prf_id = T0_POPi();
1228         size_t len = T0_POP();
1229         do_rsa_decrypt(CTX, prf_id, ENG->pad, len);
1230 }
1231
1232 \ Perform ECDH (not ECDHE). The point from the client is in the pad, and
1233 \ its length is provided as parameter.
1234 cc: do-ecdh ( len prf_id -- ) {
1235         int prf_id = T0_POPi();
1236         size_t len = T0_POP();
1237         do_ecdh(CTX, prf_id, ENG->pad, len);
1238 }
1239
1240 \ Do the second part of ECDHE.
1241 cc: do-ecdhe-part2 ( len prf_id -- ) {
1242         int prf_id = T0_POPi();
1243         size_t len = T0_POP();
1244         do_ecdhe_part2(CTX, prf_id, ENG->pad, len);
1245 }
1246
1247 \ Perform static ECDH. The point from the client is the public key
1248 \ extracted from its certificate.
1249 cc: do-static-ecdh ( prf_id -- ) {
1250         do_static_ecdh(CTX, T0_POP());
1251 }
1252
1253 \ Read a ClientKeyExchange header.
1254 : read-ClientKeyExchange-header ( -- len )
1255         read-handshake-header 16 = ifnot ERR_UNEXPECTED fail then ;
1256
1257 \ Read the Client Key Exchange contents (non-empty case).
1258 : read-ClientKeyExchange-contents ( lim -- )
1259         \ What we should get depends on the cipher suite.
1260         addr-cipher_suite get16 use-rsa-keyx? if
1261                 \ RSA key exchange: we expect a RSA-encrypted value.
1262                 read16
1263                 dup 512 > if ERR_LIMIT_EXCEEDED fail then
1264                 dup { enc-rsa-len }
1265                 addr-pad swap read-blob
1266                 enc-rsa-len addr-cipher_suite get16 prf-id do-rsa-decrypt
1267         then
1268         addr-cipher_suite get16 dup use-ecdhe? swap use-ecdh? { ecdhe ecdh }
1269         ecdh ecdhe or if
1270                 \ ECDH or ECDHE key exchange: we expect an EC point.
1271                 read8 dup { ec-point-len }
1272                 addr-pad swap read-blob
1273                 ec-point-len addr-cipher_suite get16 prf-id
1274                 ecdhe if do-ecdhe-part2 else do-ecdh then
1275         then
1276         close-elt ;
1277
1278 \ Read the Client Key Exchange (normal case).
1279 : read-ClientKeyExchange ( -- )
1280         read-ClientKeyExchange-header
1281         read-ClientKeyExchange-contents ;
1282
1283 \ Obtain all possible hash values for handshake messages so far. This
1284 \ is done because we need the hash value for the CertificateVerify
1285 \ _before_ knowing which hash function will actually be used, as this
1286 \ information is obtained from decoding the message header itself.
1287 \ All hash values are stored in the pad (208 bytes in total).
1288 cc: compute-hash-CV ( -- ) {
1289         int i;
1290
1291         for (i = 1; i <= 6; i ++) {
1292                 br_multihash_out(&ENG->mhash, i,
1293                         ENG->pad + HASH_PAD_OFF[i - 1]);
1294         }
1295 }
1296
1297 \ Copy the proper hash value from the pad into the dedicated buffer.
1298 \ Returned value is true (-1) on success, false (0) on error (error
1299 \ being an unimplemented hash function). The id has already been verified
1300 \ to be either 0 (for MD5+SHA-1) or one of the SHA-* functions.
1301 cc: copy-hash-CV ( hash_id -- bool ) {
1302         int id = T0_POP();
1303         size_t off, len;
1304
1305         if (id == 0) {
1306                 off = 0;
1307                 len = 36;
1308         } else {
1309                 if (br_multihash_getimpl(&ENG->mhash, id) == 0) {
1310                         T0_PUSH(0);
1311                         T0_RET();
1312                 }
1313                 off = HASH_PAD_OFF[id - 1];
1314                 len = HASH_PAD_OFF[id] - off;
1315         }
1316         memcpy(CTX->hash_CV, ENG->pad + off, len);
1317         CTX->hash_CV_len = len;
1318         CTX->hash_CV_id = id;
1319         T0_PUSHi(-1);
1320 }
1321
1322 \ Verify signature in CertificateVerify. Output is 0 on success, or a
1323 \ non-zero error code.
1324 cc: verify-CV-sig ( sig-len -- err ) {
1325         int err;
1326
1327         err = verify_CV_sig(CTX, T0_POP());
1328         T0_PUSHi(err);
1329 }
1330
1331 \ Process static ECDH.
1332 : process-static-ECDH ( ktu -- )
1333         \ Static ECDH is allowed only if the cipher suite uses ECDH, and
1334         \ the client's public key has type EC and allows key exchange.
1335         \ BR_KEYTYPE_KEYX is 0x10, and BR_KEYTYPE_EC is 2.
1336         0x1F and 0x12 = ifnot ERR_WRONG_KEY_USAGE fail then
1337         addr-cipher_suite get16
1338         dup use-ecdh? ifnot ERR_UNEXPECTED fail then
1339         prf-id
1340         do-static-ecdh ;
1341
1342 \ Read CertificateVerify header.
1343 : read-CertificateVerify-header ( -- lim )
1344         compute-hash-CV
1345         read-handshake-header 15 = ifnot ERR_UNEXPECTED fail then ;
1346
1347 \ Read CertificateVerify. The client key type + usage is expected on the
1348 \ stack.
1349 : read-CertificateVerify ( ktu -- )
1350         \ Check that the key allows for signatures.
1351         dup 0x20 and ifnot ERR_WRONG_KEY_USAGE fail then
1352         0x0F and { key-type }
1353
1354         \ Get header.
1355         read-CertificateVerify-header
1356
1357         \ With TLS 1.2+, there is an explicit hash + signature indication,
1358         \ which must be compatible with the key type.
1359         addr-version get16 0x0303 >= if
1360                 \ Get hash function, then signature algorithm. The
1361                 \ signature algorithm is 1 (RSA) or 3 (ECDSA) while our
1362                 \ symbolic constants for key types are 1 (RSA) or 2 (EC).
1363                 read16
1364                 dup 0xFF and 1+ 1 >> key-type = ifnot
1365                         ERR_BAD_SIGNATURE fail
1366                 then
1367                 8 >>
1368
1369                 \ We support only SHA-1, SHA-224, SHA-256, SHA-384
1370                 \ and SHA-512. We explicitly reject MD5.
1371                 dup 2 < over 6 > or if ERR_INVALID_ALGORITHM fail then
1372         else
1373                 \ With TLS 1.0 and 1.1, hash is MD5+SHA-1 (0) for RSA,
1374                 \ SHA-1 (2) for ECDSA.
1375                 key-type 0x01 = if 0 else 2 then
1376         then
1377         copy-hash-CV ifnot ERR_INVALID_ALGORITHM fail then
1378
1379         \ Read signature.
1380         read16 dup { sig-len }
1381         dup 512 > if ERR_LIMIT_EXCEEDED fail then
1382         addr-pad swap read-blob
1383         sig-len verify-CV-sig
1384         dup if fail then drop
1385
1386         close-elt ;
1387
1388 \ Send a HelloRequest.
1389 : send-HelloRequest ( -- )
1390         flush-record
1391         begin can-output? not while wait-co drop repeat
1392         22 addr-record_type_out set8
1393         0 write8 0 write24 flush-record
1394         23 addr-record_type_out set8 ;
1395
1396 \ Make a handshake.
1397 : do-handshake ( initial -- )
1398         0 addr-application_data set8
1399         22 addr-record_type_out set8
1400         0 addr-selected_protocol set16
1401         multihash-init
1402         read-ClientHello
1403         more-incoming-bytes? if ERR_UNEXPECTED fail then
1404         if
1405                 \ Session resumption
1406                 write-ServerHello
1407                 0 write-CCS-Finished
1408                 0 read-CCS-Finished
1409         else
1410                 \ Not a session resumption
1411                 write-ServerHello
1412                 write-Certificate drop
1413                 write-ServerKeyExchange
1414                 ta-names-total-length if
1415                         write-CertificateRequest
1416                 then
1417                 write-ServerHelloDone
1418                 flush-record
1419
1420                 \ If we sent a CertificateRequest then we expect a
1421                 \ Certificate message.
1422                 ta-names-total-length if
1423                         \ Read client certificate.
1424                         0 read-Certificate
1425
1426                         choice
1427                                 dup 0< uf
1428                                         \ Client certificate validation failed.
1429                                         2 flag? ifnot neg fail then
1430                                         drop
1431                                         read-ClientKeyExchange
1432                                         read-CertificateVerify-header
1433                                         dup skip-blob drop
1434                                 enduf
1435                                 dup 0= uf
1436                                         \ Client sent no certificate at all.
1437                                         drop
1438                                         2 flag? ifnot
1439                                                 ERR_NO_CLIENT_AUTH fail
1440                                         then
1441                                         read-ClientKeyExchange
1442                                 enduf
1443
1444                                 \ Client certificate was validated.
1445                                 read-ClientKeyExchange-header
1446                                 dup ifnot
1447                                         \ Empty ClientKeyExchange.
1448                                         drop
1449                                         process-static-ECDH
1450                                 else
1451                                         read-ClientKeyExchange-contents
1452                                         read-CertificateVerify
1453                                 then
1454                         endchoice
1455                 else
1456                         \ No client certificate request, we just expect
1457                         \ a non-empty ClientKeyExchange.
1458                         read-ClientKeyExchange
1459                 then
1460                 0 read-CCS-Finished
1461                 0 write-CCS-Finished
1462                 save-session
1463         then
1464         1 addr-application_data set8
1465         23 addr-record_type_out set8 ;
1466
1467 \ Entry point.
1468 : main ( -- ! )
1469         \ Perform initial handshake.
1470         -1 do-handshake
1471
1472         begin
1473                 \ Wait for further invocation. At that point, we should
1474                 \ get either an explicit call for renegotiation, or
1475                 \ an incoming ClientHello handshake message.
1476                 wait-co
1477                 dup 0x07 and case
1478                         0x00 of
1479                                 0x10 and if
1480                                         \ The best we can do is ask for a
1481                                         \ renegotiation, then wait for it
1482                                         \ to happen.
1483                                         0 addr-application_data set8
1484                                         send-HelloRequest
1485                                 then
1486                         endof
1487                         0x01 of
1488                                 \ Reject renegotiations if the peer does not
1489                                 \ support secure renegotiation, or if the
1490                                 \ "no renegotiation" flag is set.
1491                                 drop
1492                                 addr-reneg get8 1 = 1 flag? or if
1493                                         skip-ClientHello
1494                                         flush-record
1495                                         begin can-output? not while
1496                                                 wait-co drop
1497                                         repeat
1498                                         100 send-warning
1499                                         \ Put back connection in "application
1500                                         \ data" state: it's not dead yet.
1501                                         1 addr-application_data set8
1502                                         23 addr-record_type_out set8
1503                                 else
1504                                         0 do-handshake
1505                                 then
1506                         endof
1507                         ERR_UNEXPECTED fail
1508                 endcase
1509         again
1510         ;