_ Git - BearSSL/blob - 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 "adresses" 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 *cpoint, size_t cpoint_len, uint32_t ctl)
  89 {
  90         unsigned char rpms[80];
  91         size_t pms_len;
  92
  93         /*
  94          * The point length is supposed to be 1+2*Xlen, where Xlen is
  95          * the length (in bytes) of the X coordinate, i.e. the pre-master
  96          * secret. If the provided point is too large, then it is
  97          * obviously incorrect (i.e. everybody can see that it is
  98          * incorrect), so leaking that fact is not a problem.
  99          */
 100         pms_len = cpoint_len >> 1;
 101         if (pms_len > sizeof rpms) {
 102                 pms_len = sizeof rpms;
 103                 ctl = 0;
 104         }
 105
 106         /*
 107          * Make a random PMS and copy it above the decrypted value if the
 108          * decryption failed. Note that we use a constant-time conditional
 109          * copy.
 110          */
 111         br_hmac_drbg_generate(&ctx->eng.rng, rpms, pms_len);
 112         br_ccopy(ctl ^ 1, cpoint + 1, rpms, pms_len);
 113
 114         /*
 115          * Compute master secret.
 116          */
 117         br_ssl_engine_compute_master(&ctx->eng, prf_id, cpoint + 1, pms_len);
 118
 119         /*
 120          * Clear the pre-master secret from RAM: it is normally a buffer
 121          * in the context, hence potentially long-lived.
 122          */
 123         memset(cpoint, 0, cpoint_len);
 124 }
 125
 126 /*
 127  * Do the ECDH key exchange (not ECDHE).
 128  */
 129 static void
 130 do_ecdh(br_ssl_server_context *ctx, int prf_id,
 131         unsigned char *cpoint, size_t cpoint_len)
 132 {
 133         uint32_t x;
 134
 135         /*
 136          * Finalise the key exchange.
 137          */
 138         x = (*ctx->policy_vtable)->do_keyx(ctx->policy_vtable,
 139                 cpoint, cpoint_len);
 140         ecdh_common(ctx, prf_id, cpoint, cpoint_len, x);
 141 }
 142
 143 /*
 144  * Do the ECDHE key exchange (part 1: generation of transient key, and
 145  * computing of the point to send to the client). Returned value is the
 146  * signature length (in bytes), or -x on error (with x being an error
 147  * code). The encoded point is written in the ecdhe_point[] context buffer
 148  * (length in ecdhe_point_len).
 149  */
 150 static int
 151 do_ecdhe_part1(br_ssl_server_context *ctx, int curve)
 152 {
 153         int hash;
 154         unsigned mask;
 155         const unsigned char *order, *generator;
 156         size_t olen, glen;
 157         br_multihash_context mhc;
 158         unsigned char head[4];
 159         size_t hv_len, sig_len;
 160
 161         if (!((ctx->eng.iec->supported_curves >> curve) & 1)) {
 162                 return -BR_ERR_INVALID_ALGORITHM;
 163         }
 164         ctx->eng.ecdhe_curve = curve;
 165
 166         /*
 167          * Generate our private key. We need a non-zero random value
 168          * which is lower than the curve order, in a "large enough"
 169          * range. We force the top bit to 0 and bottom bit to 1, which
 170          * does the trick. Note that contrary to what happens in ECDSA,
 171          * this is not a problem if we do not cover the full range of
 172          * possible values.
 173          */
 174         order = ctx->eng.iec->order(curve, &olen);
 175         mask = 0xFF;
 176         while (mask >= order[0]) {
 177                 mask >>= 1;
 178         }
 179         br_hmac_drbg_generate(&ctx->eng.rng, ctx->ecdhe_key, olen);
 180         ctx->ecdhe_key[0] &= mask;
 181         ctx->ecdhe_key[olen - 1] |= 0x01;
 182         ctx->ecdhe_key_len = olen;
 183
 184         /*
 185          * Compute our ECDH point.
 186          */
 187         generator = ctx->eng.iec->generator(curve, &glen);
 188         memcpy(ctx->eng.ecdhe_point, generator, glen);
 189         ctx->eng.ecdhe_point_len = glen;
 190         if (!ctx->eng.iec->mul(ctx->eng.ecdhe_point, glen,
 191                 ctx->ecdhe_key, olen, curve))
 192         {
 193                 return -BR_ERR_INVALID_ALGORITHM;
 194         }
 195
 196         /*
 197          * Compute the signature.
 198          */
 199         br_multihash_zero(&mhc);
 200         br_multihash_copyimpl(&mhc, &ctx->eng.mhash);
 201         br_multihash_init(&mhc);
 202         br_multihash_update(&mhc,
 203                 ctx->eng.client_random, sizeof ctx->eng.client_random);
 204         br_multihash_update(&mhc,
 205                 ctx->eng.server_random, sizeof ctx->eng.server_random);
 206         head[0] = 3;
 207         head[1] = 0;
 208         head[2] = curve;
 209         head[3] = ctx->eng.ecdhe_point_len;
 210         br_multihash_update(&mhc, head, sizeof head);
 211         br_multihash_update(&mhc,
 212                 ctx->eng.ecdhe_point, ctx->eng.ecdhe_point_len);
 213         hash = ctx->sign_hash_id;
 214         if (hash) {
 215                 hv_len = br_multihash_out(&mhc, hash, ctx->eng.pad);
 216                 if (hv_len == 0) {
 217                         return -BR_ERR_INVALID_ALGORITHM;
 218                 }
 219         } else {
 220                 if (!br_multihash_out(&mhc, br_md5_ID, ctx->eng.pad)
 221                         || !br_multihash_out(&mhc,
 222                         br_sha1_ID, ctx->eng.pad + 16))
 223                 {
 224                         return -BR_ERR_INVALID_ALGORITHM;
 225                 }
 226                 hv_len = 36;
 227         }
 228         sig_len = (*ctx->policy_vtable)->do_sign(ctx->policy_vtable,
 229                 hash, hv_len, ctx->eng.pad, sizeof ctx->eng.pad);
 230         return sig_len ? (int)sig_len : -BR_ERR_INVALID_ALGORITHM;
 231 }
 232
 233 /*
 234  * Do the ECDHE key exchange (part 2: computation of the shared secret
 235  * from the point sent by the client).
 236  */
 237 static void
 238 do_ecdhe_part2(br_ssl_server_context *ctx, int prf_id,
 239         unsigned char *cpoint, size_t cpoint_len)
 240 {
 241         int curve;
 242         uint32_t x;
 243
 244         curve = ctx->eng.ecdhe_curve;
 245
 246         /*
 247          * Finalise the key exchange.
 248          */
 249         x = ctx->eng.iec->mul(cpoint, cpoint_len,
 250                 ctx->ecdhe_key, ctx->ecdhe_key_len, curve);
 251         ecdh_common(ctx, prf_id, cpoint, cpoint_len, x);
 252
 253         /*
 254          * Clear the ECDHE private key. Forward Secrecy is achieved insofar
 255          * as that key does not get stolen, so we'd better destroy it
 256          * as soon as it ceases to be useful.
 257          */
 258         memset(ctx->ecdhe_key, 0, ctx->ecdhe_key_len);
 259 }
 260
 261 }
 262
 263 \ =======================================================================
 264
 265 : addr-ctx:
 266         next-word { field }
 267         "addr-" field + 0 1 define-word
 268         0 8191 "offsetof(br_ssl_server_context, " field + ")" + make-CX
 269         postpone literal postpone ; ;
 270
 271 addr-ctx: flags
 272 addr-ctx: client_max_version
 273 addr-ctx: client_suites
 274 addr-ctx: client_suites_num
 275 addr-ctx: hashes
 276 addr-ctx: curves
 277 addr-ctx: sign_hash_id
 278
 279 \ Get address and length of the client_suites[] buffer. Length is expressed
 280 \ in bytes.
 281 : addr-len-client_suites ( -- addr len )
 282         addr-client_suites
 283         CX 0 1023 { BR_MAX_CIPHER_SUITES * sizeof(br_suite_translated) } ;
 284
 285 \ Check a server flag by index.
 286 : flag? ( index -- bool )
 287         addr-flags get32 swap >> 1 and neg ;
 288
 289 \ Read the client SNI extension.
 290 : read-client-sni ( lim -- lim )
 291         \ Open extension value.
 292         read16 open-elt
 293
 294         \ Open ServerNameList.
 295         read16 open-elt
 296
 297         \ Find if there is a name of type 0 (host_name) with a length
 298         \ that fits in our dedicated buffer.
 299         begin dup while
 300                 read8 if
 301                         read-ignore-16
 302                 else
 303                         read16
 304                         dup 255 <= if
 305                                 dup addr-server_name + 0 swap set8
 306                                 addr-server_name swap read-blob
 307                         else
 308                                 skip-blob
 309                         then
 310                 then
 311         repeat
 312
 313         \ Close ServerNameList.
 314         close-elt
 315
 316         \ Close extension value.
 317         close-elt ;
 318
 319 \ Set the new maximum fragment length. BEWARE: this shall be called only
 320 \ after reading the ClientHello and before writing the ServerHello.
 321 cc: set-max-frag-len ( len -- ) {
 322         size_t max_frag_len = T0_POP();
 323
 324         br_ssl_engine_new_max_frag_len(ENG, max_frag_len);
 325
 326         /*
 327          * We must adjust our own output limit. Since we call this only
 328          * after receiving a ClientHello and before beginning to send
 329          * the ServerHello, the next output record should be empty at
 330          * that point, so we can use max_frag_len as a limit.
 331          */
 332         if (ENG->hlen_out > max_frag_len) {
 333                 ENG->hlen_out = max_frag_len;
 334         }
 335 }
 336
 337 \ Read the client Max Frag Length extension.
 338 : read-client-frag ( lim -- lim )
 339         \ Extension value must have length exactly 1 byte.
 340         read16 1 <> if ERR_BAD_FRAGLEN fail then
 341         read8
 342
 343         \ The byte value must be 1, 2, 3 or 4.
 344         dup dup 0= swap 5 >= or if ERR_BAD_FRAGLEN fail then
 345
 346         \ If our own maximum fragment length is greater, then we reduce
 347         \ our length.
 348         8 + dup addr-log_max_frag_len get8 < if
 349                 dup 1 swap << set-max-frag-len
 350                 dup addr-log_max_frag_len set8
 351                 addr-peer_log_max_frag_len set8
 352         else
 353                 drop
 354         then ;
 355
 356 \ Read the Secure Renegotiation extension from the client.
 357 : read-client-reneg ( lim -- lim )
 358         \ Get value length.
 359         read16
 360
 361         \ The "reneg" value is one of:
 362         \   0   on first handshake, client support is unknown
 363         \   1   client does not support secure renegotiation
 364         \   2   client supports secure renegotiation
 365         addr-reneg get8 case
 366                 0 of
 367                         \ First handshake, value length shall be 1.
 368                         1 = ifnot ERR_BAD_SECRENEG fail then
 369                         read8 if ERR_BAD_SECRENEG fail then
 370                         2 addr-reneg set8
 371                 endof
 372                 2 of
 373                         \ Renegotiation, value shall consist of 13 bytes
 374                         \ (header + copy of the saved client "Finished").
 375                         13 = ifnot ERR_BAD_SECRENEG fail then
 376                         read8 12 = ifnot ERR_BAD_SECRENEG fail then
 377                         addr-pad 12 read-blob
 378                         addr-saved_finished addr-pad 12 memcmp ifnot
 379                                 ERR_BAD_SECRENEG fail
 380                         then
 381                 endof
 382
 383                 \ If "reneg" is 1 then the client is not supposed to support
 384                 \ the extension, and it sends it nonetheless, which means
 385                 \ foul play.
 386                 ERR_BAD_SECRENEG fail
 387         endcase ;
 388
 389 \ Read the Signature Algorithms extension.
 390 : read-signatures ( lim -- lim )
 391         \ Open extension value.
 392         read16 open-elt
 393
 394         \ Clear list of supported signature algorithms.
 395         0 addr-hashes set16
 396
 397         \ Get list of algorithms length.
 398         read16 open-elt
 399         begin dup while
 400                 read8 { hash } read8 { sign }
 401                 \ We keep the value if the signature is either 1 (RSA) or
 402                 \ 3 (ECDSA), and the hash is one of the SHA-* functions
 403                 \ (2 to 6, from SHA-1 to SHA-512). Note that we reject
 404                 \ any use of MD5. Also, we do not keep track of the client
 405                 \ preferences.
 406                 hash 2 >= hash 6 <= and
 407                 sign 1 = sign 3 = or
 408                 and if
 409                         addr-hashes get16
 410                         1 sign 1- 2 << hash + << or addr-hashes set16
 411                 then
 412         repeat
 413         close-elt
 414
 415         \ Close extension value.
 416         close-elt ;
 417
 418 \ Read the Supported Curves extension.
 419 : read-supported-curves ( lim -- lim )
 420         \ Open extension value.
 421         read16 open-elt
 422
 423         \ Open list of curve identifiers.
 424         read16 open-elt
 425
 426         \ Get all supported curves.
 427         0 addr-curves set32
 428         begin dup while
 429                 read16 dup 32 < if
 430                         1 swap << addr-curves get32 or addr-curves set32
 431                 else
 432                         drop
 433                 then
 434         repeat
 435         close-elt
 436         close-elt ;
 437
 438 \ Call policy handler to get cipher suite, hash function identifier and
 439 \ certificate chain. Returned value is 0 (false) on failure.
 440 cc: call-policy-handler ( -- bool ) {
 441         int x;
 442         br_ssl_server_choices choices;
 443
 444         x = (*CTX->policy_vtable)->choose(
 445                 CTX->policy_vtable, CTX, &choices);
 446         ENG->session.cipher_suite = choices.cipher_suite;
 447         CTX->sign_hash_id = choices.hash_id;
 448         CTX->chain = choices.chain;
 449         CTX->chain_len = choices.chain_len;
 450         T0_PUSHi(-(x != 0));
 451 }
 452
 453 \ Check for a remembered session.
 454 cc: check-resume ( -- bool ) {
 455         if (ENG->session.session_id_len == 32
 456                 && CTX->cache_vtable != NULL && (*CTX->cache_vtable)->load(
 457                         CTX->cache_vtable, CTX, &ENG->session))
 458         {
 459                 T0_PUSHi(-1);
 460         } else {
 461                 T0_PUSH(0);
 462         }
 463 }
 464
 465 \ Save the current session.
 466 cc: save-session ( -- ) {
 467         if (CTX->cache_vtable != NULL) {
 468                 (*CTX->cache_vtable)->save(
 469                         CTX->cache_vtable, CTX, &ENG->session);
 470         }
 471 }
 472
 473 \ Read ClientHello. If the session is resumed, then -1 is returned.
 474 : read-ClientHello ( -- resume )
 475         \ Get header, and check message type.
 476         read-handshake-header 1 = ifnot ERR_UNEXPECTED fail then
 477
 478         \ Get maximum protocol version from client.
 479         read16 dup { client-version-max } addr-client_max_version set16
 480
 481         \ Client random.
 482         addr-client_random 32 read-blob
 483
 484         \ Client session ID.
 485         read8 dup 32 > if ERR_OVERSIZED_ID fail then
 486         dup addr-session_id_len set8
 487         addr-session_id swap read-blob
 488
 489         \ Lookup session for resumption. We should do that here because
 490         \ we need to verify that the remembered cipher suite is still
 491         \ matched by this ClientHello.
 492         check-resume { resume }
 493
 494         \ Cipher suites. We read all cipher suites from client, each time
 495         \ matching against our own list. We accumulare suites in the
 496         \ client_suites[] context buffer: we keep suites that are
 497         \ supported by both the client and the server (so the list size
 498         \ cannot exceed that of the server list), and we keep them in
 499         \ either client or server preference order (depending on the
 500         \ relevant flag).
 501         \
 502         \ We also need to identify the pseudo cipher suite for secure
 503         \ renegotiation here.
 504         read16 open-elt
 505         0 { reneg-scsv }
 506         0 { resume-suite }
 507         addr-len-client_suites dup2 bzero
 508         over + { css-off css-max }
 509         begin
 510                 dup while
 511                 read16 dup { suite }
 512
 513                 \ Check that when resuming a session, the requested
 514                 \ suite is still valid.
 515                 resume if
 516                         dup addr-cipher_suite get16 = if
 517                                 -1 >resume-suite
 518                         then
 519                 then
 520
 521                 \ Special handling for TLS_EMPTY_RENEGOTIATION_INFO_SCSV.
 522                 \ This fake cipher suite may occur only in the first
 523                 \ handshake.
 524                 dup 0x00FF = if
 525                         addr-reneg get8 if ERR_BAD_SECRENEG fail then
 526                         -1 >reneg-scsv
 527                 then
 528
 529                 \ Test whether the suite is supported by the server.
 530                 scan-suite dup 0< if
 531                         \ We do not support this cipher suite. Note
 532                         \ that this also covers the case of pseudo
 533                         \ cipher suites.
 534                         drop
 535                 else
 536                         \ If we use server order, then we place the
 537                         \ suite at the computed offset; otherwise, we
 538                         \ append it to the list at the current place.
 539                         0 flag? if
 540                                 2 << addr-client_suites + suite swap set16
 541                         else
 542                                 drop
 543                                 \ We need to test for list length because
 544                                 \ the client list may have duplicates,
 545                                 \ that we do not filter. Duplicates are
 546                                 \ invalid so this is not a problem if we
 547                                 \ reject such clients.
 548                                 css-off css-max >= if
 549                                         ERR_BAD_HANDSHAKE fail
 550                                 then
 551                                 suite css-off set16
 552                                 css-off 4 + >css-off
 553                         then
 554                 then
 555         repeat
 556         drop
 557
 558         \ Compression methods. We need method 0 (no compression).
 559         0 { ok-compression }
 560         read8 open-elt
 561         begin dup while
 562                 read8 ifnot -1 >ok-compression then
 563         repeat
 564         close-elt
 565
 566         \ Set default values for parameters that may be affected by
 567         \ extensions:
 568         \ -- server name is empty
 569         \ -- client is reputed to know RSA and ECDSA, both with SHA-1
 570         \ -- the default elliptic curve is P-256 (secp256r1, id = 23)
 571         0 addr-server_name set8
 572         0x404 addr-hashes set16
 573         0x800000 addr-curves set32
 574
 575         \ Process extensions, if any.
 576         dup if
 577                 read16 open-elt
 578                 begin dup while
 579                         read16 case
 580                                 \ Server Name Indication.
 581                                 0x0000 of
 582                                         read-client-sni
 583                                 endof
 584                                 \ Max Frag Length.
 585                                 0x0001 of
 586                                         read-client-frag
 587                                 endof
 588                                 \ Secure Renegotiation.
 589                                 0xFF01 of
 590                                         read-client-reneg
 591                                 endof
 592                                 \ Signature Algorithms.
 593                                 0x000D of
 594                                         read-signatures
 595                                 endof
 596                                 \ Supported Curves.
 597                                 0x000A of
 598                                         read-supported-curves
 599                                 endof
 600                                 \ Supported Point Formats.
 601                                 0x000B of
 602                                         \ We only support "uncompressed", and
 603                                         \ all implementations are supposed to
 604                                         \ support it anyway.
 605                                         read-ignore-16
 606                                 endof
 607
 608                                 \ Other extensions are ignored.
 609                                 drop read-ignore-16 0
 610                         endcase
 611                 repeat
 612                 close-elt
 613         then
 614
 615         \ Close message.
 616         close-elt
 617
 618         \ Cancel session resumption if the cipher suite was not found.
 619         resume resume-suite and >resume
 620
 621         \ Now check the received data. Since the client is expecting an
 622         \ answer, we can send an appropriate fatal alert on any error.
 623
 624         \ Compute protocol version as the minimum of our maximum version,
 625         \ and the maximum version sent by the client. If that is less than
 626         \ 0x0300 (SSL-3.0), then fail. Otherwise, we may at least send an
 627         \ alert with that version. We still reject versions lower than our
 628         \ configured minimum.
 629         addr-version_max get16
 630         dup client-version-max > if drop client-version-max then
 631         dup 0x0300 < if ERR_BAD_VERSION fail then
 632         client-version-max addr-version_min get16 < if
 633                 70 fail-alert
 634         then
 635         \ If resuming the session, then enforce the previously negotiated
 636         \ version (if still possible).
 637         resume if
 638                 addr-version get16 client-version-max <= if
 639                         drop addr-version get16
 640                 else
 641                         0 >resume
 642                 then
 643         then
 644         dup addr-version set16
 645         dup addr-version_in set16
 646         dup addr-version_out set16
 647         0x0303 >= { can-tls12 }
 648
 649         \ If the client sent TLS_EMPTY_RENEGOTIATION_INFO_SCSV, then
 650         \ we should mark the client as "supporting secure renegotiation".
 651         reneg-scsv if 2 addr-reneg set8 then
 652
 653         \ Check compression.
 654         ok-compression ifnot 40 fail-alert then
 655
 656         \ Filter hash function support by what the server also supports.
 657         \ If no common hash function remains, then ECDHE suites are not
 658         \ possible.
 659         supported-hash-functions drop 257 *
 660         addr-hashes get16 and dup addr-hashes set16
 661         0<> { can-ecdhe }
 662
 663         \ Filter supported curves. If there is no common curve between
 664         \ client and us, then ECDHE suites cannot be used. Note that we
 665         \ may still allow ECDH, depending on the EC key handler.
 666         addr-curves get32 supported-curves and dup addr-curves set32
 667         ifnot 0 >can-ecdhe then
 668
 669         \ If resuming a session, then the next steps are not necessary;
 670         \ we won't invoke the policy handler.
 671         resume if -1 ret then
 672
 673         \ We are not resuming, so a new session ID should be generated.
 674         addr-session_id 32 mkrand
 675
 676         \ Translate common cipher suites, then squeeze out holes: there
 677         \ may be holes because of the way we fill the list when the
 678         \ server preference order is enforced, and also in case some
 679         \ suites are filtered out. In particular:
 680         \ -- ECDHE suites are removed if there is no common hash function
 681         \    (for signatures) or no common curve.
 682         \ -- TLS-1.2-only suites are removed if the negociated version is
 683         \    TLS-1.1 or lower.
 684         addr-client_suites dup >css-off
 685         begin dup css-max < while
 686                 dup get16 dup cipher-suite-to-elements
 687                 can-ecdhe ifnot
 688                         dup 12 >> dup 1 = swap 2 = or if
 689                                 2drop 0 dup
 690                         then
 691                 then
 692                 can-tls12 ifnot
 693                         \ Suites compatible with TLS-1.0 and TLS-1.1 are
 694                         \ exactly the ones that use HMAC/SHA-1.
 695                         dup 0xF0 and 0x20 <> if
 696                                 2drop 0 dup
 697                         then
 698                 then
 699                 dup if
 700                         css-off 2+ set16 css-off set16
 701                         css-off 4 + >css-off
 702                 else
 703                         2drop
 704                 then
 705                 4 +
 706         repeat
 707         drop
 708         css-off addr-client_suites - 2 >>
 709         dup ifnot
 710                 \ No common cipher suite: handshake failure.
 711                 40 fail-alert
 712         then
 713         addr-client_suites_num set8
 714
 715         \ Call policy handler to obtain the cipher suite and other
 716         \ parameters.
 717         call-policy-handler ifnot 40 fail-alert then
 718
 719         \ We are not resuming a session.
 720         0 ;
 721
 722 \ Write ServerHello.
 723 : write-ServerHello ( initial -- )
 724         { initial }
 725         \ Compute ServerHello length. Right now we only send the
 726         \ "secure renegotiation" extension.
 727         2 write8 70
 728
 729         addr-reneg get8 2 = if
 730                 initial if 5 else 29 then
 731         else
 732                 0
 733         then
 734         { ext-reneg-len }
 735         addr-peer_log_max_frag_len get8 if 5 else 0 then
 736         { ext-max-frag-len }
 737
 738         ext-reneg-len ext-max-frag-len + dup if 2 + then +
 739         write24
 740
 741         \ Protocol version
 742         addr-version get16 write16
 743
 744         \ Server random
 745         addr-server_random 4 bzero
 746         addr-server_random 4 + 28 mkrand
 747         addr-server_random 32 write-blob
 748
 749         \ Session ID
 750         \ TODO: if we have no session cache at all, we might send here
 751         \ an empty session ID. This would save a bit of network
 752         \ bandwidth.
 753         32 write8
 754         addr-session_id 32 write-blob
 755
 756         \ Cipher suite
 757         addr-cipher_suite get16 write16
 758
 759         \ Compression method
 760         0 write8
 761
 762         \ Extensions
 763         ext-reneg-len ext-max-frag-len + dup if
 764                 write16
 765                 ext-reneg-len dup if
 766                         0xFF01 write16
 767                         4 - dup write16
 768                         1- addr-saved_finished swap write-blob-head8
 769                 else
 770                         drop
 771                 then
 772                 ext-max-frag-len if
 773                         0x0001 write16
 774                         1 write16 addr-peer_log_max_frag_len get8 8 - write8
 775                 then
 776         else
 777                 drop
 778         then ;
 779
 780 \ Compute total chain length. This includes the individual certificate
 781 \ headers, but not the total chain header. This also sets the cert_cur,
 782 \ cert_len and chain_len context fields.
 783 cc: total-chain-length ( -- len ) {
 784         size_t u;
 785         uint32_t total;
 786
 787         total = 0;
 788         for (u = 0; u < CTX->chain_len; u ++) {
 789                 total += 3 + (uint32_t)CTX->chain[u].data_len;
 790         }
 791         T0_PUSH(total);
 792 }
 793
 794 \ Get length for current certificate in the chain; if the chain end was
 795 \ reached, then this returns -1.
 796 cc: begin-cert ( -- len ) {
 797         if (CTX->chain_len == 0) {
 798                 T0_PUSHi(-1);
 799         } else {
 800                 CTX->cert_cur = CTX->chain->data;
 801                 CTX->cert_len = CTX->chain->data_len;
 802                 CTX->chain ++;
 803                 CTX->chain_len --;
 804                 T0_PUSH(CTX->cert_len);
 805         }
 806 }
 807
 808 \ Copy a chunk of certificate data into the pad. Returned value is the
 809 \ chunk length, or 0 if the certificate end is reached.
 810 cc: copy-cert-chunk ( -- len ) {
 811         size_t clen;
 812
 813         clen = CTX->cert_len;
 814         if (clen > sizeof ENG->pad) {
 815                 clen = sizeof ENG->pad;
 816         }
 817         memcpy(ENG->pad, CTX->cert_cur, clen);
 818         CTX->cert_cur += clen;
 819         CTX->cert_len -= clen;
 820         T0_PUSH(clen);
 821 }
 822
 823 \ Write the server Certificate.
 824 : write-Certificate ( -- )
 825         11 write8
 826         total-chain-length
 827         dup 3 + write24 write24
 828         begin
 829                 begin-cert
 830                 dup 0< if drop ret then write24
 831                 begin copy-cert-chunk dup while
 832                         addr-pad swap write-blob
 833                 repeat
 834                 drop
 835         again ;
 836
 837 \ Do the first part of ECDHE. Returned value is the computed signature
 838 \ length, or a negative error code on error.
 839 cc: do-ecdhe-part1 ( curve -- len ) {
 840         int curve = T0_POPi();
 841         T0_PUSHi(do_ecdhe_part1(CTX, curve));
 842 }
 843
 844 \ Write the Server Key Exchange message (if applicable).
 845 : write-ServerKeyExchange ( -- )
 846         addr-cipher_suite get16 use-ecdhe? ifnot ret then
 847
 848         \ We must select an appropriate curve among the curves that
 849         \ are supported both by us and the peer. Right now we use
 850         \ the one with the smallest ID, which in practice means P-256.
 851         \ (TODO: add some option to make that behaviour configurable.)
 852         \
 853         \ This loop always terminates because previous processing made
 854         \ sure that ECDHE suites are not selectable if there is no common
 855         \ curve.
 856         addr-curves get32 0
 857         begin dup2 >> 1 and 0= while 1+ repeat
 858         { curve-id } drop
 859
 860         \ Compute the signed curve point to send.
 861         curve-id do-ecdhe-part1 dup 0< if neg fail then { sig-len }
 862
 863         \ If using TLS-1.2+, then the hash function and signature
 864         \ algorithm are explicitly encoded in the message.
 865         addr-version get16 0x0303 >= { tls1.2+ }
 866
 867         12 write8
 868         sig-len addr-ecdhe_point_len get8 + tls1.2+ 2 and + 6 + write24
 869
 870         \ Curve parameters: named curve with 16-bit ID.
 871         3 write8 curve-id write16
 872
 873         \ Public point.
 874         addr-ecdhe_point addr-ecdhe_point_len get8 write-blob-head8
 875
 876         \ If TLS-1.2+, write hash and signature identifiers.
 877         tls1.2+ if
 878                 \ Hash identifier is in the sign_hash_id field.
 879                 addr-sign_hash_id get8 write8
 880                 \ 'use-rsa-ecdhe?' returns -1 for RSA, 0 for ECDSA.
 881                 \ The byte on the wire shall be 1 for RSA, 3 for ECDSA.
 882                 addr-cipher_suite get16 use-rsa-ecdhe? 1 << 3 + write8
 883         then
 884
 885         \ Signature.
 886         sig-len write16
 887         addr-pad sig-len write-blob ;
 888
 889 \ Write the Server Hello Done message.
 890 : write-ServerHelloDone ( -- )
 891         14 write8 0 write24 ;
 892
 893 \ Perform RSA decryption of the client-sent pre-master secret. The value
 894 \ is in the pad, and its length is provided as parameter.
 895 cc: do-rsa-decrypt ( len prf_id -- ) {
 896         int prf_id = T0_POPi();
 897         size_t len = T0_POP();
 898         do_rsa_decrypt(CTX, prf_id, ENG->pad, len);
 899 }
 900
 901 \ Perform ECDH (not ECDHE). The point from the client is in the pad, and
 902 \ its length is provided as parameter.
 903 cc: do-ecdh ( len prf_id -- ) {
 904         int prf_id = T0_POPi();
 905         size_t len = T0_POP();
 906         do_ecdh(CTX, prf_id, ENG->pad, len);
 907 }
 908
 909 \ Do the second part of ECDHE.
 910 cc: do-ecdhe-part2 ( len prf_id -- ) {
 911         int prf_id = T0_POPi();
 912         size_t len = T0_POP();
 913         do_ecdhe_part2(CTX, prf_id, ENG->pad, len);
 914 }
 915
 916 \ Read the Client Key Exchange.
 917 : read-ClientKeyExchange ( -- )
 918         \ Get header, and check message type.
 919         read-handshake-header 16 = ifnot ERR_UNEXPECTED fail then
 920
 921         \ What we should get depends on the cipher suite.
 922         addr-cipher_suite get16 use-rsa-keyx? if
 923                 \ RSA key exchange: we expect a RSA-encrypted value.
 924                 read16
 925                 dup 512 > if ERR_LIMIT_EXCEEDED fail then
 926                 dup { enc-rsa-len }
 927                 addr-pad swap read-blob
 928                 enc-rsa-len addr-cipher_suite get16 prf-id do-rsa-decrypt
 929         then
 930         addr-cipher_suite get16 dup use-ecdhe? swap use-ecdh? { ecdhe ecdh }
 931         ecdh ecdhe or if
 932                 \ ECDH or ECDHE key exchange: we expect an EC point.
 933                 read8 dup { ec-point-len }
 934                 addr-pad swap read-blob
 935                 ec-point-len addr-cipher_suite get16 prf-id
 936                 ecdhe if do-ecdhe-part2 else do-ecdh then
 937         then
 938         close-elt ;
 939
 940 \ Send a HelloRequest.
 941 : send-HelloRequest ( -- )
 942         flush-record
 943         begin can-output? not while wait-co drop repeat
 944         22 addr-record_type_out set8
 945         0 write8 0 write24 flush-record
 946         23 addr-record_type_out set8 ;
 947
 948 \ Make a handshake.
 949 : do-handshake ( initial -- )
 950         0 addr-application_data set8
 951         22 addr-record_type_out set8
 952         multihash-init
 953         read-ClientHello
 954         more-incoming-bytes? if ERR_UNEXPECTED fail then
 955         if
 956                 \ Session resumption
 957                 write-ServerHello
 958                 0 write-CCS-Finished
 959                 0 read-CCS-Finished
 960         else
 961                 \ Not a session resumption
 962                 write-ServerHello
 963                 write-Certificate
 964                 write-ServerKeyExchange
 965                 write-ServerHelloDone
 966                 flush-record
 967                 read-ClientKeyExchange
 968                 0 read-CCS-Finished
 969                 0 write-CCS-Finished
 970                 save-session
 971         then
 972         1 addr-application_data set8
 973         23 addr-record_type_out set8 ;
 974
 975 \ Entry point.
 976 : main ( -- ! )
 977         \ Perform initial handshake.
 978         -1 do-handshake
 979
 980         begin
 981                 \ Wait for further invocation. At that point, we should
 982                 \ get either an explicit call for renegotiation, or
 983                 \ an incoming ClientHello handshake message.
 984                 wait-co
 985                 dup 0x07 and case
 986                         0x00 of
 987                                 0x10 and if
 988                                         \ The best we can do is ask for a
 989                                         \ renegotiation, then wait for it
 990                                         \ to happen.
 991                                         send-HelloRequest
 992                                 then
 993                         endof
 994                         0x01 of
 995                                 \ Reject renegotiations if the peer does not
 996                                 \ support secure renegotiation. As allowed
 997                                 \ by RFC 5246, we do not send a
 998                                 \ no_renegotiation alert and just ignore the
 999                                 \ HelloRequest.
1000                                 drop
1001                                 addr-reneg get8 1 <> if
1002                                         0 do-handshake
1003                                 else
1004                                         flush-record
1005                                         begin can-output? not while
1006                                                 wait-co drop
1007                                         repeat
1008                                 then
1009                         endof
1010                         ERR_UNEXPECTED fail
1011                 endcase
1012         again
1013         ;