Added macro that indicates presence of the time callback feature. Also added C++...
[BearSSL] / src / ssl / ssl_hs_common.t0
index 1eb5347..4674891 100644 (file)
@@ -34,7 +34,7 @@ preamble {
 /*
  * This macro evaluates to a pointer to the current engine context.
  */
-#define ENG  ((br_ssl_engine_context *)((unsigned char *)t0ctx - offsetof(br_ssl_engine_context, cpu)))
+#define ENG  ((br_ssl_engine_context *)(void *)((unsigned char *)t0ctx - offsetof(br_ssl_engine_context, cpu)))
 
 }
 
@@ -79,6 +79,23 @@ preamble {
 : NYI ( -- ! )
        "NOT YET IMPLEMENTED!" puts cr -1 fail ;
 
+\ Debug function that prints a string (and a newline) on stderr.
+cc: DBG ( addr -- ) {
+       extern void *stderr;
+       extern int fprintf(void *, const char *, ...);
+       fprintf(stderr, "%s\n", &t0_datablock[T0_POPi()]);
+}
+
+\ Debug function that prints a string and an integer value (followed
+\ by a newline) on stderr.
+cc: DBG2 ( addr x -- ) {
+       extern void *stderr;
+       extern int fprintf(void *, const char *, ...);
+       int32_t x = T0_POPi();
+       fprintf(stderr, "%s: %ld (0x%08lX)\n",
+               &t0_datablock[T0_POPi()], (long)x, (unsigned long)(uint32_t)x);
+}
+
 \ Mark the context as failed with a specific error code. This also
 \ returns control to the caller.
 cc: fail ( err -- ! ) {
@@ -95,13 +112,13 @@ cc: get8 ( addr -- val ) {
 \ Read a 16-bit word from the context (address is offset in context).
 cc: get16 ( addr -- val ) {
        size_t addr = (size_t)T0_POP();
-       T0_PUSH(*(uint16_t *)((unsigned char *)ENG + addr));
+       T0_PUSH(*(uint16_t *)(void *)((unsigned char *)ENG + addr));
 }
 
 \ Read a 32-bit word from the context (address is offset in context).
 cc: get32 ( addr -- val ) {
        size_t addr = (size_t)T0_POP();
-       T0_PUSH(*(uint32_t *)((unsigned char *)ENG + addr));
+       T0_PUSH(*(uint32_t *)(void *)((unsigned char *)ENG + addr));
 }
 
 \ Set a byte in the context (address is offset in context).
@@ -113,13 +130,13 @@ cc: set8 ( val addr -- ) {
 \ Set a 16-bit word in the context (address is offset in context).
 cc: set16 ( val addr -- ) {
        size_t addr = (size_t)T0_POP();
-       *(uint16_t *)((unsigned char *)ENG + addr) = (uint16_t)T0_POP();
+       *(uint16_t *)(void *)((unsigned char *)ENG + addr) = (uint16_t)T0_POP();
 }
 
 \ Set a 32-bit word in the context (address is offset in context).
 cc: set32 ( val addr -- ) {
        size_t addr = (size_t)T0_POP();
-       *(uint32_t *)((unsigned char *)ENG + addr) = (uint32_t)T0_POP();
+       *(uint32_t *)(void *)((unsigned char *)ENG + addr) = (uint32_t)T0_POP();
 }
 
 \ Define a word that evaluates as an address of a field within the
@@ -145,12 +162,8 @@ addr-eng: version_max
 addr-eng: suites_buf
 addr-eng: suites_num
 addr-eng: server_name
-\ addr-eng: version
-\ addr-eng: cipher_suite
 addr-eng: client_random
 addr-eng: server_random
-\ addr-eng: session_id_len
-\ addr-eng: session_id
 addr-eng: ecdhe_curve
 addr-eng: ecdhe_point
 addr-eng: ecdhe_point_len
@@ -161,6 +174,8 @@ addr-eng: pad
 addr-eng: action
 addr-eng: alert
 addr-eng: close_received
+addr-eng: protocol_names_num
+addr-eng: selected_protocol
 
 \ Similar to 'addr-eng:', for fields in the 'session' substructure.
 : addr-session-field:
@@ -212,6 +227,9 @@ err: ERR_LIMIT_EXCEEDED
 err: ERR_BAD_FINISHED
 err: ERR_RESUME_MISMATCH
 err: ERR_INVALID_ALGORITHM
+err: ERR_BAD_SIGNATURE
+err: ERR_WRONG_KEY_USAGE
+err: ERR_NO_CLIENT_AUTH
 
 \ Get supported curves (bit mask).
 cc: supported-curves ( -- x ) {
@@ -220,6 +238,7 @@ cc: supported-curves ( -- x ) {
 }
 
 \ Get supported hash functions (bit mask and number).
+\ Note: this (on purpose) skips MD5.
 cc: supported-hash-functions ( -- x num ) {
        int i;
        unsigned x, num;
@@ -236,6 +255,16 @@ cc: supported-hash-functions ( -- x num ) {
        T0_PUSH(num);
 }
 
+\ Test support for RSA signatures.
+cc: supports-rsa-sign? ( -- bool ) {
+       T0_PUSHi(-(ENG->irsavrfy != 0));
+}
+
+\ Test support for ECDSA signatures.
+cc: supports-ecdsa? ( -- bool ) {
+       T0_PUSHi(-(ENG->iecdsa != 0));
+}
+
 \ (Re)initialise the multihasher.
 cc: multihash-init ( -- ) {
        br_multihash_init(&ENG->mhash);
@@ -263,7 +292,9 @@ cc: flush-record ( -- ) {
        addr-action get8 dup if
                case
                        1 of 0 do-close endof
-                       2 of addr-application_data get8 if 0x10 or then endof
+                       2 of addr-application_data get8 1 = if
+                               0x10 or
+                       then endof
                endcase
        else
                drop
@@ -318,13 +349,18 @@ cc: flush-record ( -- ) {
 \ -- If 'cnr' is zero, then incoming data is discarded until a close_notify
 \    is received.
 \ -- At the end, the context is terminated.
+\
+\ cnr shall be either 0 or -1.
 : do-close ( cnr -- ! )
        \ 'cnr' is set to non-zero when a close_notify is received from
        \ the peer.
        { cnr }
 
-       \ Get out of application data state.
-       0 addr-application_data set8
+       \ Get out of application data state. If we were accepting
+       \ application data (flag is 1), and we still expect a close_notify
+       \ from the peer (cnr is 0), then we should set the flag to 2.
+       \ In all other cases, flag should be set to 0.
+       addr-application_data get8 cnr not and 1 << addr-application_data set8
 
        \ Flush existing payload if any.
        flush-record
@@ -357,6 +393,10 @@ cc: flush-record ( -- ) {
                has-input? if
                        addr-record_type_in get8 21 = if
                                drop process-alerts
+                               \ If we received a close_notify then we
+                               \ no longer accept incoming application
+                               \ data records.
+                               0 addr-application_data set8
                        else
                                discard-input
                        then
@@ -457,7 +497,7 @@ cc: read-chunk-native ( addr len -- addr len ) {
                        \ no_renegotiation has value 100, and we treat it
                        \ as a fatal alert.
                        dup 100 = if 256 + fail then
-                       0= ret
+                       0=
                endof
                \ Fatal alert implies context termination.
                drop 256 + fail
@@ -541,7 +581,7 @@ cc: more-incoming-bytes? ( -- bool ) {
        read16 skip-blob ;
 
 \ Open a substructure: the inner structure length is checked against,
-\ and substracted, from the output structure current limit.
+\ and subtracted, from the output structure current limit.
 : open-elt ( lim len -- lim-outer lim-inner )
        dup { len }
        - dup 0< if ERR_BAD_PARAM fail then
@@ -723,6 +763,10 @@ cc: mkrand ( addr len -- ) {
 \       3  AES-128/GCM
 \       4  AES-256/GCM
 \       5  ChaCha20/Poly1305
+\       6  AES-128/CCM
+\       7  AES-256/CCM
+\       8  AES-128/CCM8
+\       9  AES-256/CCM8
 \ -- MAC algorithm:
 \       0  none         (for suites with AEAD encryption)
 \       2  HMAC/SHA-1
@@ -731,6 +775,10 @@ cc: mkrand ( addr len -- ) {
 \ -- PRF for TLS-1.2:
 \       4  with SHA-256
 \       5  with SHA-384
+\
+\ WARNING: if adding a new cipher suite that does not use SHA-256 for the
+\ PRF (with TLS 1.2), be sure to check the suites_sha384[] array defined
+\ in ssl/ssl_keyexport.c
 
 data: cipher-suite-def
 
@@ -773,6 +821,15 @@ hexb| C030 1405 | \ TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384
 hexb| C031 3304 | \ TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256
 hexb| C032 3405 | \ TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384
 
+hexb| C09C 0604 | \ TLS_RSA_WITH_AES_128_CCM
+hexb| C09D 0704 | \ TLS_RSA_WITH_AES_256_CCM
+hexb| C0A0 0804 | \ TLS_RSA_WITH_AES_128_CCM_8
+hexb| C0A1 0904 | \ TLS_RSA_WITH_AES_256_CCM_8
+hexb| C0AC 2604 | \ TLS_ECDHE_ECDSA_WITH_AES_128_CCM
+hexb| C0AD 2704 | \ TLS_ECDHE_ECDSA_WITH_AES_256_CCM
+hexb| C0AE 2804 | \ TLS_ECDHE_ECDSA_WITH_AES_128_CCM_8
+hexb| C0AF 2904 | \ TLS_ECDHE_ECDSA_WITH_AES_256_CCM_8
+
 hexb| CCA8 1504 | \ TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256
 hexb| CCA9 2504 | \ TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256
 
@@ -835,6 +892,16 @@ hexb| 0000 | \ List terminator.
 : prf-id ( suite -- id )
        cipher-suite-to-elements 15 and ;
 
+\ Test whether a cipher suite is only for TLS-1.2. Cipher suites that
+\ can be used with TLS-1.0 or 1.1 use HMAC/SHA-1. RFC do not formally
+\ forbid using a CBC-based TLS-1.2 cipher suite, e.g. based on HMAC/SHA-256,
+\ with older protocol versions; however, servers should not do that, since
+\ it may confuse clients. Since the server code does not try such games,
+\ for consistency, the client should reject it as well (normal servers
+\ don't do that, so any attempt is a sign of foul play).
+: use-tls12? ( suite -- bool )
+       cipher-suite-to-elements 0xF0 and 0x20 <> ;
+
 \ Switch to negotiated security parameters for input or output.
 : switch-encryption ( is-client for-input -- )
        { for-input }
@@ -893,10 +960,40 @@ hexb| 0000 | \ List terminator.
                        then
                endof
 
-               \ ChaCha20/Poly1305
-               \ 5 of endof
+               \ ChaCha20+Poly1305
+               5 of drop
+                       for-input if
+                               switch-chapol-in
+                       else
+                               switch-chapol-out
+                       then
+               endof
+
+               \ Now we only have AES/CCM suites (6 to 9). Since the
+               \ input is between 0 and 15, and we checked values 0 to 5,
+               \ we only need to reject values larger than 9.
+               dup 9 > if
+                       ERR_BAD_PARAM fail
+               then
 
-               ERR_BAD_PARAM fail
+               \ Stack: is_client prf_id mac_id cipher_id
+               \ We want to remove the mac_id (it is zero for CCM suites)
+               \ and replace the cipher_id with the key and tag lengths.
+               \ The following table applies:
+               \  id   key length   tag length
+               \   6       16          16
+               \   7       32          16
+               \   8       16           8
+               \   9       32           8
+               swap drop
+               dup 1 and 4 << 16 + swap
+               8 and 16 swap -
+               for-input if
+                       switch-aesccm-in
+               else
+                       switch-aesccm-out
+               then
+               ret
        endcase
        ;
 
@@ -948,6 +1045,46 @@ cc: switch-aesgcm-in ( is_client prf_id cipher_key_len -- ) {
                ENG->iaes_ctr, cipher_key_len);
 }
 
+cc: switch-chapol-out ( is_client prf_id -- ) {
+       int is_client, prf_id;
+
+       prf_id = T0_POP();
+       is_client = T0_POP();
+       br_ssl_engine_switch_chapol_out(ENG, is_client, prf_id);
+}
+
+cc: switch-chapol-in ( is_client prf_id -- ) {
+       int is_client, prf_id;
+
+       prf_id = T0_POP();
+       is_client = T0_POP();
+       br_ssl_engine_switch_chapol_in(ENG, is_client, prf_id);
+}
+
+cc: switch-aesccm-out ( is_client prf_id cipher_key_len tag_len -- ) {
+       int is_client, prf_id;
+       unsigned cipher_key_len, tag_len;
+
+       tag_len = T0_POP();
+       cipher_key_len = T0_POP();
+       prf_id = T0_POP();
+       is_client = T0_POP();
+       br_ssl_engine_switch_ccm_out(ENG, is_client, prf_id,
+               ENG->iaes_ctrcbc, cipher_key_len, tag_len);
+}
+
+cc: switch-aesccm-in ( is_client prf_id cipher_key_len tag_len -- ) {
+       int is_client, prf_id;
+       unsigned cipher_key_len, tag_len;
+
+       tag_len = T0_POP();
+       cipher_key_len = T0_POP();
+       prf_id = T0_POP();
+       is_client = T0_POP();
+       br_ssl_engine_switch_ccm_in(ENG, is_client, prf_id,
+               ENG->iaes_ctrcbc, cipher_key_len, tag_len);
+}
+
 \ Write Finished message.
 : write-Finished ( from_client -- )
        compute-Finished
@@ -974,21 +1111,22 @@ cc: switch-aesgcm-in ( is_client prf_id cipher_key_len -- ) {
 cc: compute-Finished-inner ( from_client prf_id -- ) {
        int prf_id = T0_POP();
        int from_client = T0_POPi();
-       unsigned char seed[48];
-       size_t seed_len;
+       unsigned char tmp[48];
+       br_tls_prf_seed_chunk seed;
 
        br_tls_prf_impl prf = br_ssl_engine_get_PRF(ENG, prf_id);
+       seed.data = tmp;
        if (ENG->session.version >= BR_TLS12) {
-               seed_len = br_multihash_out(&ENG->mhash, prf_id, seed);
+               seed.len = br_multihash_out(&ENG->mhash, prf_id, tmp);
        } else {
-               br_multihash_out(&ENG->mhash, br_md5_ID, seed);
-               br_multihash_out(&ENG->mhash, br_sha1_ID, seed + 16);
-               seed_len = 36;
+               br_multihash_out(&ENG->mhash, br_md5_ID, tmp);
+               br_multihash_out(&ENG->mhash, br_sha1_ID, tmp + 16);
+               seed.len = 36;
        }
        prf(ENG->pad, 12, ENG->session.master_secret,
                sizeof ENG->session.master_secret,
                from_client ? "client finished" : "server finished",
-               seed, seed_len);
+               1, &seed);
 }
 
 \ Receive ChangeCipherSpec and Finished from the peer.
@@ -1020,3 +1158,225 @@ cc: compute-Finished-inner ( from_client prf_id -- ) {
        22 wait-rectype-out
        write-Finished
        flush-record ;
+
+\ Read and parse a list of supported signature algorithms (with hash
+\ functions). The resulting bit field is returned.
+: read-list-sign-algos ( lim -- lim value )
+       0 { hashes }
+       read16 open-elt
+       begin dup while
+               read8 { hash } read8 { sign }
+
+               \ If hash is 0x08 then this is a "new algorithm" identifier,
+               \ and we set the corresponding bit if it is in the 0..15
+               \ range. Otherwise, we keep the value only if the signature
+               \ is either 1 (RSA) or 3 (ECDSA), and the hash is one of the
+               \ SHA-* functions (2 to 6). Note that we reject MD5.
+               hash 8 = if
+                       sign 15 <= if
+                               1 sign 16 + << hashes or >hashes
+                       then
+               else
+                       hash 2 >= hash 6 <= and
+                       sign 1 = sign 3 = or
+                       and if
+                               hashes 1 sign 1- 2 << hash + << or >hashes
+                       then
+               then
+       repeat
+       close-elt
+       hashes ;
+
+\ =======================================================================
+
+\ Compute total chain length. This includes the individual certificate
+\ headers, but not the total chain header. This also sets the cert_cur,
+\ cert_len and chain_len context fields.
+cc: total-chain-length ( -- len ) {
+       size_t u;
+       uint32_t total;
+
+       total = 0;
+       for (u = 0; u < ENG->chain_len; u ++) {
+               total += 3 + (uint32_t)ENG->chain[u].data_len;
+       }
+       T0_PUSH(total);
+}
+
+\ Get length for current certificate in the chain; if the chain end was
+\ reached, then this returns -1.
+cc: begin-cert ( -- len ) {
+       if (ENG->chain_len == 0) {
+               T0_PUSHi(-1);
+       } else {
+               ENG->cert_cur = ENG->chain->data;
+               ENG->cert_len = ENG->chain->data_len;
+               ENG->chain ++;
+               ENG->chain_len --;
+               T0_PUSH(ENG->cert_len);
+       }
+}
+
+\ Copy a chunk of certificate data into the pad. Returned value is the
+\ chunk length, or 0 if the certificate end is reached.
+cc: copy-cert-chunk ( -- len ) {
+       size_t clen;
+
+       clen = ENG->cert_len;
+       if (clen > sizeof ENG->pad) {
+               clen = sizeof ENG->pad;
+       }
+       memcpy(ENG->pad, ENG->cert_cur, clen);
+       ENG->cert_cur += clen;
+       ENG->cert_len -= clen;
+       T0_PUSH(clen);
+}
+
+\ Write a Certificate message. Total chain length (excluding the 3-byte
+\ header) is returned; it is 0 if the chain is empty.
+: write-Certificate ( -- total_chain_len )
+       11 write8
+       total-chain-length dup
+       dup 3 + write24 write24
+       begin
+               begin-cert
+               dup 0< if drop ret then write24
+               begin copy-cert-chunk dup while
+                       addr-pad swap write-blob
+               repeat
+               drop
+       again ;
+
+cc: x509-start-chain ( by_client -- ) {
+       const br_x509_class *xc;
+       uint32_t bc;
+
+       bc = T0_POP();
+       xc = *(ENG->x509ctx);
+       xc->start_chain(ENG->x509ctx, bc ? ENG->server_name : NULL);
+}
+
+cc: x509-start-cert ( length -- ) {
+       const br_x509_class *xc;
+
+       xc = *(ENG->x509ctx);
+       xc->start_cert(ENG->x509ctx, T0_POP());
+}
+
+cc: x509-append ( length -- ) {
+       const br_x509_class *xc;
+       size_t len;
+
+       xc = *(ENG->x509ctx);
+       len = T0_POP();
+       xc->append(ENG->x509ctx, ENG->pad, len);
+}
+
+cc: x509-end-cert ( -- ) {
+       const br_x509_class *xc;
+
+       xc = *(ENG->x509ctx);
+       xc->end_cert(ENG->x509ctx);
+}
+
+cc: x509-end-chain ( -- err ) {
+       const br_x509_class *xc;
+
+       xc = *(ENG->x509ctx);
+       T0_PUSH(xc->end_chain(ENG->x509ctx));
+}
+
+cc: get-key-type-usages ( -- key-type-usages ) {
+       const br_x509_class *xc;
+       const br_x509_pkey *pk;
+       unsigned usages;
+
+       xc = *(ENG->x509ctx);
+       pk = xc->get_pkey(ENG->x509ctx, &usages);
+       if (pk == NULL) {
+               T0_PUSH(0);
+       } else {
+               T0_PUSH(pk->key_type | usages);
+       }
+}
+
+\ Read a Certificate message.
+\ Parameter: non-zero if this is a read by the client of a certificate
+\ sent by the server; zero otherwise.
+\ Returned value:
+\   - Empty: 0
+\   - Valid: combination of key type and allowed key usages.
+\   - Invalid: negative (-x for error code x)
+: read-Certificate ( by_client -- key-type-usages )
+       \ Get header, and check message type.
+       read-handshake-header 11 = ifnot ERR_UNEXPECTED fail then
+
+       \ If the chain is empty, do some special processing.
+       dup 3 = if
+               read24 if ERR_BAD_PARAM fail then
+               swap drop ret
+       then
+
+       \ Start processing the chain through the X.509 engine.
+       swap x509-start-chain
+
+       \ Total chain length is a 24-bit integer.
+       read24 open-elt
+       begin
+               dup while
+               read24 open-elt
+               dup x509-start-cert
+
+               \ We read the certificate by chunks through the pad, so
+               \ as to use the existing reading function (read-blob)
+               \ that also ensures proper hashing.
+               begin
+                       dup while
+                       dup 256 > if 256 else dup then { len }
+                       addr-pad len read-blob
+                       len x509-append
+               repeat
+               close-elt
+               x509-end-cert
+       repeat
+
+       \ We must close the chain AND the handshake message.
+       close-elt
+       close-elt
+
+       \ Chain processing is finished; get the error code.
+       x509-end-chain
+       dup if neg ret then drop
+
+       \ Return key type and usages.
+       get-key-type-usages ;
+
+\ =======================================================================
+
+\ Copy a specific protocol name from the list to the pad. The byte
+\ length is returned.
+cc: copy-protocol-name ( idx -- len ) {
+       size_t idx = T0_POP();
+       size_t len = strlen(ENG->protocol_names[idx]);
+       memcpy(ENG->pad, ENG->protocol_names[idx], len);
+       T0_PUSH(len);
+}
+
+\ Compare name in pad with the configured list of protocol names.
+\ If a match is found, then the index is returned; otherwise, -1
+\ is returned.
+cc: test-protocol-name ( len -- n ) {
+       size_t len = T0_POP();
+       size_t u;
+
+       for (u = 0; u < ENG->protocol_names_num; u ++) {
+               const char *name;
+
+               name = ENG->protocol_names[u];
+               if (len == strlen(name) && memcmp(ENG->pad, name, len) == 0) {
+                       T0_PUSH(u);
+                       T0_RET();
+               }
+       }
+       T0_PUSHi(-1);
+}