PC World 2000 April/PCWorld_2000-04_cd.bin/Komunik/Servery/PinkNet/pnws1076prof.exe/file0134.bin

Text File | 2000-03-12 | 8.2 KB | 285 lines

library LogApache;
{******************************************************
 *  Knihovna PinkNet Web Serveru - Open Source Part   *
 *                                                    *
 * Tento soubor loguje protokol o cinnosti tak jako   *
 * server Appache. Je s nim kompatibilni. Informace   *
 * naleznete na http://pnws.pinknet.cz/               *
 *                                                    *
 * Copyright ⌐1999, Tomas Rosa, [e-mail] *
 *                                                    *
 ******************************************************}

uses
  SysUtils,
  Classes;

type PSvrNames=^TSvrNames;
     TSvrNames=record
        svrname:ShortString;
        next:PSvrNames;
     end;

     PMySvrNames=^TMySvrNames;
     TMySvrNames=record
        svrname,
        prefix:ShortString;
        ac_buffer,
        ref_buffer,
        agent_buffer:TStringList;
        f_ac,
        f_ref,
        f_agent:TFileStream;
        next:PMySvrNames;
     end;

var FSvrNames:PMySvrNames;
    FOldNames:PSvrNames;
    FPath:string;           //cesta k logum
    DefSvr:PMySvrNames;       //pokud se nenajde jmeno, pouzije se toto
    ErrorFile:TFileStream;
    ErrorBuf:TStringList;

function OpenLogFile(fname:string;newfile:boolean):TFileStream;
var f:file;
begin
   if newfile then
   try
      assign(f,fname);
      erase(f);
   except
      //hm, nelze smazat, tak holt pokracujem
   end;
   if not FileExists(fname) then
      result:=TFileStream.Create(fname,fmCreate or {fmShareDenyWrite}fmShareDenyNone)
   else
      result:=TFileStream.Create(fname,fmOpenReadWrite or {fmShareDenyWrite}fmShareDenyNone);
end;

//LogPath je cesta k logum tak jak je nastavena v setupu
//NeedTimer je TRUE, pokud knihovna chce casovani na ukladani dat
//             FALSE, pokud nic nechce, zapisuje to hned
//SvrNames je ukazatel na seznam jmen serveru
//NewLog je TRUE, pokud se logy maji pri startu vycistit
//Funkce vraci TRUE, pokud se podarilo inicializovat
function LogDllInit(logpath:ShortString;var needtimer:boolean;svrnames:PSvrNames;newlog:boolean):boolean; stdcall;
var x:PSvrNames;
    n,tmp:PMySvrNames;
    m:integer;
