_ Git - BearSSL/blob - 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 "adresses" 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 { suite ; found }
 690         \ 0 >found
 691         \ addr-suites_buf dup addr-suites_num get8 1 << +
 692         \ begin dup2 < while
 693         \       2 - dup get16
 694         \       suite = found or >found
 695         \ repeat
 696         \ 2drop found ifnot ERR_BAD_CIPHER_SUITE fail then
 697         read16
 698         dup scan-suite 0< if ERR_BAD_CIPHER_SUITE fail then
 699         addr-cipher_suite resume check-resume
 700
 701         \ Compression method. Should be 0 (no compression).
 702         read8 if ERR_BAD_COMPRESSION fail then
 703
 704         \ Parse extensions (if any). If there is no extension, then the
 705         \ read limit (on the TOS) should be 0 at that point.
 706         dup if
 707                 \ Length of extension list.
 708                 \ message size.
 709                 read16 open-elt
 710
 711                 \ Enumerate extensions. For each of them, check that we
 712                 \ sent an extension of that type, and did not see it
 713                 \ yet; and then process it.
 714                 ext-sni-length { ok-sni }
 715                 ext-reneg-length { ok-reneg }
 716                 ext-frag-length { ok-frag }
 717                 ext-signatures-length { ok-signatures }
 718                 ext-supported-curves-length { ok-curves }
 719                 ext-point-format-length { ok-points }
 720                 ext-ALPN-length { ok-ALPN }
 721                 begin dup while
 722                         read16
 723                         case
 724                                 \ Server Name Indication. The server may
 725                                 \ send such an extension if it uses the SNI
 726                                 \ from the client, but that "response
 727                                 \ extension" is supposed to be empty.
 728                                 0x0000 of
 729                                         ok-sni ifnot
 730                                                 ERR_EXTRA_EXTENSION fail
 731                                         then
 732                                         0 >ok-sni
 733                                         read-server-sni
 734                                 endof
 735
 736                                 \ Max Frag Length. The contents shall be
 737                                 \ a single byte whose value matches the one
 738                                 \ sent by the client.
 739                                 0x0001 of
 740                                         ok-frag ifnot
 741                                                 ERR_EXTRA_EXTENSION fail
 742                                         then
 743                                         0 >ok-frag
 744                                         read-server-frag
 745                                 endof
 746
 747                                 \ Secure Renegotiation.
 748                                 0xFF01 of
 749                                         ok-reneg ifnot
 750                                                 ERR_EXTRA_EXTENSION fail
 751                                         then
 752                                         0 >ok-reneg
 753                                         read-server-reneg
 754                                 endof
 755
 756                                 \ Signature Algorithms.
 757                                 \ Normally, the server should never send this
 758                                 \ extension (so says RFC 5246 #7.4.1.4.1),
 759                                 \ but some existing servers do.
 760                                 0x000D of
 761                                         ok-signatures ifnot
 762                                                 ERR_EXTRA_EXTENSION fail
 763                                         then
 764                                         0 >ok-signatures
 765                                         read-ignore-16
 766                                 endof
 767
 768                                 \ Supported Curves.
 769                                 0x000A of
 770                                         ok-curves ifnot
 771                                                 ERR_EXTRA_EXTENSION fail
 772                                         then
 773                                         0 >ok-curves
 774                                         read-ignore-16
 775                                 endof
 776
 777                                 \ Supported Point Formats.
 778                                 0x000B of
 779                                         ok-points ifnot
 780                                                 ERR_EXTRA_EXTENSION fail
 781                                         then
 782                                         0 >ok-points
 783                                         read-ignore-16
 784                                 endof
 785
 786                                 \ ALPN.
 787                                 0x0010 of
 788                                         ok-ALPN ifnot
 789                                                 ERR_EXTRA_EXTENSION fail
 790                                         then
 791                                         0 >ok-ALPN
 792                                         read-ALPN-from-server
 793                                 endof
 794
 795                                 ERR_EXTRA_EXTENSION fail
 796                         endcase
 797                 repeat
 798
 799                 \ If we sent a secure renegotiation extension but did not
 800                 \ receive a response, then the server does not support
 801                 \ secure renegotiation. This is a hard failure if this
 802                 \ is a renegotiation.
 803                 ok-reneg if
 804                         ok-reneg 5 > if ERR_BAD_SECRENEG fail then
 805                         1 addr-reneg set8
 806                 then
 807                 close-elt
 808         then
 809         close-elt
 810         resume
 811         ;
 812
 813 cc: set-server-curve ( -- ) {
 814         const br_x509_class *xc;
 815         const br_x509_pkey *pk;
 816
 817         xc = *(ENG->x509ctx);
 818         pk = xc->get_pkey(ENG->x509ctx, NULL);
 819         CTX->server_curve =
 820                 (pk->key_type == BR_KEYTYPE_EC) ? pk->key.ec.curve : 0;
 821 }
 822
 823 \ Read Certificate message from server.
 824 : read-Certificate-from-server ( -- )
 825         addr-cipher_suite get16 expected-key-type
 826         -1 read-Certificate
 827         dup 0< if neg fail then
 828         dup ifnot ERR_UNEXPECTED fail then
 829         over and <> if ERR_WRONG_KEY_USAGE fail then
 830
 831         \ Set server curve (used for static ECDH).
 832         set-server-curve ;
 833
 834 \ Verify signature on ECDHE point sent by the server.
 835 \   'hash' is the hash function to use (1 to 6, or 0 for RSA with MD5+SHA-1)
 836 \   'use-rsa' is 0 for ECDSA, -1 for for RSA
 837 \   'sig-len' is the signature length (in bytes)
 838 \ The signature itself is in the pad.
 839 cc: verify-SKE-sig ( hash use-rsa sig-len -- err ) {
 840         size_t sig_len = T0_POP();
 841         int use_rsa = T0_POPi();
 842         int hash = T0_POPi();
 843
 844         T0_PUSH(verify_SKE_sig(CTX, hash, use_rsa, sig_len));
 845 }
 846
 847 \ Parse ServerKeyExchange
 848 : read-ServerKeyExchange ( -- )
 849         \ Get header, and check message type.
 850         read-handshake-header 12 = ifnot ERR_UNEXPECTED fail then
 851
 852         \ We expect a named curve, and we must support it.
 853         read8 3 = ifnot ERR_INVALID_ALGORITHM fail then
 854         read16 dup addr-ecdhe_curve set8
 855         dup 32 >= if ERR_INVALID_ALGORITHM fail then
 856         supported-curves swap >> 1 and ifnot ERR_INVALID_ALGORITHM fail then
 857
 858         \ Read the server point.
 859         read8
 860         dup 133 > if ERR_INVALID_ALGORITHM fail then
 861         dup addr-ecdhe_point_len set8
 862         addr-ecdhe_point swap read-blob
 863
 864         \ If using TLS-1.2+, then the hash function and signature algorithm
 865         \ are explicitly provided; the signature algorithm must match what
 866         \ the cipher suite specifies. With TLS-1.0 and 1.1, the signature
 867         \ algorithm is inferred from the cipher suite, and the hash is
 868         \ either MD5+SHA-1 (for RSA signatures) or SHA-1 (for ECDSA).
 869         addr-version get16 0x0303 >= { tls1.2+ }
 870         addr-cipher_suite get16 use-rsa-ecdhe? { use-rsa }
 871         2 { hash }
 872         tls1.2+ if
 873                 \ Read hash function; accept only the SHA-* identifiers
 874                 \ (from SHA-1 to SHA-512, no MD5 here).
 875                 read8
 876                 dup dup 2 < swap 6 > or if ERR_INVALID_ALGORITHM fail then
 877                 >hash
 878                 read8
 879                 \ Get expected signature algorithm and compare with what
 880                 \ the server just sent. Expected value is 1 for RSA, 3
 881                 \ for ECDSA. Note that 'use-rsa' evaluates to -1 for RSA,
 882                 \ 0 for ECDSA.
 883                 use-rsa 1 << 3 + = ifnot ERR_INVALID_ALGORITHM fail then
 884         else
 885                 \ For MD5+SHA-1, we set 'hash' to 0.
 886                 use-rsa if 0 >hash then
 887         then
 888
 889         \ Read signature into the pad.
 890         read16 dup { sig-len }
 891
 892         dup 512 > if ERR_LIMIT_EXCEEDED fail then
 893         addr-pad swap read-blob
 894
 895         \ Verify signature.
 896         hash use-rsa sig-len verify-SKE-sig
 897         dup if fail then drop
 898
 899         close-elt ;
 900
 901 \ Client certificate: start processing of anchor names.
 902 cc: anchor-dn-start-name-list ( -- ) {
 903         if (CTX->client_auth_vtable != NULL) {
 904                 (*CTX->client_auth_vtable)->start_name_list(
 905                         CTX->client_auth_vtable);
 906         }
 907 }
 908
 909 \ Client certificate: start a new anchor DN (length is 16-bit).
 910 cc: anchor-dn-start-name ( length -- ) {
 911         size_t len;
 912
 913         len = T0_POP();
 914         if (CTX->client_auth_vtable != NULL) {
 915                 (*CTX->client_auth_vtable)->start_name(
 916                         CTX->client_auth_vtable, len);
 917         }
 918 }
 919
 920 \ Client certificate: push some data for current anchor DN.
 921 cc: anchor-dn-append-name ( length -- ) {
 922         size_t len;
 923
 924         len = T0_POP();
 925         if (CTX->client_auth_vtable != NULL) {
 926                 (*CTX->client_auth_vtable)->append_name(
 927                         CTX->client_auth_vtable, ENG->pad, len);
 928         }
 929 }
 930
 931 \ Client certificate: end current anchor DN.
 932 cc: anchor-dn-end-name ( -- ) {
 933         if (CTX->client_auth_vtable != NULL) {
 934                 (*CTX->client_auth_vtable)->end_name(
 935                         CTX->client_auth_vtable);
 936         }
 937 }
 938
 939 \ Client certificate: end list of anchor DN.
 940 cc: anchor-dn-end-name-list ( -- ) {
 941         if (CTX->client_auth_vtable != NULL) {
 942                 (*CTX->client_auth_vtable)->end_name_list(
 943                         CTX->client_auth_vtable);
 944         }
 945 }
 946
 947 \ Client certificate: obtain the client certificate chain.
 948 cc: get-client-chain ( auth_types -- ) {
 949         uint32_t auth_types;
 950
 951         auth_types = T0_POP();
 952         if (CTX->client_auth_vtable != NULL) {
 953                 br_ssl_client_certificate ux;
 954
 955                 (*CTX->client_auth_vtable)->choose(CTX->client_auth_vtable,
 956                         CTX, auth_types, &ux);
 957                 CTX->auth_type = (unsigned char)ux.auth_type;
 958                 CTX->hash_id = (unsigned char)ux.hash_id;
 959                 ENG->chain = ux.chain;
 960                 ENG->chain_len = ux.chain_len;
 961         } else {
 962                 CTX->hash_id = 0;
 963                 ENG->chain_len = 0;
 964         }
 965 }
 966
 967 \ Parse CertificateRequest. Header has already been read.
 968 : read-contents-CertificateRequest ( lim -- )
 969         \ Read supported client authentification types. We keep only
 970         \ RSA, ECDSA, and ECDH.
 971         0 { auth_types }
 972         read8 open-elt
 973         begin dup while
 974                 read8 case
 975                         1  of 0x0000FF endof
 976                         64 of 0x00FF00 endof
 977                         65 of 0x010000 endof
 978                         66 of 0x020000 endof
 979                         0 swap
 980                 endcase
 981                 auth_types or >auth_types
 982         repeat
 983         close-elt
 984
 985         \ Full static ECDH is allowed only if the cipher suite is ECDH
 986         \ (not ECDHE). It would be theoretically feasible to use static
 987         \ ECDH on the client side with an ephemeral key pair from the
 988         \ server, but RFC 4492 (section 3) forbids it because ECDHE suites
 989         \ are supposed to provide forward secrecy, and static ECDH would
 990         \ negate that property.
 991         addr-cipher_suite get16 use-ecdh? ifnot
 992                 auth_types 0xFFFF and >auth_types
 993         then
 994
 995         \ Note: if the cipher suite is ECDH, then the X.509 validation
 996         \ engine was invoked with the BR_KEYTYPE_EC | BR_KEYTYPE_KEYX
 997         \ combination, so the server's public key has already been
 998         \ checked to be fit for a key exchange.
 999
1000         \ With TLS 1.2:
1001         \  - rsa_fixed_ecdh and ecdsa_fixed_ecdh are synoymous.
1002         \  - There is an explicit list of supported sign+hash.
1003         \ With TLS 1.0,
1004         addr-version get16 0x0303 >= if
1005                 \ With TLS 1.2:
1006                 \  - There is an explicit list of supported sign+hash.
1007                 \  - The ECDH flags must be adjusted for RSA/ECDSA
1008                 \    support.
1009                 read-list-sign-algos dup addr-hashes set32
1010
1011                 \ Trim down the list depending on what hash functions
1012                 \ we support (since the hashing itself is done by the SSL
1013                 \ engine, not by the certificate handler).
1014                 supported-hash-functions drop dup 8 << or 0x030000 or and
1015
1016                 auth_types and
1017                 auth_types 0x030000 and if
1018                         dup 0x0000FF and if 0x010000 or then
1019                         dup 0x00FF00 and if 0x020000 or then
1020                 then
1021                 >auth_types
1022         else
1023                 \ TLS 1.0 or 1.1. The hash function is fixed for signatures
1024                 \ (MD5+SHA-1 for RSA, SHA-1 for ECDSA).
1025                 auth_types 0x030401 and >auth_types
1026         then
1027
1028         \ Parse list of anchor DN.
1029         anchor-dn-start-name-list
1030         read16 open-elt
1031         begin dup while
1032                 read16 open-elt
1033                 dup anchor-dn-start-name
1034
1035                 \ We read the DN by chunks through the pad, so
1036                 \ as to use the existing reading function (read-blob)
1037                 \ that also ensures proper hashing.
1038                 begin
1039                         dup while
1040                         dup 256 > if 256 else dup then { len }
1041                         addr-pad len read-blob
1042                         len anchor-dn-append-name
1043                 repeat
1044                 close-elt
1045                 anchor-dn-end-name
1046         repeat
1047         close-elt
1048         anchor-dn-end-name-list
1049
1050         \ We should have reached the message end.
1051         close-elt
1052
1053         \ Obtain the client chain.
1054         auth_types get-client-chain
1055         ;
1056
1057 \ (obsolete)
1058 \ Write an empty Certificate message.
1059 \ : write-empty-Certificate ( -- )
1060 \       11 write8 3 write24 0 write24 ;
1061
1062 cc: do-rsa-encrypt ( prf_id -- nlen ) {
1063         int x;
1064
1065         x = make_pms_rsa(CTX, T0_POP());
1066         if (x < 0) {
1067                 br_ssl_engine_fail(ENG, -x);
1068                 T0_CO();
1069         } else {
1070                 T0_PUSH(x);
1071         }
1072 }
1073
1074 cc: do-ecdh ( echde prf_id -- ulen ) {
1075         unsigned prf_id = T0_POP();
1076         unsigned ecdhe = T0_POP();
1077         int x;
1078
1079         x = make_pms_ecdh(CTX, ecdhe, prf_id);
1080         if (x < 0) {
1081                 br_ssl_engine_fail(ENG, -x);
1082                 T0_CO();
1083         } else {
1084                 T0_PUSH(x);
1085         }
1086 }
1087
1088 cc: do-static-ecdh ( prf-id -- ) {
1089         unsigned prf_id = T0_POP();
1090
1091         if (make_pms_static_ecdh(CTX, prf_id) < 0) {
1092                 br_ssl_engine_fail(ENG, BR_ERR_INVALID_ALGORITHM);
1093                 T0_CO();
1094         }
1095 }
1096
1097 cc: do-client-sign ( -- sig_len ) {
1098         size_t sig_len;
1099
1100         sig_len = make_client_sign(CTX);
1101         if (sig_len == 0) {
1102                 br_ssl_engine_fail(ENG, BR_ERR_INVALID_ALGORITHM);
1103                 T0_CO();
1104         }
1105         T0_PUSH(sig_len);
1106 }
1107
1108 \ Write ClientKeyExchange.
1109 : write-ClientKeyExchange ( -- )
1110         16 write8
1111         addr-cipher_suite get16
1112         dup use-rsa-keyx? if
1113                 prf-id do-rsa-encrypt
1114                 dup 2+ write24
1115                 dup write16
1116                 addr-pad swap write-blob
1117         else
1118                 dup use-ecdhe? swap prf-id do-ecdh
1119                 dup 1+ write24
1120                 dup write8
1121                 addr-pad swap write-blob
1122         then ;
1123
1124 \ Write CertificateVerify. This is invoked only if a client certificate
1125 \ was requested and sent, and the authentication is not full static ECDH.
1126 : write-CertificateVerify ( -- )
1127         do-client-sign
1128         15 write8 dup
1129         addr-version get16 0x0303 >= if
1130                 4 + write24
1131                 addr-hash_id get8 write8
1132                 addr-auth_type get8 write8
1133         else
1134                 2+ write24
1135         then
1136         dup write16 addr-pad swap write-blob ;
1137
1138 \ =======================================================================
1139
1140 \ Perform a handshake.
1141 : do-handshake ( -- )
1142         0 addr-application_data set8
1143         22 addr-record_type_out set8
1144         0 addr-selected_protocol set16
1145         multihash-init
1146
1147         write-ClientHello
1148         flush-record
1149         read-ServerHello
1150
1151         if
1152                 \ Session resumption.
1153                 -1 read-CCS-Finished
1154                 -1 write-CCS-Finished
1155
1156         else
1157
1158                 \ Not a session resumption.
1159
1160                 \ Read certificate; then check key type and usages against
1161                 \ cipher suite.
1162                 read-Certificate-from-server
1163
1164                 \ Depending on cipher suite, we may now expect a
1165                 \ ServerKeyExchange.
1166                 addr-cipher_suite get16 expected-key-type
1167                 CX 0 63 { BR_KEYTYPE_SIGN } and if
1168                         read-ServerKeyExchange
1169                 then
1170
1171                 \ Get next header.
1172                 read-handshake-header
1173
1174                 \ If this is a CertificateRequest, parse it, then read
1175                 \ next header.
1176                 dup 13 = if
1177                         drop read-contents-CertificateRequest
1178                         read-handshake-header
1179                         -1
1180                 else
1181                         0
1182                 then
1183                 { seen-CR }
1184
1185                 \ At that point, we should have a ServerHelloDone,
1186                 \ whose length must be 0.
1187                 14 = ifnot ERR_UNEXPECTED fail then
1188                 if ERR_BAD_HELLO_DONE fail then
1189
1190                 \ There should not be more bytes in the record at that point.
1191                 more-incoming-bytes? if ERR_UNEXPECTED fail then
1192
1193                 seen-CR if
1194                         \ If the server requested a client certificate, then
1195                         \ we must write a Certificate message (it may be
1196                         \ empty).
1197                         write-Certificate
1198
1199                         \ If using static ECDH, then the ClientKeyExchange
1200                         \ is empty, and there is no CertificateVerify.
1201                         \ Otherwise, there is a ClientKeyExchange; there
1202                         \ will then be a CertificateVerify if a client chain
1203                         \ was indeed sent.
1204                         addr-hash_id get8 0xFF = if
1205                                 drop
1206                                 16 write8 0 write24
1207                                 addr-cipher_suite get16 prf-id do-static-ecdh
1208                         else
1209                                 write-ClientKeyExchange
1210                                 if write-CertificateVerify then
1211                         then
1212                 else
1213                         write-ClientKeyExchange
1214                 then
1215
1216                 -1 write-CCS-Finished
1217                 -1 read-CCS-Finished
1218         then
1219
1220         \ Now we should be invoked only in case of renegotiation.
1221         1 addr-application_data set8
1222         23 addr-record_type_out set8 ;
1223
1224 \ Read a HelloRequest message.
1225 : read-HelloRequest ( -- )
1226         \ A HelloRequest has length 0 and type 0.
1227         read-handshake-header-core
1228         if ERR_UNEXPECTED fail then
1229         if ERR_BAD_HANDSHAKE fail then ;
1230
1231 \ Entry point.
1232 : main ( -- ! )
1233         \ Perform initial handshake.
1234         do-handshake
1235
1236         begin
1237                 \ Wait for further invocation. At that point, we should
1238                 \ get either an explicit call for renegotiation, or
1239                 \ an incoming HelloRequest handshake message.
1240                 wait-co
1241                 dup 0x07 and case
1242                         0x00 of
1243                                 0x10 and if
1244                                         do-handshake
1245                                 then
1246                         endof
1247                         0x01 of
1248                                 drop
1249                                 0 addr-application_data set8
1250                                 read-HelloRequest
1251                                 \ Reject renegotiations if the peer does not
1252                                 \ support secure renegotiation, or if the
1253                                 \ "no renegotiation" flag is set.
1254                                 addr-reneg get8 1 = 1 flag? or if
1255                                         flush-record
1256                                         begin can-output? not while
1257                                                 wait-co drop
1258                                         repeat
1259                                         100 send-warning
1260                                 else
1261                                         do-handshake
1262                                 then
1263                         endof
1264                         ERR_UNEXPECTED fail
1265                 endcase
1266         again
1267         ;