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

IMPLEMENTATION MODULE TransLog;

        (********************************************************)
        (*                                                      *)
        (*               Transaction logging                    *)
        (*                                                      *)
        (*  Programmer:         P. Moylan                       *)
        (*  Started:            16 March 1999                   *)
        (*  Last edited:        17 December 2025                *)
        (*  Status:             OK                              *)
        (*                                                      *)
        (*     Have now reduced complexity by removing          *)
        (*     the concept of a log context.                    *)
        (*                                                      *)
        (********************************************************)


FROM SYSTEM IMPORT
    (* type *)  CARD16,
    (* proc *)  ADR;

IMPORT Strings, OS2;

FROM MyClock IMPORT
    (* proc *)  CurrentTimeToString, AppendSyslogDateTimeString;

FROM Sockets IMPORT
    (* const*)  NotASocket, SOCK_DGRAM,
    (* type *)  Socket, SockAddr, AddressFamily,
    (* proc *)  socket, connect, getsockname, soclose, send;

FROM Internet IMPORT
    (* const*)  Zero8,
    (* proc *)  inet_addr;

FROM NetDB IMPORT
    (* type *)  HostEntPtr, AddressPointerArrayPointer,
    (* proc *)  gethostbyname;

FROM Names IMPORT
    (* type *)  FilenameString, HostName;

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

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

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

FROM Timer IMPORT
    (* proc *)  Sleep, TimedWait;

FROM Semaphores IMPORT
    (* type *)  Semaphore,
    (* proc *)  CreateSemaphore, Wait, Signal;

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

FROM Inet2Misc IMPORT
    (* proc *)  Swap2, AddressToHostName, NameIsNumeric;

FROM SplitScreen IMPORT
    (* proc *)  LockScreen, UnlockScreen, SetBoundary, WriteStringAt,
                WriteString, WriteLn, NotDetached;

FROM FileOps IMPORT
    (* type *)  ChanId,
    (* proc *)  OpenAtEnd, FWriteString, FWriteLn, CloseFile;

(************************************************************************)
(*                      GLOBAL TYPES AND VARIABLES                      *)
(************************************************************************)

TYPE
    TargetType = (todisk, toscreen, topipe, tosyslog);
    FlagArray = ARRAY TargetType OF BOOLEAN;
    TransactionLogID = POINTER TO
                           RECORD
                               prefix: ARRAY [0..127] OF CHAR;
                           END (*RECORD*);

CONST
    Nul = CHR(0);
    PreambleSize = 29;      (* typical, but give this a re-think. *)
    MaxLineLength = 1024+PreambleSize;

TYPE
    LogLinePtr = POINTER TO ARRAY [0..MaxLineLength-1] OF CHAR;

