(**************************************************************************)
(*                                                                        *)
(*  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 TLSsessID;

        (********************************************************)
        (*                                                      *)
        (*                Transport Layer Security              *)
        (*                Cacheing of session IDs               *)
        (*                                                      *)
        (*  Programmer:         P. Moylan                       *)
        (*  Started:            25 January 2025                 *)
        (*  Last edited:        31 October 2025                 *)
        (*  Status:             OK                              *)
        (*                                                      *)
        (********************************************************)

(************************************************************************)
(*                                                                      *)
(* If the server accepts a session ID offered by the client, it must be *)
(* prepared to proceed imnmediately to a ServerHello followed by an     *)
(* optional ChangeCipherSpec and a Finished message.  (The client will  *)
(* respond with its own ChangeCipherSpec and Finished.)  What does this *)
(* imply about how much information must be stored with a saved ID?     *)
(* To do a ChangeCipherSpec, it turns out to be sufficent to save the   *)
(* ciphersuite and the master secret.  When those are restored, we can  *)
(* generate a new key block before changing the cipher spec.            *)
(*                                                                      *)
(* I deduced these details from RFC 5077.                               *)
(*                                                                      *)
(************************************************************************)

<* NEW DEBUGLOG + *>

FROM SYSTEM IMPORT CARD8, ADR, CAST;

IMPORT Strings, INIData;

FROM TLSCipherSuites IMPORT
    (* type *)  CipherSuite;

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

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

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

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

(* WHILE DEBUGGING: *)

<* IF DEBUGLOG THEN *>

FROM MiscFuncs IMPORT
    (* proc *)  AppendCard;

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

VAR logID: TransactionLogID;

<* END *>

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

CONST mslength = 48;  maxcount = 100;  Nul = CHR(0);

TYPE
    (* If we are acting as a server, hostaddr = 0.  If as a client,     *)
    (* hostaddr is the IP address of the server we are trying to        *)
    (* connect to.  To retrieve a saved session, we need a match both   *)
    (* on hostaddr and sessID.  It's unlikely that two different hosts  *)
    (* would give us the same sessID, but it can happen.  For a         *)
    (* character string ID, IDlength includes the terminating Nul.      *)

    SessData =  RECORD
                    hostaddr: CARDINAL;
                    IDlength: CARDINAL;
                    sessID: sessIDtype;
                    suite: CipherSuite;
                    master: ARRAY [0..mslength-1] OF CARD8;
                END (*RECORD*);

    QPtr = POINTER TO
                    RECORD
                        prev, next: QPtr;
                        this: SessData;
                    END (*RECORD*);

VAR NextID: sessIDtype;
    NextIDLock: Lock;
    sesslist:   RECORD
                    access: Lock;
                    count: CARDINAL;
                    head, tail: QPtr;
                END (*RECORD*);

    (* Our INI file name. *)

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

(************************************************************************)
(*                 CHECKSUM (ONLY NEEDED FOR DEBUGGING)                 *)
(************************************************************************)

PROCEDURE BlockChecksum (N: CARDINAL;  VAR (*IN*) A: ARRAY OF CARD8): CARD8;

    (* Calculates a checksum for an array of N bytes. *)

    VAR result: CARD8;  j: CARDINAL;

    BEGIN
        result := 0;
        FOR j := 0 TO N-1 DO
            result := IXORB (result, A[j]);
        END (*FOR*);
        RETURN result;
    END BlockChecksum;

(************************************************************************)
(*                   MISC OPERATIONS ON SESSION ID                      *)
(************************************************************************)

<* IF DEBUGLOG THEN *>
PROCEDURE CheckListIntegrity (caller: ARRAY OF CHAR);

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

    PROCEDURE CheckError (label1, label2: ARRAY OF CHAR;
                                        val1, val2: CARDINAL);

        (* Report error if val1 <> val2. *)

        VAR message: ARRAY [0..63] OF CHAR;

        BEGIN
            IF val1 <> val2 THEN
                Strings.Assign (caller, message);
                Strings.Append (": Session list fault, ", message);
                Strings.Append (label1, message);
                Strings.Append (" = ", message);
                AppendCard (val1, message);
                Strings.Append (", ", message);
                Strings.Append (label2, message);
                Strings.Append (" = ", message);
                AppendCard (val2, message);
                LogTransaction (logID, message);
            END (*IF*);
        END CheckError;

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

    VAR N, k: CARDINAL;
        prev, p: QPtr;

    BEGIN
        Obtain (sesslist.access);
        N := 0;  k := sesslist.count;
        p := sesslist.head;  prev := NIL;
        WHILE p <> NIL DO
            CheckError ("p^.prev", "prev",
                        CAST(CARDINAL,p^.prev), CAST(CARDINAL,prev));
            INC (N);
            prev := p;
            p := p^.next;
        END (*WHILE*);
        Release (sesslist.access);

        CheckError ("size", "count", N, k);

    END CheckListIntegrity;
<* END *>

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

PROCEDURE ResetNextID;

    VAR j: CARDINAL;

    BEGIN
        FOR j := 0 TO lastAN DO
            NextID[j] := ORD('0');
        END (*FOR*);
        FOR j := lastAN + 1 TO 32 DO
            NextID[j] := 0;
        END (*FOR*);
    END ResetNextID;

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

PROCEDURE RemoveFromList (p: QPtr);

    (* Removes p^ from the session list. We assume that the caller has  *)
    (* exclusive access to the list.  p^ is not destroyed.              *)

    VAR before, after: QPtr;

    BEGIN
        before := p^.prev;
        after := p^.next;
        IF before = NIL THEN
            sesslist.head := after;
        ELSE
            before^.next := after;
        END (*IF*);
        IF after = NIL THEN
            sesslist.tail := before;
        ELSE
            after^.prev := before;
        END (*IF*);
        DEC (sesslist.count);
        p^.prev := NIL;  p^.next := NIL;
    END RemoveFromList;

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

PROCEDURE Promote (p: QPtr);

    (* Swaps p^ with the element ahead of it in the list.  The pointer  *)
    (* p is not altered by this procedure, only the list pointers.      *)
    (* Assumption: we have exclusive access to the list.                *)

    VAR q, before, after: QPtr;

    BEGIN
        q := p^.prev;
        IF q <> NIL THEN
            before := q^.prev;
            after := p^.next;
            p^.prev := before;
            IF before = NIL THEN
                sesslist.head := p;
            ELSE
                before^.next := p;
            END (*IF*);
            q^.prev := p;
            p^.next := q;
            q^.next := after;
            IF after = NIL THEN
                sesslist.tail := q;
            ELSE
                after^.prev := q;
            END (*IF*);
        END (*IF*);
    END Promote;

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

PROCEDURE FindID (addr: CARDINAL;  VAR (*IN*) ID: sessIDtype;
                                           IDlength: CARDINAL): QPtr;

    (* Returns a pointer to the saved record for session ID.    *)
    (* Returns NIL if no such record is found.  The caller      *)
    (* must have exclusive access to the list.                  *)

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

    PROCEDURE IDmatch (savedID: ARRAY OF CARD8;  savedIDlength: CARDINAL): BOOLEAN;

        (* Returns TRUE iff ID matches savedID.    *)

        VAR j: CARDINAL;

        BEGIN
            IF IDlength <> savedIDlength THEN RETURN FALSE END(*IF*);
            j := 0;
            WHILE j < IDlength DO
                IF ID[j] <> savedID[j] THEN RETURN FALSE END(*IF*);
                INC (j);
            END (*WHILE*);
            RETURN TRUE;
        END IDmatch;

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

    VAR p: QPtr;

    BEGIN
        Obtain (sesslist.access);
        p := sesslist.head;
        WHILE (p <> NIL) AND ((p^.this.hostaddr <> addr)
                               OR NOT IDmatch(p^.this.sessID, p^.this.IDlength)) DO
            p := p^.next;
        END (*WHILE*);
        Release (sesslist.access);
        <* IF DEBUGLOG THEN *>
            CheckListIntegrity ("FindID");
        <* END *>
        RETURN p;
    END FindID;

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

PROCEDURE DeleteSessID (addr: CARDINAL;  ID: sessIDtype;  IDlength: CARDINAL);

    (* Destroys this ID, since we believe it to be obsolete. *)

    VAR p: QPtr;

    BEGIN
        Obtain (sesslist.access);
        p := FindID (addr, ID, IDlength);
        IF p <> NIL THEN
            RemoveFromList (p);
            DISPOSE (p);
            Release (sesslist.access);
            <* IF DEBUGLOG THEN *>
                CheckListIntegrity ("DeleteSessID");
            <* END *>
        END (*IF*);
    END DeleteSessID;

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

PROCEDURE LastSavedID (hostaddr: CARDINAL;
                        VAR (*OUT*) sessID: sessIDtype): CARDINAL;

    (* Finds the ID of the last saved session for this host, returns    *)
    (* its length (or 0 if none found).  This is a client function.     *)

    VAR p: QPtr;  length: CARDINAL;

    BEGIN
        Obtain (sesslist.access);
        p := sesslist.head;
        WHILE (p <> NIL) AND (p^.this.hostaddr <> hostaddr) DO
            p := p^.next;
        END (*WHILE*);
        IF p = NIL THEN
            length := 0;
        ELSE
            sessID := p^.this.sessID;
            length := p^.this.IDlength;
        END (*KF*);
        Release (sesslist.access);
        RETURN length;
    END LastSavedID;

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

PROCEDURE IncrNextID (k: CARDINAL);

    (* Increments NextID[0..k].  We assume that the caller has          *)
    (* exclusive access to NextID.                                      *)

    (* The standard allows for 32 bytes, i.e. 256 bits, of session ID,  *)
    (* but I am never going to save as many as 2^256 sessions.  So I'm  *)
    (* only using alphanumeric characters, and I'm only using locations *)
    (* [0..lastAN] of the ID, plus one trailing nul.                    *)

    BEGIN
        IF NextID[k] >= ORD('z') THEN
            NextID[k] := ORD('0');
            IF k = 0 THEN
                ResetNextID;
            ELSE
                IncrNextID (k-1);
            END (*IF*);
        ELSIF NextID[k] = ORD('Z') THEN
            NextID[k] := ORD('a');
        ELSIF NextID[k] = ORD('9') THEN
            NextID[k] := ORD('A');
        ELSE
            INC (NextID[k]);
        END (*IF*);
    END IncrNextID;

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

PROCEDURE GenerateSessionID (VAR (*OUT*) sessID: sessIDtype;
                                VAR (*OUT*) IDlength: CARDINAL);

    (* Assigns a session ID to a new session. *)

    BEGIN
        Obtain (NextIDLock);
        sessID := NextID;
        IncrNextID (lastAN);
        Release (NextIDLock);

        (* We consider the trailing Nul to be part of the sessID. *)

        IDlength := lastAN + 2;

    END GenerateSessionID;

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

PROCEDURE AppendSessID (VAR (*IN*) ID: sessIDtype;  IDlength: CARDINAL;
                                    VAR (*INOUT*) message: ARRAY OF CHAR);

    (* Appends ID, as an ASCII string, to message. *)

    VAR L: CARDINAL;

    BEGIN
        L := LENGTH(message);
        Copy (ADR(ID), ADR(message[L]), IDlength);
        INC (L, IDlength);
        message[L] := Nul;
    END AppendSessID;

(************************************************************************)
(*                     SAVING THE CURRENT SESSION ID                    *)
(************************************************************************)

PROCEDURE SaveSessionParams (hostaddr: CARDINAL;  VAR (*IN*) sessID: sessIDtype;
                                IDlength: CARDINAL;
                                  ciphersuite: CipherSuite;
                                    VAR (*IN*) mastersecret: ARRAY OF CARD8);

    (* Saves a copy of the current data for sessID.    *)

    VAR p, q, prev: QPtr;  found: BOOLEAN;
        <* IF DEBUGLOG THEN *>
            message: ARRAY [0..63] OF CHAR;
        <* END *>

    BEGIN
        <* IF DEBUGLOG THEN *>
            message :="storing session with ID ";
            AppendSessID (sessID, IDlength, message);
            LogTransaction (logID, message);
        <* END *>

        Obtain (sesslist.access);
        p := FindID (hostaddr, sessID, IDlength);
        found := p <> NIL;
        IF found THEN
            (* We'll overwrite the old values. *)
        ELSE
            (* Delete last list element(s) if the list is too long. *)

            WHILE sesslist.count >= maxcount DO
                q := sesslist.tail;
                IF q <> NIL THEN
                    prev := q^.prev;
                    sesslist.tail := prev;
                    IF prev = NIL THEN
                        sesslist.head := NIL;
                    ELSE
                        prev^.next := NIL;
                    END (*IF*);
                    DISPOSE (q);
                    DEC (sesslist.count);
                END (*IF*);
            END (*WHILE*);

            (* Now put the new entry at the head of the list. *)

            INC (sesslist.count);
            NEW (p);
            p^.this.hostaddr := hostaddr;
            p^.this.sessID := sessID;
            p^.this.IDlength := IDlength;
            p^.prev := NIL;
            p^.next := sesslist.head;
            IF sesslist.head <> NIL THEN
                sesslist.head^.prev := p;
            END (*IF*);
            sesslist.head := p;
            IF p^.next = NIL THEN
                sesslist.tail := p;
            END (*IF*);
        END (*IF*);
        p^.this.suite := ciphersuite;
        Copy (ADR(mastersecret), ADR(p^.this.master), mslength);
        <* IF DEBUGLOG THEN *>
            message :="added session ";
            AppendSessID (p^.this.sessID, p^.this.IDlength, message);
            Strings.Append (" to the list. Now count is ", message);
            AppendCard (sesslist.count, message);
            LogTransaction (logID, message);
        <* END *>
        Release (sesslist.access);
        <* IF DEBUGLOG THEN *>
            CheckListIntegrity ("SaveSessionParams");
        <* END *>
    END SaveSessionParams;

(************************************************************************)
(*                   RESTORING SAVED ID INFORMATION                     *)
(************************************************************************)

PROCEDURE RestoreSession (hostaddr: CARDINAL;  VAR (*IN*) sessID: sessIDtype;
                           IDlength: CARDINAL;
                           VAR (*OUT*) ciphersuite: CipherSuite;
                           VAR (*OUT*) mastersecret: ARRAY OF CARD8): BOOLEAN;

    (* Returns FALSE if a matching seeionID cannot be found.  If it is  *)
    (* found, returns TRUE with the saved ciphersuit and mastersecret.  *)

    VAR found: BOOLEAN;  p: QPtr;

    BEGIN
        (* Some clients seem to request a session ID that could not     *)
        (* have been generated by this module.  Let us reject those     *)
        (* without even checking the list.                              *)

        IF (hostaddr = 0) AND (sessID[lastAN+1] <> 0) THEN
            RETURN FALSE;
        END (*IF*);

        Obtain (sesslist.access);
        p := FindID (hostaddr, sessID, IDlength);
        found := p <> NIL;
        IF found THEN
            Promote (p);
            ciphersuite := p^.this.suite;
            Copy (ADR(p^.this.master), ADR(mastersecret), mslength);
        END (*IF*);
        Release (sesslist.access);
        RETURN found;
    END RestoreSession;

(************************************************************************)
(*                  SAVE & RESTORE OF ALL SESSION DATA                  *)
(************************************************************************)

CONST savefile = "sessions.bin";  bakfile = "sessions.bak";
      recordsize = SIZE (SessData);

PROCEDURE SaveAllSessions;

    VAR cid: ChanId;
        p: QPtr;
        <* IF DEBUGLOG THEN *>
            message: ARRAY [0..63] OF CHAR;
        <* END *>

    BEGIN
        IF Exists (savefile) THEN
            DeleteFile (bakfile);
            EVAL(MoveFile (savefile, bakfile));
        END (*IF*);
        cid := OpenNewFile (savefile, TRUE);
        Obtain (sesslist.access);
        <* IF DEBUGLOG THEN *>
            message := "";
            AppendCard (sesslist.count, message);
            Strings.Append (" sessions to save", message);
            LogTransaction (logID, message);
        <* END *>
        p := sesslist.head;
        WHILE p <> NIL DO
            (*
            message :="saving session ";
            AppendSessID (p^.this.sessID, p^.this.IDlength, message);
            LogTransaction (logID, message);
            *)
            WriteRaw (cid, p^.this, recordsize);
            p := p^.next;
        END (*WHILE*);
        Release (sesslist.access);
        CloseFile (cid);
    END SaveAllSessions;

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

PROCEDURE RestoreAllSessions;

    VAR cid: ChanId;
        Nread: CARDINAL;
        p, previous: QPtr;

    BEGIN
        Obtain (sesslist.access);
        sesslist.head := NIL;
        sesslist.tail := NIL;
        sesslist.count := 0;
        IF Exists (savefile) THEN
            previous := NIL;
            cid := OpenOldFile (savefile, FALSE, TRUE);
            REPEAT
                NEW (p);
                ReadRaw (cid, p^.this, recordsize, Nread);
                IF Nread = recordsize THEN
                    INC (sesslist.count);
                    p^.prev := previous;
                    p^.next := NIL;
                    IF previous = NIL THEN
                        sesslist.head := p;
                    ELSE
                        previous^.next := p;
                    END (*IF*);
                    previous := p;
                    sesslist.tail := p;
                ELSE
                    DISPOSE (p);
                END (*IF*);
            UNTIL Nread < recordsize;
            CloseFile (cid);
        END (*IF*);
        Release (sesslist.access);
    END RestoreAllSessions;

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

PROCEDURE SetINIname (name: ARRAY OF CHAR);

    (* Takes note of our INI name. *)

    VAR hini: INIData.HINI;
        SYSapp: ARRAY [0..7] OF CHAR;
        IDstring: ARRAY [0..32] OF CHAR;

    BEGIN
        Strings.Assign (name, ININame);
        hini := INIData.OpenINIFile(ININame);
        IF INIData.INIValid (hini) THEN
            SYSapp := '$SYS';
            IF INIData.INIGet (hini, SYSapp, 'NextID', IDstring) THEN
                Copy (ADR(IDstring), ADR(NextID), LENGTH(IDstring)+1);
            ELSE
                ResetNextID;
            END (*IF*);
            INIData.CloseINIFile (hini);
        END (*IF*);
    END SetINIname;

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

PROCEDURE SaveNextID;

    (* Copies NextID to the INI file. *)

    VAR hini: INIData.HINI;
        SYSapp: ARRAY [0..7] OF CHAR;
        IDstring: ARRAY [0..32] OF CHAR;

    BEGIN
        hini := INIData.OpenINIFile(ININame);
        IF INIData.INIValid (hini) THEN
            SYSapp := '$SYS';
            Copy (ADR(NextID), ADR(IDstring), 33);
            INIData.INIPut (hini, SYSapp, 'NextID', IDstring);
            INIData.CloseINIFile (hini);
        END (*IF*);
    END SaveNextID;

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

BEGIN
    <* IF DEBUGLOG THEN *>
        logID := CreateLogID ("sessID ");
    <* END *>
    CreateLock (NextIDLock);
    CreateLock (sesslist.access);
    sesslist.head := NIL;
    sesslist.tail := NIL;
    sesslist.count := 0;
    RestoreAllSessions;
FINALLY
    SaveNextID;
    SaveAllSessions;
    <* IF DEBUGLOG THEN *>
        DiscardLogID (logID);
    <* END *>
END TLSsessID.

