(**************************************************************************)
(*                                                                        *)
(*  Transport Layer Security                                              *)
(*  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 TLSCertificates;

        (********************************************************)
        (*                                                      *)
        (*                   TLS certificates                   *)
        (*      For now I'm handling only RSA certificates      *)
        (*           Also handles domain private keys           *)
        (*                                                      *)
        (*  Programmer:         P. Moylan                       *)
        (*  Started:            5 September 2018                *)
        (*  Last edited:        26 July 2025                    *)
        (*  Status:             Under revision                  *)
        (*                                                      *)
        (********************************************************)


FROM SYSTEM IMPORT LOC, CARD8, ADR, CAST;

FROM STextIO IMPORT
    (* proc *)  WriteString, WriteLn;

FROM ASN1 IMPORT
    (* proc *)  ExtractParts, INTEGERtoBN, BitStringToBN, GetObjID;

IMPORT Strings, BigNum, TLSsessID, Names;

FROM Names IMPORT
    (* type *)  DomainName;

FROM Domains IMPORT
    (* type *)  Domain,
    (* proc *)  NameOfDomain;

FROM INIData IMPORT
    (* type *)  HINI, StringReadState,
    (* proc *)  ChooseDefaultINI, OpenINIFile, INIValid, CloseINIFile,
                INIGetString, GetStringList, NextString, CloseStringList;

FROM VarStrings IMPORT
    (* type *)  ByteStr, ByteStringPtr,
    (* proc *)  MakeBS, BSExpand, TrimBS;

FROM TLSBase IMPORT
    (* proc *)  NYI, Get3Bytes, Put3Bytes, Checksize, AppendHexString;

FROM BigNum IMPORT
    (* type *)  BN;

FROM RSAKeys IMPORT
    (* type *)  RSAKeyType,
    (* proc *)  InitKey, IsNilKey;

FROM TLSRSA IMPORT
    (* proc*)   LoadRSAPrivateKey;

FROM MiscFuncs IMPORT
    (* proc *)  StringMatch, AppendCard;

FROM WildCard IMPORT
    (* proc *)  WildMatch;

FROM Base64 IMPORT
    (* proc *)  Decode, DecodePart;

FROM FileOps IMPORT
    (* const*)  NoSuchChannel,
    (* type *)  ChanId, FilenameString,
    (* proc *)  OpenOldFile, OpenNewFile, CloseFile, ReadRaw, WriteRaw, ReadLine,
                Exists, DeleteFile, MoveFile;

FROM TransLog IMPORT
    (* type *)  TransactionLogID,
    (* proc *)  LogTransaction;

FROM TaskControl IMPORT
    (* type *)  Lock,
    (* proc *)  CreateLock, DestroyLock, Obtain, Release;

FROM LowLevel IMPORT
    (* proc *)  EVAL, Copy, AddOffset;

FROM Storage IMPORT
    (* proc *)  ALLOCATE, DEALLOCATE;

(************************************************************************)
(* In this module we represent a certificate or a certificate chain by  *)
(* a byte string and the length of that string.  The first ten bytes    *)
(* are overhead, as follows:                                            *)
(*      (a) first 4 bytes   reserved for handshake header               *)
(*      (b) next 3 bytes    total remaining length                      *)
(*      (c) next 3 bytes    length of the certificate itself            *)
(************************************************************************)

CONST
    Nul = CHR(0);  CR = CHR(13);  LF = CHR(10);  CtrlZ = CHR(26);
    LogCertificateData = FALSE;

(* From RFC 3280, page 15.  The X.509 v3 certificate basic syntax is as *)
(* follows. For signature calculation, the data that is to be signed is *)
(* encoded using the ASN.1 distinguished encoding rules (DER) [X.690].  *)
(* ASN.1 DER encoding is a tag, length, value encoding system for each  *)
(* element.                                                             *)

(*
    Certificate ::= SEQUENCE {
                             tbsCertificate: TBSCertificate,
                             signatureAlgorithm: AlgorithmIdentifier,
                             signatureValue: BIT STRING }
    TBSCertificate ::= SEQUENCE {
                                version: [0] EXPLICIT Version DEFAULT v1,
                                serialNumber: CertificateSerialNumber,
                                signature : AlgorithmIdentifier,
                                issuer: Name,
                                validity: Validity,
                                subject: Name,
                                subjectPublicKeyInfo: SubjectPublicKeyInfo,
                                issuerUniqueID: [1] IMPLICIT UniqueIdentifier OPTIONAL,
                                -- If present, version MUST be v2 or v3
                                subjectUniqueID: [2] IMPLICIT UniqueIdentifier OPTIONAL,
                                -- If present, version MUST be v2 or v3
                                extensions: [3] EXPLICIT Extensions OPTIONAL
                                -- If present, version MUST be v3
                                }
    Version ::= INTEGER {v1(0), v2(1), v3(2)}
    CertificateSerialNumber ::= INTEGER
    Validity ::= SEQUENCE {
                          notBefore: Time,
                          notAfter: Time }
    Time ::= CHOICE {
                    utcTime: UTCTime,
                    generalTime: GeneralizedTime }
    UniqueIdentifier ::= BIT STRING
    SubjectPublicKeyInfo ::= SEQUENCE {
                                      algorithm: AlgorithmIdentifier,
                                      subjectPublicKey: BIT STRING }
    Extensions ::= SEQUENCE SIZE (1..MAX) OF Extension
    Extension ::= SEQUENCE {
                           extnID: OBJECT IDENTIFIER,
                           critical: BOOLEAN DEFAULT FALSE,
                           extnValue: OCTET STRING
                           }
*)

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

CONST NilDomain = CAST(Domain, NIL);

(************************************************************************)
(*                        THE CERTIFICATE CACHE                         *)
(************************************************************************)

TYPE
    (* A CertList is the chain of certificates for one domain. *)

    CertList = POINTER TO
                    RECORD
                        next: CertList;
                        cert: FilenameString;
                    END (*RECORD*);

    (* Here we have a list of CertLists for all domains. *)

    DomainPtr = POINTER TO DomainData;
    DomainList = DomainPtr;

    DomainData = RECORD
                     next: DomainPtr;
                     this: CertList;
                     D: Domain;
                     privkey: RSAKeyType;
                 END (*RECORD*);

VAR cache: DomainList;

    (* Critical section protection for operations on the above lists.   *)

    ListLock: Lock;

    (* A flag that lets us use just one global domain, with value NIL.  *)

    SingleCertificateMode: BOOLEAN;

    (* Our INI file name. *)

    ININame: ARRAY [0..31] OF CHAR;

(************************************************************************)
(*                OPERATIONS ON OUR CACHE OF DOMAIN DATA                *)
(************************************************************************)

PROCEDURE CachePos (D: Domain): DomainPtr;

    (* Returns a pointer to this domain's record in the cache, or NIL   *)
    (* if the domain data have not yet been initialised.  Assumption:   *)
    (* the caller has exclusive access to the lists.                    *)

    VAR p: DomainList;

    BEGIN
        p := cache;
        WHILE (p <> NIL) AND (D <> p^.D) DO
            p := p^.next;
        END (*WHILE*);
        RETURN p;
    END CachePos;

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

PROCEDURE CertificateList (D: Domain): CertList;

    (* Returns the certificate list for this domain, or NIL if the      *)
    (* domain data have not yet been initialised.  Assumption: the      *)
    (* caller has exclusive access to the lists.                        *)

    VAR p: DomainList;

    BEGIN
        p := CachePos (D);
        IF p = NIL THEN
            RETURN NIL;
        ELSE
            RETURN p^.this;
        END (*IF*);
    END CertificateList;

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

PROCEDURE AddCacheRecord (D: Domain): DomainList;

    (* Adds a new record to the master list.  It doesn't matter where   *)
    (* it goes, and adding at the beginning is easiest.                 *)

    VAR p: DomainList;

    BEGIN
        NEW (p);
        p^.next := cache;
        p^.this := NIL;
        p^.D := D;
        p^.privkey := InitKey();
        cache := p;
        RETURN p;
     END AddCacheRecord;

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

PROCEDURE FindCacheRecord (D: Domain): DomainList;

    (* Adds a new record to the master list, unless it is already       *)
    (* there, and returns a pointer to it.                              *)

    VAR p: DomainList;

    BEGIN
        p := CachePos (D);
        IF p = NIL THEN
            p := AddCacheRecord (D);
        END (*IF*);
        RETURN p;
     END FindCacheRecord;

(************************************************************************)
(*                               OBJECT ID                              *)
(************************************************************************)

TYPE ID7 = ARRAY [0..6] OF CARDINAL;

CONST sha256_RSA = ID7 {1, 2, 840, 113549, 1, 1, 11};

(************************************************************************)
(*                       RECEIVING A CERTIFICATE                        *)
(************************************************************************)

PROCEDURE AcceptCertificate (logID: TransactionLogID;
                        pdata: ByteStringPtr;  offset: CARDINAL;
                        VAR (*OUT*) RSAKey: RSAKeyType);

    (* Accepts a certificate sent by the peer.  Returns the public key. *)

    CONST BNbufsize = 600;

    VAR message: ARRAY [0..800] OF CHAR;
        BNbuf: ARRAY [0..BNbufsize-1] OF CHAR;
        keybuff: ARRAY [0..4095] OF CARD8;
        part: ARRAY [0..31] OF ByteStr;
        pcert, pk: ByteStringPtr;
        j, N, length: CARDINAL;
        V, exponent, modulus: BN;
        values: ARRAY [0..15] OF CARDINAL;

    BEGIN
        length := Get3Bytes (pdata^, offset);
        IF LogCertificateData THEN
            message := "Length of certificate is ";
            AppendCard (length, message);
            LogTransaction (logID, message);
        END (*KF*);

        (*
        message := "First few bytes of the certificate are ";
        AppendHexString (pdata^, offset, 16, TRUE, message);
        LogTransaction (logID, message);
        *)
        pcert := AddOffset (pdata, offset);
        EVAL (ExtractParts (pcert^, part));

        (* There should be three parts. For testing, dump those 3 parts.*)

        (*
        IF N = 3 THEN
            FOR j := 0 TO N-1 DO
                DumpASN (j+1, part[j].size, part[j].data);
            END (*FOR*);
        ELSE
            message := "certificate has ";
            AppendCard (N, message);
            Strings.Append (" parts.", message);
            LogTransaction (logID, message);
        END (*IF*);
        *)

        (* Part 2 is signature value. *)

        (*
        message := "Signature is ";
        V := BitStringToBN (part[2].val^, 0);
        BigNum.ToHex (V, BNbuf, BNbufsize);
        Strings.Append (BNbuf, message);
        LogTransaction (logID, message);
        *)

        (* Part 0 is the certificate itself.  Break that into parts.  *)

        N := ExtractParts (part[0].data^, part);
        IF LogCertificateData THEN
            message := "Body of certificate has ";
            AppendCard (N, message);
            Strings.Append (" parts.", message);
            LogTransaction (logID, message);
        END (*IF*);

        (* For now I'm only interested in part 6, which is the public   *)
        (* key.  It has further substructure, as shown below.           *)

        EVAL (ExtractParts (part[6].data^, part));
        pk := part[1].data;         (* Save part 1 for later. *)

        (* part[0] contains the object identifier for the encryption    *)
        (* method.  For now I'm assuming RSA encryption, whose object   *)
        (* ID is {1 2 840 113549 1 1 1}.  In a future version I'll have *)
        (* to check this.                                               *)

        EVAL (ExtractParts (part[0].data^, part));
        N := GetObjID (part[0].data^, 0, values);
        IF LogCertificateData THEN
            message := "Encryption = ";
            IF N = 0 THEN
                Strings.Append ("<missing>", message);
            ELSE
                Strings.Append ("{", message);
                FOR j := 0 TO N-1 DO
                    IF j > 0 THEN
                        Strings.Append (" ", message);
                    END (*IF*);
                    AppendCard (values[j], message);
                END (*FOR*);
                Strings.Append ("}", message);
            END (*IF*);
            LogTransaction (logID, message);
        END (*IF*);

        (* pk^ is the public key, which is itself an ASN.1 sequence of  *)
        (* modulus and exponent.  So we have one extra step of ASN.1    *)
        (* decoding.                                                    *)

        V := BitStringToBN (pk^, 0);
        (*
        message := "Public key = ";
        BigNum.ToHex (V, BNbuf, BNbufsize);
        Strings.Append (BNbuf, message);
        LogTransaction (logID, message);
        *)

        EVAL (BigNum.BNtoBytes (V, keybuff));
        EVAL (ExtractParts (keybuff, part));

        modulus := INTEGERtoBN (part[0].data^, 0);
        (*
        message := "Public key modulus = ";
        BigNum.ToHex (modulus, BNbuf, BNbufsize);
        Strings.Append (BNbuf, message);
        LogTransaction (logID, message);
        *)
        exponent := INTEGERtoBN (part[1].data^, 0);
        IF LogCertificateData THEN
            message := "Public key exponent = ";
            BigNum.ToHex (exponent, BNbuf, BNbufsize);
            Strings.Append (BNbuf, message);
            LogTransaction (logID, message);
        END (*IF*);

        RSAKey         := InitKey();
        RSAKey.n       := modulus;
        RSAKey.public  := exponent;

    END AcceptCertificate;

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

PROCEDURE AcceptCertificates (logID: TransactionLogID;
                        pdata: ByteStringPtr;  offset: CARDINAL;
                        VAR (*OUT*) key: RSAKeyType): BOOLEAN;

    (* Accepts a chain of certificates sent by the peer.  (But, in this *)
    (* version, we only look at the first one.)  The returned key       *)
    (* parameter is the public key.  It is the caller's responsibility  *)
    (* to deallocate pdata^.                                            *)

    BEGIN
        (* Read tatal length, but ignore it. *)
        EVAL (Get3Bytes (pdata^, offset));
        AcceptCertificate (logID, pdata, offset, key);
        RETURN TRUE;
    END AcceptCertificates;

(************************************************************************)
(*              PREPARING OUR CERTIFICATES FOR TRANSMISSION             *)
(************************************************************************)

PROCEDURE AssembleOneCertificate (ID: TransactionLogID;
                                    VAR (*IN*) filename: ARRAY OF CHAR;
                                    VAR (*INOUT*) result: ByteStr;
                                    VAR (*INOUT*) pos: CARDINAL): CARDINAL;

    (* At position data^[pos] of the result string, stores a            *)
    (* three-byte length followed by the file content, and updates pos. *)
    (* Expands result if necessary.  Returns length = file size + 3.    *)
    (* If the certificate does not exist, or cannot be read, we store   *)
    (* a three-byte length=0 and no following data.                     *)

    CONST binary = TRUE;
        linesize = 1500;

    VAR cid: ChanId;
        nread, length, pos0: CARDINAL;
        q: ByteStringPtr;
        line: ARRAY [0..linesize-1] OF CHAR;
        message: ARRAY [0..255] OF CHAR;

    BEGIN
        pos0 := pos;
        BSExpand (result, 3);
        INC (result.size, 3);
        INC (pos, 3);
        length := 0;

        cid := OpenOldFile (filename, FALSE, binary);
        REPEAT
            ReadRaw (cid, line, linesize, nread);
            IF nread > 0 THEN
                BSExpand (result, nread);
                Copy (ADR(line), ADR(result.data^[pos]), nread);
                INC (result.size, nread);
                INC (length, nread);
                INC (pos, nread);
            END (*IF*);
        UNTIL nread = 0;
        CloseFile (cid);
        q := ADR(result.data^[pos0]);
        Put3Bytes (q^, length);

        message := "Assembled certificate ";  Strings.Append (filename, message);
        Strings.Append (", length ", message);  AppendCard (length, message);
        LogTransaction (ID, message);

        INC (length, 3);

        RETURN length;

    END AssembleOneCertificate;

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

PROCEDURE CollectChain (chain: CertList;  ID: TransactionLogID): ByteStr;

    (* Collects all the certificates on the list to be sent to the peer.*)

    VAR q: ByteStringPtr;
        result: ByteStr;
        length, pos: CARDINAL;

    BEGIN
        length := 0;
        MakeBS (result, 7);
        pos := 7;
        Obtain (ListLock);
        WHILE chain <> NIL DO
            INC (length, AssembleOneCertificate (ID, chain^.cert, result, pos));
            chain := chain^.next;
        END (*WHILE*);
        Release (ListLock);

        q := ADR (result.data^[4]);
        Put3Bytes (q^, length);
        TrimBS (result);
        RETURN result;

    END CollectChain;

(************************************************************************)
(*                     COLLECTING THE CERTIFICATE NAMES                 *)
(************************************************************************)

PROCEDURE AddToTail (VAR (*INOUT*) chain, tail: CertList;
                                VAR (*IN*) name: ARRAY OF CHAR);

    (* Adds this name to the end of the chain.  *)

    VAR p: CertList;

    BEGIN
        NEW (p);
        p^.next := NIL;
        Strings.Assign (name, p^.cert);
        IF chain = NIL THEN
            chain := p;
        ELSE
            tail^.next := p;
        END (*IF*);
        tail := p;
    END AddToTail;

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

PROCEDURE ProcessPEMFile (cid: ChanId;  VAR (*INOUT*) chain, tail: CertList;
                                        VAR (*IN*) file: ARRAY OF CHAR);

    (* Normally adds one file to the tail of the list, but with some    *)
    (* extra possibilities: sometimes a file can contain more than one  *)
    (* certificate, and when we find a PEM-format certificate we        *)
    (* replace it with the ASN.1 binary equivalent.                     *)

    VAR subname: ARRAY [0..3] OF CHAR;

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

    PROCEDURE Incrementsubname (N: CARDINAL);

        (* Increments the number in subname, starting at character N. *)

        BEGIN
            IF subname[0] = Nul THEN
                subname := ".001";
            ELSE
                IF N = 0 THEN N := 3 END(*IF*);
                IF subname[N] < '9' THEN
                    INC (subname[N]);
                ELSE
                    subname[N] := '0';
                    IF N = 1 THEN
                        Incrementsubname (3);
                    ELSE
                        Incrementsubname (N-1);
                    END (*IF*);
                END (*IF*);
            END (*IF*);
        END Incrementsubname;

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

    TYPE CharSet = SET OF CHAR;

    CONST B64chars = CharSet {'A'..'Z','a'..'z','0'..'9','+','/'};

    CONST BinBufSize = 32768;

    VAR found: BOOLEAN;
        pos, amount, total: CARDINAL;
        outcid: ChanId;
        basename, binfile, BAKname: FilenameString;
        excess: ARRAY [0..3] OF CHAR;
        binbuf: ARRAY [0..BinBufSize-1] OF CARD8;
        line: ARRAY [0..511] OF CHAR;

    BEGIN
        Strings.Assign (file, basename);
        Strings.FindPrev ('.', basename, LENGTH(basename) - 1, found, pos);
        IF found THEN
            basename[pos] := CHR(0);
        END (*IF*);
        subname := ".001";
        ReadLine  (cid, line);

        (* Outer loop is to allow for more than one certificate in  *)
        (* a single file.                                           *)

        WHILE line[0] = '-' DO
            (* Skip over the BEGIN line(s). *)

            WHILE line[0] = '-' DO
                ReadLine (cid, line);
            END (*WHILE*);

            (* Translate one long B64 string. *)

            excess := "";  pos := 0;  total := 0;
            WHILE line[0] IN B64chars DO
                amount := DecodePart (line, excess, binbuf, pos);
                INC (total, amount);
                ReadLine (cid, line);
            END (*WHILE*);

            IF total > 0 THEN
                (* Create a new file name. *)

                binfile := basename;
                IF subname[0] <> Nul THEN
                    Strings.Append (subname, binfile);
                END (*IF*);
                BAKname := binfile;
                Strings.Append (".BAK", BAKname);
                Strings.Append (".bin", binfile);
                DeleteFile (BAKname);
                IF Exists (binfile) THEN
                    EVAL (MoveFile (binfile, BAKname));
                END (*IF*);

                (* Write out the binary file. *)

                outcid := OpenNewFile (binfile, TRUE);
                WriteRaw (outcid, binbuf, total);
                CloseFile (outcid);
                AddToTail (chain, tail, binfile);
                Incrementsubname (3);

            END (*IF*);

            (* Skip over the END line(s) and empty line(s). *)

            WHILE line[0] = '-' DO
                ReadLine (cid, line);
            END (*WHILE*);
            WHILE line[0] = Nul DO
                ReadLine (cid, line);
            END (*WHILE*);

        END (*WHILE*);

    END ProcessPEMFile;

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

PROCEDURE ProcessFile (VAR (*INOUT*) chain, tail: CertList;
                                        VAR (*IN*) file: ARRAY OF CHAR);

    (* Normally adds one file to the tail of the list, but with some    *)
    (* extra possibilities: sometimes a file can contain more than one  *)
    (* certificate, and when we find a PEM-format certificate we        *)
    (* replace it with the ASN.1 binary equivalent.                     *)

    VAR cid: ChanId;
        buffer: ARRAY [0..0] OF CHAR;
        nread: CARDINAL;

    BEGIN
        cid := OpenOldFile (file, FALSE, TRUE);
        IF cid <> NoSuchChannel THEN
            ReadRaw (cid, buffer, 1, nread);
            IF (nread <> 0) AND (buffer[0] = '-') THEN
                ProcessPEMFile (cid, chain, tail, file);
            ELSE
                (* Non-PEM file, just add it to the list. *)

                AddToTail (chain, tail, file);
            END (*IF*);
            CloseFile (cid);
        END (*IF*);
    END ProcessFile;

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

PROCEDURE CreateCertificateList (D: Domain): CertList;

    (* Loads certificate names from the INI file. *)

    VAR hini: HINI;
        chain, tail: CertList;
        state: StringReadState;
        name: FilenameString;
        app: DomainName;
        key: ARRAY [0..15] OF CHAR;

    BEGIN
        chain := NIL;  tail := NIL;
        hini := OpenINIFile(ININame);
        IF INIValid (hini) THEN
            IF SingleCertificateMode THEN
                app := "$SYS";
            ELSE
                NameOfDomain (D, app);
            END (*IF*);
            key := "CertChain";
            GetStringList (hini, app, key, state);
            REPEAT
                NextString (state, name);
                IF name[0] <> Nul THEN
                    ProcessFile (chain, tail, name);
                END (*IF*);
            UNTIL name[0] = Nul;
            CloseStringList (state);
            CloseINIFile (hini);
        END (*IF*);
        RETURN chain;
    END CreateCertificateList;

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

PROCEDURE AssembleCertificateChain (D: Domain;
                                    VAR (*OUT*) length: CARDINAL;
                                    VAR (*OUT*) pdata: ByteStringPtr;
                                    ID: TransactionLogID);

    (* Prepares the certificate data for transmission.                  *)

    (* The required format is a 3-byte total length; then, for each     *)
    (* certificate, a 3-byte length followed by the certificate itself. *)
    (* These are preceded by the 4-byte overhead required by the        *)
    (* handshake protocol.                                              *)

    (* That suggests that I need to define a new data type that allows  *)
    (* linking of nested structures, but for now I can't think of an    *)
    (* elegant way to do this.  And, since my present code works, it    *)
    (* might be best not to fix what is not broken.                     *)

    VAR chain: CertList;
        p: DomainList;
        result: ByteStr;

    BEGIN
        IF SingleCertificateMode THEN
            D := NIL;
        END (*IF*);
        Obtain (ListLock);
        chain := CertificateList (D);
        IF chain = NIL THEN
            p := FindCacheRecord (D);
            p^.this := CreateCertificateList (D);
        END (*IF*);
        result := CollectChain (chain, ID);
        Release (ListLock);
        length := result.size;
        pdata := result.data;
    END AssembleCertificateChain;

(************************************************************************)
(*                        FIND PRIVATE KEY FILE                         *)
(************************************************************************)

PROCEDURE GetPrivateKeyName (D: Domain;  VAR (*OUT*) name: ARRAY OF CHAR);

    (* Returns the name of the private key for this domain. *)

    VAR hini: HINI;
        app: DomainName;

    BEGIN
        IF SingleCertificateMode THEN
            app := "$SYS";
        ELSE
            NameOfDomain (D, app);
        END (*IF*);
        hini := OpenINIFile(ININame);
        IF INIValid (hini) THEN
            EVAL (INIGetString (hini, app, 'PrivateKey', name));
            CloseINIFile (hini);
        END (*IF*);
    END GetPrivateKeyName;

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

PROCEDURE GetPrivateKey (D: Domain): RSAKeyType;

    (* Returns the private key for this domain. *)

    VAR p: DomainPtr;
        name: FilenameString;
        result: RSAKeyType;

    BEGIN
        Obtain (ListLock);
        p := FindCacheRecord (D);
        result := p^.privkey;
        IF IsNilKey (result) THEN
            GetPrivateKeyName (D, name);
            result := LoadRSAPrivateKey (name);
            p^.privkey := result;
        END (*IF*);
        Release (ListLock);
        RETURN result;
    END GetPrivateKey;

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

PROCEDURE SetINIname (name: ARRAY OF CHAR);

    (* Takes note of our INI name. *)

    BEGIN
        Strings.Assign (name, ININame);
        TLSsessID.SetINIname (name);
    END SetINIname;

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

PROCEDURE SetSingleCertificateMode;

    (* Sets a mode where the domain name is ignored when fetching a     *)
    (* server certificate or private key, because the one certificate   *)
    (* is used for all domains.                                         *)

    BEGIN
        SingleCertificateMode := TRUE;
    END SetSingleCertificateMode;

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

BEGIN
    SingleCertificateMode := FALSE;
    cache := NIL;
    CreateLock (ListLock);
FINALLY
    DestroyLock (ListLock);
END TLSCertificates.