begin
   Result:=false;
   needtimer:=true;   //chceme casovac
   FSvrNames:=nil;
   FOldNames:=SvrNames;
   FPath:=logpath;
   if (length(FPath)>0) and (FPath[length(FPath)]<>'\') then FPath:=FPath+'\';

  try
   //Zlikviduj predany seznam serveru a udelej novy
   x:=SvrNames;
   while x<>nil do
   begin
      //neexistuje uz?
      tmp:=FSvrNames;
      while tmp<>nil do
      begin
         if tmp^.svrname=x^.svrname then break;
         tmp:=tmp^.next;
      end;
      if not ((tmp<>nil) and (tmp^.svrname=x^.svrname)) then
      begin //neni tam
         GetMem(n,sizeof(TMySvrNames));
         n^.svrname:=x^.svrname;
         if n^.svrname='*' then DefSvr:=n;
         n^.prefix:=n^.svrname;
         for m:=1 to length(n^.prefix) do
           if n^.prefix[m] in ['.',',','-',' '] then n^.prefix[m]:='_';
         if n^.prefix='*' then n^.prefix:=''
           else n^.prefix:=n^.prefix+'_';
         n^.ac_buffer:=TStringList.Create;
         n^.ref_buffer:=TStringList.Create;
         n^.agent_buffer:=TStringList.Create;
         n^.f_ac:=OpenLogFile(FPath+n^.prefix+'access.txt',newlog);
         n^.f_ref:=OpenLogFile(FPath+n^.prefix+'referer.txt',newlog);
         n^.f_agent:=OpenLogFile(FPath+n^.prefix+'agent.txt',newlog);
         n^.next:=FSvrNames;
         FSvrNames:=n;
      end;
      x:=x^.next;
   end;
   //ted jeste soubor na chyby
   ErrorFile:=OpenLogFile(FPath+'error.txt',newlog);
   ErrorBuf:=TStringList.Create;
  except
   //Chyba, vypadneme s FALSE a server spadne
   Exit;
  end;

   result:=true;
end;

//Prida zaznam pristupu do logu
{ Vyznam polozek:
                 svrname   - jmeno serveru, ktereho se to tyka
                 from_ip   - z jake IP adresy uzivatel prisel
                 auth_user - jak se prihlasil, pokud byl soubor zabespecen
                 gmt_date  - datum a cas ve formatu GMT
                 request   - prvni radek pozadavku "GET / HTTP/1.0"
                 referer   - odkud prisel
                 agent     - co pouzil za prohlizec
                 code      - kod, kterym odpovedel server (200-OK, 404-Not Found,..)
                 bytes     - kolik dat bylo preneseno, nebo -1, pokud to nelze zjistit
//Vraci TRUE, pokud se povedlo         }
function LogDllAddAccess(svrname,from_ip,auth_user,gmt_date,request,
                         referer,agent:ShortString;code,bytes:Integer):boolean; stdcall;
var tmp:PMySvrNames;
    s:string;

  procedure WriteLogBuf;
  begin
     if auth_user='' then auth_user:='-';
     if bytes>=0 then s:=IntToStr(bytes)
                 else s:='-';
     tmp^.ac_buffer.Add(from_ip+' '+auth_user+' - '+gmt_date+' "'+request+
                        '" '+IntToStr(code)+' '+s);
     if length(referer)>2 then
     begin
        s:=request;
        s:=Copy(s,pos(' ',s),length(s));
        Delete(s,pos(' HTTP/',s),length(s));
        tmp^.ref_buffer.add(referer+' ->'+s);
     end;
     tmp^.agent_buffer.add(agent);
  end;

begin
   result:=false;

   tmp:=FSvrNames;
   while tmp<>nil do
   begin
      if UpperCase(tmp^.svrname)=UpperCase(svrname) then
      begin
         WriteLogBuf;
         result:=true;
         exit;
      end;
      tmp:=tmp^.next;
   end;
   if DefSvr<>nil then
   begin
      tmp:=DefSvr;
      WriteLogBuf;
      result:=true;
   end;
end;

//Prida zaznam chyby do logu
{ Vyznam polozek:
                 msg       - chybova hlaska, ktera se ma zaznamenat
                 gmt_date  - datum a cas ve formatu GMT
//Vraci TRUE, pokud se povedlo         }
function LogDllAddError(msg,gmt_date:ShortString):boolean; stdcall;
begin
   result:=true;
   ErrorBuf.Add(gmt_date+' '+msg);
end;

//Pokud si Funkce LOGDLLINIT vyzadala casovac, bude volana
//tato funkce pro ulozeni zaznamu na disk. Je nutne, aby ukladani
//na disk bylo nezavisle na zbylych funkcich, ktere jsou volany
//nezavisle a asynchrone. Je tedy mozne zavolat vsechny funkce naraz
//Vraci TRUE, pokud se povedlo
function LogDllTimer:boolean; stdcall;
var tmp:PMySvrNames;
    s:string;
begin
   result:=false;

   //zapis chybove hlasky
   try
      s:=ErrorBuf.text;
      if length(s)>0 then ErrorFile.Write(s[1],length(s));
      ErrorBuf.Clear;
   except
      Exit;
   end;

   tmp:=FSvrNames;
   while tmp<>nil do
   begin
      // Pridej nove radky do LOGu
      try
         s:=tmp^.ac_buffer.text;
         if length(s)>0 then tmp^.f_ac.Write(s[1],length(s));
         tmp^.ac_buffer.Clear;

         s:=tmp^.ref_buffer.text;
         if length(s)>0 then tmp^.f_ref.Write(s[1],length(s));
         tmp^.ref_buffer.Clear;

         s:=tmp^.agent_buffer.text;
         if length(s)>0 then tmp^.f_agent.Write(s[1],length(s));
         tmp^.agent_buffer.Clear;
      except
         Exit;
      end;
      tmp:=tmp^.next;
   end;
   result:=true;
end;

//Ukonci logovaci knihovnu. Nelze odlozit, knihovna se musi ukoncit hned
procedure LogDllDone; stdcall;
var x:PMySvrNames;
    y:PSvrNames;
begin
   //Uloz posledni zkytky v pameti
   LogDllTimer;

   //Zlikviduj seznam serveru
   while FSvrNames<>nil do
   begin
      FSvrNames^.ac_buffer.Free;
      FSvrNames^.ref_buffer.Free;
      FSvrNames^.agent_buffer.Free;
      FSvrNames^.f_ac.Free;
      FSvrNames^.f_ref.Free;
      FSvrNames^.f_agent.Free;
      x:=FSvrNames^.next;
      FreeMem(FSvrNames,sizeof(TMySvrNames));
      FSvrNames:=x;
   end;

   //a jeste stary
   while FOldNames<>nil do
   begin
      y:=FOldNames^.next;
      FreeMem(FOldNames,sizeof(TSvrNames));
      FOldNames:=y;
   end;

   //a jeste chyby
   ErrorFile.Free;
   ErrorBuf.Free;
end;


//Nejaky info o knihovne a autorovi
function LogDllAbout:ShortString; stdcall;
begin
   result:='<b>LogApache 1.0</b> Copyright ©1999 <a href="mailto:[e-mail]">'+
           'Tomas Rosa</a>, <a href="http://ws.pinknet.cz">PinkNet Web Server</a>. '+
           '<i>PNWS log in common log file format</i>';
end;

exports
   LogDllAbout,
   LogDllTimer,
   LogDllAddError,
   LogDllAddAccess,
   LogDllDone,
   LogDllInit;

end.