Program OpenFileLog;
{ S. Kurowski 940426  quickly hacked together from NetSecurity code.

	Filters the OpenFile() request and logs all mode modify open
	requests with file name, username (or node), date  time.
	
	Output file is '[SCR]<$000>OpenLog.log'.
	
	Link V6, OpenFileLog.obj pasmin.obj, 1k stack, protected.
}

{$Debug}	{No debugger code}

const
  ThisVersion = '1.0.0';
  sThisVersion = 5;
  sbLogFileSpec = chr(22) * '[SCR]<$000>OpenLog.log';
  sbDeinstSpec = chr(26) * '[$@$]<$000>x$$SJKOFF1994$$';
  LogInstallMsg = 'OpenFile(mm) Log Service ' * ThisVersion * chr(10);
  sLogInstallMsg = 25 + sThisVersion;
  LogDeinstallMsg = 'OpenFile(mm) Log Service deinstalled' * chr(10);
  sLogDeinstallMsg = 36;
  NotInstalledMsg = 'OpenFile(mm) Log Service is not installed' * chr(10);
  sNotInstalledMsg = 42;
  PartitionName  = 'OpenLog1.0';
  sPartitionName = 10;
  ServeRqCode = 4;   {OpenFile() request code to filter}
  wModeModify = retype(word,'mm');
  wModeRead = retype(word,'mr');
  wModeWrite = retype(word,'mw');
  ercFileInUse = 220;
  ercNoSuchFile = 203;
  ercNoSuchVolume = 215;
  sBuffer = 4096;
  cPriority = 20;
 
type
  reqType    = record				{OpenFile() request block}
                 sCntInfo    [0] : byte;  { = 6}
                 RtCode      [1] : byte;  { = 0}
                 nReqPbCb    [2] : byte;  { = 2}
                 nRespPbCb   [3] : byte;  { = 1}
                 userNum     [4] : word;
                 exchResp    [6] : word;
                 ercRet      [8] : word;
                 rqCode     [10] : word;  { = 4}
                 reserved   [12] : word;
		 Mode	    [14] : word;
                 reserved2  [16] : word;
		 pbFileSpec [18] : adsmem;
		 cbFileSpec [22] : word;
		 pbPW       [24] : adsmem;
		 cbPW       [28] : word;
		 pFhRet     [30] : ads of word;		 
		 sFhRet	    [34] : word;  { = 2}
               end;
  LocationType = record			{GetUserLocation() record structure}
		 bCode		[0] : byte;
		 localUserNum	[1] : word;
		 iCPU		[3] : word;
	       end;
  StatusType = record			{GetUserStatus() record structure}
		 StatusCode [0]: byte;
		 sbUserName [1] : array[wrd(0)..30] of char;
		 sbNodeName [32]: array[wrd(0)..12] of char;
	       end;
  SdType = record			{VLPB Parameter structure}
             pParam : adsmem;
             sParam : word;
           end;
var [public]
  fh,i,origExch,MyExch: word;
  UserLocation: LocationType;
  UserStatus: StatusType;
  pUserReq : ads of reqType;
  wUserNum,cb,Erc : word;
  wMyUserNum, nWilds : word;
  LogFile : record
              rgbFileSpec : array[wrd(0)..91] of byte;
              cbFileSpec  : word;
            end;
  Sd : SdType;
  BSWA : array[0..299] of byte;
  Buffer: array[1..sBuffer] of byte;
  Wilds : array[wrd(1)..100] of record
                                 Leng : word;
                                 Strg : array[wrd(1)..50] of byte;
                               end;
  DateTimeRet : integer4;
  ExpDateTimeRet : record
			Year [0]: word;  Month[2]: byte;  Day [3]: byte;
			DayOfWeek [4]: byte;
			Hour [5]: byte;  Min  [6]: byte;  Sec [7]: byte;
                   end;
  FormattedDT : array[wrd(0)..16] of byte;

