{***************************************************************************}
{*                               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!    *}
{***************************************************************************}

Program pbs;

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

const
   Postfixcmd= '/usr/sbin/postmap';
   Postparam = '/etc/postfix/pbs';
   pbsfile   = '/etc/postfix/pbs';
   MaxUser = 500; // If this is not enough for you ...
   // Set this to the no of Sekonds 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   : String[40];
       IP     : String[16];
       Uhrzeit: LongInt; // ????
     end;

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

var
      Change     : Boolean;                        // Something happend
      User       : Array[1..MaxUser] of UserEntry; // Our small Table
      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):LongInt;
var
   i : LongInt;
   Back: LongInt;

begin
  i:=0;
  Back:=0;
  for i:=1 to 500 do begin
    if User[i].IP=ben then begin
       FindIP:=i;
       exit;
    end;
    if (User[i].Uhrzeit=0) And (Back=0) then Back:=i;
  end;
  FindIP:=Back;
end;


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

var
  i: LongInt;
begin
  for i:=1 to 500 do User[i].Uhrzeit:=0
end;

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

var
  unum  : LongInt; // temporary number for user

begin
  unum:=FindIP(Wort(Zeile,1));
  User[unum].Name:=Wort(Zeile,2);
  User[unum].IP:=wort(Zeile,1);
  User[unum].Uhrzeit:=GetEpochTime+Verfallsek;
  Change:=TRUE;
end; // end procedure

// Write the database in the file
Procedure WriteChanges;

var i: LongInt;
   ct: LongInt;
   ah : Text;
begin
  Change:=FALSE;
  ct:=GetEpochTime;
  Assign(ah,pbsfile);
  Rewrite(ah);
  write(ah,'');
  for i:=1 to 500 do begin
     if (User[i].Uhrzeit<ct) then begin
        User[i].Uhrzeit:=0;  // RÃ?cksetzen
        User[i].IP:='';
        User[i].Name:='';
     end else begin
        if debug then writeln('User: ',User[i].Uhrzeit,'  CT: ',ct);
        if User[i].Uhrzeit>0 then writeln(ah,User[i].IP,' ',User[i].Name,' ',User[i].Uhrzeit);
     end;
  end;
  close(ah);
  if FileCheck('/usr/sbin/postmap',load) then Exec(Postfixcmd,PostParam);
end;


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

var
  i: Longint;
  ct : LongInt;
  ah: Text;

begin
  if FileExists(pbsfile) then begin
     Assign(ah,pbsfile);
     reset(ah);
     i:=0;
     repeat
       Readln(ah,zeile);
       strip_blks(zeile);
       if wort(zeile,3)<>'' then begin // Only if we have a timestamp!
          inc(i);
          ct:=StrToInt(wort(zeile,3));
          With User[i] do begin
            Name:=wort(zeile,2);
            IP:=wort(Zeile,1);
            Uhrzeit:=ct;
          end;
       end;
     until eof(ah);
  end;
end;

// Are any changes in our database
Procedure CheckForChanges;

var
   i : LongInt;
   ct : LongInt;

begin
  i:=0;
  ct:=GetEpochTime;
  repeat
    inc(i);
  until ((User[i].Uhrzeit<ct) AND (User[i].Uhrzeit<>0)) or (i>499);
  if i<500 then Change:=TRUE;
end;

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

var
  mtype  : LongInt;

begin
  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;
end;

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

begin
  my_pid:=fork;
  if my_pid=0 then begin
     Debug:=FALSE;  // SpÃ?ter raus.
     LoadOld;
     //***   if ParamStr(1)<>'' then Verfallsek:=(StrtoInt(ParamStr(1)))*60;
     //***  if Verfallsek=0 then VerfallSek:=15*60;
     Inittable;
     // 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;
     Signal(SigTerm,@PrgStop);
     cfc:=0;
     repeat
        // readln(LogHandle,Zeile);
        POP_Message;
        if Zeile<>'' then begin
           Auswertung;
           if debug then writeln(Zeile);
        end;
        if Change then WriteChanges;
        Sleep(100);
        inc(cfc);
        if cfc=20 then begin
           CheckforChanges;
           cfc:=0;
        end;
     until Anhalten;
   end else
   writeln('Daemon started');
end.

Druckversion

zuletzt geändert am 13.05.2003