VAR
    (* A four-bit code to say what we are logging to. *)

    loglevel: CARDINAL;
    Target: FlagArray;

    (* Log ID for internal admin messages. *)

    InternalID: TransactionLogID;

    (* Critical section protection for the transaction log. *)

    GlobalLock: Lock;

    (* Transaction log file on disk. *)

    TransactionLogChannel: ChanId;
    TransactionLogName, InterimLogName: FilenameString;
    UpdateTaskRunning: BOOLEAN;
    InterimDiskFileOpen: BOOLEAN;
    updateclosing: BOOLEAN;
    FileLock: Lock;
    update: Semaphore;

    (* Screen width (value irrelevant if no screen available.  *)

    ScreenWidth: CARDINAL;

    (* A copy of the text that should be on the top two lines of the screen. *)

    TopLine, BlankLine: ARRAY [0..MaxLineLength] OF CHAR;

    (* Name of the pipe for the case where we are logging to a pipe. *)

    PipeName: FilenameString;

    (* Socket for syslog logging. *)

    LogSocket: Socket;

    (* IP address (network byte order) of syslog host. *)

    syslogaddress: CARDINAL;

    (* Critical section protection for LogSocket. *)

    LogSocketLock: Lock;

    (* Number of contexts currently using pipe and syslog. *)

    PipeUsers, SyslogUsers: CARDINAL;

    (* A tag (process name) for syslog messages. *)

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

    (* Host name for syslog messages. *)

    OurHostname: HostName;

    (* Facility code for syslog messages. *)

    Facility: CARDINAL;

    (* Syslog currently in use. *)

    SyslogActive: BOOLEAN;

    (* Flag to say that this process has access to the screen. *)

    ScreenAvailable: BOOLEAN;

    (* Flag to say that shutdown processing has commenced. *)

    ShuttingDown: BOOLEAN;

(********************************************************************************)
(*                               PIPE OPERATIONS                                *)
(********************************************************************************)

CONST
    PipeSize = 8192;
    PipeBufferSize = 32;

TYPE
    BufferIndex = [0..PipeBufferSize-1];
    StrDesc = RECORD
                  addr: LogLinePtr;
                  length: CARDINAL;
              END (*RECORD*);

    PipeState = RECORD
                    access: Lock;
                    handle: OS2.HPIPE;
                    InIndex, OutIndex: BufferIndex;
                    stuck: CARDINAL;
                    PipeTaskRunning: BOOLEAN;
                    open: BOOLEAN;
                    count: Semaphore;
                    Buffer: ARRAY BufferIndex OF StrDesc;
                END (*RECORD*);

VAR
    Pipe: PipeState;
    PipeInUse: BOOLEAN;
    PipeOpenRequest: Semaphore;

    CRLF: ARRAY [0..1] OF CHAR;

(************************************************************************)
(*                      PUT A THREAD ID INTO THE LOG                    *)
(************************************************************************)

PROCEDURE LogThreadID (logID: TransactionLogID);

    (* Puts a message showing our thread ID into the log, to help in    *)
    (* reading the log file.                                            *)

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

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

    PROCEDURE AppendID (N: CARDINAL);

        (* Appends N to message in both decimal and hex *)

        BEGIN
            AppendCard (N, message);
            Strings.Append (" (", message);
            AppendHex (N, message);
            Strings.Append (" hex)", message);
        END AppendID;

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

    VAR ptib: OS2.PTIB;  ppib: OS2.PPIB;

    BEGIN
        IF logID <> NIL THEN
            OS2.DosGetInfoBlocks (ptib, ppib);
            Strings.Assign ("tib_ordinal=", message);
            AppendID (ptib^.tib_ordinal);
            Strings.Append (", tib2_ultid=", message);
            AppendID (ptib^.tib_ptib2^.tib2_ultid);
            LogTransaction (logID, message);
        END (*IF*);
    END LogThreadID;

(********************************************************************************)
(*                                 LOG TO PIPE                                  *)
(********************************************************************************)

PROCEDURE PipeTask;

    (* Feeds data from the pipe circular buffer to the pipe itself. *)

    VAR rc, actual: CARDINAL;
        success: BOOLEAN;
        towrite: StrDesc;
        logID: TransactionLogID;

    BEGIN
        logID := CreateLogID ("pipelog ");
        LogThreadID (logID);
        REPEAT
            Wait (PipeOpenRequest);

            (* Open the pipe.  We don't want critical section protection here   *)
            (* because the DosConnectNPipe request below could block all        *)
            (* logging if we still held Pipe.access; and anyway the protection  *)
            (* is not needed because nobody else will try to use the pipe       *)
            (* until we set Pipe.open = TRUE.                                   *)

            rc := OS2.DosCreateNPipe (PipeName, Pipe.handle, OS2.NP_ACCESS_OUTBOUND,
                                      (*OS2.NP_NOWAIT*) + 1, PipeSize, 0, 0);
            success := rc = 0;
            IF success THEN
                rc := OS2.DosConnectNPipe (Pipe.handle);
                success := (rc = 0) OR (rc = 233);
            END (*IF*);
            Pipe.open := success;

            (* Transfer data while we want the pipe open, or until the pipe is  *)
            (* closed at the client end.  If the pipe is closed at the other    *)
            (* end, we'll close it and then attempt to reopen it, in case the   *)
            (* client program is restarted.                                     *)

            rc := 0;
            WHILE PipeInUse AND (rc = 0) DO

                WITH Pipe DO
                    Wait (count);
                    Obtain (access);
                    towrite := Buffer[OutIndex];
                    IF towrite.addr <> NIL THEN
                        WITH Buffer[OutIndex] DO
                            addr := NIL;
                            length := 0;
                        END (*WITH*);
                        OutIndex := (OutIndex + 1) MOD PipeBufferSize;
                    END (*IF*);
                    WHILE stuck > 0 DO
                        Signal (count);  DEC(stuck);
                    END (*WHILE*);
                    Release (access);
                END (*WITH*);
                rc := 0;
                WITH towrite DO
                    IF addr <> NIL THEN
                        IF length > 1 THEN
                            rc := OS2.DosWrite (Pipe.handle, addr, length-1, actual);
                        END (*IF*);
                        IF rc = 0 THEN
                            rc := OS2.DosWrite (Pipe.handle, ADR(CRLF), 2, actual);
                        END (*IF*);
                        DEALLOCATE (addr, length);
                        IF rc = OS2.ERROR_BROKEN_PIPE THEN
                            Signal (PipeOpenRequest);
                        END (*IF*);
                    END (*IF*);
                END (*WITH*);

            END (*WHILE*);

            (* Close the pipe when PipeInUse becomes FALSE *)
            (* or when a write fails.                      *)

            Obtain (Pipe.access);
            Pipe.open := FALSE;
            OS2.DosDisConnectNPipe (Pipe.handle);
            CloseFile (Pipe.handle);
            Release (Pipe.access);

        UNTIL ShuttingDown;
        Pipe.PipeTaskRunning := FALSE;

    END PipeTask;

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

PROCEDURE InitialisePipe;

    (* Creates the data structure associated with the pipe. *)

    VAR j: BufferIndex;

    BEGIN
        CreateLock (Pipe.access);
        FOR j := 0 TO MAX(BufferIndex) DO
            Pipe.Buffer[j].addr := NIL;
            Pipe.Buffer[j].length := 0;
        END (*FOR*);
        Pipe.InIndex := 0;
        Pipe.OutIndex := 0;
        Pipe.stuck := 0;
        Pipe.PipeTaskRunning := FALSE;
        Pipe.open := FALSE;
        PipeInUse := FALSE;
        CreateSemaphore (Pipe.count, 0);
        CreateSemaphore (PipeOpenRequest, 0);
    END InitialisePipe;

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

PROCEDURE CopyToPipe (ptext: LogLinePtr);

    (* Adds one entry to the queue of items waiting to be sent to the pipe. *)

    VAR overflow: BOOLEAN;

    BEGIN
        WITH Pipe DO
            IF NOT PipeTaskRunning THEN
                PipeTaskRunning := CreateTask (PipeTask, 5, "pipe output");
            END (*IF*);
            Obtain (access);
            IF open THEN
                WITH Buffer[InIndex] DO
                    overflow := addr <> NIL;
                    IF overflow THEN
                        INC (stuck);
                    ELSE
                        length := Strings.Length(ptext^) + 1;
                        IF length > MaxLineLength THEN
                            length := MaxLineLength;
                        END (*IF*);
                        ALLOCATE (addr, length);
                        IF length > 1 THEN
                            Copy (ptext, addr, length-1);
                        END (*IF*);
                        addr^[length-1] := Nul;
                        InIndex := (InIndex + 1) MOD PipeBufferSize;
                        Signal (count);
                    END (*IF*);
                END (*WITH*);
            END (*IF*);
            Release (access);
        END (*WITH*);
    END CopyToPipe;

(************************************************************************)
(*                      SYSLOG SOCKET OPERATIONS                        *)
(************************************************************************)

PROCEDURE GetOurHostName (S: Socket);

    (* Sets OurHostname to what we are currently calling our host name  *)
    (* for our end of the connection using socket S.  If we can't get a *)
    (* reasonable answer then we use the IP address.  If we do get a    *)
    (* textual hostname then we discard the part after the first '.'.   *)

    VAR myaddr: SockAddr;  size: CARDINAL;  found: BOOLEAN;

    BEGIN
        size := SIZE(myaddr);
        IF NOT getsockname (S, myaddr, size) THEN
            EVAL (AddressToHostName (myaddr.in_addr.addr, OurHostname));
        END (*IF*);
        IF OurHostname[0] <> '[' THEN
            Strings.FindNext ('.', OurHostname, 0, found, size);
            IF found THEN
                OurHostname[size] := Nul;
            END (*IF*);
        END (*IF*);
    END GetOurHostName;

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

PROCEDURE StartSyslogging;

    (* Starts logging to syslog, by opening and connecting the necessary   *)
    (* socket.  If this operation fails, we clear Target[tosyslog].  Even  *)
    (* though this is a UDP connection, the connect() saves us the trouble *)
    (* of having to specify an address for each transfer.                  *)

    CONST loopback = 256*256*256*127 + 1;

    VAR addr: SockAddr;

    BEGIN
        Obtain (LogSocketLock);
        LogSocket := socket (AF_INET, SOCK_DGRAM, AF_UNSPEC);

        (* Connect to the syslog service on the specified machine. *)
        (* Port 514 is as specified in RFC3164.                    *)

        WITH addr DO
            family := AF_INET;
            WITH in_addr DO
                port := Swap2 (514);
                addr := syslogaddress;
                zero := Zero8;
            END (*WITH*);
        END (*WITH*);

        EVAL((LogSocket <> NotASocket)
                            AND NOT connect (LogSocket, addr, SIZE(addr)));
        GetOurHostName (LogSocket);
        Release (LogSocketLock);

    END StartSyslogging;

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

PROCEDURE StopSyslogging;

    (* Closes logging to syslog. *)

    BEGIN
        Obtain (LogSocketLock);
        soclose (LogSocket);
        LogSocket := NotASocket;
        Release (LogSocketLock);
    END StopSyslogging;

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

PROCEDURE SetSyslogHost (hostname: ARRAY OF CHAR);

    (* Sets syslogaddress to the IP address, in network byte order, of  *)
    (* the specified host.  If the lookup fails, leaves syslogaddress   *)
    (* unchanged.                                                       *)

    VAR HostInfo: HostEntPtr;
        p: AddressPointerArrayPointer;

    BEGIN
        IF NameIsNumeric(hostname) THEN
            syslogaddress := inet_addr(hostname);
        ELSE
            HostInfo := gethostbyname (hostname);
            IF HostInfo <> NIL THEN
                p := HostInfo^.h_addr_list;
                IF p <> NIL THEN
                    syslogaddress := p^[0]^;
                END (*IF*);
            END (*IF*);
        END (*IF*);
        IF SyslogActive THEN
            StopSyslogging;
            StartSyslogging;
        END (*IF*);
    END SetSyslogHost;

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

PROCEDURE CopyToSyslog (ptext: LogLinePtr);

    (* Sends this line to syslog, with an appropriate header. *)

    VAR message: ARRAY [0..1023] OF CHAR;
        pos: CARDINAL;

    BEGIN
        message := "<";  pos := 1;
        ConvertCard (8*Facility + 6, message, pos);
        message[pos] := '>';  INC(pos);
        message[pos] := Nul;
        AppendSyslogDateTimeString (message);
        Strings.Append (' ', message);
        Strings.Append (OurHostname, message);
        Strings.Append (' ', message);
        Strings.Append (procname, message);
        Strings.Append (": ", message);
        Strings.Append (ptext^, message);
        Obtain (LogSocketLock);
        send (LogSocket, message, LENGTH(message), 0);
        Release (LogSocketLock);

    END CopyToSyslog;

(************************************************************************)
(*                       ADDING A NEW LOG ENTRY                         *)
(************************************************************************)

PROCEDURE WriteTopTwoScreenLines;

    (* Refreshes the top two lines of the screen, provided that the     *)
    (* screen is available to us.                                       *)

    BEGIN
        IF ScreenAvailable THEN
            LockScreen;
            WriteStringAt (0, 0, TopLine);
            WriteStringAt (1, 0, BlankLine);
            UnlockScreen;
        END (*IF*);
    END WriteTopTwoScreenLines;

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

PROCEDURE AddToTransactionLog (ptext: LogLinePtr);

    (* Writes the text, preceded by the date and time, to the screen    *)
    (* and/or the transaction log and/or the pipe, depending on Target. *)

    VAR pLogLine: LogLinePtr;
        testchar: ARRAY [0..1] OF CHAR;
        count: CARD16;

    BEGIN
        IF loglevel > 0 THEN

            (* Create a string containing date/time and the text.  *)

            NEW (pLogLine);
            CurrentTimeToString (pLogLine^);
            Strings.Append (" ", pLogLine^);
            Strings.Append (ptext^, pLogLine^);

            (* Write to disk if Target[todisk) is TRUE. *)

            IF Target[todisk] THEN
                Obtain (FileLock);
                IF NOT InterimDiskFileOpen THEN
                    TransactionLogChannel := OpenAtEnd (InterimLogName);
                    InterimDiskFileOpen := TRUE;
                END (*IF*);
                FWriteString (TransactionLogChannel, pLogLine^);
                FWriteLn (TransactionLogChannel);
                OS2.DosResetBuffer (TransactionLogChannel);
                Release (FileLock);
            END (*IF*);

            (* Write to the screen if Target[toscreen] is TRUE. *)

            IF Target[toscreen] THEN
                LockScreen;
                WriteString (pLogLine^);  WriteLn;
                UnlockScreen;
            END (*IF*);

            (* Do we also want to write to the pipe? *)

            IF Target[topipe] THEN
                CopyToPipe (pLogLine);
            END (*IF*);

            (* Write to the syslog socket if that option is active. *)

            IF Target[tosyslog] THEN
                CopyToSyslog (pLogLine);
            END (*IF*);

            DISPOSE (pLogLine);

        END (*IF*);

        (* Repair the screen display if row 1 has been overwritten. *)

        IF ScreenAvailable THEN
            count := 2;
            OS2.VioReadCharStr (testchar, count, 1, 0, 0);
            IF (testchar[0] <> ' ') OR (testchar[1] <> ' ') THEN
                WriteTopTwoScreenLines;
            END (*IF*);
        END (*IF*);

    END AddToTransactionLog;

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

PROCEDURE LogTransaction (id: TransactionLogID;
                          VAR (*IN*) text: ARRAY OF CHAR);

    (* Puts id+text in the transaction log (if logging enabled). *)

    VAR bufptr: LogLinePtr;

    BEGIN
        IF (id <> NIL) AND (loglevel > 0) THEN
            NEW (bufptr);
            Strings.Assign (id^.prefix, bufptr^);
            Strings.Append ("  ", bufptr^);
            Strings.Append (text, bufptr^);
            AddToTransactionLog (bufptr);
            DISPOSE (bufptr);
        END (*IF*);
    END LogTransaction;

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

PROCEDURE LogTransactionL (id: TransactionLogID;
                           text: ARRAY OF CHAR);

    (* Like LogTransaction, but for a literal text string. *)

    BEGIN
        LogTransaction (id, text);
    END LogTransactionL;

(************************************************************************)
(*                     OTHER EXPORTED PROCEDURES                        *)
(************************************************************************)

PROCEDURE UpdateTopScreenLine (pos: CARDINAL; newstring: ARRAY OF CHAR);

    (* Puts newstring at position pos in our record of what should go   *)
    (* into the top screen line.  Rewrites that part of the screen if   *)
    (* we are a non-detached process.                                   *)

    VAR N: CARDINAL;

    BEGIN
        N := Strings.Length(newstring);
        IF pos > ScreenWidth THEN
            N := 0;
        ELSIF pos + N > ScreenWidth THEN
            N := ScreenWidth - pos;
        END (*IF*);
        IF N < HIGH(newstring) THEN
            newstring[N] := Nul;
        END (*IF*);
        Strings.Replace (newstring, pos, TopLine);
        IF ScreenAvailable THEN
            LockScreen;
            WriteStringAt (0, pos, newstring);
            UnlockScreen;
        END (*IF*);

    END UpdateTopScreenLine;

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

PROCEDURE SetProcname (name: ARRAY OF CHAR;  facility: CARDINAL);

    (* Sets process name and facility number for use in syslog messages *)
    (* and for making the pipe name if we use a pipe.  Must be called   *)
    (* before StartTransactionLogging if you plan to use syslog and/or  *)
    (* a pipe for the log messages.                                     *)

    BEGIN
        Strings.Assign (name, procname);
        Strings.Assign ("\PIPE\", PipeName);
        Strings.Append (name, PipeName);
        Strings.Append ("TransLog", PipeName);
        Facility := facility;
    END SetProcname;

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

PROCEDURE DiscardLogID (VAR (*INOUT*) id: TransactionLogID);

    (* Discards a previously created logfile ID. *)

    BEGIN
        DISPOSE (id);
    END DiscardLogID;

(************************************************************************)
(*           COPYING INTERIM DISK FILE TO PERMANENT LOG FILE            *)
(************************************************************************)

PROCEDURE CopyTransactionLogUpdates;

    (* Appends all the data from the interim transaction log to the final       *)
    (* transaction log, then deletes the interim transaction log.  We assume    *)
    (* that caller has obtained the G^.GroupLock.                               *)

    BEGIN
        IF InterimDiskFileOpen THEN
            CloseFile (TransactionLogChannel);
            InterimDiskFileOpen := FALSE;
            OS2.DosCopy (InterimLogName, TransactionLogName,
                                                        OS2.DCPY_APPEND);
            OS2.DosDelete (InterimLogName);
        END (*IF*);
    END CopyTransactionLogUpdates;

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

PROCEDURE TransactionLogUpdateTask;

    (* A separate task that updates a transaction log disk file  *)
    (* approximately every minute.                               *)

    VAR TimedOut: BOOLEAN;
        logID: TransactionLogID;

    BEGIN
        logID := CreateLogID ("trlog  ");
        LogThreadID (logID);
        REPEAT
            TimedWait (update, 60000, TimedOut);
            Obtain (FileLock);
            CopyTransactionLogUpdates;
            Release (FileLock);
        UNTIL updateclosing OR ShuttingDown;

        (* There is a risk of exiting the above loop without having     *)
        (* done the final update, so do an extra check.                 *)

        Obtain (FileLock);
        CopyTransactionLogUpdates;
        UpdateTaskRunning := FALSE;
        Release (FileLock);

        (* Tell the StopUpdateTask procedure that we're terminating. *)

        updateclosing := FALSE;

    END TransactionLogUpdateTask;

(************************************************************************)
(*                         OTHER DISK OPERATIONS                        *)
(************************************************************************)

PROCEDURE StopUpdateTask;

    (* Tells the update task to shut itself down. *)

    BEGIN
        Obtain (FileLock);
        IF UpdateTaskRunning THEN
            CopyTransactionLogUpdates;
            updateclosing := TRUE;
        END (*IF*);
        Release (FileLock);
        Signal (update);
        WHILE updateclosing DO
            Sleep (10);
        END (*WHILE*);
    END StopUpdateTask;

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

PROCEDURE StartUpdateTask (VAR (*IN*) name: ARRAY OF CHAR);

    (* Starts or restarts the update task, possibly with a new filename. *)

    VAR posOfPattern: CARDINAL;  patternFound: BOOLEAN;

    BEGIN
        Strings.Capitalize (name);
        updateclosing := FALSE;

        (* Store the file name, and work out an interim file name. *)

        Strings.Capitalize (name);
        Strings.Assign (name, TransactionLogName);
        Strings.FindPrev ('.', name, LENGTH(name) - 1,
                                       patternFound, posOfPattern);
        IF patternFound THEN
            name[posOfPattern] := Nul;
        END (*IF*);
        Strings.Append (".$$$", name);
        Strings.Assign (name, InterimLogName);

        (* Start the disk file updater. *)

        UpdateTaskRunning := CreateTask (TransactionLogUpdateTask,
                                                3, "trlog update");

    END StartUpdateTask;

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

PROCEDURE SetTarget (level: CARDINAL;  VAR (*OUT*) result: FlagArray);

    (* Translates log level to a set of Boolean flags. *)

    VAR t: TargetType;

    BEGIN
        FOR t := MIN(TargetType) TO MAX(TargetType) DO
            result[t] := ODD(level);
            level := level DIV 2;
        END (*FOR*);
    END SetTarget;

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

PROCEDURE SetInitialLogFile;

    (* Temporarily allows logging to disk at startup.  The lines logged *)
    (* into this file will eventually be moved to the final log file.   *)
    (* This is like StartTransactionLogging, but for the special case   *)
    (* of initial startup.                                              *)

    CONST InitialLogFileName = "InitialLog.log";

    VAR filename: FilenameString;

    BEGIN
        filename := InitialLogFileName;
        IF ScreenAvailable THEN
            loglevel := 3;
        ELSE
            loglevel := 2;
        END (*IF*);
        SetTarget (loglevel, Target);
        StartUpdateTask (filename);
    END SetInitialLogFile;

(************************************************************************)
(*                     OTHER EXPORTED PROCEDURES                        *)
(************************************************************************)

PROCEDURE StartStopPipeAndSyslog (usepipe, hadpipe,
                                  usesyslog, hadsyslog: BOOLEAN);

    (* Starts or stops pipe and syslog logging, as required. *)

    BEGIN
        Obtain (GlobalLock);

        (* Open or close the pipe, as necessary. *)

        IF usepipe <> hadpipe THEN
            IF hadpipe THEN
                DEC (PipeUsers);
                IF PipeUsers = 0 THEN
                    PipeInUse := FALSE;
                    Signal (Pipe.count);
                END (*IF*);
            ELSE
                IF PipeUsers = 0 THEN
                    Signal (PipeOpenRequest);
                    (*Sleep (2000);*)            (* not sure why I had this *)
                END (*IF*);
                INC (PipeUsers);
                PipeInUse := TRUE;
            END (*IF*);
        END (*IF*);

        (* Open or close the syslog socket, as necessary. *)

        IF usesyslog <> hadsyslog THEN
            IF hadsyslog THEN
                DEC (SyslogUsers);
                IF SyslogUsers = 0 THEN
                    SyslogActive := FALSE;
                    StopSyslogging;
                END (*IF*);
            ELSE
                IF SyslogUsers = 0 THEN
                    StartSyslogging;
                END (*IF*);
                INC (SyslogUsers);
                SyslogActive := TRUE;
            END (*IF*);
        END (*IF*);

        Release (GlobalLock);

    END StartStopPipeAndSyslog;

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

PROCEDURE StartTransactionLogging (LogfileName: ARRAY OF CHAR;  level: CARDINAL);

    (* Sets the transaction log file name, and enables logging.  The    *)
    (* level parameter means: 0 for none, 1 for disk, 2 for screen, 4   *)
    (* for pipe, 8 for syslog, and sums of these for multiple log       *)
    (* targets.  This can be called more than once, to change the log   *)
    (* file name or level.  On a second or later call the existing log  *)
    (* file is closed and the next log entry will cause it to be        *)
    (* reopened, possibly as a new file with a new name.  Similarly,    *)
    (* the pipe and syslog socket will be opened or closed if the       *)
    (* change in level requires this.                                   *)

    VAR UsedPipe, UsedSyslog, changefile: BOOLEAN;
        newtarget: FlagArray;

    BEGIN
        LogTransactionL (InternalID, "Entering StartTransactionLogging");
        level := level MOD 16;
        changefile := NOT StringMatch (LogfileName, TransactionLogName);
        IF changefile THEN
            (* Append any existing log data to the new file. *)
            Obtain (FileLock);
            OS2.DosCopy (TransactionLogName, LogfileName, OS2.DCPY_APPEND);
            OS2.DosDelete (TransactionLogName);
            IF InterimDiskFileOpen THEN
                CloseFile (TransactionLogChannel);
                InterimDiskFileOpen := FALSE;
                OS2.DosCopy (InterimLogName, LogfileName, OS2.DCPY_APPEND);
                OS2.DosDelete (InterimLogName);
            END (*IF*);
            Release (FileLock);
        END (*IF*);

        IF changefile OR (loglevel <> level) THEN

            (* Where do we want the logs to go to now? *)

            loglevel := level;
            SetTarget (level, newtarget);

            (* Temporarily stop the disk updates. *)

            IF Target[todisk] THEN
                Target[todisk] := FALSE;
                StopUpdateTask;
            END (*IF*);

            (* Were we already using pipe and/or syslog? *)

            UsedPipe := Target[topipe];
            UsedSyslog := Target[tosyslog];

            (* If we are now logging to disk, put this context into *)
            (* the group appropriate to the log file name.          *)

            IF newtarget[todisk] THEN
                StartUpdateTask (LogfileName);
            END (*IF*);

            (* Open or close the pipe and syslog socket, as necessary. *)

            StartStopPipeAndSyslog (newtarget[topipe], UsedPipe,
                                    newtarget[tosyslog], UsedSyslog);

            (* Set the flags for log targets. We have not committed     *)
            (* them until now because we needed to compare the old      *)
            (* and new targets.                                         *)

            Target := newtarget;

        END (*IF*);

    END StartTransactionLogging;

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

PROCEDURE CreateLogID (code: ARRAY OF CHAR): TransactionLogID;

    (* Creates a new logfile ID within the given log context. *)

    VAR result: TransactionLogID;

    BEGIN
        NEW (result);
        WITH result^ DO
            Strings.Assign (code, prefix);
        END (*WITH*);
        RETURN result;
    END CreateLogID;

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

PROCEDURE GetLogPrefix (LogID: TransactionLogID;  VAR (*OUT*) code: ARRAY OF CHAR);

    (* Returns the code used as a session ID prefix in the log. *)

    BEGIN
        Strings.Assign (LogID^.prefix, code);
    END GetLogPrefix;

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

PROCEDURE ReviseLogPrefix (LogID: TransactionLogID;  newchars: ARRAY OF CHAR);

    (* Modifies the first few characters of the session ID prefix. *)

    VAR j: CARDINAL;

    BEGIN
        FOR j := 0 TO LENGTH(newchars) - 1 DO
            LogID^.prefix[j] := newchars[j];
        END (*FOR*);
    END ReviseLogPrefix;

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

PROCEDURE NILLogID (): TransactionLogID;

    (* Returns a NIL result of the correct type. *)

    BEGIN
        RETURN NIL;
    END NILLogID;

(************************************************************************)
(*                     INITIALISATION OF SCREEN INFO                    *)
(************************************************************************)

PROCEDURE InitScreenInfo;

    (* Mostly this is about management of the two top screen rows. *)

    VAR modeinfo: OS2.VIOMODEINFO;
        j: CARDINAL;

    BEGIN
        ScreenAvailable := NotDetached();
        IF ScreenAvailable THEN
            OS2.VioGetMode (modeinfo, 0);
            ScreenWidth := modeinfo.col;
            FOR j := 0 TO ScreenWidth-1 DO
                BlankLine[j] := ' ';
            END (*FOR*);
            BlankLine[ScreenWidth] := Nul;
            TopLine := BlankLine;
            WriteTopTwoScreenLines;
            SetBoundary (2, 0);
            TopLine[0] := '.';
        ELSE
            ScreenWidth := 0;
        END (*IF*);
    END InitScreenInfo;

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

BEGIN
    CRLF[0] := CHR(13);  CRLF[1] := CHR(10);
    TopLine := BlankLine;
    ShuttingDown := FALSE;
    LogSocket := NotASocket;
    OurHostname := "localhost";
    SetProcname ("", 0);
    CreateLock (GlobalLock);
    CreateLock (FileLock);
    CreateLock (LogSocketLock);
    CreateSemaphore (update, 0);
    SetSyslogHost ("127.0.0.1");
    PipeUsers := 0;
    SyslogUsers := 0;
    loglevel := 0;
    SyslogActive := FALSE;
    PipeInUse := FALSE;
    InitialisePipe;
    InterimDiskFileOpen := FALSE;
    InitScreenInfo;
    SetInitialLogFile;
    InternalID := CreateLogID ("*******");
FINALLY
    LogTransactionL (InternalID, "Transaction logging closing down");
    ShuttingDown := TRUE;
    Signal (Pipe.count);
    Signal (update);
    StopUpdateTask;
    DiscardLogID (InternalID);
    DestroyLock (FileLock);
END TransLog.

