(**************************************************************************)
(*                                                                        *)
(*  TLS module                                                            *)
(*  Copyright (C) 2025   Peter Moylan                                     *)
(*                                                                        *)
(*  This program is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation, either version 3 of the License, or     *)
(*  (at your option) any later version.                                   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful,       *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(*  GNU General Public License for more details.                          *)
(*                                                                        *)
(*  You should have received a copy of the GNU General Public License     *)
(*  along with this program.  If not, see <http://www.gnu.org/licenses/>. *)
(*                                                                        *)
(*  To contact author:   http://www.pmoylan.org   peter@pmoylan.org       *)
(*                                                                        *)
(**************************************************************************)

IMPLEMENTATION MODULE TLSCipherSuites;

        (********************************************************)
        (*                                                      *)
        (*  Interface between TLS and the encryption algorithms *)
        (*                                                      *)
        (*  Programmer:         P. Moylan                       *)
        (*  Started:            27 August 2018                  *)
        (*  Last edited:        13 May 2025                     *)
        (*  Status:             OK                              *)
        (*                                                      *)
        (********************************************************)

FROM SYSTEM IMPORT CARD8, ADR;

IMPORT Strings;

FROM TLSRecord IMPORT
    (* type *)  RLState,
    (* proc *)  SetCipher;

FROM TLSCrypt IMPORT
    (* type *)  BulkCipherAlgorithm,
    (* proc *)  KeyLength, FixedIVLength;

FROM TLSHMAC IMPORT
    (* type *)  HMACType,
    (* proc *)  HMAClength;

FROM LowLevel IMPORT
    (* proc *)  Copy;

(************************************************************************)

TYPE
    (*BulkCipherAlgorithm = (nocipher, rc4_128, tripledes, aes128, aes256);*)
    PRFAlgorithm = (tls_prf_sha256);
    KeyExchangeAlgorithm = (nullkeyx, RSA);

    (* See RFC 5246, Appendix C, for how these decompose into three     *)
    (* critical properties: key exchange, bulk cipher, and MAC.  There  *)
    (* is obviously extensive use of suites that are not mentioned in   *)
    (* RFC 5246, and for those I am relying on web sources.             *)

    PropertyRecord =
            RECORD
                supported       : BOOLEAN;
                UsesKeyExchange : BOOLEAN;
                code1, code2    : CARD8;
                keyx            : KeyExchangeAlgorithm;
                cipher          : BulkCipherAlgorithm;
                mac             : HMACType;
            END (*RECORD*);

    PropertyList = ARRAY CipherSuite OF PropertyRecord;

    (* Reminder of CipherSuite definition from CipherSuites.def.  Their *)
    (* properties are set in procedure SetSuiteProperties.              *)
    (*
    CipherSuite = (TLS_NULL_WITH_NULL_NULL,
                   TLS_RSA_WITH_NULL_MD5,
                   TLS_RSA_WITH_NULL_SHA,
                   TLS_RSA_WITH_NULL_SHA256,
                   TLS_RSA_WITH_RC4_128_MD5,
                   TLS_RSA_WITH_RC4_128_SHA,
                   TLS_RSA_WITH_3DES_EDE_CBC_SHA,
                   TLS_RSA_WITH_AES_128_CBC_SHA,
                   TLS_RSA_WITH_AES_256_CBC_SHA,
                   TLS_RSA_WITH_AES_128_CBC_SHA256,
                   TLS_RSA_WITH_AES_256_CBC_SHA256
                   );
    *)

    (* The list of suites I get from OS/2 Firefox, in preference order, is
        00 1E       TLS_KRB5_WITH_DES_CBC_SHA (not implemented)
        C0 2B       TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 (not implemented)
        C0 2F       TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256 (not implemented)
        C0 0A       TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA (not implemented)
        C0 09       TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA (not implemented)
        C0 13       TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA (not implemented)
        C0 14       TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA (not implemented)
        C0 07       TLS_ECDHE_ECDSA_WITH_RC4_128_SHA (not implemented)
        C0 11       TLS_ECDHE_RSA_WITH_RC4_128_SHA (not implemented)
        00 33       TLS_DHE_RSA_WITH_AES_128_CBC_SHA (not implemented)
        00 39       TLS_DHE_RSA_WITH_AES_256_CBC_SHA (not implemented)
        00 2F       TLS_RSA_WITH_AES_128_CBC_SHA (done)
        00 35       TLS_RSA_WITH_AES_256_CBC_SHA (done)
        00 0A       TLS_RSA_WITH_3DES_EDE_CBC_SHA (done)

    Clearly there is a disconnect between what I have implemented and
    what Firefox prefers.  To be compatible, I need to do one or more
    of the following:
      - implement the CBC version of AES - DONE;
      - implement RC4 - DONE;
      - look into ECDHE - probably hard, but worth a look.
      - implement 3DES - DONE.
    *)

VAR
    Property: ARRAY CipherSuite OF PropertyRecord;

(************************************************************************)
(*    TRANSLATING BETWEEN DIFFERENT REPRESENTATIONS OF A CipherSuite    *)
(************************************************************************)

PROCEDURE NameOfSuite (s: CipherSuite;  VAR (*OUT*) name: ARRAY OF CHAR);

    (* Returns name as the name of ciphersuite s. *)

    TYPE SNtype = ARRAY CipherSuite OF ARRAY [0..32] OF CHAR;

    CONST
        SuiteName = SNtype {"TLS_NULL_WITH_NULL_NULL",
                            "TLS_RSA_WITH_NULL_MD5",
                            "TLS_RSA_WITH_NULL_SHA",
                            "TLS_RSA_WITH_NULL_SHA256",
                            "TLS_RSA_WITH_RC4_128_MD5",
                            "TLS_RSA_WITH_RC4_128_SHA",
                            "TLS_RSA_WITH_3DES_EDE_CBC_SHA",
                            "TLS_RSA_WITH_AES_128_CBC_SHA",
                            "TLS_RSA_WITH_AES_256_CBC_SHA",
                            "TLS_RSA_WITH_AES_128_CBC_SHA256",
                            "TLS_RSA_WITH_AES_256_CBC_SHA256"
                            };

    BEGIN
        Strings.Assign (SuiteName[s], name);
    END NameOfSuite;

(************************************************************************)

PROCEDURE CodeToCipherSuite (code1, code2: CARD8): CipherSuite;

    (* Translates two-byte code to a CipherSuite. *)

    VAR j: CipherSuite;

    BEGIN
        j := NullSuite;
        WHILE j < MAX(CipherSuite) DO
            INC (j);
            IF (Property[j].code1 = code1)
                    AND (Property[j].code2 = code2) THEN
                RETURN j;
            END (*IF*);
        END (*LOOP*);
        RETURN NullSuite;
    END CodeToCipherSuite;

(************************************************************************)

PROCEDURE CipherSuiteToCode (s: CipherSuite;  VAR (*OUT*) code1, code2: CARD8);

    (* Returns the two-byte code for s. *)

    BEGIN
        code1 := Property[s].code1;
        code2 := Property[s].code2;
    END CipherSuiteToCode;

(************************************************************************)
(*                       ACCEPTING A CIPHER SUITE                       *)
(************************************************************************)

PROCEDURE SuiteEnabled (suite: CipherSuite): BOOLEAN;

    (* Returns TRUE iff we support this cipher suite. *)

    BEGIN
        RETURN Property[suite].supported;
    END SuiteEnabled;

(************************************************************************)

PROCEDURE AcceptCipherSuite (code1, code2: CARD8): CipherSuite;

    (* Returns result <> NullSuite iff we support this cipher suite. *)

    VAR suite: CipherSuite;

    BEGIN
        suite := CodeToCipherSuite (code1, code2);
        IF Property[suite].supported THEN
            RETURN suite;
        ELSE
            RETURN NullSuite;
        END (*IF*);
    END AcceptCipherSuite;

(************************************************************************)
(*                     PROPERTIES OF A CIPHER SUITE                     *)
(************************************************************************)

PROCEDURE ServerKeyExchangeNeeded (cs: CipherSuite): BOOLEAN;

    (* Returns TRUE if the initial negotiation requires a key exchange  *)
    (* step.                                                            *)
    (* I need to update my information about this.                      *)

    BEGIN
        RETURN Property[cs].UsesKeyExchange;
    END ServerKeyExchangeNeeded;

(************************************************************************)
(*                     COMMITTING A CIPHER SUITE                        *)
(************************************************************************)

PROCEDURE KeyBlockSize (cs: CipherSuite): CARDINAL;

    (* Works out how much key material has to be generated. *)

    VAR cipher: BulkCipherAlgorithm;
        mac: HMACType;
        cipherkeylength, mackeylength, ivlength: CARDINAL;

    BEGIN
        cipher := Property[cs].cipher;
        mac := Property[cs].mac;
        cipherkeylength := KeyLength (cipher);
        mackeylength := HMAClength (mac);
        ivlength := FixedIVLength (cipher);

        RETURN 2*(mackeylength + cipherkeylength + ivlength);

    END KeyBlockSize;

(************************************************************************)

PROCEDURE Commit (sess: RLState;  cs: CipherSuite;  server_write: BOOLEAN;
                                    truncate_MAC: BOOLEAN;
                                    VAR (*IN*) key_block: ARRAY OF CARD8);

    (* The caller has alread calculated the key_block, which has content *)
    (*      client_write_MAC_key[SecurityParameters.mac_key_length]     *)
    (*      server_write_MAC_key[SecurityParameters.mac_key_length]     *)
    (*      client_write_key[SecurityParameters.enc_key_length]         *)
    (*      server_write_key[SecurityParameters.enc_key_length]         *)
    (*      client_write_IV[SecurityParameters.fixed_iv_length]         *)
    (*      server_write_IV[SecurityParameters.fixed_iv_length]         *)
    (* Unused values are empty. We use these data to set the MAC, key,  *)
    (* and IV parameters to the relevant session.                       *)

    (* The longest MAC (so far) is 64 bytes, the longest key is 24      *)
    (* bytes, and the longest IV is 16 bytes. However, let's be careful *)
    (* and allow 256 bytes for each.                                    *)

    (* In RFC 5246, Appendix C, the MAC key length is specified to be   *)
    (* the same as the MAC length. For now I'll assume that this will   *)
    (* continue to be the case for new MAC algorithms.                  *)

    (* Note: the IV mentioned below is the one used only by AEAD        *)
    (* ciphers.  The IV used by block ciphers is not calculated here,   *)
    (* because it has to change with every transmission.                *)

    TYPE section = (mack, ck, ivk);

    VAR cipher: BulkCipherAlgorithm;
        mac: HMACType;
        cipherkeylength, mackeylength, ivlength, j: CARDINAL;
        start: ARRAY section OF CARDINAL;
        gdata: ARRAY section OF ARRAY [0..255] OF CARD8;

    BEGIN
        cipher := Property[cs].cipher;
        mac := Property[cs].mac;
        cipherkeylength := KeyLength (cipher);
        mackeylength := HMAClength (mac);
        ivlength := FixedIVLength (cipher);

        (* Separate out the three relevant subarrays. *)

        IF server_write THEN
            start[mack] := mackeylength;
            start[ck]   := 2*mackeylength + cipherkeylength;
            start[ivk]  := 2*(mackeylength + cipherkeylength) + ivlength;
        ELSE
            start[mack] := 0;
            start[ck]   := 2*mackeylength;
            start[ivk]  := 2*(mackeylength + cipherkeylength);
        END (*F*);

        IF mackeylength > 0 THEN
            j := start[mack];
            Copy (ADR(key_block[j]), ADR(gdata[mack]), mackeylength);
        END (*IF*);
        IF cipherkeylength > 0 THEN
            j := start[ck];
            Copy (ADR(key_block[j]), ADR(gdata[ck]), cipherkeylength);
        END (*IF*);
        IF ivlength > 0 THEN
            j := start[ivk];
            Copy (ADR(key_block[j]), ADR(gdata[ivk]), ivlength);
        END (*IF*);

        SetCipher (sess, server_write, truncate_MAC, cipher, mac,
                     gdata[mack], mackeylength,
                        gdata[ck], cipherkeylength, gdata[ivk], ivlength);

    END Commit;

(************************************************************************)
(*                        MODULE INITIALISATION                         *)
(************************************************************************)

PROCEDURE SetSuiteProperties;

    (* Sets the properties of each suite.  Doing it this way is safer   *)
    (* than just declaring a big constant array; we are not assuming a  *)
    (* fixed order of the suites, so the method can't be broken by      *)
    (* adding or removing suites.                                       *)

    CONST allownocipher = FALSE;  allow3DES = TRUE;  allowAES = TRUE;
          allowsha256 = TRUE;

    VAR cs: CipherSuite;

    BEGIN
        FOR cs := MIN(CipherSuite) TO MAX(CipherSuite) DO
            CASE cs OF
              | TLS_NULL_WITH_NULL_NULL:
                    Property[cs] := PropertyRecord {FALSE,  FALSE, 0, 0, nullkeyx, nocipher, nullhmac};
              | TLS_RSA_WITH_NULL_MD5:
                    Property[cs] := PropertyRecord {allownocipher, FALSE, 0, 1, RSA, nocipher, hmacmd5};
              | TLS_RSA_WITH_NULL_SHA:
                    Property[cs] := PropertyRecord{allownocipher, FALSE, 0, 2, RSA, nocipher, hmacsha1};
              | TLS_RSA_WITH_NULL_SHA256:
                    Property[cs] := PropertyRecord{allownocipher AND allowsha256, FALSE, 0, 3BH, RSA, nocipher, hmacsha256};
              | TLS_RSA_WITH_RC4_128_MD5:
                    Property[cs] := PropertyRecord{TRUE, FALSE, 0, 4, RSA, rc4_128, hmacmd5};
              | TLS_RSA_WITH_RC4_128_SHA:
                    Property[cs] := PropertyRecord{TRUE, FALSE, 0, 5, RSA, rc4_128, hmacsha1};
              | TLS_RSA_WITH_3DES_EDE_CBC_SHA:
                    Property[cs] := PropertyRecord{allow3DES,  FALSE, 0, 0AH, RSA, tripledes_cbc, hmacsha1};
              | TLS_RSA_WITH_AES_128_CBC_SHA:
                    Property[cs] := PropertyRecord{allowAES,  FALSE, 0, 2FH, RSA, aes128_cbc, hmacsha1};
              | TLS_RSA_WITH_AES_256_CBC_SHA:
                    Property[cs] := PropertyRecord {allowAES, FALSE, 0, 35H, RSA, aes256_cbc, hmacsha1};
              | TLS_RSA_WITH_AES_128_CBC_SHA256:
                    Property[cs] := PropertyRecord{allowAES AND allowsha256, FALSE, 0, 3CH, RSA, aes128_cbc, hmacsha256};
              | TLS_RSA_WITH_AES_256_CBC_SHA256:
                    Property[cs] := PropertyRecord{allowAES AND allowsha256, FALSE, 0, 3DH, RSA, aes256_cbc, hmacsha256};
            END (*CASE*);
        END (*FOR*);
    END SetSuiteProperties;

(************************************************************************)

BEGIN
    SetSuiteProperties;
END TLSCipherSuites.

