Опенсорс проект на Rust

library connector;
 
{$mode objfpc}{$H+}
 
uses
  Classes, SysUtils, blcksock, winsock, dynlibs, IniFiles;
 
type // тип сервера
  TServer=class(TThread)
  private
    MyIP: String;         // IP компьютера
    Port: String;         // порт сервера
    Tout: Integer;        // таймоут
    Sock: TTCPBlockSocket;// сокет сервера
  public
    procedure Execute; override;            // прослушивание сервером
    constructor Create(ip: String='0.0.0.0';// IP сервера   > конструктор
                       pt: String='80';     // порт сервера > создания
                       tt: Integer=1000);   // таймоут      > сервера
    destructor Destroy; override;           // уничтожение сервера
end;
type // тип обработчика запроса
  Vestibulum=class(TThread)
  private
    Sock: TTCPBlockSocket;              // сокет обработки запроса
  public
    ReAn: TStringList;
    constructor Create(MSock: TSocket); // создание обработчика запроса
    procedure Execute; override;        // обработка запроса
    procedure Publisher;                // публикатор сайта
    procedure Transfer(act,wfl: String);// передача файла
    function Authorization(ses: String): Boolean;// авторизация
    destructor Destroy; override;       // уничтожение обработчика запроса
end;
type // тип функции вызова обработки модулем
  TModProcessus=procedure(var ReAn: TStringList); stdcall;
const
  TITL='CONNECTOR';
  //CRLF=#13+#10;    // перевод строки
var
  test: String;
  ExfC: String;         // расширение файлов скриптов
  Name: String;         // имя сервера
  Ling: Integer;        // задержка
  Basic: String;        // основной сайт
  Scripts: String;      // директория скриптов
  Server: TServer;      // поток сервера
  Sessions: String;     // директория сессий
  Modules: TStringList; // модули
  Settings: TStringList;// настройки
//*******************************************************************
// загрузка настроек
procedure SettingsLoad;
var
  Ifl: TIniFile;
  ns,nv: Integer;
  lsc,lvl: TStringList;
begin
  if Settings.Count>0 then Settings.Clear;
  Ifl:=TIniFile.Create(GetCurrentDir+'\settings.ini');
  lsc:=TStringList.Create;lvl:=TStringList.Create;
  Ifl.ReadSections(lsc);
  for ns:=0 to lsc.Count-1 do begin
    Ifl.ReadSectionValues(lsc.Strings[ns],lvl);
    for nv:=0 to lvl.Count-1 do begin
      if lvl.Strings[nv][1]<>'#' then
        Settings.Add(lsc.Strings[ns]+'_'+lvl.Strings[nv]);
    end;
  end;
  lvl.Destroy;lsc.Destroy;
  Ifl.Destroy;
end;
// установка настроек
procedure SetSettings(key,val: String); stdcall;
var
  nx: Integer;
begin
  nx:=Settings.IndexOfName(key);
  if nx<>-1 then
    Settings.ValueFromIndex[nx]:=val
  else
    Settings.Add(key+'='+val);
end;
// получение настроек
function GetSettings(mdl,key: String): String; stdcall;
var
  nx: Integer;
begin
  nx:=Settings.IndexOfName(mdl+'_'+key);
  if nx<>-1 then
     Result:=Settings.ValueFromIndex[nx]
  else
     Result:='';
end;
// получение хендла модуля
function GetMhndl(mdl: String): TLibHandle; stdcall;
var
  nx: Integer;
begin
  if Modules<>nil then begin
    nx:=Modules.IndexOf(mdl);
    if nx<>-1 then Result:=TLibHandle(Modules.Objects[nx])
    else Result:=0;
  end else Result:=0;
end;
// локальный IP
function GetLocalIP: String;
var
  WSAData: TWSAData;
  HostEnt: PHostEnt;
  Buf: array [0..63] of Char;
begin
  Result:='';WSAData.wHighVersion:=65535;
  if WSAStartup(WINSOCK_VERSION,WSAData)=0 then begin
    if GetHostName(@Buf,SizeOf(Buf))=0 then begin
      HostEnt:=GetHostByName(@Buf);
      if HostEnt<>nil then Result:=inet_ntoa(PInAddr(HostEnt^.h_addr_list^)^);
    end;
    WSACleanup;
  end;
end;
// запись лога
procedure RecLog(msg: String; pfx: String=''); stdcall;
var
  wfl: String;
  Flog: TextFile;
begin
  wfl:=GetSettings(TITL,'LogDir');
  if DirectoryExists(wfl) then begin
    if wfl[Length(wfl)]<>'\' then wfl:=wfl+'\';
    wfl:=wfl+pfx+'_'+FormatDateTime('ddmmyy',Now)+'.log';
    AssignFile(Flog,wfl);
    if FileExists(wfl) then Append(Flog) else ReWrite(Flog);
    WriteLn(Flog,FormatDateTime('hh:nn:ss',Now)+' '+msg);
    CloseFile(Flog);
  end;
end;
// загрузка модуля
function LoadMod(mdl: String): Boolean;
var
  nm: Integer;
  Hndl: TLibHandle;
