{***************************************************************************}
{*                               SysQuadrat (c) M. Weinert                 *}
{*                                                                         *}
{* ProgramId: pbs                                                          *}
{* Date     : 01.10.2002                                                   *}
{* Time     : 19:35                                                        *}
{* License GPL                                                             *}
{* (c) 1995,1996,1997,1998,2001,2002 by M. Weinert                         *}
{***************************************************************************}
{* POP before smtp                                                         *}
{* Sorry most of the variables have german names. Maybe I do an update!    *}
{* If you want to use this software you have to remove all the writelns    *}
{* they are for debugging purposes only!                                   *}
{* This version works with pointers, so no userlimit any more.             *}
{***************************************************************************}

Program pbs;

uses stwort,fileapi,sysutils,linux,crt,dos,ipc;

const
   Postfixcmd= '/usr/sbin/postmap';
   Postparam = '/etc/postfix/pbs';
   pbsfile   = '/etc/postfix/pbs';

   // Set this to the no of Seconds you want
   // Or if you want to adjust this via cmdline
   // comment this here and uncomment the //*** Lines
   VerfallSek = 15*60;


type
     UserEntry=Record
       Name   : PChar;
       IP     : PChar;
       Uhrzeit: LongInt; // Keep the time from last login
       Next   : Pointer; // Next entry in List
     end;

  PUserEntry = ^UserEntry;                         // Pointer to UserEntry
  PMyMsgBuf = ^TMyMsgBuf;                          // Pointer for Messages
  TMyMsgBuf = Record                               // Buffer of Message
    mtype: LongInt;
    mtext: string[128];
  end;

var
      Change     : Boolean;                        // Something happend
      User       : PUserEntry;                      // Our small Table
      UserStart  : Pointer;                        // Start of our List
      Anhalten   : Boolean;                        // Halt the program
      Zeile      : String;                         // Zeile = Line
      My_PID     : LongInt;                        // Prozess ID of Child
//*** VerfallSek : LongInt;                        // Uncomment for cmdline
      cfc        : Byte;                           // CheckForChanges
      Debug      : Boolean;                        // For debugging only
      // IPC variables
      IPC_Key    : TKey;
      IPC_ID     : LongInt;
      IPC_BUF    : TMyMsgBuf;


// If we get the signal, we will stop
Procedure PrgStop(sig:LongInt);cdecl;

begin
  Anhalten:=TRUE;
end;


// Is the IP already in the database? So return it.
Function FindIP(ben:String):PUserEntry;

begin
  if debug then writeln('FindIP');
  User:=UserStart;
  while (User^.IP<>ben) AND (User^.Next<>NIL) do User:=User^.Next;
  FindIP:=User;
  if debug then writeln('FindIP end');
end;

// Initialise our table for the first time
Procedure InitTable;

begin
  if debug then writeln('Inittable');
  new(User);
  User^.Name:=nil;
  User^.IP:=nil;
  User^.next:=nil;
  UserStart:=User;
  if debug then writeln('Inittable END');
end;

// AddUser
Procedure AddUser(neu : String);

var
  uz : PUserEntry;
  pneu : PUserEntry;

begin
  if debug then writeln('AddUser');
  // Erst bis zum Ende durcharbeiten:
  uz:=UserStart;
  while uz^.next<>nil do uz:=uz^.next;
  new(pneu);
  uz^.next:=pneu;
  pneu^.name:=stralloc(sizeof(wort(Zeile,2)));
  strPCopy(pneu^.Name,Wort(Zeile,2));
  pneu^.ip:=stralloc(sizeof(wort(zeile,1)));
  strPCopy(pneu^.IP,wort(Zeile,1));
  if wort(Zeile,3)<>'' then pneu^.Uhrzeit:=StrToInt(wort(zeile,3)) else pneu^.Uhrzeit:=(GetEpochTime+VerfallSek);
  Change:=TRUE;
  if debug then writeln('AddUser End');
end;

Procedure DelUser(olu : PuserEntry);

var
    uz : PUserEntry;
begin
  if olu=NIL then begin // Exception first Entry!
     olu:=UserStart;    // First entry
     if olu^.next=NIL then begin // Wow first=last!
        if olu^.name<>Nil then dispose(olu^.name);
        if olu^.ip<>Nil then dispose(olu^.ip);
        olu^.name:=Nil;
        user^.ip:=Nil;
        UserStart:=olu;
     end
     else begin
        UserStart:=olu^.next;
        if olu^.name<>Nil then dispose(olu^.name);
        if olu^.ip<>Nil then dispose(olu^.ip);
        Dispose(olu);
     end;
  end
  else begin
     uz:=olu^.next;        // uz is the entry to delete.
     olu^.next:=uz^.next;  // Now set prev to next.
     Dispose(uz^.name);
     Dispose(uz^.ip);
     Dispose(uz);
  end;
end;


// Add the line in the database if it doesn't exit.
Procedure Auswertung;