procedure CheckErc(Erc: word); extern;
function OutputToVid0(pMsg: adsmem; cbMsg: word): word; extern;
function GetpStructure(StrucCode,ph: word; ppStructRet: adsmem): word; extern;
function ExpandDateTime(DateTime: integer4;
                        pSysTimeRec: adsmem): word; extern;
function WriteLog(pbRecord: adsmem; cbRecord: word): word; extern;
function AllocExch(pExchRet: adsmem): word; extern;
function Wait(Exch: word; ppMsgRet: adsmem): word; extern;
function ServeRq(RqCode,Exch: word): word; extern;{exch=0 means no longer srvd}
function Respond(pRq: adsmem): word; extern;
function DeAllocExch(Exch: word): word; extern;
function GetUserLocation(UserNum:word;pLocRet:adsmem;sb:word):word; extern;
function GetUserStatus(UserNum: word; pStatusRet: adsmem;sb:word):word; extern;
function RgParam(i,j: word; pSdRet: adsmem): word; extern;
procedure Delay(n100ms: word); extern;
function OpenByteStream(pbBswa, pbFileName : adsmem; cbFileNameLen : word;
                         pbPassword : adsmem; cbPasswordLen, Mode : word;
                         ptBuffer : adsmem; cbBufferSize : word): word; extern;
function WriteBsRecord(pBswa,pD: adsmem; sD: word; pW: adsmem): word; extern;
function WriteByte(pBSWA: adsmem; bByte: byte): word; extern;
{ function SetBsLfa(pBSWA: adsmem; qLfa: integer4): word; extern; }
function SetBsLfa(pBSWA: adsmem; LfaLo: word; LfaHi: word): word; extern;
function CloseByteStream( pbBswa : adsmem): word; extern;
function WildCardMatch(pbWildStr: adsmem; cbWildStr:word;
			pbStr: adsmem; cbStr: word): boolean; extern;
function CreateFile(pbFileSpec: adsmem; cbFileSpec: word;
		pbPW: adsmem; cbPW: word; LfaSize: integer4): word; extern;
procedure Exit; extern;
function SetPartitionName(ph:word; pbName: adsmem; cbName:word): word; extern;
function QueryRequestInfo(rq: word; pRet: adsmem; sRet: word): word; extern;
function ForwardRequest(exch: word; pMsg: adsmem): word; extern;
function ConvertToSys: word; extern;
function ChangePriority(Pri: word): word; extern;
function SetPartitionLock(fLock: boolean): word; extern;
procedure ExitAndRemove; extern;
function SetMsgRet(pbMsg: adsmem; cbMsg: word): word; extern;
function OpenFile(pFhRet,pFileSpec: adsmem; sFileSpec: word;
			pPassword: adsmem; sPassword,mode: word): word; extern;
function GetDateTime(pDateTimeRet : adsmem): word; extern;


procedure GetTime;
begin {GetTime}
  CheckErc(GetDateTime(ads DateTimeRet));
  CheckErc(ExpandDateTime(DateTimeRet,ads ExpDateTimeRet));
  with ExpDateTimeRet do
  begin
  FormattedDT[00] := 30 + Month div 10;
  FormattedDT[01] := 30 + Month mod 10;
  FormattedDT[02] := wrd('');
  FormattedDT[03] := 30 + Day div 10;
  FormattedDT[04] := 30 + Day mod 10;
  FormattedDT[05] := wrd('');
  FormattedDT[06] := 30 + (Year mod 100) div 10;
  FormattedDT[07] := 30 + Year mod 10;
  FormattedDT[08] := wrd(' ');
  FormattedDT[09] := 30 + Hour div 10;
  FormattedDT[10] := 30 + Hour mod 10;
  FormattedDT[11] := wrd(':');
  FormattedDT[12] := 30 + Min div 10;
  FormattedDT[13] := 30 + Min mod 10;
  FormattedDT[14] := wrd(':');
  FormattedDT[15] := 30 + Sec div 10;
  FormattedDT[16] := 30 + Sec mod 10;
  end;
end; {GetTime}