begin
  Result:=true;
  if Modules=nil then begin
    Modules:=TStringList.Create;
    nm:=-1;
  end else nm:=Modules.IndexOf(mdl);
  if nm=-1 then begin
    Hndl:=LoadLibrary(PChar(mdl+'.dll'));
    if Hndl<>0 then begin
      Modules.AddObject(mdl,TObject(Hndl));
    end else Result:=false;
  end;
end;
// выгрузка модуля
function KillMod(mdl: String): Boolean;
var
  nm: Integer;
  Hndl: TLibHandle;
begin
  Result:=true;
  if Modules<>nil then begin
    nm:=Modules.IndexOf(mdl);
    if nm<>-1 then begin
      Hndl:=TLibHandle(Settings.Objects[nm]);
       if FreeLibrary(Hndl) then begin
         Settings.Delete(nm);
         if Modules.Count=0 then
           Modules.Free;
       end else Result:=false;
    end
  end;
end;
// запуск модуля
procedure ModuleRun(mdl: String; var ReAn: TStringList); stdcall;
var
  Hndl: TLibHandle;
  Processus: TModProcessus;
begin
  Hndl:=GetMhndl(mdl);
  if Hndl<>0 then begin
    Processus:=TModProcessus(GetProcAddress(Hndl,'Processus'));
    if Processus<>nil then Processus(ReAn)
    else begin
      ReAn.Clear;ReAn.Add(Name+' ['+TITL+'] > no processus '+mdl);
    end;
  end else begin
    ReAn.Clear;ReAn.Add(Name+' ['+TITL+'] > no module '+mdl);
  end;
end;
// перезапуск
procedure ReStart(fs: Boolean=true); stdcall;
var
  nx: Integer;
  ip,pt: String;
  lmd: TStringList;
begin
  if Server<>nil then
    Server.Terminate;
  SettingsLoad;
  lmd:=TStringList.Create;lmd.Delimiter:=',';
  lmd.CommaText:=UpperCase(GetSettings(TITL,'Modules'));
  for nx:=0 to lmd.Count-1 do
    if KillMod(lmd.Strings[nx]) and fs then LoadMod(lmd.Strings[nx]);
  lmd.Free;
  Sessions:=GetSettings('CONNECTOR','Sessions');
  if Sessions<>'' then
    if Sessions[Length(Sessions)]<>'\' then Sessions:=Sessions+'\';
  Scripts:=GetSettings('CEREBRUM','Scripts');
  if Scripts[Length(Scripts)]<>'\' then Scripts+='\';
  Ling:=StrToIntDef(GetSettings(TITL,'Ling'),100000);
  ExfC:=GetSettings('CEREBRUM','Extension');
  Basic:=GetSettings('CEREBRUM','Basic');
  Name:=GetSettings(TITL,'Alias');
  ip:=GetSettings(TITL,'MyIP');
  if ip='' then begin
    ip:=GetLocalIP;
    SetSettings(TITL+'_MyIP',ip);
  end;
  pt:=GetSettings(TITL,'Port');
  nx:=StrToIntDef(GetSettings(TITL,'Tout'),5000);
  if fs then Server:=TServer.Create(ip,pt,nx);
end;
// ****************************** Сервер *****************************
// создание сервера
constructor TServer.Create(ip: String='0.0.0.0';
                          pt: String='80';
                          tt: Integer=1000);
begin
  inherited Create(False);
  MyIP:=ip;Port:=pt;Tout:=tt;
  Sock:=TTCPBlockSocket.Create;
  FreeOnTerminate:=true;
  Priority:=tpHighest;
end;
// прослушивание сервером
procedure TServer.Execute;
begin
  with Sock do begin
    CreateSocket;
    SocksResolver:=False;  Sock.
    SetLinger(true,Ling);
    Bind(MyIP,Port);Listen;
    repeat
      if CanRead(Tout) then
        if LastError=0 then
          Vestibulum.Create(Accept);
    until Terminated;
  end;
end;
// уничтожение сервера
destructor TServer.Destroy;
begin
  Sock.Free;
  inherited Destroy;
end;
//************************** Обработка запроса *********************
// создание обработчика запроса
Constructor Vestibulum.Create(MSock: TSocket);
begin
  inherited Create(False);
  FreeOnTerminate:=True;
  Priority:=tpHigher;
  Sock:=TTCPBlockSocket.Create;
  ReAn:=TStringList.Create;
  Sock.Socket:=MSock; //Sock.GetRemoteSinIP  Round((now-25569)*86400);
end;
// обработка запроса
procedure Vestibulum.Execute;
var
  mdl,ses: String;
begin
  ReAn.Text:=Sock.RecvPacket(10);
  mdl:=ReAn.Strings[0];
  if Pos('HTTP/',mdl)<>0 then Publisher // публикация сайта
  else begin
    ReAn.Delete(0);
    ses:=ReAn.Strings[0];
    if Authorization(ses) then
      ModuleRun(mdl,ReAn);              // обработка модулем
    Sock.SendString(ReAn.Text);         // отправка ответа
  end;