var
  uz  : PuserEntry; // temporary number for user

begin
  if debug then writeln('Auswertung');
  uz:=FindIP(Wort(Zeile,1));
  if uz=NIL then AddUser(Zeile) else begin
     if debug then writeln('Found User');
     if uz^.Name<>Nil then dispose(uz^.name);
     if uz^.ip<>Nil then dispose(uz^.ip);
     if uz^.Name=Nil then uz^.name:=StrAlloc(sizeOf(wort(Zeile,2)));
     strPCopy(uz^.Name,Wort(Zeile,2));
     if uz^.IP=Nil then uz^.ip:=StrAlloc(sizeOf(wort(Zeile,1)));
     strPCopy(uz^.IP,wort(Zeile,1));
     uz^.Uhrzeit:=GetEpochTime+Verfallsek;
     Change:=TRUE;
  end;
  if debug then writeln('Auswertung End');
end; // end procedure

// Write the database in the file
Procedure WriteChanges;

var
   ct : LongInt;
   ah : Text;
   uz : PUserEntry;
begin
  writeln('WriteChanges');
  Change:=FALSE;
  ct:=GetEpochTime;
  Assign(ah,pbsfile);
  Rewrite(ah);
  write(ah,'');
  uz:=UserStart;
  while uz<>NIL do begin
     if (uz^.Uhrzeit>0) and (uz^.Uhrzeit>ct) then begin
         writeln(ah,uz^.ip,' ',uz^.name,' ',uz^.uhrzeit);
         if debug then writeln('DEBUG AUS',uz^.ip);
     end;
     uz:=uz^.next;
     // if
  end;
  close(ah);
  if FileCheck('/usr/sbin/postmap',load) then Exec(Postfixcmd,PostParam);
  writeln('WriteChanges End');
end;


// Load the old data from file so we don't loose em.
Procedure LoadOld;

var
  ct : LongInt;
  ah: Text;

begin
  writeln('LoadOld');
  if FileExists(pbsfile) then begin
     Assign(ah,pbsfile);
     reset(ah);
     repeat
       Readln(ah,zeile);
       strip_blks(zeile);
       if wort(zeile,3)<>'' then begin // Only if we have a timestamp!
          ct:=StrToInt(wort(zeile,3));
          if ct<GetEpochTime then AddUser(Zeile);
       end;
     until eof(ah);
  end;
  writeln('LoadOld End');
end;

// Are any changes in our database
Procedure CheckForChanges;

var
   ct : LongInt;
   uz : PUserEntry;
   oz : PUserEntry;

begin
  uz:=UserStart;
  ct:=GetEpochTime;
  Change:=False;
  oz:=NIL;  // Old Entry
  while (uz^.next<>NIL) do begin
    if uz^.Uhrzeit<ct then begin
       DelUser(oz);
       Change:=TRUE;
    end;
    oz:=uz;
    uz:=uz^.next;
  end;
  if (Change) AND (debug) then writeln('CheckForChanges=TRUE');
end;

// Look for a message from pop-daemone
Procedure POP_Message;

var
  mtype  : LongInt;

begin
  writeln('POP_Message');
  IPC_Buf.Mtype:=1; Mtype:=1;
  if msgrcv(IPC_ID,PmsgBuf(@IPC_BUF),128,mtype,IPC_NOWAIT) then begin
     Zeile:=IPC_Buf.Mtext;
     if Debug then writeln('msg rec ',Zeile);
     if Zeile<>'' then Auswertung;
     Zeile:='';
  end;
  writeln('POP_Message End');
end;

// This is an simple implementation of delay
procedure Sleep(dtime: word);
begin
 Select(0,nil,nil,nil,dtime);
end;

begin
  // my_pid:=fork;
  my_pid:=0;
  if my_pid=0 then begin
     Debug:=TRUE;  // Später raus.
     Inittable;
     LoadOld;
     //***   if ParamStr(1)<>'' then Verfallsek:=(StrtoInt(ParamStr(1)))*60;
     //***  if Verfallsek=0 then VerfallSek:=15*60;
     // This directory MUST exist!
     IPC_Key:=ftok('/tmp/pop','M');
     IPC_ID:=msgget(IPC_Key,IPC_CREAT or 438);
     if IPC_ID<0 then begin
        writeln('Couldnt open the IPC-Queue!');
        halt(255);
     end;
     writeln('IPC success');
     Signal(SigTerm,@PrgStop);
     writeln('Signal success');
     cfc:=0;
     repeat
        // readln(LogHandle,Zeile);
        POP_Message;
        writeln('pop');
        if Zeile<>'' then begin
           Auswertung;
           if debug then writeln(Zeile);
        end;
        if Change then WriteChanges;
        Sleep(2000);
        inc(cfc);
        if cfc=20 then begin
           CheckforChanges;
           cfc:=0;
        end;
     until Anhalten;
   end else
   writeln('Daemon started');
end.