procedure GetWilds;                               { Copy Wildcard expressions }
begin                                             { from parameters into local}
  nWilds := 0;                                    { array for longterm storage}
  while RgParam(1,nWilds,ads Sd) = 0 do
  begin
    nWilds := nWilds + 1;
    for cb := 1 to Sd.sParam do
      Wilds[nWilds].Strg[cb] := Sd.pParam^[cb1];
    Wilds[nWilds].Leng := Sd.sParam;
  end;
end; {GetWilds}

function fWildsMatch(pbStr: adsmem; cbStr: word): boolean [public];
begin
  if nWilds = 0 then
  begin
    fWildsMatch := true;
    return;
  end;
  for cb := 1 to nWilds do
    if WildCardMatch(ads Wilds[cb].Strg, Wilds[cb].Leng, pbStr, cbStr) then
    begin
      fWildsMatch := true;
      return;
    end;
  fWildsMatch := false;
end;

procedure GetLogFile;
begin
  if RgParam(2,0,ads Sd) = 0 then
  begin
    for cb := 0 to Sd.sParam1 do
      LogFile.rgbFileSpec[cb] := Sd.pParam^[cb];
    LogFile.cbFileSpec := Sd.sParam;
  end
  else { use default log file spec }
  begin
    for cb := 0 to wrd(sbLogFileSpec[1])1 do
      LogFile.rgbFileSpec[cb] := wrd(sbLogFileSpec[cb+2]);
    LogFile.cbFileSpec := wrd(sbLogFileSpec[1]) and ff;
  end;
end;

procedure ProcessRequest [public];
begin {ProcessRequest}
  if ( ((pUserReq^.Mode or 2020) = wModeWrite) or
       ((pUserReq^.Mode or 2020) = wModeModify) ) and
       fWildsMatch(pUserReq^.pbFileSpec,pUserReq^.cbFileSpec) then
  { log the open file access... }
  begin
    {Find out where requesting user is ...}
    wUserNum := pUserReq^.userNum;
    Eval(GetUserLocation(wUserNum,ads UserLocation,5));
    while UserLocation.bCode = 1 do
    begin
      wUserNum := UserLocation.localUserNum;
      Eval(GetUserLocation(wUserNum,ads UserLocation,5));
    end;
    Eval(GetUserStatus(wUserNum,ads UserStatus,44));
    
    GetTime;
    
    Eval(ServeRq(ServeRqCode,origExch));         { Reroute Rq 4 Back again}
    Erc := OpenByteStream(ads BSWA,ads LogFile.rgbFileSpec,
      			LogFile.cbFileSpec, ads NULL, 0, wModeModify,
	      		ads Buffer, sBuffer);
    Eval(ServeRq(ServeRqCode,MyExch));      { Reroute Rq 4 through us }
    
    if Erc = 0 then
      Erc := SetBsLfa(ads BSWA,ffff,ffff);  { set to EOF }
    
    { write file name }
    if Erc = 0 then
      Erc := WriteBsRecord(ads BSWA, pUserReq^.pbFileSpec,
      				pUserReq^.cbFileSpec, ads cb);
    { pad to 49 chars }
    cb := 47  pUserReq^.cbFileSpec;
    if pUserReq^.cbFileSpec > 47 then cb := 0;
    while cb > 0 do
    begin
      if Erc = 0 then
        Erc := WriteByte(ads BSWA, wrd(' '));
      cb := cb  1;
    end;
    
    Eval(ForwardRequest(origExch,pUserReq));
    
    { write user namelocation }
    if UserStatus.StatusCode <> 2 then
    begin
      if Erc = 0 then
        Erc := WriteByte(ads BSWA, wrd(''));
      if Erc = 0 then
        Erc := WriteBsRecord(ads BSWA, ads UserStatus.sbUserName[1],
    			wrd(UserStatus.sbUserName[0]), ads cb);
      if Erc = 0 then
        Erc := WriteByte(ads BSWA, wrd(''));
      { pad to 13 chars }
      cb := 13  wrd(UserStatus.sbUserName[0]);
    end
    else
    begin
      if Erc = 0 then
        Erc := WriteByte(ads BSWA, wrd('{'));
      if Erc = 0 then
        Erc := WriteBsRecord(ads BSWA, ads UserStatus.sbNodeName[1],
    			wrd(UserStatus.sbNodeName[0]), ads cb);
      if Erc = 0 then
        Erc := WriteByte(ads BSWA, wrd('}'));
      { pad to 13 chars }
      cb := 13  wrd(UserStatus.sbNodeName[0]);
    end;
    while cb > 0 do
    begin
      if Erc = 0 then
        Erc := WriteByte(ads BSWA, wrd(' '));
      cb := cb  1;
    end;
    
    { write datetime fetched by GetTime }
    if Erc = 0 then
      Erc := WriteBsRecord(ads BSWA, ads FormattedDT, 17, ads cb);
    
    if Erc = 0 then
      Erc := WriteByte(ads BSWA, wrd(chr(10)) );   {write newline char}

    Eval( CloseByteStream(ads BSWA) );

  end
  else
    Eval(ForwardRequest(origExch,pUserReq));
