IMPLEMENTATION MODULE DKIM;

        (********************************************************)
        (*                                                      *)
        (*                    DKIM Signatures                   *)
        (*                                                      *)
        (*                                                      *)
        (*  Programmer:         Peter Moylan                    *)
        (*  Started:            2 August 2023                   *)
        (*  Last edited:        18 October 2025                 *)
        (*  Status:             Signature generation working.   *)
        (*                      Still a problem with checking.  *)
        (*                                                      *)
        (*  The standard governing this code is RFC 6376        *)
        (*                                                      *)
        (* This is a new approach that bypasses the solution    *)
        (* by Andrey Vasilkin (digi@os2.snc.ru).  For some      *)
        (* reason my use of his DLL was giving incorrect        *)
        (* results, so I've gone back to square one.            *)
        (*                                                      *)
        (********************************************************)



FROM SYSTEM IMPORT
    (* type *)  CARD8, ADR, CAST;

IMPORT Strings, FileSys, INIData, Base64, BigNum, OS2;

FROM Arith64 IMPORT
    (* type *)  CARD64LE, CARD64API,
    (* proc *)  Add64LE, Sub64LE, ShortMul64LE;

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

FROM Signatures IMPORT
    (* type *)  PKAType,
    (* sign *)  Sign, SignatureValid;

FROM Domains IMPORT
    (* type *)  Domain,
    (* proc *)  OpenDomainINI, CloseDomainINI;

FROM GetDNStxt IMPORT
    (* proc *)  GetFirstTXTrecord;

FROM WRSA IMPORT
    (* proc *)  LoadRSAPrivateKey, LoadPublicKey;

FROM WINI IMPORT
    (* proc *)  OpenINI, CloseINI;

FROM HashAlgs IMPORT
    (* type *)  HashAlgorithm, HashCtx,
    (* proc *)  HashLength, HashInit, HashInitOK, HashAbort,
                HashUpdate, HashFinal;

FROM FileOps IMPORT
    (* const*)  NoSuchChannel,
    (* type *)  ChanId, FilenameString, FilePos,
    (* proc *)  OpenOldFile, OpenNewFile, OpenNewHiddenFile, CloseFile,
                ReadRaw, ReadLine, FWriteChar, FWriteString, FWriteLn,
                FWriteStringV,
                CurrentPosition, SetPosition, DeleteFile, AppendFile;

FROM VarStrings IMPORT
    (* type *)  ByteStr, CharStr, CharStringPtr,
    (* proc *)  MakeBS, MakeCS, CopyOfCS, StrToCharStr, DiscardBS,
                DiscardCS, CSDelete, CSExtract, CSExpand, CSAppendStr,
                CSAppendStrV;

FROM TempFiles IMPORT
    (* proc *)  OpenNewOutputFile;

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

FROM MiscFuncs IMPORT
    (* proc *)  HeadMatch, HexEncodeArray, AppendCard;

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

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

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

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

CONST
    Nul = CHR(0);  Tab = CHR(9);  CR = CHR(13);  LF = CHR(10);  CtrlZ = CHR(26);

    NILDomain = CAST (Domain, NIL);

TYPE
    CharSet = SET OF CHAR;
    ParamStr = ARRAY [0..4095] OF CHAR;
    HeaderName = ARRAY [0..63] OF CHAR;

    (* A HeaderPtr record is created only for those headers that    *)
    (* need to be included in the DKIM signature calculation.  The  *)
    (* pos field points to the location in the canonicalised file   *)
    (* where that header starts, and len is the length of the       *)
    (* header line.  If there is no such header, len = 0.  I take   *)
    (* page 30 of the standard as meaning that the terminating      *)
    (* CRLF should be included in the length.                       *)

    (* Remark: we currently do not try to handle the case where a   *)
    (* header occurs more than once.  Page 35 of the DKIM standard  *)
    (* covers this possibility, but to follow it precisely would    *)
    (* complicate the processing.  Fortunately, I have never met a  *)
    (* case where this mattered.                                    *)

    (* Storing the information this way allows for an unlimited     *)
    (* number of headers, each with variable length, which matters  *)
    (* because some software generates very long headers.           *)

    HeaderPtr = POINTER TO
                    RECORD
                        next: HeaderPtr;
                        name: CharStr;
                        pos: FilePos;   (* position in canonicalised file *)
                        len: CARDINAL;  (* length of the header line *)
                    END (*RECORD*);

    ParamPtr = POINTER TO Params;

    (* A Params record holds the parameters specified by a          *)
    (* DKIM-Signature header, in the case where we are verifying a  *)
    (* signature.  (In that case, the privatekey field is unused.)  *)
    (* When we are generating a signature, the information is taken *)
    (* from the INI file.                                           *)

    Params = RECORD
                alg: HashAlgorithm;
                HeaderRelaxed, BodyRelaxed: BOOLEAN;
                BodyLength: CARD64LE;
                selector, domain: ParamStr;
                HeaderString: ARRAY [0..1023] OF CHAR;
                privatekey: RSAKeyType;
             END (*RECORD*);

    (* The next type definition is for a list of parameters for     *)
    (* multiple domains.                                            *)

    ParamListPtr = POINTER TO
                        RECORD
                            next: ParamListPtr;
                            domain: Domain;
                            pparams: ParamPtr;
                        END (*RECORD*);

    (* A StateRecord contains other information that we need to     *)
    (* calculate the b and bh values.                               *)

    StateRecord =   RECORD
                        logID: TransactionLogID;
                        canfilename: FilenameString;
                        BodyStart: FilePos;
                        HeaderFields: HeaderPtr;
                        bh : ParamStr;
                    END (*RECORD*);

    State = POINTER TO StateRecord;

    (* When creating or processing a DKIM-Signature, it is          *)
    (* convenient to keep two copies.  The relaxed copy is a single *)
    (* long string with no line breaks.  The simple copy, which we  *)
    (* also call the folded copy, is a sequence of lines, collected *)
    (* as follows.                                                  *)

    LineList = POINTER TO
                    RECORD
                        next: LineList;
                        text: CharStr;
                    END (*RECORD*);

VAR
    (* Serialisation lock to make callers queue up. *)

    access: Lock;

    (* A list of parameters for different domains.  *)

    ParamList:  RECORD
                    access: Lock;
                    head: ParamListPtr;
                END (*RECORD*);

    (* NOTE 1: LocalParams can be on this list in the case where    *)
    (* domain = NILDomain.                                          *)
    (* NOTE 2: The list contains the parameters for all the domains *)
    (* for which we have had to insert a signature since the last   *)
    (* time the list was emptied.                                   *)

    (* TRANSITION ARRANGEMENT: We use LocalParams if the caller     *)
    (* specifies a NIL domain.  I intended to phase out the use of  *)
    (* LocalParams, but in the medium term I think I'll still need  *)
    (* for the case where Weasel is running in single-domain mode.  *)

    LocalParams: Params;

(********************************************************************)
(*                     MISCELLANEOUS UTILITIES                      *)
(********************************************************************)

(*
PROCEDURE WriteHexChar (N: CARDINAL);

    (* Writes one hex digit.  *)

    BEGIN
        IF N < 10 THEN
            WriteChar (CHR(ORD('0') + N));
        ELSE
            WriteChar (CHR(ORD('A') + N - 10));
        END (*IF*);
    END WriteHexChar;

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

PROCEDURE WriteHexByte (N: CARDINAL);

    (* Writes a two-digit hex number.  *)

    BEGIN
        WriteHexChar (N DIV 16);
        WriteHexChar (N MOD 16);
    END WriteHexByte;

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

PROCEDURE WriteHexArray (data: ARRAY OF CARD8;  N: CARDINAL);

    (* Writes out a sequence of N bytes.  *)

    VAR j: CARDINAL;

    BEGIN
        FOR j := 0 TO N-1 DO
            WriteHexByte (data[j]);
        END (*FOR*);
    END WriteHexArray;
*)

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

PROCEDURE DiscardLines (VAR (*INOUT*) list: LineList);

    (* Disposes of a list of linked lines.  *)

    VAR next: LineList;

    BEGIN
        WHILE list <> NIL DO
            next := list^.next;
            DiscardCS (list^.text);
            DISPOSE (list);
            list := next;
        END (*WHILE*);
    END DiscardLines;

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

PROCEDURE ToLower (VAR (*INOUT*) ch: CHAR);

    (* Converts alpha character to lower case. *)

    BEGIN
        IF ch IN CharSet {'A'..'Z'} THEN
            ch := CHR(ORD(ch) - ORD('A') + ORD('a'));
        END (*IF*);
    END ToLower;

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

PROCEDURE StripSpaces (VAR (*INOUT*) str: ARRAY OF CHAR);

    (* Removes leading and trailing whitespace. *)

    VAR L: CARDINAL;

    BEGIN
        L := Strings.Length (str);
        WHILE (L > 0) AND ((str[L-1] = ' ') OR (str[L-1] = Tab)) DO
            DEC (L);
        END (*WHILE*);
        str[L] := Nul;
        WHILE (str[0] = ' ') OR (str[0] = Tab) DO
            Strings.Delete (str, 0, 1);
        END (*WHILE*);
    END StripSpaces;

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

PROCEDURE RemoveAllSpaces (VAR (*INOUT*) str: ARRAY OF CHAR);

    (* Removes all whitespace. *)

    VAR j, k, L: CARDINAL;  ch: CHAR;

    BEGIN
        j := 0;  k := 0;
        L := Strings.Length (str);
        WHILE j < L DO
            ch := str[j];
            IF (ch <> ' ') AND (ch <> Tab) THEN
                str[k] := ch;
                INC (k);
            END (*IF*);
            INC (j);
        END (*WHILE*);
        str[k] := Nul;
    END RemoveAllSpaces;

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

PROCEDURE ReduceSpaces (VAR (*INOUT*) line: ARRAY OF CHAR);

    (* Collapses whitespace down to a single space character.   *)
    (* Also removes all trailing whitespace.                    *)

    VAR pos1, pos2: CARDINAL;

    BEGIN
        pos1 := 0;  pos2 := 0;
        WHILE line[pos1] <> Nul DO
            IF (line[pos1] = ' ') OR (line[pos1] = Tab) THEN
                line[pos2] := ' ';  INC(pos2);
                REPEAT
                    INC (pos1);
                UNTIL (line[pos1] <> ' ') AND (line[pos1] <> Tab);
                IF (line[pos1] = Nul) OR (line[pos1] = CR) THEN
                    (* We have just moved past trailing spaces. *)
                    DEC (pos2);
                END (*IF*);
            ELSE
                line[pos2] := line[pos1];
                INC (pos1);  INC(pos2);
            END (*IF*);
        END (*WHILE*);
        line[pos2] := Nul;
    END ReduceSpaces;

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

PROCEDURE MakeHeaderList (VAR (*IN*) str: ARRAY OF CHAR): HeaderPtr;

    (* Builds the table of the headers we have to deal with.  We    *)
    (* set the length to zero at this stage; this will be changed   *)
    (* if and when that header is encountered in the canonicalised  *)
    (* copy of the message file.                                    *)

    VAR j, pos, L: CARDINAL;
        result, tail, current: HeaderPtr;
        hname: HeaderName;
        found: BOOLEAN;

    BEGIN
        result := NIL;
        tail := NIL;
        j := 0;  L := Strings.Length(str);
        WHILE j < L DO
            Strings.FindNext (':', str, j, found, pos);
            IF NOT found THEN
                pos := L;
            END (*IF*);
            IF pos > j THEN
                Strings.Extract (str, j, pos-j, hname);
            END (*IF*);
            StripSpaces (hname);
            j := pos+1;

            (* Add this header to our list of headers to include. *)

            NEW (current);
            current^.next := NIL;
            current^.name := StrToCharStr (hname);
            current^.len := 0;
            current^.pos := CARD64API{0,0};     (* for neatness, but redundant *)
            IF tail = NIL THEN
                result := current;
            ELSE
                tail^.next := current;
            END (*IF*);
            tail := current;
        END (*WHILE*);

        RETURN result;

    END MakeHeaderList;

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

PROCEDURE WhichHeader (state: State;  VAR (*IN*) line: ARRAY OF CHAR): HeaderPtr;

    (* Finds the entry in the list of checked headers that matches  *)
    (* the leading part of line.  Returns NIL for no match.         *)

    VAR k: CARDINAL;
        p: HeaderPtr;
        hname: HeaderName;

    BEGIN
        k := 0;
        p := state^.HeaderFields;
        LOOP
            IF p = NIL THEN EXIT(*LOOP*) END (*IF*);
            WITH p^.name DO
                Copy (data, ADR(hname), size+1);
            END (*WITH*);
            IF HeadMatch (line, hname) THEN
                RETURN p;
            END (*IF*);
            INC (k);
            p := p^.next;
        END (*LOOP*);
        RETURN NIL;
    END WhichHeader;

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

PROCEDURE DiscardState (VAR (*INOUT*) state: State);

    (* Disposes of the state information, including deletion of *)
    (* the canonicalised file copy.                             *)

    VAR p, next: HeaderPtr;

    BEGIN
        IF state <> NIL THEN
            p := state^.HeaderFields;
            WHILE p <> NIL DO
                DiscardCS (p^.name);
                next := p^.next;
                DISPOSE (p);
                p := next;
            END (*WHILE*);
            state^.HeaderFields := NIL;
            IF state^.canfilename[0] <> Nul THEN
                DeleteFile (state^.canfilename);
            END (*IF*);
            DISPOSE (state);
        END (*IF*);
    END DiscardState;

(********************************************************************)
(*                  EXTRACTING A TAG = VALUE PAIR                   *)
(********************************************************************)

PROCEDURE GetTagAndValue (VAR (*INOUT*) line: ARRAY OF CHAR;
                            VAR (*INOUT*) pos: CARDINAL;
                            VAR (*OUT*) tag, value: ARRAY OF CHAR);

    (* Extracts a tag=value pair starting at line[pos].  *)

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

    PROCEDURE SkipSpaces;

        BEGIN
            WHILE (line[pos] = ' ') OR (line[pos] = Tab) DO
                INC (pos);
            END (*WHILE*);
        END SkipSpaces;

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

    VAR k: CARDINAL;
        found: BOOLEAN;

    BEGIN
        SkipSpaces;
        k := 0;
        WHILE line[pos] IN CharSet {'a'..'z'} DO
            tag[k] := line[pos];  INC(k);  INC(pos);
        END (*WHILE*);
        tag[k] := Nul;
        SkipSpaces;
        IF line[pos] = '=' THEN
            INC (pos);
        ELSE
            value[0] := Nul;
        END (*IF*);
        Strings.FindNext (';', line, pos, found, k);
        IF NOT found THEN k := Strings.Length(line) END (*IF*);
        Strings.Extract (line, pos, k - pos, value);
        StripSpaces (value);
        pos := k + 1;
    END GetTagAndValue;

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

PROCEDURE GetTagAndValue2 (VAR (*INOUT*) str: CharStr;
                            VAR (*INOUT*) pos: CARDINAL;
                            VAR (*OUT*) tag, value: ARRAY OF CHAR);

    (* Extracts a tag=value pair starting at str.data^[pos].  We    *)
    (* alter str line in one special case, deleting the 'b' value.  *)

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

    PROCEDURE SkipSpaces;

        BEGIN
            WHILE (str.data^[pos] = ' ') OR (str.data^[pos] = Tab) DO
                INC (pos);
            END (*WHILE*);
        END SkipSpaces;

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

    VAR k, valstart, amount: CARDINAL;
        found: BOOLEAN;

    BEGIN
        SkipSpaces;
        k := 0;
        WHILE str.data^[pos] IN CharSet {'a'..'z'} DO
            tag[k] := str.data^[pos];  INC(k);  INC(pos);
        END (*WHILE*);
        tag[k] := Nul;
        SkipSpaces;
        IF str.data^[pos] = '=' THEN
            INC (pos);
        ELSE
            value[0] := Nul;
        END (*IF*);
        valstart := pos;
        Strings.FindNext (';', str.data^, pos, found, k);
        IF NOT found THEN k := str.size END (*IF*);
        CSExtract (str, pos, k - pos, value);
        StripSpaces (value);

        (* Special case: if the tag is 'b', then we must delete the *)
        (* value, including any surrounding spaces, from the str.data^.  *)

        IF (tag[0] = 'b') AND (tag[1] = Nul) THEN
            amount := k - valstart;
            CSDelete (str, valstart, amount);
            pos := valstart;
        END (*IF*);

        pos := k + 1;

    END GetTagAndValue2;

(********************************************************************)
(*              GETTING THE SENDER'S DKIM PUBLIC KEY                *)
(********************************************************************)

PROCEDURE GetPublicKey (VAR (*IN*) params: Params): RSAKeyType;

    (* Returns the client's public key.  A zero-length result means *)
    (* that the DNS lookup failed to return a result.               *)

    VAR Buf, value: ARRAY [0..2047] OF CHAR;
        TXTRec: ARRAY [0..4095] OF CHAR;
        bindata: ARRAY [0..2047] OF CARD8;
        tag: ARRAY [0..3] OF CHAR;
        result: RSAKeyType;
        pos: CARDINAL;
        found: BOOLEAN;

    BEGIN
        result := InitKey();

        (* Make the name of the subdomain to look up. *)

        Strings.Assign (params.selector, Buf);
        Strings.Append ("._domainkey.", Buf);
        Strings.Append (params.domain, Buf);

        (* Discovery: some senders don't follow the recommendation  *)
        (* that the TXT record should start with "v=DKIM1", so I'll *)
        (* have to settle for any text record I find.               *)

        IF GetFirstTXTrecord (Buf, "", TXTRec) <> 0 THEN
            RETURN result;
        END (*IF*);

        (* TXTRec contains a sequence of tag=value pairs. The only  *)
        (* one we care about is the p tag.                          *)

        pos := 0;  found := FALSE;
        WHILE (NOT found) AND (pos < Strings.Length(TXTRec)) DO
            GetTagAndValue (TXTRec, pos, tag, value);
            found := (tag[0] = 'p') AND (tag[1] = Nul);
        END (*WHILE*);
        IF found THEN
            EVAL (Base64.Decode (value, bindata));
            result := LoadPublicKey (bindata);
        END (*IF*);

        RETURN result;

    END GetPublicKey;

(********************************************************************)
(*                  CANOCALISATION OF THE MESSAGE                   *)
(********************************************************************)

PROCEDURE GetLine (cid: ChanId;  VAR (*OUT*) line: ARRAY OF CHAR);

    (* Reads one line from the input file, removing any leading dot.*)
    (* Weasel always stores messages in transit in dot-stuffed      *)
    (* format, but the canonicalised copy should not be in          *)
    (* dot-stuffed format.                                          *)

    (* A correctly dot-stuffed line, according to the RFC 821 rule, *)
    (* starts with two dots. (The terminator has one dot, but the   *)
    (* terminator is not stored with the file.) A single dot means  *)
    (* the sender has violated RFC 821, so in that case we do not   *)
    (* delete the dot.                                              *)

    BEGIN
        ReadLine (cid, line);
        IF (line[0] = '.') AND (line[1] = '.') THEN
            Strings.Delete (line, 0, 1);
        END (*IF*);
    END GetLine;

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

PROCEDURE RelaxHeaderLine (VAR (*INOUT*) str: CharStr);

    (* Simplifies a header line according to the "relaxed" rules.   *)
    (* Note that a header line is always a single line in the       *)
    (* relaxed case, because we've already removed the folding.     *)

    VAR pos: CARDINAL;

    BEGIN
        ReduceSpaces (str.data^);
        pos := 0;

        (* Convert header names to lower case. *)

        WHILE (str.data^[pos] <> Nul) AND (str.data^[pos] <> ':') DO
            ToLower (str.data^[pos]);  INC(pos);
        END (*LOOP*);

        (* Remove spaces before and after the colon. There can be   *)
        (* at most one space before and after, because we've        *)
        (* already collapsed multiple spaces/tabs.                  *)

        IF str.data^[pos] = ':' THEN
            IF str.data^[pos-1] = ' ' THEN
                Strings.Delete (str.data^, pos-1, 1);
                DEC (pos);
            END (*IF*);
            IF str.data^[pos+1] = ' ' THEN
                Strings.Delete (str.data^, pos+1, 1);
            END (*IF*);
        END (*IF*);

        (* Recalculate the string size, because the space reduction *)
        (* has reduced the size.  We don't want to use              *)
        (* Strings.Length because it has a value parameter.         *)

        pos := 0;
        WHILE (pos < str.size) AND (str.data^[pos] <> Nul) DO
            INC (pos);
        END (*WHILE*);
        str.size := pos;

    END RelaxHeaderLine;

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

PROCEDURE MakeCanonicalCopy (state: State;  VAR (*IN*) params: Params;
                            VAR (*IN*) infile: ARRAY OF CHAR): ChanId;

    (* Makes a copy of infile in canonical form.  We also fill in   *)
    (* the table of header locations.                               *)

    VAR incid, outcid: ChanId;
        emptylines, k, length: CARDINAL;
        wanted: CARD64LE;
        phl: HeaderPtr;
        linestart: FilePos;
        line: ARRAY [0..1001] OF CHAR;      (* 998 (see SMTP rules) *)
                                            (* + CRLF + Nul.        *)
        lineout: CharStr;
        relaxed, haveline, inheader: BOOLEAN;

    BEGIN
        (*LogTransactionL (state^.logID, "Entering MakeCanonicalCopy");*)
        incid := OpenOldFile (infile, FALSE, FALSE);
        outcid := OpenNewOutputFile ("DK", ".tmp", state^.canfilename, TRUE);
        lineout.allocated := 0;
        phl := NIL;
        inheader := TRUE;  haveline := FALSE;
        relaxed := params.HeaderRelaxed;
        length := 0;
        WHILE inheader DO
            IF NOT haveline THEN
                GetLine (incid, line);
            END (*IF*);
            lineout := StrToCharStr (line);
            haveline := FALSE;
            IF (line[0] = Nul) OR (line[0] = CtrlZ) THEN
                inheader := FALSE;
            ELSIF relaxed THEN
                (* Check for continuation lines. *)
                GetLine (incid, line);
                WHILE (line[0] = ' ') OR (line[0] = Tab) DO
                    CSAppendStr (lineout, line);
                    GetLine (incid, line);
                END (*WHILE*);
                haveline := TRUE;

                (* No more continuation lines, so do the    *)
                (* 'relaxed' processing.                    *)

                RelaxHeaderLine (lineout);

                (* Write line to the output file, and record    *)
                (* the line position and length.                *)

                linestart := CurrentPosition (outcid);
                FWriteStringV (outcid, lineout.data^);
                FWriteLn (outcid);
                phl := WhichHeader (state, lineout.data^);
                IF phl <> NIL THEN
                    phl^.pos := linestart;
                    phl^.len := lineout.size + 2;
                    (* The +2 is to count the terminating CRLF  *)
                    (* that FWriteLn has added.                 *)
                END (*IF*);
            ELSE
                (* The non-relaxed case, where we have to   *)
                (* work out the header length over multiple *)
                (* lines.                                   *)

                IF (line[0] = ' ') OR (line[0] = Tab) THEN

                    (* Continuation line. *)

                    INC (length, Strings.Length(line) + 2);
                    FWriteString (outcid, line);
                    FWriteLn (outcid);
                ELSE
                    (* Store information for previous header. *)

                    IF phl <> NIL THEN
                        phl^.pos := linestart;
                        phl^.len := length;
                    END (*IF*);

                    (* Now handle current line. *)

                    length := Strings.Length(line) + 2;
                    phl := WhichHeader (state, line);
                    linestart := CurrentPosition (outcid);
                    FWriteString (outcid, line);
                    FWriteLn (outcid);
                END (*IF*);
            END (*IF*);

        END (*WHILE*);

        (* Now copy some or all of the body, depending on   *)
        (* the length restriction.                          *)

        relaxed := params.BodyRelaxed;
        emptylines := 0;

        state^.BodyStart := CurrentPosition (outcid);
        wanted := params.BodyLength;
        LOOP
            GetLine (incid, line);
            IF line[0] = CtrlZ THEN EXIT(*LOOP*);
            ELSE
                IF relaxed THEN
                    ReduceSpaces (line);
                END (*IF*);
                IF line[0] = Nul THEN INC(emptylines);
                ELSE
                    WHILE emptylines > 0 DO
                        FWriteLn (outcid);  DEC(emptylines);
                    END (*WHILE*);
                    FWriteString (outcid, line);  FWriteLn (outcid);

                    (* Stop copying when we exceed the BodyLength   *)
                    (* limit.  We might go a little over, but that  *)
                    (* does not matter, because the surplus will    *)
                    (* not be included in the hash calculation.     *)

                    k := Strings.Length(line) + 2;
                    IF wanted.high = 0 THEN
                        IF wanted.low < k THEN EXIT(*LOOP*);
                        ELSE DEC (wanted.low, k);
                        END (*IF*);
                    ELSE
                        Sub64LE (wanted, k);
                    END (*IF*);

                END (*IF*);
            END (*IF*);
        END (*LOOP*);

        (* Note that, in both the simple and the relaxed case,      *)
        (* trailing empty lines are ignored.                        *)

        CloseFile (incid);

        (*LogTransactionL (state^.logID, "Leaving MakeCanonicalCopy");*)
        RETURN outcid;

    END MakeCanonicalCopy;

(********************************************************************)
(*                          THE HASH CALCULATIONS                   *)
(********************************************************************)

PROCEDURE HashStep1 (state: State;  VAR (*IN*) params: Params;
                                                cid: ChanId): BOOLEAN;

    (* Computes the bh value by hashing the message body.  Parameter*)
    (* cid identifies the canonicalised file, which is still open.  *)
    (* Result, Base64-encoded, is in state^.bh.                     *)

    CONST buffersize = 4096;

    VAR ctx: HashCtx;  L, N: CARDINAL;  finished: BOOLEAN;
        wanted: CARD64LE;
        digest: ARRAY [0..63] OF CARD8;
        pbuffer: CharStringPtr;

    BEGIN
        ctx := HashInit (params.alg);
        IF NOT HashInitOK (ctx) THEN
            HashAbort (ctx);
            RETURN FALSE;
        END (*IF*);
        L := HashLength (params.alg);
        SetPosition (cid, state^.BodyStart);
        wanted := params.BodyLength;
        finished := FALSE;
        ALLOCATE (pbuffer, buffersize);
        REPEAT
            ReadRaw (cid, pbuffer^, buffersize, N);
            IF N = 0 THEN
                finished := TRUE;
            ELSE
                IF wanted.high = 0 THEN
                    IF wanted.low < N THEN
                        N := wanted.low;
                    ELSIF N > 0 THEN
                        DEC (wanted.low, N);
                        finished := wanted.low = 0;
                    END (*IF*);
                ELSE
                    Sub64LE (wanted, N);
                END (*IF*);
                HashUpdate (ctx, pbuffer^, N);
            END (*IF*);
        UNTIL finished;
        DEALLOCATE (pbuffer, buffersize);
        HashFinal (ctx, digest);
        Base64.Encode (digest, L, state^.bh);
        RETURN TRUE;
    END HashStep1;

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

PROCEDURE HashStep2 (state: State;  VAR (*IN*) params: Params;
                             cid: ChanId;
                             VAR (*IN*) DKsig: CharStr;
                             pfoldedsig: LineList;
                             VAR (*OUT*) digest: ARRAY OF CARD8);

    (* Calculates the message to be presented to the signing        *)
    (* algorithm. The DKsig parameter is the                        *)
    (* partly-completed DKIM-Signature line, with an empty string   *)
    (* where the "b=" value is expected.  (In the non-relaxed case  *)
    (* we have to process the multiline pfoldedsig^ rather than     *)
    (* DKsig.)  The resulting digest is NOT Base64 encoded.         *)

    VAR ctx: HashCtx;  k, numberread: CARDINAL;
        p: LineList;
        phl: HeaderPtr;
        line: ARRAY [0..8192] OF CHAR;

    BEGIN
        (* First, the hash calculation. *)

        ctx := HashInit (params.alg);

        (* We start with the headers listed in state^.HeaderFields *)

        phl := state^.HeaderFields;
        WHILE phl <> NIL DO
            IF phl^.len <> 0 THEN
                (* In the case len=0, this header makes no  *)
                (* contribution to the hash.                *)
                SetPosition (cid, phl^.pos);
                ReadRaw (cid, line, phl^.len, numberread);
                HashUpdate (ctx, line, phl^.len);
            END (*IF*);
            phl := phl^.next;
        END (*FOR*);

        (* Then the DKIM-Signature, in which the "b" value is   *)
        (* currently the empty string.                          *)

        IF params.HeaderRelaxed THEN
            HashUpdate (ctx, DKsig.data^, DKsig.size);
        ELSE
            p := pfoldedsig;
            WHILE p <> NIL DO
                k := p^.text.size;
                IF p^.text.data^[k-1] = Nul THEN DEC(k) END(*IF*);
                HashUpdate (ctx, p^.text.data^, k);
                p := p^.next;
            END (*WHILE*);
        END (*IF*);

        (* Page 31 of RFC 6376 seems to imply that we also have *)
        (* to pass the body hash to the current hash            *)
        (* calculation (before or after the base64 encoding?),  *)
        (* but this contradicts page 30, so I'm confused.       *)
        (* My tests suggest that page 30 is correct and page    *)
        (* 31 is wrong.                                         *)

        HashFinal (ctx, digest);

        (* That is the end of the hashing step.  The caller     *)
        (* will now we have to turn it into a signature.        *)

    END HashStep2;

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

PROCEDURE AddCRLF (VAR (*INOUT*) str: ARRAY OF CHAR);

    (* Appends a CRLF to the end of str.  *)

    VAR L: CARDINAL;

    BEGIN
        L := Strings.Length (str);
        str[L] := CR;  INC (L);
        str[L] := LF;  INC (L);
        str[L] := Nul;
    END AddCRLF;

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

PROCEDURE AddCRLF2 (VAR (*INOUT*) str: CharStr);

    (* Appends a CRLF to the end of str.  *)

    VAR L: CARDINAL;

    BEGIN
        L := str.size;
        IF (L > 0) AND (str.data^[L-1] = Nul) THEN
            DEC (L);
        END (*IF*);
        CSExpand (str, 2);
        str.data^[L] := CR;  INC (L);
        str.data^[L] := LF;  INC (L);
        IF L < str.allocated THEN
            str.data^[L] := Nul;
        END (*IF*);
        str.size := L;
    END AddCRLF2;

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

PROCEDURE FoldHeader (VAR (*IN*) header: CharStr;
                        VAR (*OUT*) folded: LineList);

    (* Folds header into a sequence of nlines shorter lines.  This  *)
    (* is called only for the generated DKIM-Signature header,      *)
    (* which we initially generated as a single line.               *)

    (* We terminate each line except the last with a CRLF. *)

    CONST linewidth = 72;

    VAR spaceleft: CARDINAL;
        current: LineList;

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

    PROCEDURE StartNewLine;

        BEGIN
            AddCRLF2 (current^.text);
            NEW (current^.next);
            current := current^.next;
            current^.next := NIL;
            MakeCS (current^.text, 0);
            spaceleft := linewidth;
        END StartNewLine;

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

    VAR j, k, L, length: CARDINAL;
        psection: POINTER TO ARRAY [0..127] OF CHAR;
        found, sc1, sc2, firsttime, neednewline: BOOLEAN;

    BEGIN
        NEW (psection);
        NEW (current);  folded := current;
        current^.next := NIL;
        MakeCS (current^.text, 0);
        spaceleft := linewidth;  firsttime := TRUE;  neednewline := FALSE;
        sc1 := FALSE;  sc2 := FALSE;
        j := 0;  L := header.size;
        WHILE j < L DO

            IF neednewline OR (spaceleft = 0) THEN
                StartNewLine;  neednewline := FALSE;
            END (*IF*);

            (* Copy up to the next semicolon, if possible. *)

            Strings.FindNext (';', header.data^, j, found, k);
            IF NOT found THEN k := L-1;  END(*IF*);
            length := k - j + 1;

            (* NOTE: length = 0 is not possible here, I believe. *)

            (* Check for special case.  The logic here is       *)
            (* complex enough that I'll break it into steps.    *)
            (* sc1 is for the b and bh values, and sc2 is for   *)
            (* the h values.                                    *)

            IF NOT sc1 THEN
                sc1 := (header.data^[j] = 'b') AND ((header.data^[j+1] = '=')
                        OR ((header.data^[j+1] = 'h') AND (header.data^[j+2] = '=')));
            END (*IF*);
            IF NOT sc2 THEN
                sc2 := (header.data^[j] = 'h') AND (header.data^[j+1] = '=');
            END (*IF*);

            (* In these special cases start a new line anyway. *)

            IF sc1 OR sc2 THEN
                StartNewLine;  neednewline := FALSE;
            END (*IF*);

            (* Now handle all cases that still don't fit. *)

            IF length > spaceleft THEN
                IF sc1 OR sc2 THEN

                    (* Reduce k so as to trim what we'll put on     *)
                    (* this line.  The rest will overflow to as     *)
                    (* many more lines as needed.                   *)

                    k := j + spaceleft - 1;
                    length := spaceleft;
                    IF sc2 THEN
                        (* Back up to the last colon that will fit. *)
                        WHILE (length > 0) AND (header.data^[k] <> ':') DO
                            DEC (k);  DEC(length);
                        END (*WHILE*);
                        (*
                        IF length = 0 THEN

                            (* I don't think this can ever happen.  *)
                            (* We have already started a new line,  *)
                            (* so It would require a header field   *)
                            (* too long to fit on a line alone.     *)

                            StartNewLine;
                        END (*IF*);
                        *)
                    END (*IF*);
                ELSE
                    (* In this case we still might have length      *)
                    (* greater than spaceleft, but if so we'll      *)
                    (* choose to live with a long line.  In the     *)
                    (* majority of cases, other than the special    *)
                    (* cases handled above, starting a new line     *)
                    (* means that spaceleft is now greater than     *)
                    (* length.                                      *)
                END (*IF*);
                neednewline := TRUE;

            END (*IF*);

            (* neednewline means that we want a new line AFTER      *)
            (* writing out this segment.  Write out header[j..k].   *)
            (* We precede it with a space to compensate for the     *)
            (* space we skipped when moving past a semicolon.       *)

            (* Note: it's not clear whether the previous pass       *)
            (* through this loop can have left us with no new line  *)
            (* and spaceleft=0, but I'll be cautious here.          *)

            IF NOT firsttime THEN
                CSAppendStr (current^.text, ' ');
                IF spaceleft > 0 THEN
                    DEC(spaceleft);
                END (*IF*);
            END(*IF*);
            IF length > 0 THEN
                CSExtract (header, j, length, psection^);
                CSAppendStr (current^.text, psection^);
            END(*IF*);

            IF spaceleft > length THEN DEC (spaceleft, length)
            ELSE spaceleft := 0
            END(*IF*);

            IF header.data^[k] = ';' THEN
                sc1 := FALSE;  sc2 := FALSE;
            END(*IF*);
            j := k + 1;
            WHILE header.data^[j] = ' ' DO INC(j) END(*IF*);
            firsttime := FALSE;

        END (*WHILE*);
        DISPOSE (psection);

    END FoldHeader;

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

PROCEDURE AppendBval (VAR (*INOUT*) folded: LineList;
                                bval: ARRAY OF CHAR);

    (* Appends bval to the already-folded text.  We terminate each  *)
    (* line EXCEPT the last with a CRLF.                            *)

    CONST linewidth = 72;

    VAR space, amount, toadd: CARDINAL;
        p: LineList;
        psection: POINTER TO ARRAY [0..127] OF CHAR;

    BEGIN
        NEW (psection);

        (* Find the end of the existing text. *)

        p := folded;
        WHILE p^.next <> NIL DO
            p := p^.next;
        END (*WHILE*);
        amount := p^.text.size;
        toadd := Strings.Length (bval);
        WHILE toadd > 0 DO
            IF amount < linewidth THEN
                space := linewidth - amount;
            ELSE
                space := 0;
            END (*IF*);
            IF toadd <= space THEN
                CSAppendStr (p^.text, bval);
                toadd := 0;
            ELSE
                IF space > 0 THEN
                    Strings.Extract (bval, 0, space, psection^);
                    CSAppendStr (p^.text, psection^);
                    Strings.Delete (bval, 0, space);
                    DEC (toadd, space);
                END (*IF*);
                AddCRLF2 (p^.text);
                NEW (p^.next);  p := p^.next;  p^.next := NIL;
                p^.text := StrToCharStr (" ");
                amount := 1;
            END (*IF*);
        END (*WHILE*);
        DISPOSE (psection);
    END AppendBval;

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

(*
PROCEDURE RecheckSignature (logID: TransactionLogID;  signature: ByteStr);

    (* For debugging, and useful only in localhost testing. *)
    (* Decrypts the signature to extract the digest that was encoded. *)

    (* My tests so far say that the payload after decoding is the   *)
    (* same as it was before encryption, so encryption/decryption   *)
    (* is not a problem.                                            *)

    VAR pubkey: RSAKeyType;
        sigstring: ARRAY [0..511] OF CARD8;

    BEGIN
        Copy (signature.data, ADR(sigstring), signature.size);
        pubkey := GetPublicKey (LocalParams);
        ExtractDigest (sigstring, pubkey);
    END RecheckSignature;
*)

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

PROCEDURE LMoveFile (oldname, newname: ARRAY OF CHAR): CARDINAL;

    (* Moves a file, deleting the original target file if it        *)
    (* exists.  This duplicates the function of FileOps.MoveFile,   *)
    (* which seemed to be producing a corrupt result.  In fact it   *)
    (* wasn't faulty, but now that I've written this version it     *)
    (* might as well stay in place.                                 *)

    VAR status: CARDINAL;  done: BOOLEAN;

    BEGIN
        status := OS2.DosCopy (oldname, newname, OS2.DCPY_EXISTING);
        IF status = 0 THEN
            FileSys.Remove (oldname, done);
            IF NOT done THEN
                status := 1;
            END (*IF*);
        END (*IF*);
        RETURN status;
    END LMoveFile;

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

PROCEDURE DKIMSignatureSet (logID: TransactionLogID;
                            pparams: ParamPtr;
                            inFile, outFile: ARRAY OF CHAR): CARDINAL;

    (* Insert a DKIM signature into the file.  If outFile = "",     *)
    (* the result replaces the input file.                          *)
    (*                                                              *)
    (*  Returns: DKIM_RC_OK, DKIM_RC_ILLEGALHASHALG                 *)

    VAR cancid, outcid: ChanId;  state: State;
        (*params: Params;*)
        rc: CARDINAL;
        tempfile: BOOLEAN;
        sigalg: PKAType;
        DKsig: CharStr;
        signature: ByteStr;
        p, nextp: HeaderPtr;
        resultFile: FilenameString;
        digest: ARRAY [0..63] OF CARD8;
        buffer: ARRAY [0..127] OF CHAR;
        bval: ARRAY [0..511] OF CHAR;
        folded, next: LineList;

    BEGIN
        (*LogTransactionL (logID, "Entering DKIMSignatureSet");*)

        NEW (state);
        state^.logID := logID;
        state^.HeaderFields := MakeHeaderList (pparams^.HeaderString);

        (* Create a canonicalised copy of the input file, and   *)
        (* do the body hash calculation.                        *)

        cancid := MakeCanonicalCopy (state, pparams^, inFile);
        IF NOT HashStep1 (state, pparams^, cancid) THEN
            DiscardState (state);
            RETURN DKIM_RC_ILLEGALHASHALG;
        END (*IF*);

        (* Create a signature containing everything except the b    *)
        (* value, which has not yet been computed.                  *)

        DKsig := StrToCharStr ("DKIM-Signature: v=1; q=dns/txt; a=");
        IF pparams^.alg = sha1 THEN
            CSAppendStr (DKsig, "rsa-sha1");
        ELSIF pparams^.alg = sha2_256 THEN
            CSAppendStr (DKsig, "rsa-sha256");
        ELSIF pparams^.alg = sha2_512 THEN
            CSAppendStr (DKsig, "rsa-sha512");
        ELSE
            CSAppendStr (DKsig, "???");
        END (*IF*);
        CSAppendStr (DKsig, "; c=");
        IF pparams^.HeaderRelaxed THEN
            CSAppendStr (DKsig, "relaxed");
        ELSE
            CSAppendStr (DKsig, "simple");
        END (*IF*);
        CSAppendStr (DKsig, "/");
        IF pparams^.BodyRelaxed THEN
            CSAppendStr (DKsig, "relaxed");
        ELSE
            CSAppendStr (DKsig, "simple");
        END (*IF*);
        CSAppendStr (DKsig, "; s=");
        CSAppendStr (DKsig, pparams^.selector);
        CSAppendStr (DKsig, "; d=");
        CSAppendStr (DKsig, pparams^.domain);
        CSAppendStr (DKsig, "; bh=");
        CSAppendStr (DKsig, state^.bh);
        CSAppendStr (DKsig, "; h=");
        p := state^.HeaderFields;
        WHILE p <> NIL DO
            CSAppendStrV (DKsig, p^.name.data^);
            nextp := p^.next;
            IF nextp <> NIL THEN
                CSAppendStr (DKsig, ":");
            END (*IF*);
            p := nextp;
        END (*WHILE*);
        CSAppendStr (DKsig, "; b=");

        (*LogTransactionL (logID, "Calling FoldHeader");*)
        FoldHeader (DKsig, folded);
        (*LogTransactionL (logID, "Returned from FoldHeader");*)

        (* The folded list is what we need to use for       *)
        (* simple canonicalisation, but we will use DKsig   *)
        (* in the relaxed case.                             *)

        RelaxHeaderLine (DKsig);

        (* Now compute the b value. *)

        (*LogTransactionL (logID, "Calling HashStep2");*)
        HashStep2 (state, pparams^, cancid, DKsig, folded, digest);
        (*LogTransactionL (logID, "Returned from HashStep2");*)

        IF pparams^.alg = sha1 THEN
            sigalg := sshrsa;
        ELSE
            sigalg := rsa_sha2_256;
        END (*IF*);
        signature := Sign (sigalg, digest, pparams^.privatekey);
        Base64.Encode (signature.data^, signature.size, bval);

        AppendBval (folded, bval);

        DiscardBS (signature);

        (* The canonicalised copy is no longer needed; delete it.   *)
        (* Also zero out the "len" fields of the header list, so as *)
        (* to be ready for the next signing.                        *)

        CloseFile (cancid);
        DiscardState (state);

        (* Now write the whole signature header to the output file, *)
        (* followed by the whole of the input file.                 *)

        IF outFile[0] = Nul THEN
            outcid := OpenNewOutputFile ("DK", ".tmp", resultFile, TRUE);
            tempfile := TRUE;
        ELSE
            Strings.Assign (outFile, resultFile);
            DeleteFile (outFile);
            outcid := OpenNewFile (resultFile, FALSE);
            tempfile := FALSE;
        END (*IF*);
        WHILE folded <> NIL DO
            Copy (folded^.text.data, ADR(buffer), folded^.text.size+1);
            FWriteString (outcid, buffer);
            DiscardCS (folded^.text);
            next := folded^.next;
            DISPOSE (folded);
            folded := next;
        END (*WHILE*);
        FWriteLn (outcid);
        CloseFile (outcid);
        EVAL (AppendFile (inFile, resultFile));

        IF tempfile THEN
            (* Special case: the output file replaces the input file. *)
            DeleteFile (inFile);
            Strings.Assign ("Moving result from ", buffer);
            Strings.Append (resultFile, buffer);
            Strings.Append (" to ", buffer);  Strings.Append (inFile, buffer);
            LogTransaction (logID, buffer);
            rc := LMoveFile (resultFile, inFile);
            IF rc <> 0 THEN
                Strings.Assign ("File move error ", buffer);
                AppendCard (rc, buffer);
                LogTransaction (logID, buffer);
            END (*IF*);
        END (*IF*);

        (*LogTransactionL (logID, "Leaving DKIMSignatureSet");*)
        RETURN DKIM_RC_OK;

    END DKIMSignatureSet;

(********************************************************************)
(*                      VALIDATING A SIGNATURE                      *)
(********************************************************************)

PROCEDURE DecodeDecimal (VAR (*OUT*) val: CARD64LE;
                                VAR (*IN*) str: ARRAY OF CHAR);

    (* Fetches a long cardinal from str. *)

    VAR pos, digit: CARDINAL;

    BEGIN
        val := CARD64LE{0,0};
        pos := 0;
        WHILE str[pos] IN CharSet {'0'..'9'} DO
            digit := ORD(str[pos]) - ORD('0');
            val := ShortMul64LE (val, 10);
            Add64LE (val, digit);
            INC (pos);
        END (*WHILE*);
    END DecodeDecimal;

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

PROCEDURE RemoveBval (VAR (*INOUT*) pheader: LineList);

    (* header is a (probably multiline) DKIM-Signature header.  We  *)
    (* modify it to remove the value of the b= field.               *)

    VAR prev, current: LineList;
        lineno: CARDINAL;           (* only while debugging *)

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

    PROCEDURE DeleteCurrentLine;

        VAR next: LineList;

        BEGIN
            DiscardCS (current^.text);
            next := current^.next;
            IF prev = NIL THEN
                pheader := next;
            ELSE
                prev^.next := next;
            END (*IF*);
            DISPOSE (current);
            current := next;
        END DeleteCurrentLine;

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

    VAR j, pos: CARDINAL;
        p: CharStringPtr;
        ch: CHAR;
        found, invalue, inbvalue, needeq: BOOLEAN;

    BEGIN
        lineno := 1;
        prev := NIL;  current := pheader;
        j := 0;
        invalue := FALSE;  inbvalue := FALSE;  needeq := FALSE;
        REPEAT
            p := current^.text.data;
            IF j >= current^.text.size THEN
                prev := current;  current := current^.next;
                INC (lineno);
                j := 0;
            ELSIF needeq THEN
                Strings.FindNext ('=', p^, j, found, pos);
                IF found THEN
                    invalue := TRUE;  needeq := FALSE;  j := pos+1;
                ELSE
                    j := current^.text.size;
                END (*IF*);
            ELSIF invalue THEN

                (* We are inside some parameter's value field.  *)
                (* This will be terminated by a semicolon.      *)

                Strings.FindNext (';', p^, j, found, pos);
                IF found THEN
                    IF inbvalue THEN
                        (* We have to delete the range [j..pos-1].  *)
                        IF pos > j THEN
                            Strings.Delete (p^, j, pos-j);
                            DEC (current^.text.size, pos-j);
                        END (*IF*);
                        (* This will not leave the line empty,          *)
                        (* because there is a semicolon still there.    *)
                        inbvalue := FALSE;
                    ELSE
                        j := pos + 1;
                    END (*IF*);
                    invalue := FALSE;
                ELSE
                    IF inbvalue THEN
                        (* Delete remainder of line. *)
                        p^[j] := Nul;
                        current^.text.size := j;
                        IF j = 0 THEN
                            DeleteCurrentLine;
                        ELSE
                            IF current^.next <> NIL THEN
                                (* Restore the CRLF.  There is enough   *)
                                (* space for it in the current string   *)
                                (* because we have just deleted stuff.  *)
                                AddCRLF2 (current^.text);
                            END (*IF*);
                            j := current^.text.size;
                        END (*IF*);
                    END (*IF*);
                END (*IF*);
            ELSE
                (* We must be at the beginning of a new field. *)

                p := current^.text.data;
                ch := p^[j];
                WHILE ch = ' ' DO
                    INC(j);
                    ch := p^[j];
                END (*WHILE*);
                IF ch = CR THEN
                    prev := current;  current := current^.next;
                    INC (lineno);
                    j := 0;
                ELSE
                    IF ch = 'b' THEN
                        inbvalue := p^[j+1] <> 'h';
                    END (*IF*);
                    Strings.FindNext ('=', p^, j, found, pos);
                    IF found THEN
                        invalue := TRUE;  j := pos+1;
                    ELSE
                        needeq := TRUE;  j := current^.text.size;
                    END (*IF*);
                END (*IF*);
            END (*IF*);
        UNTIL current = NIL;

        (* Remove any CRLF that remains on the final line.  *)

        IF prev = NIL THEN
            prev := pheader;
            WHILE prev^.next <> NIL DO
                prev := prev^.next;
            END (*WHILE*);
        END (*IF*);
        IF prev <> NIL THEN
            pos := prev^.text.size;
            IF prev^.text.data^[pos-1] = Nul THEN DEC(pos) END (*IF*);
            IF (pos >= 2) THEN DEC(pos, 2) END(*IF*);
            IF prev^.text.data^[pos] = CR THEN
                prev^.text.data^[pos] := Nul;
                DEC (prev^.text.size, 2);
            END (*IF*);
        END (*IF*);

    END RemoveBval;

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

PROCEDURE ExtractDKIMHeader (VAR (*IN*) infile: ARRAY OF CHAR;
                             state: State;
                             VAR (*OUT*) params: Params;
                             VAR (*OUT*) DKheader: CharStr;
                             VAR (*OUT*) OriginalHeader: LineList;
                             VAR (*OUT*) bh, b: ARRAY OF CHAR): CARDINAL;

    (* Searches the file for a DKIM-Signature header line, and      *)
    (* parses it if found.  We return two copies of the DKIM header,*)
    (* because we don't know, before parsing this header, whether   *)
    (* to use simple or relaxed canonicalisation.  DKheader is the  *)
    (* relaxed version, and OriginalHeader, which is multiline,     *)
    (* is the original non-relaxed copy.  The caller only wants to  *)
    (* know one of these, of course, but it's simpler to return both.*)

    (* Each string in OriginalHeader EXCEPT the last is terminated  *)
    (* with a CRLF.                                                 *)

    (* Possible results: DKIM_RC_OK, DKIM_RC_NOSIGNATURE, DKIM_RC_UNSUPPORTEDVERSION *)

    VAR incid: ChanId;  pos, pos2: CARDINAL;
        last, current: LineList;
        found: BOOLEAN;
        tag: ARRAY [0..7] OF CHAR;
        value: ARRAY [0..511] OF CHAR;
        line: ARRAY [0..1023] OF CHAR;

    BEGIN
        (* We need an initial pass through the file to extract the  *)
        (* DKIM-Signature header.  Until we have that, we don't     *)
        (* know the parameter values we must use.                   *)

        OriginalHeader := NIL;  last := NIL;  current := NIL;
        incid := OpenOldFile (infile, FALSE, FALSE);
        found := FALSE;
        MakeCS (DKheader, 0);
        LOOP
            GetLine (incid, line);
            IF (line[0] = CtrlZ) OR (line[0] = Nul) THEN

                (* End of headers, so nothing more to search. *)

                EXIT (*LOOP*);
            ELSIF (line[0] = ' ') OR (line[0] = Tab) THEN
                (* Continuation line. *)
                IF found THEN
                    CSAppendStr (DKheader, line);
                    AddCRLF (line);
                    NEW (current);
                    last^.next := current;  current^.next := NIL;
                    current^.text := StrToCharStr (line);
                    last := current;
                END (*IF*);
            ELSIF found THEN
                (* No more continuation lines. *)
                EXIT (*LOOP*);
            ELSIF HeadMatch (line, "DKIM-Signature") THEN
                CSAppendStr (DKheader, line);
                AddCRLF (line);
                NEW (OriginalHeader);
                OriginalHeader^.next := NIL;
                OriginalHeader^.text := StrToCharStr (line);
                last := OriginalHeader;
                found := TRUE;
            END(*IF*);
        END (*LOOP*);
        CloseFile (incid);

        IF NOT found THEN
            RETURN DKIM_RC_NOSIGNATURE;
        END (*IF*);

        (* The final lline in OriginalHeader should not end with    *)
        (* CRLF, so remove that one.                                *)

        IF last <> NIL THEN
            pos := last^.text.size;
            IF last^.text.data^[pos-1] = Nul THEN DEC(pos) END(*IF*);
            IF (pos >= 2) THEN DEC(pos, 2) END(*IF*);
            IF last^.text.data^[pos] = CR THEN
                last^.text.data^[pos] := Nul;
            END (*IF*);
        END (*IF*);

        (* End of initial pass. *)

        RelaxHeaderLine (DKheader);

        (* Now we pick up the parameters.  Begin by setting default *)
        (* values if they are allowed.                              *)

        params.HeaderRelaxed := FALSE;  params.BodyRelaxed := FALSE;
        params.BodyLength := DKIM_ENTIREBODY;

        pos2 := 15;
        WHILE pos2 < DKheader.size DO
            GetTagAndValue2 (DKheader, pos2, tag, value);
            CASE tag[0] OF
             |  'a':    IF Strings.Equal (value, "rsa-sha1") THEN
                            params.alg := sha1;
                        ELSIF Strings.Equal (value, "rsa-sha256") THEN
                            params.alg := sha2_256;
                        ELSE
                            (* Illegal algorithm. *)
                        END (*IF*);
             |  'b':    IF tag[1] = 'h' THEN
                            Strings.Assign (value, bh);
                        ELSE
                            Strings.Assign (value, b);
                        END (*IF*);
             |  'c':    IF HeadMatch (value, "simple") THEN
                            Strings.Delete (value, 0, 6);
                        ELSIF HeadMatch (value, "relaxed") THEN
                            Strings.Delete (value, 0, 7);
                            params.HeaderRelaxed := TRUE;
                        ELSE
                            (* Report syntax error. *)
                        END (*IF*);
                        IF value[0] = '/' THEN
                            Strings.Delete (value, 0, 1);
                            IF HeadMatch (value, "relaxed") THEN
                                params.BodyRelaxed := TRUE;
                            ELSE
                                (* Assume simple. *)
                            END (*IF*);
                        END (*IF*);
             |  'd':    Strings.Assign (value, params.domain);
             |  'h':    RemoveAllSpaces (value);
                        state^.HeaderFields := MakeHeaderList(value);
             |  'i':    (* Ignored parameter, until I can see a point to it. *);
             |  'l':    DecodeDecimal (params.BodyLength, value);
             |  'q':    (* Ignored, since there is only one possibility. *);
             |  's':    Strings.Assign (value, params.selector);
             |  't':    (* Not implemented. *);
             |  'v':    IF (value[0] <> '1') OR (value[1] <> Nul) THEN
                            (* Report unknown version number *)
                            RETURN DKIM_RC_UNSUPPORTEDVERSION;
                        END (*IF*);
             |  'x':    (* Not implemented. *);
             |  'z':    (* Not implemented. *);
            ELSE
                (* Report illegal tag *)
            END (*CASE*);
        END (*WHILE*);

        RemoveAllSpaces (b);
        RemoveAllSpaces (bh);

        (* We are now finished in the HeaderRelaxed case.  In the   *)
        (* non-relaxed case we still have to partly repeat the      *)
        (* above analysis on OriginalHeader, because our HashStep2  *)
        (* calculation requires a copy of the DKIM-Signature header *)
        (* in which the b value has been deleted.                   *)

        IF NOT params.HeaderRelaxed THEN
            RemoveBval (OriginalHeader);
        END (*IF*);

        RETURN DKIM_RC_OK;

    END ExtractDKIMHeader;

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

(*
PROCEDURE DummyExtractDKIMHeader (VAR (*IN*) infile: ARRAY OF CHAR;
                             VAR (*OUT*) params: Params;
                             VAR (*OUT*) DKheader: CharStr;
                             VAR (*OUT*) OriginalHeader: LineList;
                             VAR (*OUT*) bh, b: ARRAY OF CHAR): CARDINAL;

    (* For testing: returns a fixed result rather than one          *)
    (* derived from infile.                                         *)

    VAR hlist: ARRAY [0..23] OF CHAR;

    BEGIN
        params.alg := sha2_256;
        params.HeaderRelaxed := TRUE;
        params.BodyRelaxed := TRUE;
        params.BodyLength := DKIM_ENTIREBODY;
        params.selector := "default";
        params.domain := "pmoylan.org";
        hlist := "From:To";
        params.HeaderFields := MakeHeaderList(hlist);

        DKheader := StrToCharStr ("dkim-signature: v=1; q=dns/txt; c=relaxed/relaxed; a=rsa-sha256;");
        CSAppendStr (DKheader, "bh=K66BMGyWfRZGX4iFNHb9Rzlf4rR0jh2Fr2mxGqoRaqU=; d=pmoylan.org;");
        CSAppendStr (DKheader, "h=From:To; s=default; b=");

        OriginalHeader := NIL;

        Strings.Assign ("K66BMGyWfRZGX4iFNHb9Rzlf4rR0jh2Fr2mxGqoRaqU=", bh);
        Strings.Assign ("ILwvfT9r+Cq9zhFJAbAc1NPVA1GYb1CaNAhQw/aYbZ/rUPcOIm6BOvL4qHamHVeTtGlTd" +
            "BH0EQ1BGqE84jCwDBBAns63aPmwVJ1zWx4avBiYaj9g+BooeYfAJ0CW5TXmmGZcdwHHUPFd" +
            "66fbMAU3ko1bOtB6TJE/5Mp+hNYHw7M=", b);

        RETURN 0;

    END DummyExtractDKIMHeader;
*)

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

(* Something in the first half of this procedure is creating a      *)
(* memory corruption problem.  At present ExtractDKIMHeader is my   *)
(* prime suspect.                                                   *)

PROCEDURE DKIMSignatureValidate (VAR (*IN*) File: ARRAY OF CHAR;
                                   logID: TransactionLogID): CARDINAL;

    (* Check the DKIM signature in a file.  Possible results:       *)
    (* DKIM_RC_OK, DKIM_RC_NOSIGNATURE, DKIM_RC_UNSUPPORTEDVERSION, *)
    (* DKIM_RC_VERIFICATIONFAILED, DKIM_RC_KEYNOTPROVIDED,          *)
    (* DKIM_RC_ILLEGALHASHALG.                                      *)

    (* signature is a binary string, not a character string. *)

    VAR cancid: ChanId;
        params: Params;
        state: State;
        signature: ByteStr;
        publickey: RSAKeyType;
        OriginalHeader: LineList;
        DKheader: CharStr;

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

    PROCEDURE TidyUp;

        (* Tidies up before an error return. *)

        BEGIN
            IF cancid <> NoSuchChannel THEN
                CloseFile (cancid);
            END (*IF*);
            DiscardState (state);
            IF OriginalHeader <> NIL THEN
                DiscardLines (OriginalHeader);
            END (*IF*);
            DiscardBS (signature);
            DiscardCS (DKheader);
            DiscardKey (publickey);
            (*
            Heap.SayHeapCount (logID, "Validate");
            Heap.StopHeapLogging;
            *)
        END TidyUp;

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

    VAR rc, N: CARDINAL;
        sigalg: PKAType;
        bh, b: ParamStr;
        digest: ARRAY [0..63] OF CARD8;
        bindata: ARRAY [0..2047] OF CARD8;

        (* Note that we are keeping two copies of the DKIM header,  *)
        (* because we don't yet know whether to use simple or       *)
        (* relaxed canonicalisation.                                *)

    BEGIN
        (*
        Heap.EnableHeapLogging (logID);
        Heap.SayHeapCount (logID, "Validate");
        *)
        state := NIL;  OriginalHeader := NIL;
        cancid := NoSuchChannel;
        publickey := InitKey();    (* initialised to an all-NIL key *)
        MakeBS (signature, 0);

        NEW (state);  state^.canfilename := "";
        state^.logID := logID;
        state^.HeaderFields := NIL;

        (* We need an initial pass through the file to extract the  *)
        (* DKIM-Signature header.  Until we have that, we don't     *)
        (* know the parameter values we must use.                   *)

        rc := ExtractDKIMHeader (File, state, params, DKheader,
                                    OriginalHeader, bh, b);
        IF rc <> DKIM_RC_OK THEN
            TidyUp;
            RETURN rc;
        END (*IF*);

        (* The remainder of the calculation is essentially the same *)
        (* as that for signing.  We calculate what the bh and b     *)
        (* values should be, and compare them with what we have     *)
        (* extracted from the DKIM signature.                       *)

        cancid := MakeCanonicalCopy (state, params, File);

        (* If we have an invalid hash algorithm, or if the bh value *)
        (* is wrong, there is no point in going on to the next step.*)

        IF NOT HashStep1 (state, params, cancid) THEN
            rc := DKIM_RC_ILLEGALHASHALG;
        END (*IF*);
        IF NOT Strings.Equal (bh, state^.bh) THEN
            (* Body hash mismatch. *)
            TidyUp;
            rc := DKIM_RC_INVALIDBODYHASH;
        END (*IF*);
        (*LogTransactionL (logID, "Finished hash step 1");*)

        (*rc := DKIM_RC_OK;*)

        (**)
        IF rc = DKIM_RC_OK THEN

            (* Fetch the public key. *)

            publickey := GetPublicKey (params);
            IF IsNilKey(publickey) THEN
                TidyUp;
                RETURN DKIM_RC_KEYNOTPROVIDED;
            END (*IF*);

            (* The b value from the DKIM-Signature header is Base64 *)
            (* encoded.  Reduce it to a binary string.              *)

            N := Base64.Decode (b, bindata);
            MakeBS (signature, N);
            Copy (ADR(bindata), signature.data, N);
            HashStep2 (state, params, cancid,
                             DKheader, OriginalHeader, digest);

            IF params.alg = sha1 THEN
                sigalg := sshrsa;
            ELSE
                sigalg := rsa_sha2_256;
            END (*IF*);
            (*LogTransactionL (logID, "Finished hash step 2");*)

            IF NOT SignatureValid (sigalg, digest, publickey,
                                        signature, logID) THEN
                (* Header b value mismatch. *)

                LogTransactionL (logID, "Verification failed");
                rc := DKIM_RC_VERIFICATIONFAILED;
            END (*IF*);

        END (*IF*);

        TidyUp;
        RETURN rc;

    END DKIMSignatureValidate;

(********************************************************************)
(*                 LOADING PARAMETERS FROM INI FILE                 *)
(********************************************************************)

PROCEDURE DiscardParams (VAR (*INOUT*) p: ParamPtr);

    (* Discards the parameters for one domain.  *)

    BEGIN
        DiscardKey (p^.privatekey);
        DISPOSE (p);
    END DiscardParams;

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

PROCEDURE GetDKIMEnable (D: Domain;  VAR (*OUT*) check, sign: BOOLEAN);

    (* Is DKIM checking and signing enabled for this domain? *)

    VAR hini: INIData.HINI;
        app: ARRAY [0..7] OF CHAR;

    BEGIN
        hini := OpenDomainINI(D);
        IF INIData.INIValid (hini) THEN
            app := "$SYS";
            IF NOT INIData.INIGet (hini, app, "DKIMCheckEnable", check) THEN
                check := FALSE;
            END (*IF*);
            IF NOT INIData.INIGet (hini, app, "DKIMSignEnable", sign) THEN
                sign := FALSE;
            END (*IF*);
        ELSE
            check := FALSE;  sign := FALSE;
        END (*IF*);
    END GetDKIMEnable;

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

PROCEDURE MakeParamRecord (D: Domain): ParamPtr;

    (* Sets several parameters controlling DKIM operation.  This is *)
    (* the version where we we can have different parameters for    *)
    (* different domains.  Assumption: D <> NILDomain.              *)

    (* This is to create signatures on outgoing mail.  For incoming *)
    (* mail, the parameters are instead taken from the existing     *)
    (* DKIM signature in the message headers.                       *)

    VAR hini: INIData.HINI;
        result: ParamPtr;
        app: ARRAY [0..7] OF CHAR;
        file: FilenameString;
        pass: ARRAY [0..63] OF CHAR;
        DKIMsr: CARD8;  bool, enable: BOOLEAN;

    BEGIN
        NEW (result);

        (* Now fill in the values. *)

        WITH result^ DO

            (* Set initial defaults in case of failure. *)

            Strings.Assign ("localhost", domain);
            Strings.Assign ("_default", selector);
            alg := sha2_256;
            file := "keys\id_rsa";
            pass := "";
            Strings.Assign ("Received:From:To:Subject:Date:Message-ID", HeaderString);
            BodyRelaxed := FALSE;
            HeaderRelaxed := FALSE;

            (* Now load the values. *)

            hini := OpenDomainINI(D);
            IF INIData.INIValid (hini) THEN
                app := "$SYS";
                enable :=INIData.INIGet (hini, app, "DKIMSignEnable", bool) AND bool;
                IF enable THEN
                    EVAL(INIData.INIGetString (hini, app, "DKIMSigning", domain));
                    EVAL(INIData.INIGetString (hini, app, "DKIMSelector", selector));
                    IF INIData.INIGet (hini, app, "DKIMsha1", bool) AND bool THEN
                        alg := sha1;
                    ELSE
                        alg := sha2_256;
                    END (*IF*);
                    EVAL(INIData.INIGetString (hini, app, "DKIMPrivKeyFile", file));
                    privatekey := LoadRSAPrivateKey (file);
                    EVAL(INIData.INIGetString (hini, app, "DKIMHeaders", HeaderString));
                    EVAL(INIData.INIGet (hini, app, "DKIMsr", DKIMsr));
                    (*    00 = s/s     01 = s/r    10 = r/s    11 = r/r  *)
                    BodyRelaxed := ODD (DKIMsr);
                    HeaderRelaxed := ODD (DKIMsr DIV 2);
                END (*IF*);
                CloseDomainINI(D, hini);
            END (*IF*);
            BodyLength := DKIM_ENTIREBODY;
        END (*WITH*);

        (* No provision now, and possible none ever, for    *)
        (* password-protected key file.                     *)

        RETURN result;

    END MakeParamRecord;

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

PROCEDURE GetParams (D: Domain): ParamPtr;

    (* Returns a pointer to the DKIM parameters for this domain,    *)
    (* updating ParamList if necessary.                             *)

    VAR p, current: ParamListPtr;
        result: ParamPtr;

    BEGIN
        Obtain (ParamList.access);
        p := ParamList.head;
        WHILE (p <> NIL) AND (p^.domain <> D) DO
            p := p^.next;
        END (*WHILE*);
        IF p = NIL THEN
            IF D = NILDomain THEN
                result := ADR(LocalParams);
            ELSE
                result := MakeParamRecord(D);
            END (*IF*);

            (* Insert the new result at the head of ParamList, on   *)
            (* the grounds that recently accessed records are       *)
            (* likely to be accessed again soon. We don't go as far *)
            (* as re-sorting the list, because it's probably not    *)
            (* very long anyway.                                    *)

            NEW (current);
            current^.next := ParamList.head;
            current^.domain := D;
            current^.pparams := result;
            ParamList.head := current;
        ELSE
            result := p^.pparams;
        END (*IF*);
        Release (ParamList.access);
        RETURN result;
    END GetParams;

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

PROCEDURE LoadDefaultParameters;

    (* Sets several parameters controlling DKIM operation.  This is  *)
    (* the version where we use the same parameters for all domains. *)

    (* This is to create signatures on outgoing mail.  For incoming *)
    (* mail, the parameters are instead taken from the existing     *)
    (* DKIM signature.                                              *)

    VAR hini: INIData.HINI;
        app: ARRAY [0..7] OF CHAR;
        file: FilenameString;
        pass: ARRAY [0..63] OF CHAR;
        DKIMsr: CARD8;  bool, enable: BOOLEAN;

    BEGIN
        WITH LocalParams DO

            (* Set initial defaults in case of failure. *)

            Strings.Assign ("localhost", domain);
            Strings.Assign ("_default", selector);
            file := "keys\id_rsa";
            pass := "";
            Strings.Assign ("Received:From:To:Subject:Date:Message-ID", HeaderString);
            BodyRelaxed := FALSE;
            HeaderRelaxed := FALSE;
            privatekey := InitKey();

            (* Now load the values. *)

            hini := OpenINI();
            IF INIData.INIValid (hini) THEN
                app := "$SYS";
                enable :=INIData.INIGet (hini, app, "DKIMSignEnable", bool) AND bool;
                IF enable THEN
                    EVAL(INIData.INIGetString (hini, app, "DKIMSigning", domain));
                    EVAL(INIData.INIGetString (hini, app, "DKIMSelector", selector));
                    IF INIData.INIGet (hini, app, "DKIMsha1", bool) AND bool THEN
                        alg := sha1;
                    ELSE
                        alg := sha2_256;
                    END (*IF*);
                    EVAL(INIData.INIGetString (hini, app, "DKIMPrivKeyFile", file));
                    DiscardKey (privatekey);
                    privatekey := LoadRSAPrivateKey (file);
                    EVAL(INIData.INIGetString (hini, app, "DKIMHeaders", HeaderString));
                    EVAL(INIData.INIGet (hini, app, "DKIMsr", DKIMsr));
                    (*    00 = s/s     01 = s/r    10 = r/s    11 = r/r  *)
                    BodyRelaxed := ODD (DKIMsr);
                    HeaderRelaxed := ODD (DKIMsr DIV 2);
                END (*IF*);
                CloseINI;
            END (*IF*);
            BodyLength := DKIM_ENTIREBODY;
        END (*WITH*);

        (* No provision at this stage for password-protected file. *)

    END LoadDefaultParameters;

(********************************************************************)
(*                 THE EXTERNALLY CALLABLE PROCEDURES               *)
(********************************************************************)

PROCEDURE InsertDKIMSignature (logID: TransactionLogID;  D: Domain;
                                        infile, outfile: ARRAY OF CHAR);

    (* Inserts a DKIM signature as a header in the message file     *)
    (* infile, with the result put in outfile.  (If outfile is the  *)
    (* empty string, the result overwrites infile.)  No result is   *)
    (* returned to the caller.  Instead, error messages are sent to *)
    (* the log file.                                                *)

    VAR rc: CARDINAL;
        pparams: ParamPtr;

    BEGIN
        IF D = NILDomain THEN
            pparams := ADR(LocalParams);
        ELSE
            pparams := GetParams(D);
        END (*IF*);
        IF IsNilKey(pparams^.privatekey) THEN
            LogTransactionL (logID, "DKIM: can't read private key file");
            LogTransactionL (logID, "No DKIM signature generated");
            RETURN;
        END (*IF*);
        Obtain (access);
        rc := DKIMSignatureSet (logID, pparams, infile, outfile);
        Release (access);

        CASE rc OF
            DKIM_RC_OK:
                LogTransactionL (logID, "DKIM signature added");
           |
            DKIM_RC_ILLEGALHASHALG:
                LogTransactionL (logID, "Bad hash algorithm, DKIM signature not added");
        ELSE
            LogTransactionL (logID, "DKIM: unknown error code");
        END (*CASE*);

    END InsertDKIMSignature;

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

PROCEDURE CheckDKIMSignature (logID: TransactionLogID;
                                VAR (*IN*) filename: ARRAY OF CHAR;
                                VAR (*OUT*) reason: ARRAY OF CHAR;
                                VAR (*IN*) dummy: ARRAY OF CARD8)
                                                         : DKIMresult;

    (* Checks the DKIM-Signature header field, if any, in the file. *)
    (* If there is no such header, we return TEMPFAIL.  The reason  *)
    (* output is a message suitable for logging.                    *)

    VAR result: CARDINAL;

    BEGIN
        Obtain (access);
        result := DKIMSignatureValidate (filename, logID);
        Release (access);

        CASE result OF
            DKIM_RC_OK:
                Strings.Assign ("DKIM signature is valid", reason);
                RETURN SUCCESS;
          | DKIM_RC_KEYNOTPROVIDED:
                Strings.Assign ("DKIM public key not provided", reason);
                RETURN TEMPFAIL;
          | DKIM_RC_NOSIGNATURE:
                Strings.Assign ("There is no DKIM signature", reason);
                RETURN TEMPFAIL;
          | DKIM_RC_INVALIDBODYHASH:
                Strings.Assign ("DKIM failure: invalid body hash", reason);
                RETURN PERMFAIL;
          | DKIM_RC_VERIFICATIONFAILED:
                Strings.Assign ("DKIM signature does not match", reason);
                RETURN PERMFAIL;
          | DKIM_RC_UNSUPPORTEDVERSION:
                Strings.Assign ("Invalid DKIM version number", reason);
                RETURN TEMPFAIL;
        ELSE
            Strings.Assign ("unknown return code from DKIM checker", reason);
            RETURN PERMFAIL;
        END (*CASE*);
    END CheckDKIMSignature;

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

PROCEDURE DiscardAllDKIMParameters;

    (* To be called when the INI file has changed.  We unload all   *)
    (* the DKIM parameters that we have stored.  They will be       *)
    (* reloaded gradually as calls to insert a DKIM signature arise.*)

    VAR p, next: ParamListPtr;

    BEGIN
        Obtain (ParamList.access);
        p := ParamList.head;
        WHILE p <> NIL DO
            next := p^.next;
            IF p^.domain <> NILDomain THEN
                DiscardParams (p^.pparams);
            END (*IF*);
            DISPOSE (p);
            p := next;
        END (*WHILE*);
        ParamList.head := NIL;
        Release (ParamList.access);
    END DiscardAllDKIMParameters;

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

BEGIN
    CreateLock (access);
    CreateLock (ParamList.access);
    ParamList.head := NIL;
    LoadDefaultParameters;
FINALLY
    DiscardAllDKIMParameters;
    DestroyLock (ParamList.access);
    DestroyLock (access);
    DiscardKey (LocalParams.privatekey);
END DKIM.