end;
// авторизация пользователя
function Vestibulum.Authorization(ses: String): Boolean;
var
  nx: Integer;
  lgn,psw: String;
  ldat: TStringList;
begin
  Result:=false;
  nx:=Pos('#',ses);
  if nx<>0 then begin
    lgn:=Copy(ses,1,nx-1);
    psw:=Copy(ses,nx+1,Length(ses)-nx);
    //ldat:=TStringList.Create;
    //ldat.Add();
    //ModuleRun('CUSTODEM',ldat);
    ReAn.Clear;ReAn.Add('session=bnbgfbu');
  end else if not FileExists(Sessions+ses) then begin
    ReAn.Clear;ReAn.Add('answer=no access');
  end else Result:=true;
end;
// публикация сайта
procedure Vestibulum.Publisher;
var
  np: integer;
  tst: String;
  lpar: TStringList;
begin
  lpar:=TStringList.Create;
  lpar.Delimiter:=' ';
  lpar.DelimitedText:=ReAn.Strings[0];
  ReAn.Text:=StringReplace(ReAn.Text,': ','=',[rfReplaceAll]);
  ReAn.Strings[0]:='Method='+lpar.Strings[0];
  ReAn.Insert(1,'HTTPv='+lpar.Strings[2]);
  tst:=lpar.Strings[1];
  lpar.Delimiter:='/';
  np:=Pos('?',tst);
  if np<>0 then begin
    lpar.DelimitedText:=Copy(tst,1,np-1);
    tst:=Copy(tst,np+1,Length(tst)-np);
    np:=ReAn.Count-1;
    if ReAn.Strings[np]='' then ReAn.Add(tst)
    else ReAn.Strings[np]:=tst+'&'+ReAn.Strings[np];//URLDecode(
  end else lpar.DelimitedText:=tst;
  lpar.Delimiter:='\';
  if lpar.Strings[1]='' then lpar.Strings[1]:=Basic
  else if Pos('.',lpar.Strings[1])<>0 then lpar.Insert(1,Basic);
  if lpar.Count<3 then lpar.Add('main'+ExfC);
  ReAn.Insert(3,'Script='+lpar.Strings[1]);
  lpar.Delete(1);
  tst:=ExtractFileExt(lpar.DelimitedText);
  if tst='' then begin
    tst:=ExfC;lpar.DelimitedText:=lpar.DelimitedText+tst;
  end;
  ReAn.Insert(4,'File='+lpar.DelimitedText);
  ReAn.Insert(5,'Extension='+tst);
  lpar.Clear;lpar.Add(ReAn.Values['HTTPv']);
  if tst<>Exfc then begin
    lpar.Add(Scripts+ReAn.Values['Script']+ReAn.Values['File']);
    ReAn.Clear;test:=lpar.Strings[1];
    if FileExists(lpar.Strings[1]) then begin
      ReAn.Add(lpar.Strings[0]+' 200 OK');
      case tst of
        'css': tst:='text/css';
        'js':  tst:='text/javascript';
        else   tst:='image/'+tst;
      end;
      ReAn.Add('Content-type: '+tst);
      tst:='PUT';
    end else begin
      ReAn.Add(lpar.Strings[0]+' 204 No Content');
      tst:='';
    end;
    ReAn.Add('');
  end else begin
    ModuleRun('CEREBRUM',ReAn);
    if ReAn.Count=0 then begin
      ReAn.Add(lpar.Strings[0]+' 206 Partial Content');
      ReAn.Add('');
      ReAn.Add(Name+' ['+TITL+'] > CEREBRUM no content');
      tst:='';
    end else begin
      if ReAn.Strings[0]='Transfer' then begin
        ReAn.Delete(0);
        tst:=ReAn.Strings[0];
        ReAn.Delete(0);
        lpar.Add(ReAn.Strings[0]);
        ReAn.Delete(0);
      end else tst:='';
    end;
  end;
  ReAn.Insert(1,'Server: '+Name);
  Sock.SendString(ReAn.Text);
  if tst<>'' then Transfer(tst,lpar.Strings[1]);
  lpar.Free;
end;
// передача файла
procedure Vestibulum.Transfer(act,wfl: String);
var
  StFl: TFileStream; // поток файла
begin
  case act of
    'GET': begin // получаем
             StFl:=TFileStream.Create(wfl,fmCreate);
             Sock.RecvStreamRaw(StFl,Ling);
             StFl.Free;
           end;
    'PUT': begin // передаём
             StFl:=TFileStream.Create(wfl,fmOpenRead or fmShareDenyNone);
             StFl.Seek(0,soFromBeginning);
             Sock.SendStreamRaw(StFl);
             StFl.Free;
           end;
  end;
end;
// уничтожение потока обработки запроса
destructor Vestibulum.Destroy;
begin
  ReAn.Free;Sock.Free;
  inherited Destroy;
end;
 
exports SetSettings,GetSettings,GetMhndl,ModuleRun,RecLog,ReStart;
 
begin
  Settings:=TStringList.Create;
  ReStart;
end.