end; {ProcessRequest}

function fDeinstallReq: boolean  [public];
var
  i : word;
  pSpec : adsmem;
begin
  with pUserReq^ do
  begin
    pSpec := ads sbDeinstSpec[1];
    if cbFileSpec <> pSpec^[0] then
    begin
      fDeinstallReq := false;
      return;
    end;
    for i := 0 to cbFileSpec  1 do
      if pbFileSpec^[i] <> pSpec^[i+1] then
    begin
      fDeinstallReq := false;
      return;
    end;
    {***** Keep this ServeRq() here			     ******
     ***** We MUST reroute the request code before Respond() ******}
    Eval(ServeRq(ServeRqCode,origExch));         { Reroute Rq 4 Back again}
    ercRet := 0;
    Eval(Respond(pUserReq));    
  end;
  fDeinstallReq := true;
end; {fDeinstallReq}

procedure DeinstallIt;
var
  Erc : word;
begin
  Erc := OpenFile(ads fh,ads sbDeinstSpec[2],wrd(sbDeinstSpec[1]),
    		      ads null,0,wModeRead);
  if Erc = 0 then
    CheckErc(SetMsgRet(ads LogDeinstallMsg,sLogDeinstallMsg+1)) {done}
  else
    if Erc <> ercNoSuchFile {We expect NoSuchFile error} then
      if Erc = ercNoSuchVolume {or NoSuchVolume} then
        CheckErc(SetMsgRet(ads NotInstalledMsg,sNotInstalledMsg))
      else
        CheckErc(Erc);
end; {DeinstallIt}


begin {Main Module}
  if RgParam(0,1,ads Sd) = 0 then { CASE value set to DEinstall?}
    if (Sd.pParam^[0] = retype(byte,'D')) and
       (Sd.pParam^[1] = retype(byte,'E')) then
    DeinstallIt
  else
  begin				{Get ready to become resident...}
    GetWilds;
    GetLogFile;
    CheckErc(SetMsgRet(ads LogInstallMsg[1],sLogInstallMsg+1)); {includes LF}
   
    CheckErc(ConvertToSys);
    Exit;
    Eval(SetPartitionName(0,ads PartitionName,sPartitionName));
    Eval(SetPartitionLock(true));
    
    Eval(AllocExch(ads MyExch));            { Make new Exch for Rq 4 }
    Eval(ChangePriority(cPriority));	    { Change Priority to high sys serv}
    Eval(QueryRequestInfo(ServeRqCode,ads origExch,2)); {Get Exch Addr: Rq 4} 
    
    Eval(CreateFile(ads LogFile.rgbFileSpec,LogFile.cbFileSpec,ads NULL,0,0));
    
    Eval(ServeRq(ServeRqCode,MyExch));      { Reroute Rq 4 through us }
    while (Wait(MyExch,ads pUserReq) = 0)	{Serve the request...}
        and not fDeinstallReq do
          ProcessRequest;
    
    Eval(DeAllocExch(MyExch));			 { deinstall ourself...}
    Eval(SetPartitionLock(false));
    ExitAndRemove;
    
  end; {if}
END.
