unit xserver;



{$MODE Delphi}



{ $MODE Delphi}



{$H+}

{ $Y+}

{$R+}

{$M+}

{$UNDEF STRING_IS_ANSI}

{$DEFINE STRING_IS_UNICODE}

interface



uses

  {Windows,}{$IFNDEF LCL}  Messages, {$ELSE} LCLIntf, LMessages, LclType,interfaces,LResources, {$ENDIF}

  SysUtils, Classes, Graphics, Controls, Forms,IdGlobal,

  Dialogs, IdBaseComponent, IdComponent, IdCustomTCPServer, IdCustomHTTPServer,

  IdHTTPServer,IdContext,IdCookie,  IdException ,IdHeaderList,

  //idssl,

  //IdServerIOHandlerSocket,

  //IdServerIOHandlerSSLOpenSSL,

 //   sharemem,

 //indyapp,

 IdIOHandlerStack,IdIOHandler,

  syncobjs,

  xsecgi,

  xsexml,

  xsefun,

  xseexp,

  xsecomp,

  xsedif,   ExtCtrls ,

  xseftp,xsetimers,xsesmtp,xsesta,

  xsexse, StdCtrls,   IdSSLOpenSSL ,IdSchedulerOfThread ;



  type



  { Txseusform }



  Txseusform = class(TForm)

    LOG: TMemo;

    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);

    procedure FormCreate(Sender: TObject);

    procedure FormDeactivate(Sender: TObject);

 //   procedure notif(sender:tobject);

  private

    procedure GetPassword(var Password: String);

    procedure Status(ASender: TObject; const AStatus: TIdStatus;

      const AStatusText: string);

    public

   function verpeer(Certificate: TIdX509; AOk: Boolean): Boolean;

  end;

   txseusserver=class(tobject)

    server:tidhttpserver;

    sessionlist:tlist;

  // ssl:tIdSSLIOHandlerSocketbase;

   // connections:integer;

    procedure onCommandGet(AContext: TIdContext;

      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

    procedure OnInvalidSession(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo; var VContinueProcessing: Boolean; const AInvalidSessionID: String);

    constructor create;

    //private

    procedure sessionstart(Sender: TIdHTTPSession);

    private

    procedure sessionend(Sender: TIdHTTPSession);

    procedure serverConnect(AContext: TIdContext);

    procedure serverdisconnect(AContext:TIdContext);

//    procedure CreatePostStream(c:tidcontext;h:tidheaderlist;s:tstream);

  end;

  tsslserver=class(tobject)

  private

    server:tidhttpserver;

  // ssl:tIdSSLIOHandlerSocketbase;

    connections:integer;

    sessionlist:tlist;

    procedure onConnect(AContext: TIdContext);

    procedure onCommandGet(AContext: TIdContext;

      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

    constructor create;

  procedure sessionstart(Sender: TIdHTTPSession);

 // private



procedure sessionend(Sender: TIdHTTPSession);

end;

//  tlocked=class(tobject)

//     files:tstringlist;

//     function lockfile(st:string):boolean;

//     function unlockfile(st:string):boolean;

//     constructor create;

//  end;



const

   crlf=^M^J;

   //tmpoutdir='c:\www\tmp\';

   //tmpindir='c:\website\cgi-temp\';

   isost=32000;

   whitespace=crlf+' ';

   inlins=',tt,span,strong,code,br,BR,img,em,b,i,a,strike,font,q,del,ins,value,FONT,STRONG,CODE,A,';g_myurl='http://valtweb.pc.helsinki.fi/cgi-shl/cgitalk.exe';

var    xseusserver: TxseusServer;ftpserver:txseusftp;

 sslserver:tsslserver;servicemode:boolean;

  xseusform: Txseusform;

  connections:integer;

  //uploadlimits:tstringlist;

  //timer:ttimertask; //locriti,

  logicriti:TCriticalSection;

  log:textfile;

  //g_locs:TLOCS;

  //cookie:string;

  {$IFNDEF LAZARUS}      logstream:tfilestream;

    {$ENDIF}

threadvar thrxs:txseus;mythreadelems:tlist;



  procedure logwrite(st:ANSIstring);







implementation



{$IFNDEF LCL}

{$R *.dfm}

uses xsesvc;

{$ELSE}

{x$R *.lfm}

{$ENDIF}



threadvar  ResponseStream : TMemoryStream;

respa:tidhttpresponseinfo;xso:txseus;actx:tidcontext;



constructor tsslserver.create;

var port:integer;

ssl:TIdServerIOHandlerSSLOpenSSL;

begin

 // port:=strtointdef(x_config.subs('commands/port'),80);

 try

 sessionlist:=tlist.Create;

 connections:=0;

 server:=tidhttpserver.create;

 server.SessionState:=true;

 server.onsessionstart:=sessionstart;

// server.onsessionend:=sessionend;

 server.SessionTimeout:=1000000;

 server.DefaultPort:=443;

 server.oncommandget:=oncommandget;

 server.OnConnect:=onconnect;

 //server.active:=true;

 server.AutoStartSession:=true;

 //server.AutoStartSession:=false;

 ssl:=TIdServerIOHandlerSSLOpenSSL.create;

 //SSL.SSLOptions.Method := sslvSSLv2;//sslvSSLv3;sslvSSLv23;

 SSL.SSLOptions.Method := sslvSSLv3;

 //SSL.SSLOptions.Method :=sslvtlSv1;

 //ssl.ssloptions.certfile:='c:\xx\xseus.cer';

 //ssl.ssloptions.keyfile:='c:\xx\xseus.key';

 ssl.ssloptions.certfile:=extractfiledir(paramstr(0))+'\xseus.cer';

 ssl.ssloptions.keyfile:=extractfiledir(paramstr(0))+'\xseus.key';

//&  xseusform.memo1.lines.add('cert in '+ssl.ssloptions.certfile);

  logwrite('cert '+ssl.ssloptions.certfile);

 //ssl.onverifyPeer:=xseusform.verpeer;

 //ssl.ssloptions.verifymode:=[sslvrfPeer];

 //ssl.ongetpassword:=xseusform.getpassword;

 ssl.ssloptions.verifymode:=[];

 ssl.ssloptions.verifydirs:='';

 ssl.ssloptions.Mode :=sslmServer;

 // ssl.ssloptions.Mode :=  sslmUnassigned;

 ssl.ssloptions.VerifyDepth := 2;

//ssl.OnStatus := xseusform.Status;

//server.OnStatus := xseusform.Status;

 server.iohandler:=ssl;

 server.Active:=true;





 //ssl.OnVerifyPeer:=Txseusform.VERPEER;

 //TIdServerIOHandlerSSLOpenSSL

 //TIdServerIOHandlerSocket.create;

 //server.intercept:=TIdserverSSLIOHandler.create;

 //TIdSSLIOHandlerSocketOpenSSL

 //ClientServerIndySSLIOHandlerSocket

//& xseusform.Memo1.lines.add('sslserver started on port 801');

  logwrite('Started SSL-server on port '+inttostr(server.defaultport));

 except

  logwrite('Failed to start SSL-server on port 443');

 end;

end;



constructor txseusserver.create;

var port:integer;



begin

 try

  sessionlist:=tlist.Create;

  port:=strtointdef(x_config.subs('commands/port'),80);

 connections:=0;

g_smtpindir:=x_config.subs('//smtp/@indir');

logwrite('SMTP INDIR:'+g_smtpindir);

 try

 //logwrite('trying  to create a Xseus-server');

 server:=tidhttpserver.create;

 //server.sessionlist.

 server.maxconnections:=10;

 except  logwrite('Failed to create a Xseus-server'); end;

 server.SessionState:=true;//false;

 server.onsessionstart:=sessionstart;

 write(log,'1-');

 server.onsessionend:=sessionend;

// server.SessionTimeout:=25000;

  server.SessionTimeout:=strtointdef(x_config.subs('commands/sessiontime'),25000);

 //server.sessionlist.SessionTimeout:=15000;

 write(log,'2-');

 server.oninvalidsession :=oninvalidsession;



 server.DefaultPort:=port;

 server.oncommandget:=oncommandget;

// server.OnContextCreated

 write(log,'3-(port:',port,')');

 server.active:=true;

 write(log,'4-');

 server.AutoStartSession:=true;

 //server.AutoStartSession:=false;

 //server.keepalive:=false;

 server.keepalive:=true;

 write(log,'5-');

 //xseusform.Memo1.text:='xseusserver started on port '+inttostr(port);

  logwrite('Started Xseus server app on port '+inttostr(port)+ '( sess_'+inttostr(server.sessiontimeout));

 except

  logwrite('Failed to start Xseus server app');

 end;

end;



{procedure txseusserver.CreatePostStream(c:tidcontext;h:tidheaderlist;s:tstream);

begin

//  c.Connection.IOHandler.headerhasbeenwritten:=false;

end;}



procedure tsslserver.onConnect(AContext: TIdContext);

begin

  //logwrite('ssl.connect:');

  inherited;

  //logwrite('ssl.connect2:');

end;



procedure logwrite(st:ANSIstring);

begin

//  logicriti.Enter;

  try

  try

  if servicemode then

 // writeln(log,st)

{$IFNDEF LCL}

   logstream.write(st[1],length(st))

{$ENDIF}



   else

  {begin

  try

    FEventLogger.LogMessage(st, EVENTLOG_ERROR_TYPE, 0, 0); //writeln(log,st);

  EXCEPT WRITELN(log,'failed to log');end;

  end else}



 begin

 //if xseusform.LOG.Lines.count>1000 then  xseusform.LOG.Lines.Clear;

 xseusform.LOG.Lines.add(st);

{$IFNDEF LCL}

   logstream.write(st[1],length(st))

{$ENDIF}

 end;

 except end;

  finally

  //  logicriti.Leave;

  end;

end;





function txseusform.verpeer(Certificate: TIdX509; AOk: Boolean): Boolean;

begin

  //writeln('cerify');

  result:=true;

end;

function HexToString(H: String): String;

var I : Integer;

begin

  Result:= '';

  for I := 1 to length (H) div 2 do

    Result:= Result+Char(StrToInt('$'+Copy(H,(I-1)*2+1,2)));

end;



function HtmlOutput(var F: TTextRec): Integer;

var tx,TX2:ANSIstring;TBP:pchar;

tb:tidbytes;

begin

try

  if f.bufpos=0 then exit;

  if f.bufptr=nil then exit;

  {if not xso.httpinited then

    begin

     try

      respa.WriteHeader;xso.httpinited:=true;

      respa.HeaderHasBeenWritten:=true;

     finally

            end;

    end;}

  with F do

  begin

   try

  //actx.connection.iohandler.write(copy(bufptr,0,bufpos));

 // respa.contenttext:=inttohex(bufpos,1)+crlf+copy(bufptr,0,bufpos)+crlf;

 { respa.contenttext:=copy(bufptr,0,bufpos)+crlf;

  respa.WriteContent;



   respa.ContentText:='';

   sleep(3000);

   BufPos := 0;

   Result := 0;

 exit;

 // actx.connection.iohandler.DefStringEncoding:=nil;

  tx:=inttohex(bufpos-1,1)+crlf+copy(bufptr,0,bufpos)+crlf;

  TRY

     tbp:=@tx[1];

    // SetString(TX2, tbp,Length(TX));

  EXCEPT

      LOGWRITE('NOTX2');

  END;

  logwrite('TX::'+inttostr(length(tx))+'///'+TX+'\\\');

  //logwrite('TX2::'+inttostr(length(tx2))+'///'+TX2+'\\\');

  // actx.connection.iohandler.write(rawtobytes(tx[1],length(tx)-1),length(tx)-1);

   //sleep(5000);

   }

   TRY

   if bufpos=0 then exit;



//--   tx:=inttohex(bufpos,4)+crlf+copy(bufptr,0,bufpos)+crlf;//+CRLF;

   except

      logwrite('noGO Tx///'+inttostr(length(tx)));//+respa.contenttext+' //'+inttostr(length(respa.contenttext)));

   end;

   try

     tbp:=@tx[1];

     //rawtobytes(tx[1],length(tx));

     //tb:=rawtobytes(tx[1],length(tx));

 //  actx.connection.iohandler.write(TIDBYTES(tbp),length(tx),0);

   except

      logwrite('noGO RTB///'+inttostr(length(tx)));//+respa.contenttext+' //'+inttostr(length(respa.contenttext)));

   end;

   try

   //actx.connection.iohandler.WriteDirect(RAWTObytes(tbp,LENGTH(TX)), Length(tx), 0);

  // actx.connection.iohandler.Writedirect(tb, Length(tx), 0);

   actx.Connection.IOHandler.Write(RawToBytes(PAnsiChar(tx)^, Length(tx)));

   //actx.connection.iohandler.Write(@tb, Length(tx), 0);

   //actx.connection.iohandler.Writedirect(tidbytes(@tx[1]), Length(tx), 0);

   except

      logwrite('noGO WD///'+inttostr(length(tx))+'/'+inttostr(sizeof(tb)));//+respa.contenttext+' //'+inttostr(length(respa.contenttext)));

   end;

   BufPos := 0;

   Result := 0;

   except

      logwrite('nooutputt///'+tx);//+respa.contenttext+' //'+inttostr(length(respa.contenttext)));

   end;

  end;

  exit;

{

  with F do

  begin

   if respa<>nil then

   begin

    if not xso.httpinited then

    begin

     try

      respa.WriteHeader;xso.httpinited:=true;

        respa.HeaderHasBeenWritten:=true;

      //respa.contenttext:=copy(bufptr,0,bufpos)+'/INITED';

      //respa.WriteContent;

     except

       logwrite('failed httpinit');

       raise;

     end;

    end;

     try

     //respa.contentstream.write(BufPtr^, BufPos);

     //respa.ContentText:='';

     TRY

      if bufpos>bufsize  then logwrite('ffffffffffffff'+inttostr(bufsize));

      respa.ContentText:=copy(pchar(bufptr),0,bufpos);

     except

       logwrite('failed htmloutput'+respa.contenttext);

       //LAZARUS FREEZES: raise;

     end;

     TRY

     //logwrite('TRY htmloutput'+respa.contenttext+inttostr(bufpos));

     respa.WriteContent;

     except

       logwrite('failed WRITECONTENT'+respa.contenttext);

       //LAZARUS FREEZES: raise;

     end;

     except

       logwrite('failed htmloutput'+respa.contenttext);

       //LAZARUS FREEZES: raise;

     end;

   BufPos := 0;

   Result := 0;

  end;

  end;

  }

  except

    logwrite('***********************didnot output');

  end;

end;



function HtmlCLOSE(var F: TTextRec): Integer;

begin

FileClose(F.Handle); { *Converted from CloseHandle*  }

 result:=0;

  END;



function HtmlOpen(var F: TTextRec): Integer;

begin

  with F do begin

  begin

      Mode := fmOutput;

      InOutFunc := @HtmlOutput;

      FlushFunc := @HtmlOutput;

      CloseFunc := @HtmlClose;

    end;

    Result := 0;

  end;

end;



procedure AssignHtml(var F: TextFile);

begin

  with TTextRec(F) do

  begin

    FillChar(F, SizeOf(F), 0);

    Mode := fmClosed;

    BufSize := SizeOf(Buffer);

    BufPtr := @Buffer;

    OpenFunc := @HtmlOpen;

    htmlopen(ttextrec(f));

  end;

end;





{procedure TForm1.Button1Click(Sender: TObject);

begin

 xseusserver.server.active:=false;

 xseusserver.server.bindings.clear;

 xseusserver.server.Free;

 xseusserver.Free;

 xseusserver:=txseusserver.create;

 xseusserver.connections:=0;

end;

}





procedure Txseusform.FormCreate(Sender: TObject);

var inif:string;//f:textfile;

//timerini:tstringlist;

i:integer;timersini:ttag;

begin

 try

   try

   logwrite('formcreate ');

      //    ReportMemoryLeaksOnShutdown := DebugHook <> 0;

      try

        g_locs:=tlocs.create;

        //criti:=tcriticalsection.create;

        logicriti:=tcriticalsection.create;

        //timer.interval:=17000;

        //timer.OnTimer:=notif;

        inif:=extractfiledir(paramstr(0))+'\xseus.xsi';

        //if not FileExistsUTF8(inif) { *Converted from FileExists*  } then

        if not FileExists(inif) { *Converted from FileExists*  } then

        inif:=extractfiledir(paramstr(0))+'\xseus.ini';

        //inif:='C:\XSER\xseus.ini';

        logwrite('read config '+inif);

        x_config:=ttag.create;

        x_config.fromfile(inif,nil);

      except  logwrite('failed to read inifile from '+inif); exit; end;

      xseusserver:=TxseusServer.create;

      //exit;

      // xseusserver.server.OndisConnect:=xseusserver.serverconnect;

      xseusserver.server.OndisConnect:=xseusserver.serverdisconnect;

      sslserver:=TsslServer.create;

      logwrite('sslservr created***********');

      //x_config.fromfile('c:\xi\xseus.ini',nil);

   except  logwrite('failed to load servers'); exit; end;

   try

     xsecache:=TSTRINGLIST.CREATE;

     x_commands:=x_config.subt('commands');

     TRY

     //LOGWRITE(X_COMMANDS.XMLIS);



     EXCEPT

       logwrite('fauiled lsit x_coms');

     end;

     x_dirs:=x_commands.subt('dirs');

     logwrite('config read '+x_config.vari+ ' from ' +inif);

     try

       TIMERSINI:=x_commands.subt('timers');

       if timersini<>nil then

       for i:=0 to timersini.subtags.Count - 1 do

       begin

         //logwrite(ttag(timersini.subtags[i]).listraw);

         if ttag(timersini.subtags[i]).vari='timer' then

         ttimertask.Create(ttag(timersini.subtags[i]).attributes);//(self);

       end;

     except logwrite('problems: timers /xseus.ini, timers-section'); end;

     //  logwrite('timer='+ini.text);

     // logwrite(x_commands.listraw);

     try

         x_ftp:=x_commands.subt('ftp');

         x_smtp:=x_commands.subt('smtp');

     except logwrite('problems: xweus.ini, ftp/smtp-section');   end;

     try

       if x_ftp<>nil then

       begin

         logwrite('ftpserver create:');

         ftpserver:=txseusftp.create;

         logwrite('ftpserver created');

       end;

     except  logwrite('problems: ftp-server');  end;

     try

       if x_smtp<>nil then

       begin

         smtpserver:=txseussmtp.create(x_smtp);

        logwrite('smtpserver created');

       end;

     except logwrite('problems: smtp-server. ');  end;

   except  logwrite('failed to initialize'); exit; end;

 except logwrite('initialization failed '+inif); exit; end;

 logwrite('FORM CREATED');

end;



procedure Txseusform.FormCloseQuery(Sender: TObject; var CanClose: boolean);

begin

 //showmessage('DEACIVATE');

 xseusserver.server.active:=false;

 //showmessage('DEACIVATEd');

 xseusserver.free;



end;



procedure Txseusform.FormDeactivate(Sender: TObject);

begin



end;



//function txseusserver.sessionstart:TOnSessionStartEvent;

procedure startsession(Sender: TIdHTTPSession);

var ase:ttag;

begin

     //if ase=nil then

     ase:=ttag.create;

     ase.vari:='session';

     ase.attributes.add('class=system:login');

     //ase.attributes.add('dir='+sesdir);

     //if xseus.x_newcookie<>'' then

     ase.attributes.add('id='+sender.sessionid);

     //else

     //  ase.attributes.add('id='+cookies.values['xseus_session']);



     ase.attributes.add('time='+timetostr(now));

     //ase.attributes.add('ip='+xseus.x_cgi.subs('REMOTE_ADDR'));

     ase.attributes.add('ip='+sender.RemoteHost);

     ase.attributes.add('new=true');

    sender.content.addobject('welcome',ase);

    sender.content.addobject('connections',tstringlist.create);

 LOGWRITE(sender.RemoteHost+'|'

 +sender.sessionid+'Session startED, '+ sender.content.text);

//& xseusform.Memo1.lines.add('Session started, '+ sender.content.text);

end;



procedure TXSEUSSERVER.sessionstart(Sender: TIdHTTPSession);

var i:integer;ases: TIdHTTPSession;

begin

//if sender.SessionID='sauna_timer' then exit;

//inherited;

//if sender.

logwrite('XSEUSsession start'+sender.SessionID);

 startsession(sender);

try

try

 sessionlist.add(sender);

  except

    logwrite('sesslist probs');

  end;

 for i:=0 to SessionList.Count-1 do

 begin

 ases:=tidhttpsession(SessionList[i]);

 IF ASES.Content<>nil then

  logwrite(inttostr(i)+'sess:'+ases.SessionID+':'+  ases.RemoteHost+'|');

 //sender.content.add('welcome');

 end;

except

    logwrite('sesslist items probs');

end;

end;



procedure TsslSERVER.sessionstart(Sender: TIdHTTPSession);

var i:integer;ases: TIdHTTPSession;

begin

//if sender.SessionID='sauna_timer' then exit;

//inherited;

//if sender.

logwrite('XSEUSsession start'+sender.SessionID);

 startsession(sender);

try

try

 sessionlist.add(sender);

  except

    logwrite('sesslist probs');

  end;

 for i:=0 to SessionList.Count-1 do

 begin

 ases:=tidhttpsession(SessionList[i]);

 IF ASES.Content<>nil then

  logwrite(inttostr(i)+'sess:'+ases.SessionID+':'+  ases.RemoteHost+'|');

 //sender.content.add('welcome');

 end;

except

    logwrite('sesslist items probs');

end;

end;

procedure TsslSERVER.sessionend(Sender: TIdHTTPSession);

begin

 //&xseusform.Memo1.lines.add('SSLsession ended'+sender.SessionID);

 //ttag(sender.content.Objects[0]).subtags.free;

 //ttag(sender.content.Objects[0]).attributes.free;

// listwrite(ttag(sender.content.Objects[0]));

logwrite('end sslsession');

if sender.Content.count>0 then

begin

 ttag(sender.content.Objects[0]).clear;

 ttag(sender.content.Objects[0]).free;

end;

end;

procedure TXSEUSSERVER.sessionend(Sender: TIdHTTPSession);

begin



//& xseusform.Memo1.lines.add('session ended'+sender.SessionID);

 //ttag(sender.content.Objects[0]).subtags.free;

 //ttag(sender.content.Objects[0]).attributes.free;

// listwrite(ttag(sender.content.Objects[0]));

logwrite('end session'+inttostr(sender.content.count));

if sender.Content.count>0 then

begin

 if sessionlist.IndexOf(sender)>=0 then

 sessionlist.delete(sessionlist.IndexOf(sender)) else

logwrite('remains in sessionlist');



 //ttag(sender.content.Objects[0]).clear;

 ttag(sender.content.Objects[0]).free;

end;

 inherited;

{ if ttag(sender.content.Objects[0])<>nil then

 begin

 //ttag(sender.content.Objects[0]).clear;

 ttag(sender.content.Objects[0]).free;

 end;}

end;





procedure LISTLOCS;begin end;





{var

  AList: TList;

  RecThread: tidcontext;

  i: Integer;

  cret,extt,kert,usrt:filetime;

FUNCTION _secSince(filtim:filetime):integer;

var systemtime:TSystemTime;

  LocalTime : TFileTime;

begin

if FileTimeToLocalFileTime(FilTim, LocalTime) then

if FileTimeToSystemTime(localtime, systemTime) then

         Result := round(24*3600*(now-(SystemTimeToDateTime(SystemTime))));

end;

FUNCTION _SHTIME(filtim:filetime):tdatetime;

var systemtime:TSystemTime;

  LocalTime : TFileTime;

begin

//if FileTimeToLocalFileTime(FilTim, LocalTime) then

if FileTimeToSystemTime(filtim, systemTime) then

         Result := (SystemTimeToDateTime(SystemTime));

end;

  begin

  //AList := TList.Create;

  AList := Xseusserver.server.contexts.LockList;

  try

    for i := 0 to AList.count - 1 do

    begin

     try

      RecThread := tidcontext(AList.Items[i]);

      GetThreadTimes(TIdYarnOfThread(recthread.yarn).thread.handle,  cret,extt,kert,usrt);

      logwrite('#'+inttostr(i)+' '+inttostr(_secsince(cret))+'   '

      +inttostr(usrt.dwLowDateTime div 1000000)+'   '

      +inttostr(kert.dwLowDateTime div 1000000));

      //RecThread.yarn.

      //RecThread.Connection.Disconnect;

      //RecThread.Terminate;

      //AList.Remove(RecThread);

      except logwrite('failed to list locks');end;

    end;

  finally

    Xseusserver.server.contexts.UnLockList;

  end;

  //if alist<>nil then AList.Free;

end;}

 procedure txseusserver.serverConnect(AContext: TIdContext);

begin

 EXIT;//FOR LAZARUS

//logwrite('connect');

  logicriti.Enter;

  try

   //listlocs;

  finally

    logicriti.leave;

  end;

end;



 procedure txseusserver.serverdisConnect(AContext: TIdContext);

begin

 logwrite('disconnect');

end;



procedure doconnection(AContext: TIdContext;

  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

var  xs:txseus;st,infile:string; // resst:tstringlist;

  //ReadCookie : TIdCookie;//RFC2109;

  //WriteCookie : TIdserverCookie;i:integer;

  threadelems:tlist;threadstates:tlist;stime:double;ohep:integer;

  locked:boolean;aTASK:tidcontext;

  RecThread: TIdcontext;//i:integer;

  ses:tidhttpsession;



begin





try

try

  //try

  // for i := 0 to xseusserver.sessionlist.Count - 1 do

   //   logwrite('**asess');//+datetimetostr(tidhttpsession(sessionlist.items[i]).lasttimestamp));

   //except writeln('mo list');end;

  while connections>10 do

   sleep(1000);

 //listlocs;

  //if xseusserver.server.contexts<>nil then

   stime:=((now));





   {for i := 0 to -10 do //aRequestInfo.Cookies.items.Count - 1 do

   begin

      try

       ReadCookie := aRequestInfo.Cookies.items[i];

      except break;end;



       //logwrite('cookie'+inttostr(i)+readcookie.cookiename+'='+readcookie.cookietext);

   end;}





//   xseusserver.server.CreateSession(AContext,aResponseInfo,aRequestInfo);

 {





{   ReadCookie := aRequestInfo.Cookies.Cookie['IDHTTPSESSIONID'];

   try

       logwrite('COOKIE:'+readcookie.cookiename+'|=|'+readcookie.value );

       logwrite('COOKIE:'+readcookie.cookiename+'|=|'+readcookie.cookietext );

   except

       logwrite('NOCOOKIE');



   end;



  try

      xseusserver.server.CreateSession(AContext,aResponseInfo,aRequestInfo);



  if xseusserver.server.sessionlist.getsession(readcookie.value,'127.0.0.1')<>nil then

      logwrite('got session') else

      begin

      logwrite('nossession');

      //sessio:=

      ses:=tidhttpsession.CreateInitialized(xseusserver.server.sessionlist,readcookie.cookiename+'='+readcookie.value,arequestinfo.remoteip);

      startsession(ses);



//      arequestinfo.session:=ses;

      end;



  except

      logwrite('failssession');

  end;

 }



 st:=arequestinfo.document;

 logwrite('xxxxxxxxxxxxxxxxxxxxx'+st);

   logwrite('start: '+arequestinfo.document+' id=' //+arequestinfo.session.sessionid

//+ ':' + arequestinfo.session.content.text

  + ' active='+inttostr(connections) +' mem:'+inttostr(getheapstatus.totalallocated));



  //logwrite('start request:'+st+'****');

  st:=ansilowercase(copy(st,_poslast('.',st),999));

  //logwrite('start request:'+st+'****');

  if st='.ico' then exit;

  if (st<>'.htme') and (st<>'.htmi') then

  //requests for files not ending .htme are sent as is

  begin

   try

    //

    infile:=ansilowercase(arequestinfo.document);

    infile:=_mapurltofile(infile, x_commands.subt('mappings'));

    if extractfilename(infile)='' then

    begin

       infile:=infile+'index.htm';

       //--if not FileExistsUTF8(infile) { *Converted from FileExists*  } then

       if not FileExists(infile) { *Converted from FileExists*  } then

       infile:=infile+'l'

    end

    else

    if extractfileext(infile)='' then

    begin

     aresponseinfo.redirect(arequestinfo.document+'/');

     exit;

    end;

    //--if not FileExistsUTF8(infile) { *Converted from FileExists*  } then

    if not FileExists(infile) { *Converted from FileExists*  } then

    begin

      if not aResponseInfo.HeaderHasBeenWritten then

      begin

        // set error code

        aResponseInfo.ResponseNo := 404;

        aResponseInfo.ResponseText := 'Document not found';

        // write header

        aResponseInfo.WriteHeader;

      end else

      // return content

      aResponseInfo.ContentText := 'The document requested is not available.';

      aResponseInfo.WriteContent;

       exit;

    end;

    try

      if st='ico' then

       aresponseinfo.contenttype:='';

      if st='.htm' then

       aresponseinfo.contenttype:='text/html';

      if st='.html' then

       aresponseinfo.contenttype:='text/html';

      if st='.txt' then

       aresponseinfo.contenttype:='text/plain';

      if st='.ics' then

      begin

       aresponseinfo.contenttype:='text/calendar';

       aResponseinfo.CharSet := 'utf-8';

      end;

      if st='.svg' then

      begin

       logwrite('svg');

       aresponseinfo.contenttype:='image/svg+xml';

       aresponseinfo.contentdisposition:='inline';

      end;

       if st='.rtf' then

          aresponseinfo.contenttype:='application/rtf';

       if st='.pdf' then

           aresponseinfo.contenttype:='application/pdf' else

      if aresponseinfo.contenttype<>'' then

      begin

       //aresponseinfo.contentstream:=tfilestream.create(infile,fmopenread)



      end;

      aresponseinfo.contentdisposition:='inline';

      if st='.css' then

      begin

       aresponseinfo.contenttype:='text/css';

       logwrite('serveCSS');

      end;

     logwrite(' servefile'+infile);

    //aresponseinfo.ServeFile(Acontext, infile);

    aresponseinfo.smartServeFile(Acontext, arequestinfo,infile);

    except logwrite('could not servefile'+infile);



    end;

    finally

    //resst.Clear;resst.Free;

    end;

    exit;

  end;

  logwrite('start htme request');

  connections:=connections+1;

  respa:=aresponseinfo;

  actx:=acontext;

  // respa.contenttype:='text/raw';

  //respa.HeaderHasBeenWritten:=false;

  //  respa.writeheader;

  logwrite('wrotehhedeaer');

  //respa.HeaderHasBeenWritten:=true;

{  respa.contenttext:='6'+crlf+'Xuihai';

  respa.WriteContent;

  respa.contenttext:=crlf+'0'+crlf+'';

  respa.WriteContent;

  logwrite('wrotehhedeaer');

  //respa.contenttext:='hiphei';

  //respa.WriteContent;



  //exit;

  }

  //respa.HeaderHasBeenWritten:=true;

  // assignhtml(output); //to be able to use "write/writeln" in subsequent programs

  //Respa.CharSet := 'utf-8';

 // respa.TransferEncoding:='chunked';

  Respa.Contenttype := 'text/html; charset=utf-8';

  respa.TransferEncoding:='chunked';

  respa.WriteHeader;

  respa.ContentEncoding:='utf-8';

  // actx.connection.iohandler.writeln('A'+CRLF+'0123456789');



{  aresponseinfo.HeaderHasBeenWritten:=false;

  respa.WriteHeader;

  with actx.connection.iohandler do

  begin

  WriteLn('HTTP/1.1 200 OK');

  WriteLn('Content-Type: text/html');

  //WriteLn('Content-length: 0');

  WriteLn('Transfer-encoding: chunked');

  WriteLn();



  //writeln('0');

  end;

 // Disconnect;

 //EXIT;



  //exit;}

  //actx.connection.iohandler.writeln('xxxxxxxxxxxxxxxxxx');

  //EXIT;

  try

   //if arequestinfo.session=nil then

   // xseusserver.server.createsession(acontext,aresponseinfo,arequestinfo);

   try

   assignhtml(output); //to be able to use "write/writeln" in subsequent programs

   except logwrite('failed assightnml');end;

 // respa.writeheader;

{  writeln('0987654321');

  writeln('1234567890');

  writeln('0987654321');

  writeln('1234567890');

  writeln('EKAT ÖÄÖÄÖ-ÄÄÖÄÄÖÄÖ');

  writeln('1234567890');

  writeln('TOKAT ÖÄÖÄÖ-ÄÄÖÄÄÖÄÖ');

  writeln('1234567890');

  writeln('2EKAT ÖÄÖÄÖ-ÄÄÖÄÄÖÄÖ');

  writeln('1234567890');

  writeln('2TOKAT ÖÄÖÄÖ-ÄÄÖÄÄÖÄÖ');

  writeln('1234567890');

  writeln('3EKAT ÖÄÖÄÖ-ÄÄÖÄÄÖÄÖ');

  writeln('1234567890');

  writeln('3TOKAT ÖÄÖÄÖ-ÄÄÖÄÄÖÄÖASDFOAKSDJFLAJSLDFKJASDLKFJALKSDJFASLSDKFJLAKSDJFALSDKFJ');

  writeln('1234567890');

  writeln('4EKAT ÖÄÖÄÖ-ÄÄÖÄÄÖÄÖ');

  writeln('1234567890');

  writeln('4TOKAT ÖÄÖÄÖ-ÄÄÖÄÄÖÄÖASDFOAKSDJFLAJSLDFKJASDLKFJALKSDJFASLSDKFJLAKSDJFALSDKFJ');

  writeln('1234567890');

  writeln('MELKOPITKAÖÄÖÄÖ-ÄÄÖÄÄÖÄÖADFÄÖKLASDÄFLÖ SADÄFLAÄSDÖFLÄ ASÖDLFÄ ÖASDLF ÄASÖDLF ÄÖALS FÄLASDÄFLÖ AÄS');

  writeln('1234567890');

  writeln('RIVINVAIHDOT;ÖÄÖÄÖ-ÄÄÖÄÄÖÄÖ'+CRLF+'ASFASDF'+CRLF+'ÖALSKDFÖASLDKF');

  writeln('aaaaaaaaaaaaaaaaaaaaaaaaaaaaa');

  writeln('PITKAÖÄÖÄÖ-ÄÄÖÄÄÖÄÖADFÄÖKLASDÄFLÖ SADÄFLAÄSDÖFLÄ ASÖDLFÄ ÖASDLF ÄASÖDLF ÄÖALS FÄLASDÄFLÖ AÄSÖÄÖÄÖ-ÄÄÖÄÄÖÄÖADFÄÖKLASDÄFLÖ SADÄFLAÄSDÖFLÄ ASÖDLFÄ ÖASDLF ÄASÖDLF ÄÖALS FÄLASDÄFLÖ AÄSÖÄÖÄÖ-ÄÄÖÄÄÖÄÖADFÄÖKLASDÄFLÖ SAD');

  writeln('BBBBBBBBBBBBBBBBBBBBBBBBBBBB');

  writeln('CCCCCCCCCCCCCCCCCCCCCCC');

}

  //writeln;

  //    respa.contenttext:='00'+crlf;

  //respa.WriteContent;

  //exit;

   xs:=txseus.create(true);

    TRY

      infile:=_mapurltofile(ansilowercase(arequestinfo.document), x_commands.subt('mappings'));

     except logwrite('failed TXSEUS.CREATE');end;



  // logwrite('**'+infile+'**'+x_commands.subt('mappings').listraw);

   xs.ifile:=infile;

    logwrite('createdit:'+xs.ifile);

   xs.locked:=g_locs.lockfile(xs.ifile);

   if not xs.locked then xs.locks.add(xs.ifile);

   //locked:=false;

   //if xs.locked then

   //begin

   // logwrite('LOCKED:'+g_locs.locks.text);

   // exit;

   //end;

   xso:=xs;

   xs.httpinited:=false;

   //xs.httpinited:=true;

   logwrite('session?');

   xs.x_session:=ttag(arequestinfo.session.content.objects[0]);

   logwrite('session!');

   xs.x_connections:=tstringlist(arequestinfo.session.content.objects[1]);

   logwrite('session2!');

   //respa.writeheader;

   xs.ns:='xse:';

   xs.request:=ARequestInfo;

   xs.response:=AResponseInfo;

   //acontext.Connection.

   //acontext.Connection.IOHandler.ReadTimeOut := 300000; //5 mins

   //acontext.Connection.IOHandler.ReadTimeOut := 300; //5 mins

    logwrite('tryit:'+xs.ifile);

   xs.doit;

    //write('didit:'+xs.ifile+xs.x_handler.vali+xs.x_handler.attributes.text);

    logwrite('didit:'+xs.ifile);

   finally

   try

    connections:=connections-1;

  try

   //try

    //if not locked then g_locs.freefile(infile);

    //   except logwrite('failed freefile'+inttostr(g_locs.locks.count));

    //    end;

    xs.clear;

        except logwrite('failed xseus.clear');end;

   try

    logwrite('did:'+xs.ifile);

    respa.contenttext:='0'+crlf+crlf;

    respa.WriteContent;

    //writeln('');

    xs.free;

        except logwrite('failed xseus.free');end;



        except logwrite('failed doconnection finally');end;

  end;

  except logwrite('failed doconnectionxx');end;

 finally

   ohep:=getheapstatus.totalallocated;

   logwrite('stop '+infile +' s.'

    +inttostr(round((now-stime)*24*36000))

    +' ses= '+ inttostr(connections)

    +' bytes: '  +inttostr(getheapstatus.totalallocated)

    );

end;



end;





{procedure txseusform.notif(sender: tobject);

var sched:ttimertask;

begin

  xseusform.memo1.lines.add('x'+datetimetostr(now));

  //sched:=timertask.create(cookie);

  sched:=ttimertask.create(nil);

  sched.Free;

  //httppost('http://localhost/test.htme?sauna','',nil,true);



end;}

procedure txseusserver.OnInvalidSession(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo; var VContinueProcessing: Boolean; const AInvalidSessionID: String);

begin

 logwrite('invalid session');

end;



procedure txseusserver.onCommandGet(AContext: TIdContext;

  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

var  xs:txseus;st,ifile:string;  resst:tstringlist;

  //ReadCookie : TIdserverCookie;

  //WriteCookie : TIdserverCookie;i:integer;

  threadelems:tlist;threadstates:tlist;stime:double;ohep:integer;

begin

  //aresponseinfo.HeaderHasBeenWritten:=false;

  logwrite('VERSION:'+server.Version);

  respa:=aresponseinfo;

  actx:=acontext;

  //  server.CreateSession(AContext,aResponseInfo,aRequestInfo);

   // respa.HasContentLength:=false;

{  respa.Transferencoding:='chunked';

  respa.writeheader;

  aresponseinfo.HeaderHasBeenWritten:=false;



  with actx.connection.iohandler do

  begin

  WriteLn('HTTP/1.1 200 Continue');

  //WriteLn('HTTP/1.1 100 Continue');

  WriteLn('Content-Type: text/html; charset=UTF-8');

 // WriteLn('Content-Length: ');

  //WriteLn('Transfer-Encoding: chunked');

  WriteLn('Connection: Keep-Alive');

  WriteLn('Set-Cookie: hui=hai; Path=/');

  WriteLn();

  write('<h1>hello wordl</h1>');

  write('<h1>byby world</h1>');

  end;

  //actx.Connection.close;

  actx.Connection.Disconnect;

  exit;

}

   if arequestinfo.document='/favicon.ico' then exit

   ;//else

   //logwrite('GET:'+arequestinfo.document);



   if arequestinfo.session=nil then

   begin

     server.createsession(acontext,aresponseinfo,arequestinfo);

     //logwrite('new session');

   end;

 //      if pos('xxxx',arequestinfo.document)>0 then

 // begin

 //logwrite('xxx');

 // exit;



//  end;

 try

  try

       logwrite('dddddddddddddddddoooooooooooooo');

  doconnection(AContext,  ARequestInfo,AResponseInfo);

except

on E: EIdException do begin

   logwrite('indy exception');

// Handle Indy exception here

 end;



end;

finally

{$IFDEF LAZARUS}

  logwrite('stopget');

  EXIT;

 //close(output);

 //htmlclose(ttextrec(output));

{$ENDIF}

 end;

 //logwrite('stopget');

  //xseusform.memo1.lines.add(arequestinfo.rawheaders.text);

  //xseusform.memo1.lines.add('******'+arequestinfo.command);

  //xseusform.memo1.lines.add(datetimetostr(aresponseinfo.lastmodified));

  //xseusform.memo1.lines.add(datetimetostr(aresponseinfo.lastmodified));



{  stime:=((now));

  st:=arequestinfo.document;

  st:=copy(st,_poslast('.',st),999);

  if st='.ico' then exit;

  if st<>'.htme' then

  //requests for files not ending .htme are sent as is

  begin

    ifile:=ansilowercase(arequestinfo.document);

    ifile:=_mapurltofile(ifile, x_commands.subt('mappings'));

    try

    aresponseinfo.ServeFile(Acontext, ifile);

    finally

    //resst.Clear;resst.Free;

    end;

    exit;

  end;

  connections:=connections+1;

  xseusform.memo1.lines.add('start '+arequestinfo.document  //+' id='+ arequestinfo.session.sessionid

  //+ ':' + arequestinfo.session.content.text

  + ' active='+inttostr(connections) +' mem used:'+inttostr(getheapstatus.totalallocated));

  respa:=aresponseinfo;

  try

   if arequestinfo.session=nil then

    xseusserver.server.createsession(acontext,aresponseinfo,arequestinfo);

   assignhtml(output); //to be able to use "write/writeln" in subsequent programs

   respa.WriteHeader;

   xs:=txseus.create;

   xso:=xs;

   xs.httpinited:=false;

   xs.x_session:=ttag(arequestinfo.session.content.objects[0]);

   xs.ns:='xse:';

   xs.request:=ARequestInfo;

   xs.response:=AResponseInfo;

   xs.doit;

  finally

    ohep:=getheapstatus.totalallocated;

    xs.clear;

    xs.free;

    connections:=connections-1;

    xseusform.memo1.lines.add(' stop '+ifile +' s.'

    +inttostr(round((now-stime)*24*36000))

    +' active calls= '+ inttostr(connections)

    +' bytes allocated: '

    +inttostr(getheapstatus.totalallocated)

    );

  end;

  }

end;



  procedure tsslserver.onCommandGet(AContext: TIdContext;

  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

var  xs:txseus;st,ifile:string;  resst:tstringlist;

  //ReadCookie : TIdserverCookie;

  //WriteCookie : TIdserverCookie;

  i:integer;

  threadelems:tlist;threadstates:tlist;stime:double;ohep:integer;



  begin

  logwrite('ssä');

//&  xseusform.Memo1.lines.add('sslreq on port 443');

//   if arequestinfo.session=nil then

//     server.createsession(acontext,aresponseinfo,arequestinfo);

  //aresponseinfo.writeheader;





  doconnection(AContext,  ARequestInfo,AResponseInfo);

  //aresponseinfo.ContentText:=datetimetostr(now);

  //AResponseInfo.WriteContent;

  //xseusform.Memo1.lines.add('sslreq on port 432');

  logwrite('did ssä');

  end;





procedure txseusform.Status(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);

begin

//& xseusform.Memo1.lines.add('-'+astatustext);

 //writeln('-',astatustext);

end;



procedure Txseusform.GetPassword(var Password: String);

begin

Password := 'aaaa';

end;









initialization

  { $i xserver.lrs}



  end.