MODULE keygen;

        (********************************************************)
        (*                                                      *)
        (*                Generating an RSA key                 *)
        (*                                                      *)
        (*  We create both public and private key files, and    *)
        (*  also create a BINDData.txt file containing a TXT    *)
        (*  entry suitable for insertion as nameserver data.    *)
        (*                                                      *)
        (*      Usage: keygen -b N                              *)
        (*  where N is the desired number of bits.  If the -b   *)
        (*  parameter is missing then we assume 1024 bits.      *)
        (*                                                      *)
        (*  Programmer:         P. Moylan                       *)
        (*  Last edited:        30 August 2023                  *)
        (*  Status:             OK                              *)
        (*                                                      *)
        (*      In case you're wondering what RSA stands for,   *)
        (*      it's Rivest-Shamir-Adleman, after the           *)
        (*      inventors of the algorithm.                     *)
        (*                                                      *)
        (********************************************************)


IMPORT IOChan, TextIO, BigNum, Base64, ASN1, Strings, INIData;

FROM SYSTEM IMPORT CARD8, ADR;

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

FROM RSAGenerate IMPORT
    (* proc *)  RSA_Generate;

FROM BigNum IMPORT
    (* type *)  BN;

FROM VarStrings IMPORT
    (* type *)  ByteStr, ByteStringPtr,
    (* proc *)  DiscardBS;

FROM TimeConv IMPORT
    (* proc *)  time;

FROM FileOps IMPORT
    (* type *)  ChanId, FilenameString,
    (* proc *)  Exists, DeleteFile, MoveFile, CreateDir, OpenNewFile, CloseFile,
                FWriteChar, FWriteString, FWriteLn;

FROM ProgramArgs IMPORT
    (* proc *)  ArgChan, IsArgPresent;

FROM INIData IMPORT
    (* proc *)  ChooseDefaultINI, OpenINIFile, INIGetString, CloseINIFile;

FROM Inet2Misc IMPORT
    (* proc *)  Swap4, AddressToHostName;

FROM Sockets IMPORT
    (* proc *)  gethostid;

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

FROM Names IMPORT
    (* type *)  HostName;

FROM Storage IMPORT
    (* proc *)  ALLOCATE;

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

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

CONST
    TESTING = FALSE;
    keydir = "keys";
    defaultkeylength = 1024;         (* bits *)
    testOptions = "-b 64";        (* while testing *)
    Nul = CHR(0);
    MaxKeyChars = 16384;

VAR
    SavedKey: ARRAY [0..MaxKeyChars] OF CHAR;

(************************************************************************)
(*                       GETTING THE PARAMETERS                         *)
(************************************************************************)

PROCEDURE GetParams (VAR (*OUT*) keylength: CARDINAL);

    (* Only option in this version is   *)
    (*      -b bits                     *)

    TYPE CharSet = SET OF CHAR;

    CONST Digits = CharSet {'0'..'9'};

    VAR Options: ARRAY [0..63] OF CHAR;
        j: CARDINAL;

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

    PROCEDURE SkipBlanks;

        BEGIN
            LOOP
                IF Options[j] <> ' ' THEN EXIT(*LOOP*) END(*IF*);
                IF j = 63 THEN
                    Options[j] := CHR(0);  EXIT (*LOOP*);
                ELSE
                    INC (j);
                END (*IF*);
            END (*LOOP*);
        END SkipBlanks;

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

    VAR args: IOChan.ChanId;

    BEGIN
        keylength := 0;
        args := ArgChan();
        IF IsArgPresent() OR TESTING THEN
            IF TESTING THEN
                Options := testOptions;
            ELSE
                TextIO.ReadString (args, Options);
            END (*IF*);
            j := 0;  SkipBlanks;
            LOOP
                CASE Options[j] OF
                    CHR(0): EXIT (*LOOP*);
                  | '0'..'9':
                            (* Be tolerant of a missing -b *)

                            IF keylength = 0 THEN
                                WHILE Options[j] IN Digits DO
                                    keylength := 10*keylength
                                                + ORD(Options[j]) - ORD('0');
                                    INC (j);
                                END (*WHILE*);
                            END (*IF*);
                  | '-':    INC (j);
                  | 'b':    INC (j);  SkipBlanks;
                            WHILE Options[j] IN Digits DO
                                keylength := 10*keylength
                                            + ORD(Options[j]) - ORD('0');
                                INC (j);
                            END (*WHILE*);
                ELSE
                    WriteString ("Unknown option ");
                    WriteChar (Options[j]);  WriteLn;
                    INC(j);
                END (*CASE*);
                SkipBlanks;
            END (*LOOP*);
        END (*IF*);
        IF keylength = 0 THEN
            keylength := defaultkeylength;
        END (*IF*);
    END GetParams;

(************************************************************************)
(*                       GENERIC WRITE KEY FILE                         *)
(************************************************************************)

PROCEDURE WriteKeyFile (private, SaveIt: BOOLEAN;  filename: FilenameString;
                            N: CARDINAL;  keydata: ARRAY OF BN);

    (* Writes a key file based on N elements of keydata.  If SaveIt is  *)
    (* true then we also save the encoded key string in SavedKey.       *)

    CONST
        CharsPerLine = 64;  Nul = CHR(0);

    VAR cid: ChanId;
        amount: CARDINAL;
        asn: ByteStr;
        encoded: ARRAY [0..MaxKeyChars-1] OF CHAR;
        line: ARRAY [0..CharsPerLine-1] OF CHAR;
        bakname: FilenameString;
        label: ARRAY [0..15] OF CHAR;

    BEGIN
        (* Encode keydata as an ASN1 array. *)

        asn := ASN1.ASNEncodeBNArray (N, keydata);

        (* Further encoded it as Base64. *)

        Base64.Encode (asn.data^, asn.size, encoded);
        DiscardBS (asn);

        (* If required, save the result in a global variable. *)

        IF SaveIt THEN
            Strings.Assign (encoded, SavedKey);
        END (*IF*);

        (* Write the final result to the file.  *)

        bakname := filename;
        Strings.Append (".bak", bakname);

        IF Exists(filename) THEN
            IF Exists(bakname) THEN
                DeleteFile (bakname);
            END (*IF*);
            EVAL (MoveFile (filename, bakname));
        END (*IF*);
        cid := OpenNewFile (filename, FALSE);
        IF private THEN
            label := "PRIVATE";
        ELSE
            label := "PUBLIC";
        END (*IF*);
        FWriteString (cid, "-----BEGIN RSA ");
        FWriteString (cid, label);
        FWriteString (cid, " KEY-----");  FWriteLn (cid);
        REPEAT
            amount := Strings.Length (encoded);
            IF amount > CharsPerLine THEN
                amount := CharsPerLine;
            END (*IF*);
            Strings.Extract (encoded, 0, amount, line);
            Strings.Delete (encoded, 0, amount);
            FWriteString (cid, line);
            FWriteLn (cid);
        UNTIL encoded[0] = Nul;
        FWriteString (cid, "-----END RSA ");
        FWriteString (cid, label);
        FWriteString (cid, " KEY-----");  FWriteLn (cid);
        FWriteLn (cid);
        CloseFile (cid);
    END WriteKeyFile;

(************************************************************************)
(*                      WRITING A PUBLIC KEY FILE                       *)
(************************************************************************)

PROCEDURE WriteCard (N: CARDINAL);

    (* Writes N to standard output in decimal.  *)

    BEGIN
        IF N > 9 THEN
            WriteCard (N DIV 10);
            N := N MOD 10;
        END (*IF*);
        WriteChar (CHR(ORD('0') + N));
    END WriteCard;

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

PROCEDURE HexVal (ch: CHAR): CARD8;

    (* Convert a single hexadecimal digit. *)

    TYPE CharSet = SET OF CHAR;

    BEGIN
        IF ch IN CharSet{'a'..'f'} THEN
            RETURN ORD(ch) - ORD('a') + 10;
        ELSIF ch IN CharSet{'A'..'F'} THEN
            RETURN ORD(ch) - ORD('A') + 10;
        ELSE
            RETURN ORD(ch) - ORD('0');
        END (*IF*);
    END HexVal;

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

PROCEDURE HexToByteStr (str: ARRAY OF CHAR): ByteStr;

    (* Converts a hexadecimal string to ByteStr form. *)

    VAR result: ByteStr;
        count, j, k: CARDINAL;
        p: ByteStringPtr;
        val: CARD8;

    BEGIN
        (* First get the string length, skipping spaces. *)

        count := 0;
        FOR j := 0 TO HIGH(str) DO
            IF (str[j] <> Nul) AND (str[j] <> ' ') THEN
                INC (count);
            END (*IF*);
        END (*FOR*);

        (* Allocate space for the result. *)

        count := (count + 1) DIV 2;
        ALLOCATE (p, count);
        result.allocated := count;
        result.size := count;
        result.data := p;

        (* Do the translation. *)

        k := 0;
        FOR j := 0 TO count-1 DO
            WHILE str[k] = ' ' DO INC(k) END(*WHILE*);
            val := HexVal(str[k]);  INC (k);
            val := 16*val + HexVal(str[k]);  INC (k);
            p^[j] := val;
        END (*FOR*);

        RETURN result;

    END HexToByteStr;

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

PROCEDURE WritePublicKeyFile (key: RSAKeyType);

    (* The format is different from the private key, because we need    *)
    (* to encode a structure of the form                                *)
    (*                                                                  *)
    (*  SEQUENCE                                                        *)
    (*     {                                                            *)
    (*     SEQUENCE                                                     *)
    (*        {                                                         *)
    (*      OBJECT IDENTIFIER {1 2 840 113549 1 1 1}                    *)
    (*      NULL                                                        *)
    (*      }                                                           *)
    (*   BIT STRING 0 unused bits                                       *)
    (*      30 ...                                                      *)
    (*   }                                                              *)
    (* where the first part is the object ID for an RSA key, and the    *)
    (* bit string is s sequence of the two key components.              *)

    CONST filename = keydir+"\pub.key";  bakname = filename+".bak";
        idcode = "30 0D 06 09 2A 86 48 86 F7 0D 01 01 01 05 00";

    CONST CharsPerLine = 64;  Nul = CHR(0);

    VAR BNdata: ARRAY [0..1] OF BN;
        part: ARRAY [0..1] OF ByteStr;
        asn: ByteStr;
        encoded: ARRAY [0..MaxKeyChars-1] OF CHAR;
        line: ARRAY [0..CharsPerLine-1] OF CHAR;
        amount: CARDINAL;
        cid: ChanId;

    BEGIN
        (* Encode the object identifier. *)

        part[0] := HexToByteStr (idcode);

        (* Encode the key as a bit string. *)

        BNdata[0] := key.n;
        BNdata[1] := key.public;
        part[1] := ASN1.ASNEncodeBNArray (2, BNdata);
        ASN1.ASNEncodeBitString (part[1], 0);

        (* Put the two parts together as a sequence. *)

        asn := ASN1.ASNEncodeSequence (2, part);

        (* Further encoded it as Base64. *)

        Base64.Encode (asn.data^, asn.size, encoded);
        DiscardBS (asn);

        (* Save the result in a global variable, because we will    *)
        (* want to reuse it.                                        *)

        Strings.Assign (encoded, SavedKey);

        (* Write the final result to the file.  *)

        IF Exists(filename) THEN
            IF Exists(bakname) THEN
                DeleteFile (bakname);
            END (*IF*);
            EVAL (MoveFile (filename, bakname));
        END (*IF*);
        cid := OpenNewFile (filename, FALSE);
        FWriteString (cid, "-----BEGIN PUBLIC KEY-----");  FWriteLn(cid);
        REPEAT
            amount := Strings.Length (encoded);
            IF amount > CharsPerLine THEN
                amount := CharsPerLine;
            END (*IF*);
            Strings.Extract (encoded, 0, amount, line);
            Strings.Delete (encoded, 0, amount);
            FWriteString (cid, line);
            FWriteLn (cid);
        UNTIL encoded[0] = Nul;
        FWriteString (cid, "-----END PUBLIC KEY-----");
        FWriteLn (cid);
        CloseFile (cid);

    END WritePublicKeyFile;

(************************************************************************)
(*                     WRITING A PRIVATE KEY FILE                       *)
(************************************************************************)

PROCEDURE WritePrivateKeyFile (key: RSAKeyType);

    CONST filename = keydir+"\priv.key";  bakname = filename+".bak";
        CharsPerLine = 64;  Nul = CHR(0);

    VAR Zero: BN;
        keydata: ARRAY [0..8] OF BN;

    BEGIN
        (* Copy the information we want to put in the file.  *)

        Zero := BigNum.MakeBignum(0);

        keydata[0] := Zero;
        keydata[1] := key.n;
        keydata[2] := key.public;
        keydata[3] := key.private;
        keydata[4] := key.p;
        keydata[5] := key.q;
        keydata[6] := key.dp;
        keydata[7] := key.dq;
        keydata[8] := key.qinv;

        WriteKeyFile (TRUE, FALSE, filename, 9, keydata);
        BigNum.Discard (Zero);

    END WritePrivateKeyFile;

(************************************************************************)
(*                            KEY GENERATION                            *)
(************************************************************************)

(*
PROCEDURE WriteKey (key: RSAKeyType);

    (* Writes public and private key to standard output. *)

    BEGIN
        WriteString ("PUBLIC KEY");  WriteLn;
        WriteString ("n = ");     BigNum.WriteBignum(key.n);  WriteLn;
        WriteString ("e = ");     BigNum.WriteBignum (key.public);  WriteLn;

        WriteString ("PRIVATE KEY");  WriteLn;
        WriteString ("d = ");     BigNum.WriteBignum (key.private);  WriteLn;
        WriteString ("p = ");     BigNum.WriteBignum (key.p);  WriteLn;
        WriteString ("q = ");     BigNum.WriteBignum (key.q);  WriteLn;
        WriteString ("dp = ");    BigNum.WriteBignum (key.dp);  WriteLn;
        WriteString ("dq = ");    BigNum.WriteBignum (key.dq);  WriteLn;
        WriteString ("qinv = ");  BigNum.WriteBignum (key.qinv);  WriteLn;

    END WriteKey;
*)

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

PROCEDURE CreateTheKey (keylength: CARDINAL;  strict: BOOLEAN);

    (* Parameter is desired key length in bits.  If strict, we want     *)
    (* exactly that many significant bits.                              *)

    VAR key: RSAKeyType;
        t0, t1, N: CARDINAL;  success: BOOLEAN;

    BEGIN
        WriteString ("Generating an RSA key, please be patient");  WriteLn;
        t0 := time();
        REPEAT
            key := RSA_Generate(keylength);
            N := BigNum.Nbits(key.n);
            success := (keylength = N) OR NOT strict;
            IF NOT success THEN
                WriteString ("Key length too short, trying again");
                WriteLn;
            END (*IF*);
        UNTIL (NOT strict) OR (N = keylength);
        t1 := time();

        WriteString ("Key length is ");  WriteCard (N);
        WriteString (" significant bits");
        IF N < keylength THEN
            WriteString (", but we will round it up to ");
            WriteCard (keylength);  WriteString (" bits");
        END (*IF*);
        WriteLn;
        IF N < 368 THEN
            WriteString ("WARNING: at least 368 bits are needed to create a RSASSA-PKCS1-V1_5 signature");
            WriteLn;
        END (*IF*);

        IF t1 < t0 THEN t1 := t0 END (*IF*);
        WriteString ("Generation took ");  WriteCard (t1-t0);
        WriteString (" seconds");  WriteLn;

        WritePrivateKeyFile (key);
        WritePublicKeyFile (key);
        DiscardKey (key);

    END CreateTheKey;

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

PROCEDURE MakeDNSentry;

    (* Creates a file "BINDData.txt" with content suitable for  *)
    (* inserting in a BIND zone file.                           *)

    VAR cid: ChanId;
        Linepos: CARDINAL;

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

    PROCEDURE PutString (str: ARRAY OF CHAR);

        (* Writes str to output file, updates Linepos.  *)

        BEGIN
            FWriteString (cid, str);
            INC (Linepos, Strings.Length(str));
        END PutString;

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

    PROCEDURE PutPart;

        (* Puts an initial part of SavedKey to output file, based on    *)
        (* what fits on the line, and deletes that part.  Also writes   *)
        (* a terminating quotation mark.                                *)

        CONST MaxLinepos = 71;

        VAR amount, L: CARDINAL;

        BEGIN
            amount := MaxLinepos - Linepos - 1;
            L := LENGTH(SavedKey);
            IF amount > L THEN amount := L END(*IF*);
            WHILE amount > 0 DO
                FWriteChar (cid, SavedKey[0]);
                Strings.Delete (SavedKey, 0, 1);
                DEC (amount);  INC (Linepos);
            END (*WHILE*);
            FWriteChar (cid, '"');
        END PutPart;

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

    CONST fname = "BINDData.txt";

    VAR bakname, INIname, selector, domain: FilenameString;
        app: ARRAY [0..7] OF CHAR;
        hini: INIData.HINI;
        useTNI: BOOLEAN;

    BEGIN
        (* Get the selector from the INI file. *)

        INIname := "Weasel.INI";
        IF ChooseDefaultINI ("Weasel", useTNI) AND useTNI THEN
            INIname := "Weasel.TNI";
        END (*IF*);
        hini := OpenINIFile (INIname);
        app := "$SYS";
        IF NOT INIGetString (hini, app, "DKIMSelector", selector) THEN
            selector := "default";
            WriteString ("WARNING: No selector in ");
            WriteString (INIname);  WriteString (", assuming 'default'");
            WriteLn;
        END (*IF*);
        IF NOT INIGetString (hini, app, "DKIMSigning", domain) THEN
            domain := "localhost";
            WriteString ("WARNING: No signing domain in ");
            WriteString (INIname);  WriteString (", assuming 'localhost'");
            WriteLn;
        END (*IF*);
        CloseINIFile (hini);

        (* Open the output file. *)

        Strings.Assign (fname, bakname);
        Strings.Append (".bak", bakname);
        IF Exists(fname) THEN
            IF Exists(bakname) THEN
                DeleteFile (bakname);
            END (*IF*);
            EVAL (MoveFile (fname, bakname));
        END (*IF*);
        cid := OpenNewFile (fname, FALSE);
        Linepos := 0;
        PutString (selector);
        PutString ('._domainkey.');
        PutString (domain);
        PutString ('. 3600 IN TXT "v=DKIM1; k=rsa; p=');
        LOOP
            PutPart;
            IF SavedKey[0] = Nul THEN EXIT END(*IF*);
            (* Start a new line. *)
            FWriteLn (cid);  Linepos := 0;
            PutString ('  "');
        END (*LOOP*);
        PutString (' )');  FWriteLn (cid);
        CloseFile (cid);
        WriteString ("The BIND record is in ");
        WriteString (fname);  WriteLn;
    END MakeDNSentry;

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

VAR keylength: CARDINAL;

BEGIN
    CreateDir (keydir);
    GetParams (keylength);
    CreateTheKey (keylength, TRUE);
    MakeDNSentry;
END keygen.

