* update lNet to 0.6.4

git-svn-id: trunk@15275 -

.gitattributes

@@ -11455,7 +11455,7 @@ utils/fppkg/fprepos.pp svneol=native#text/plain
 utils/fppkg/fpxmlrep.pp svneol=native#text/plain
 utils/fppkg/lnet/LICENSE -text
 utils/fppkg/lnet/LICENSE.ADDON -text
-utils/fppkg/lnet/fastcgi.pp svneol=native#text/plain
+utils/fppkg/lnet/fastcgi_base.pp svneol=native#text/plain
 utils/fppkg/lnet/lcommon.pp svneol=native#text/plain
 utils/fppkg/lnet/lcontainers.inc svneol=native#text/plain
 utils/fppkg/lnet/lcontainersh.inc svneol=native#text/plain
@@ -11476,6 +11476,7 @@ utils/fppkg/lnet/lstrbuffer.pp svneol=native#text/plain
 utils/fppkg/lnet/ltelnet.pp svneol=native#text/plain
 utils/fppkg/lnet/ltimer.pp svneol=native#text/plain
 utils/fppkg/lnet/lwebserver.pp svneol=native#text/plain
+utils/fppkg/lnet/lws2tcpip.pp svneol=native#text/pascal
 utils/fppkg/lnet/sys/lepolleventer.inc svneol=native#text/plain
 utils/fppkg/lnet/sys/lepolleventerh.inc svneol=native#text/plain
 utils/fppkg/lnet/sys/lkqueueeventer.inc svneol=native#text/plain

utils/fppkg/lnet/fastcgi.pp → utils/fppkg/lnet/fastcgi_base.pp

@@ -1,4 +1,4 @@
-unit fastcgi;
+unit fastcgi_base;
 
 interface
 

utils/fppkg/lnet/lcommon.pp

@@ -1,6 +1,6 @@
 { lCommon
 
-  CopyRight (C) 2004-2007 Ales Katona
+  CopyRight (C) 2004-2008 Ales Katona
 
   This library is Free software; you can rediStribute it and/or modify it
   under the terms of the GNU Library General Public License as published by
@@ -36,6 +36,8 @@ const
   SOL_SOCKET = $ffff;
   LMSG = 0;
   SOCKET_ERROR = WinSock2.SOCKET_ERROR;
+  SHUT_RDWR = SD_BOTH;
+  SHUT_WR = SD_SEND;
   {$ENDIF}
 
   {$IFDEF OS2}
@@ -69,7 +71,41 @@ const
   {$ENDIF}
   { Default Values }
   LDEFAULT_BACKLOG = 5;
-  BUFFER_SIZE = 65536;
+  BUFFER_SIZE = 262144;
+  { Net types }
+  LAF_INET      =  AF_INET;
+  LAF_INET6     = AF_INET6;
+  { Address constants }
+  LADDR_ANY = '0.0.0.0';
+  LADDR_BR  = '255.255.255.255';
+  LADDR_LO  = '127.0.0.1';
+  LADDR6_ANY = '::0';
+  LADDR6_LO  = '::1';
+  { ICMP }
+  LICMP_ECHOREPLY     = 0;
+  LICMP_UNREACH       = 3;
+  LICMP_ECHO          = 8;
+  LICMP_TIME_EXCEEDED = 11;
+  { Protocols }
+  LPROTO_IP     =     0;
+  LPROTO_ICMP   =     1;
+  LPROTO_IGMP   =     2;
+  LPROTO_TCP    =     6;
+  LPROTO_UDP    =    17;
+  LPROTO_IPV6   =    41;
+  LPROTO_ICMPV6 =    58;
+  LPROTO_RAW    =   255;
+  LPROTO_MAX    =   256;
+
+type
+
+  { TLSocketAddress }
+
+  TLSocketAddress = record
+    case Integer of
+      LAF_INET  : (IPv4: TInetSockAddr);
+      LAF_INET6 : (IPv6: TInetSockAddr6);
+  end;
   
   { Base functions }
   {$IFNDEF UNIX}
@@ -82,13 +118,18 @@ const
   { DNS }
   function GetHostName(const Address: string): string;
   function GetHostIP(const Name: string): string;
+  function GetHostName6(const Address: string): string;
+  function GetHostIP6(const Name: string): string;
 
   function LStrError(const Ernum: Longint; const UseUTF8: Boolean = False): string;
   function LSocketError: Longint;
   
   function SetBlocking(const aHandle: Integer; const aValue: Boolean): Boolean;
+//  function SetNoDelay(const aHandle: Integer; const aValue: Boolean): Boolean;
 
   function IsBlockError(const anError: Integer): Boolean; inline;
+  function IsNonFatalError(const anError: Integer): Boolean; inline;
+  function IsPipeError(const anError: Integer): Boolean; inline;
 
   function TZSeconds: Integer; inline;
 
@@ -97,18 +138,18 @@ const
   function StrToNetAddr(const IP: string): Cardinal; inline;
   function NetAddrToStr(const Entry: Cardinal): string; inline;
   
-  procedure FillAddressInfo(var aAddrInfo: TInetSockAddr; const aFamily: sa_family_t;
-                            const Address: string; const aPort: Word); inline;
+  procedure FillAddressInfo(var aAddrInfo: TLSocketAddress; const aFamily: sa_family_t;
+                            const Address: string; const aPort: Word);
                             
 implementation
 
 uses
-  StrUtils, lNet
+  StrUtils
   
 {$IFNDEF UNIX}
 
 {$IFDEF WINDOWS}
-  , Windows;
+  , Windows, lws2tcpip;
   
 {$IFDEF WINCE}
 
@@ -248,6 +289,45 @@ begin
   end;
 end;
 
+function GetHostName6(const Address: string): string;
+var
+  H: TAddrInfo;
+  R: PAddrInfo;
+  n: Integer;
+begin
+  Result := '';
+  ZeroMemory(@H, SizeOf(H));
+  H.ai_flags := AI_NUMERICHOST;
+  H.ai_family := AF_INET6;
+  H.ai_protocol := PF_INET6;
+  H.ai_socktype := SOCK_STREAM;
+
+  n := getaddrinfo(pChar(Address), nil, @H, R);
+  if n <> 0 then
+    Exit;
+  Result := R^.ai_canonname;
+  freeaddrinfo(R);
+end;
+
+function GetHostIP6(const Name: string): string;
+var
+  H: TAddrInfo;
+  R: PAddrInfo;
+  n: Integer;
+begin
+  Result := '';
+  ZeroMemory(@H, SizeOf(H));
+  H.ai_family := AF_INET6;
+  H.ai_protocol := PF_INET6;
+  H.ai_socktype := SOCK_STREAM;
+
+  n := getaddrinfo(pChar(Name), nil, @H, R);
+  if n <> 0 then
+    Exit;
+  Result := NetAddrToStr6(sockets.in6_addr(R^.ai_addr^));
+  freeaddrinfo(R);
+end;
+
 function SetBlocking(const aHandle: Integer; const aValue: Boolean): Boolean;
 const
   BlockAr: array[Boolean] of DWord = (1, 0);
@@ -265,6 +345,20 @@ begin
   Result := anError = WSAEWOULDBLOCK;
 end;
 
+function IsNonFatalError(const anError: Integer): Boolean; inline;
+begin
+  Result := (anError = WSAEINVAL) or (anError = WSAEFAULT)
+         or (anError = WSAEOPNOTSUPP) or (anError = WSAEMSGSIZE)
+         or (anError = WSAEADDRNOTAVAIL) or (anError = WSAEAFNOSUPPORT)
+         or (anError = WSAEDESTADDRREQ);
+end;
+
+function IsPipeError(const anError: Integer): Boolean; inline;
+begin
+  {$WARNING check these ambiguous errors}
+  Result := anError = WSAECONNRESET;
+end;
+
 {$ELSE}
 
 // unix
@@ -308,6 +402,28 @@ begin
     Result := NetAddrToStr(Cardinal(HE.Addr));
 end;
 
+function GetHostName6(const Address: string): string;
+var
+  HE: THostEntry6;
+begin
+  Result := '';
+{  if GetHostByAddr(StrToHostAddr6(Address), HE) then
+    Result := HE.Name
+  else} if ResolveHostbyAddr6(StrToHostAddr6(Address), HE) then
+    Result := HE.Name;
+end;
+
+function GetHostIP6(const Name: string): string;
+var
+  HE: THostEntry6;
+begin
+  Result := '';
+{  if GetHostByName(Name, HE) then
+    Result := HostAddrToStr6(HE.Addr) // for localhost
+  else} if ResolveHostByName6(Name, HE) then
+    Result := NetAddrToStr6(HE.Addr);
+end;
+
 function SetBlocking(const aHandle: Integer; const aValue: Boolean): Boolean;
 var
   opt: cInt;
@@ -331,6 +447,18 @@ begin
   Result := (anError = ESysEWOULDBLOCK) or (anError = ESysENOBUFS);
 end;
 
+function IsNonFatalError(const anError: Integer): Boolean; inline;
+begin
+  Result := (anError = ESysEINTR) or (anError = ESysEMSGSIZE)
+         or (anError = ESysEFAULT) or (anError = ESysEINVAL)
+         or (anError = ESysEOPNOTSUPP);
+end;
+
+function IsPipeError(const anError: Integer): Boolean; inline;
+begin
+  Result := anError = ESysEPIPE;
+end;
+
 function TZSeconds: Integer; inline;
 begin
   Result := unixutil.TZSeconds;
@@ -338,6 +466,19 @@ end;
 
 {$ENDIF}
 
+{function SetNoDelay(const aHandle: Integer; const aValue: Boolean): Boolean;
+var
+  opt: cInt = 0;
+begin
+  if aValue then
+    opt := 1;
+
+  if fpsetsockopt(aHandle, IPPROTO_TCP, TCP_NODELAY, opt, SizeOf(opt)) < 0 then
+    Exit(False);
+
+  Result := True;
+end;}
+
 function StrToHostAddr(const IP: string): Cardinal; inline;
 begin
   Result := Cardinal(Sockets.StrToHostAddr(IP));
@@ -358,15 +499,36 @@ begin
   Result := Sockets.NetAddrToStr(in_addr(Entry));
 end;
 
-procedure FillAddressInfo(var aAddrInfo: TInetSockAddr; const aFamily: sa_family_t;
-  const Address: string; const aPort: Word); inline;
+function IsIP6Empty(const aIP6: TInetSockAddr6): Boolean; inline;
+var
+  i: Integer;
+begin
+  Result := True;
+  for i := 0 to High(aIP6.sin6_addr.u6_addr32) do
+    if aIP6.sin6_addr.u6_addr32[i] <> 0 then
+      Exit(False);
+end;
+
+procedure FillAddressInfo(var aAddrInfo: TLSocketAddress; const aFamily: sa_family_t;
+  const Address: string; const aPort: Word);
 begin
-  aAddrInfo.family := AF_INET;
-  aAddrInfo.Port := htons(aPort);
-  aAddrInfo.Addr := StrToNetAddr(Address);
-  
-  if (Address <> LADDR_ANY) and (aAddrInfo.Addr = 0) then
-    aAddrInfo.Addr := StrToNetAddr(GetHostIP(Address));
+  aAddrInfo.IPv4.family := aFamily;
+  aAddrInfo.IPv4.Port := htons(aPort);
+
+  case aFamily of
+    LAF_INET  :
+      begin
+        aAddrInfo.IPv4.Addr := StrToNetAddr(Address);
+        if (Address <> LADDR_ANY) and (aAddrInfo.IPv4.Addr = 0) then
+          aAddrInfo.IPv4.Addr := StrToNetAddr(GetHostIP(Address));
+      end;
+    LAF_INET6 :
+      begin
+        aAddrInfo.IPv6.sin6_addr := StrToNetAddr6(Address);
+        if (Address <> LADDR6_ANY) and (IsIP6Empty(aAddrInfo.IPv6)) then
+          aAddrInfo.IPv6.sin6_addr := StrToNetAddr6(GetHostIP6(Address));
+      end;
+  end;
 end;
 
 

utils/fppkg/lnet/lcontrolstack.pp

@@ -1,6 +1,6 @@
 { Control stack
 
-  CopyRight (C) 2004-2007 Ales Katona
+  CopyRight (C) 2004-2008 Ales Katona
 
   This library is Free software; you can rediStribute it and/or modify it
   under the terms of the GNU Library General Public License as published by

utils/fppkg/lnet/levents.pp

@@ -1,6 +1,6 @@
 { lNet Events abstration
 
-  CopyRight (C) 2006-2007 Ales Katona
+  CopyRight (C) 2006-2008 Ales Katona
 
   This library is Free software; you can rediStribute it and/or modify it
   under the terms of the GNU Library General Public License as published by
@@ -32,11 +32,11 @@ interface
 uses
   {$ifdef Linux}
     {$undef nochoice} // undefine for all "Optimized" targets
-    Linux, Contnrs,
+    Linux, Contnrs, Errors,
   {$endif}
   {$ifdef BSD}
     {$undef nochoice}
-    BSD,
+    BSD, Errors,
   {$endif}
   {$i sys/osunits.inc}
 
@@ -66,6 +66,7 @@ type
     FNext: TLHandle;
     FFreeNext: TLHandle;
     FInternalData: Pointer;
+    
     procedure SetIgnoreError(const aValue: Boolean);
     procedure SetIgnoreWrite(const aValue: Boolean);
     procedure SetIgnoreRead(const aValue: Boolean);
@@ -140,6 +141,7 @@ type
     FFreeRoot: TLHandle; // the root of "free" list if any
     FFreeIter: TLHandle; // the last of "free" list if any
     FInLoop: Boolean;
+    function GetCount: Integer; virtual;
     function GetTimeout: Integer; virtual;
     procedure SetTimeout(const Value: Integer); virtual;
     function Bail(const msg: string; const Ernum: Integer): Boolean;
@@ -151,13 +153,14 @@ type
     function GetInternalData(aHandle: TLHandle): Pointer;
     procedure SetInternalData(aHandle: TLHandle; const aData: Pointer);
     procedure SetHandleEventer(aHandle: TLHandle);
+    procedure InternalUnplugHandle(aHandle: TLHandle); virtual;
    public
     constructor Create; virtual;
     destructor Destroy; override;
     function AddHandle(aHandle: TLHandle): Boolean; virtual;
     function CallAction: Boolean; virtual;
     procedure RemoveHandle(aHandle: TLHandle); virtual;
-    procedure UnplugHandle(aHandle: TLHandle); virtual;
+    procedure UnplugHandle(aHandle: TLHandle);
     procedure UnregisterHandle(aHandle: TLHandle); virtual;
     procedure LoadFromEventer(aEventer: TLEventer); virtual;
     procedure Clear;
@@ -165,7 +168,7 @@ type
     procedure DeleteRef;
     property Timeout: Integer read GetTimeout write SetTimeout;
     property OnError: TLEventerErrorEvent read FOnError write FOnError;
-    property Count: Integer read FCount;
+    property Count: Integer read GetCount;
   end;
   TLEventerClass = class of TLEventer;
   
@@ -189,12 +192,16 @@ type
 {$i sys/lepolleventerh.inc}
 
   function BestEventerClass: TLEventerClass;
-
+  
 implementation
 
 uses
+  syncobjs,
   lCommon;
   
+var
+  CS: TCriticalSection;
+  
 { TLHandle }
 
 procedure TLHandle.SetIgnoreError(const aValue: Boolean);
@@ -244,15 +251,19 @@ end;
 destructor TLHandle.Destroy;
 begin
   if Assigned(FEventer) then
-    FEventer.UnplugHandle(Self);
+    FEventer.InternalUnplugHandle(Self);
 end;
 
 procedure TLHandle.Free;
 begin
+  CS.Enter;
+
   if Assigned(FEventer) and FEventer.FInLoop then
     FEventer.AddForFree(Self)
   else
     inherited Free;
+
+  CS.Leave;
 end;
 
 { TLTimer }
@@ -302,6 +313,11 @@ begin
   Clear;
 end;
 
+function TLEventer.GetCount: Integer;
+begin
+  Result := FCount;
+end;
+
 function TLEventer.GetTimeout: Integer;
 begin
   Result := 0;
@@ -376,6 +392,29 @@ begin
   aHandle.FEventer := Self;
 end;
 
+procedure TLEventer.InternalUnplugHandle(aHandle: TLHandle);
+begin
+  if aHandle.FEventer = Self then begin
+    if aHandle.FEventer.FInLoop then begin
+      aHandle.FEventer.AddForFree(aHandle);
+      Exit;
+    end;
+
+    aHandle.FEventer := nil; // avoid recursive AV
+    if Assigned(aHandle.FPrev) then begin
+      aHandle.FPrev.FNext := aHandle.FNext;
+      if Assigned(aHandle.FNext) then
+        aHandle.FNext.FPrev := aHandle.FPrev;
+    end else if Assigned(aHandle.FNext) then begin
+      aHandle.FNext.FPrev := aHandle.FPrev;
+      if aHandle = FRoot then
+        FRoot := aHandle.FNext;
+    end else FRoot := nil;
+    if FCount > 0 then
+      Dec(FCount);
+  end;
+end;
+
 function TLEventer.AddHandle(aHandle: TLHandle): Boolean;
 begin
   Result := False;
@@ -409,20 +448,11 @@ end;
 
 procedure TLEventer.UnplugHandle(aHandle: TLHandle);
 begin
-  if aHandle.FEventer = Self then begin
-    aHandle.FEventer := nil; // avoid recursive AV
-    if Assigned(aHandle.FPrev) then begin
-      aHandle.FPrev.FNext := aHandle.FNext;
-      if Assigned(aHandle.FNext) then
-        aHandle.FNext.FPrev := aHandle.FPrev;
-    end else if Assigned(aHandle.FNext) then begin
-      aHandle.FNext.FPrev := aHandle.FPrev;
-      if aHandle = FRoot then
-        FRoot := aHandle.FNext;
-    end else FRoot := nil;
-    if FCount > 0 then
-      Dec(FCount);
-  end;
+  CS.Enter;
+
+  InternalUnplugHandle(aHandle);
+
+  CS.Leave;
 end;
 
 procedure TLEventer.UnregisterHandle(aHandle: TLHandle);
@@ -502,7 +532,8 @@ end;
 function TLSelectEventer.CallAction: Boolean;
 var
   Temp, Temp2: TLHandle;
-  MaxHandle, n: Integer;
+  n: Integer;
+  MaxHandle: THandle;
   TempTime: TTimeVal;
 begin
   if FInLoop then
@@ -583,4 +614,10 @@ end;
 
 {$endif}
 
+initialization
+  CS := TCriticalSection.Create;
+
+finalization
+  CS.Free;
+
 end.

utils/fppkg/lnet/lfastcgi.pp

@@ -1,6 +1,6 @@
 { FastCGI requester support for lNet
 
-  Copyright (C) 2006-2007 Micha Nelissen
+  Copyright (C) 2006-2008 Micha Nelissen
 
   This library is Free software; you can redistribute it and/or modify it
   under the terms of the GNU Library General Public License as published by
@@ -28,7 +28,7 @@ unit lfastcgi;
 interface
 
 uses
-  classes, sysutils, fastcgi, lnet, levents, lstrbuffer, ltimer;
+  classes, sysutils, fastcgi_base, lnet, levents, lstrbuffer, ltimer;
 
 type
   TLFastCGIClient = class;
@@ -123,7 +123,7 @@ type
     function Connect: Boolean; override;
     procedure ConnectEvent(ASocket: TLHandle); override;
     procedure DisconnectEvent(ASocket: TLHandle); override;
-    procedure ErrorEvent(const Msg: string; ASocket: TLHandle); override;
+    procedure ErrorEvent(ASocket: TLHandle; const msg: string); override;
     function  CreateRequester: TLFastCGIRequest;
     procedure HandleGetValuesResult;
     procedure HandleReceive(ASocket: TLSocket);
@@ -572,7 +572,7 @@ begin
     Connect;
 end;
 
-procedure TLFastCGIClient.ErrorEvent(const Msg: string; ASocket: TLHandle);
+procedure TLFastCGIClient.ErrorEvent(ASocket: TLHandle; const msg: string);
 begin
   if (FState = fsConnectingAgain) 
     or ((FState = fsConnecting) and (FPool.FSpawnState = ssSpawned)) then

utils/fppkg/lnet/lftp.pp

@@ -1,4 +1,4 @@
-{ lFTP CopyRight (C) 2005-2007 Ales Katona
+{ lFTP CopyRight (C) 2005-2008 Ales Katona
 
   This library is Free software; you can rediStribute it and/or modify it
   under the terms of the GNU Library General Public License as published by
@@ -67,19 +67,25 @@ type
     FData: TLTcp;//TLTcpList;
     FSending: Boolean;
     FTransferMethod: TLFTPTransferMethod;
+    FFeatureList: TStringList;
+    FFeatureString: string;
 
     function GetConnected: Boolean; virtual;
     
     function GetTimeout: Integer;
     procedure SetTimeout(const Value: Integer);
-    
+
+    function GetSession: TLSession;
+    procedure SetSession(const AValue: TLSession);
+    procedure SetCreator(AValue: TLComponent); override;
+
     function GetSocketClass: TLSocketClass;
     procedure SetSocketClass(Value: TLSocketClass);
    public
     constructor Create(aOwner: TComponent); override;
     destructor Destroy; override;
     
-    function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    function Get(out aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
     function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; virtual; abstract;
     
     function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
@@ -92,6 +98,8 @@ type
     property ControlConnection: TLTelnetClient read FControl;
     property DataConnection: TLTCP read FData;
     property TransferMethod: TLFTPTransferMethod read FTransferMethod write FTransferMethod default ftPassive;
+    property Session: TLSession read GetSession write SetSession;
+    property FeatureList: TStringList read FFeatureList;
   end;
 
   { TLFTPTelnetClient }
@@ -111,6 +119,7 @@ type
     FExpectedBinary: Boolean;
     FPipeLine: Boolean;
     FPassword: string;
+    FPWD: string;
     FStatusFlags: array[TLFTPStatus] of Boolean;
 
     FOnError: TLSocketErrorEvent;
@@ -135,12 +144,17 @@ type
     procedure OnControlRe(aSocket: TLSocket);
     procedure OnControlCo(aSocket: TLSocket);
     procedure OnControlDs(aSocket: TLSocket);
+    
+    procedure ClearStatusFlags;
 
+    function GetCurrentStatus: TLFTPStatus;
     function GetTransfer: Boolean;
 
     function GetEcho: Boolean;
     procedure SetEcho(const Value: Boolean);
 
+    procedure ParsePWD(const s: string);
+
     function GetConnected: Boolean; override;
 
     function GetBinary: Boolean;
@@ -152,6 +166,7 @@ type
 
     procedure SetStartPor(const Value: Word);
 
+    procedure EvaluateFeatures;
     procedure EvaluateAnswer(const Ans: string);
 
     procedure PasvPort;
@@ -166,7 +181,7 @@ type
     constructor Create(aOwner: TComponent); override;
     destructor Destroy; override;
 
-    function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
+    function Get(out aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
     function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; override;
     
     function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
@@ -177,7 +192,7 @@ type
     
     function Authenticate(const aUsername, aPassword: string): Boolean;
     
-    function GetData(var aData; const aSize: Integer): Integer;
+    function GetData(out aData; const aSize: Integer): Integer;
     function GetDataMessage: string;
     
     function Retrieve(const FileName: string): Boolean;
@@ -193,11 +208,11 @@ type
     procedure List(const FileName: string = '');
     procedure Nlst(const FileName: string = '');
     procedure SystemInfo;
-    procedure FeatureList;
+    procedure ListFeatures;
     procedure PresentWorkingDirectory;
     procedure Help(const Arg: string);
     
-    procedure Disconnect; override;
+    procedure Disconnect(const Forced: Boolean = True); override;
     
     procedure CallAction; override;
    public
@@ -208,6 +223,8 @@ type
     property Echo: Boolean read GetEcho write SetEcho;
     property StartPort: Word read FStartPort write FStartPort default DEFAULT_FTP_PORT;
     property Transfer: Boolean read GetTransfer;
+    property CurrentStatus: TLFTPStatus read GetCurrentStatus;
+    property PresentWorkingDirectoryString: string read FPWD;
 
     property OnError: TLSocketErrorEvent read FOnError write FOnError;
     property OnConnect: TLSocketEvent read FOnConnect write FOnConnect;
@@ -223,7 +240,7 @@ type
 implementation
 
 uses
-  SysUtils;
+  SysUtils, Math;
 
 const
   FLE             = #13#10;
@@ -275,6 +292,25 @@ end;
 
 { TLFTP }
 
+function TLFTP.GetSession: TLSession;
+begin
+  Result := FControl.Session;
+end;
+
+procedure TLFTP.SetSession(const AValue: TLSession);
+begin
+  FControl.Session := aValue;
+  FData.Session := aValue;
+end;
+
+procedure TLFTP.SetCreator(AValue: TLComponent);
+begin
+  inherited SetCreator(AValue);
+  
+  FControl.Creator := AValue;
+  FData.Creator := AValue;
+end;
+
 function TLFTP.GetConnected: Boolean;
 begin
   Result := FControl.Connected;
@@ -310,16 +346,22 @@ begin
   FPort := 21;
 
   FControl := TLFTPTelnetClient.Create(nil);
+  FControl.Creator := Self;
 
   FData := TLTcp.Create(nil);
+  FData.Creator := Self;
+  FData.SocketClass := TLSocket;
 
   FTransferMethod  :=  ftPassive; // let's be modern
+
+  FFeatureList := TStringList.Create;
 end;
 
 destructor TLFTP.Destroy;
 begin
   FControl.Free;
   FData.Free;
+  FFeatureList.Free;
 
   inherited Destroy;
 end;
@@ -336,8 +378,6 @@ end;
 constructor TLFTPClient.Create(aOwner: TComponent);
 const
   DEFAULT_CHUNK = 8192;
-var
-  s: TLFTPStatus;
 begin
   inherited Create(aOwner);
 
@@ -351,16 +391,15 @@ begin
   FData.OnCanSend := @OnSe;
   FData.OnError := @OnEr;
 
-  FStatusSet := []; // empty Event set
+  FStatusSet := [fsNone..fsLast]; // full Event set
   FPassWord := '';
   FChunkSize := DEFAULT_CHUNK;
   FStartPort := DEFAULT_FTP_PORT;
   FSL := TStringList.Create;
   FLastPort := FStartPort;
 
-  for s := fsNone to fsDEL do
-    FStatusFlags[s] := False;
-    
+  ClearStatusFlags;
+
   FStatus := TLFTPStatusFront.Create(EMPTY_REC);
   FCommandFront := TLFTPStatusFront.Create(EMPTY_REC);
   
@@ -369,7 +408,7 @@ end;
 
 destructor TLFTPClient.Destroy;
 begin
-  Disconnect;
+  Disconnect(True);
   FSL.Free;
   FStatus.Free;
   FCommandFront.Free;
@@ -406,6 +445,15 @@ end;
 procedure TLFTPClient.OnControlEr(const msg: string; aSocket: TLSocket);
 begin
   FSending := False;
+  
+  if Assigned(FOnFailure) then begin
+    while not FStatus.Empty do
+      FOnFailure(aSocket, FStatus.Remove.Status);
+  end else
+    FStatus.Clear;
+    
+  ClearStatusFlags;
+
   if Assigned(FOnError) then
     FOnError(msg, aSocket);
 end;
@@ -428,6 +476,19 @@ begin
     FOnError('Connection lost', aSocket);
 end;
 
+procedure TLFTPClient.ClearStatusFlags;
+var
+  s: TLFTPStatus;
+begin
+  for s := fsNone to fsLast do
+    FStatusFlags[s] := False;
+end;
+
+function TLFTPClient.GetCurrentStatus: TLFTPStatus;
+begin
+  Result := FStatus.First.Status;
+end;
+
 function TLFTPClient.GetTransfer: Boolean;
 begin
   Result := FData.Connected;
@@ -440,7 +501,7 @@ end;
 
 function TLFTPClient.GetConnected: Boolean;
 begin
-  Result  :=  FStatusFlags[fsCon] and inherited;
+  Result := FStatusFlags[fsCon] and inherited;
 end;
 
 function TLFTPClient.GetBinary: Boolean;
@@ -461,9 +522,10 @@ var
   i: Integer;
 begin
   FSL.Text := s;
-  if FSL.Count > 0 then
-    for i := 0 to FSL.Count-1 do
-      if Length(FSL[i]) > 0 then EvaluateAnswer(FSL[i]);
+  for i := 0 to FSL.Count - 1 do
+    if Length(FSL[i]) > 0 then
+      EvaluateAnswer(FSL[i]);
+
   s := StringReplace(s, FLE, LineEnding, [rfReplaceAll]);
   i := Pos('PASS', s);
   if i > 0 then
@@ -478,6 +540,32 @@ begin
     FLastPort := Value;
 end;
 
+procedure TLFTPClient.EvaluateFeatures;
+var
+  i: Integer;
+begin
+  FFeatureList.Clear;
+  if Length(FFeatureString) = 0 then
+    Exit;
+
+  FFeatureList.Text := FFeatureString;
+  FFeatureString := '';
+  FFeatureList.Delete(0);
+
+  i := 0;
+  while i < FFeatureList.Count do begin
+    if (Length(Trim(FFeatureList[i])) = 0)
+    or (FFeatureList[i][1] <> ' ') then begin
+      FFeatureList.Delete(i);
+      Continue;
+    end;
+
+    FFeatureList[i] := Trim(FFeatureList[i]);
+
+    Inc(i);
+  end;
+end;
+
 procedure TLFTPClient.SetEcho(const Value: Boolean);
 begin
   if Value then
@@ -486,14 +574,30 @@ begin
     FControl.UnSetOption(TS_ECHO);
 end;
 
+procedure TLFTPClient.ParsePWD(const s: string);
+var
+  i: Integer;
+  IsIn: Boolean = False;
+begin
+  FPWD := '';
+  for i := 1 to Length(s) do begin
+    if s[i] = '"' then begin
+      IsIn := not IsIn;
+      Continue;
+    end;
+    if IsIn then
+      FPWD := FPWD + s[i];
+  end;
+end;
+
 procedure TLFTPClient.SetBinary(const Value: Boolean);
 const
   TypeBool: array[Boolean] of string = ('A', 'I');
 begin
   if CanContinue(fsType, BoolToStr(Value), '') then begin
     FExpectedBinary := Value;
-    FControl.SendMessage('TYPE ' + TypeBool[Value] + FLE);
     FStatus.Insert(MakeStatusRec(fsType, '', ''));
+    FControl.SendMessage('TYPE ' + TypeBool[Value] + FLE);
   end;
 end;
 
@@ -501,11 +605,12 @@ procedure TLFTPClient.EvaluateAnswer(const Ans: string);
 
   function GetNum: Integer;
   begin
-    try
+    Result := -1;
+    if (Length(Ans) >= 3)
+    and (Ans[1] in ['0'..'9'])
+    and (Ans[2] in ['0'..'9'])
+    and (Ans[3] in ['0'..'9']) then
       Result := StrToInt(Copy(Ans, 1, 3));
-    except
-      Result := -1;
-    end;
   end;
 
   procedure ParsePortIP(s: string);
@@ -563,6 +668,7 @@ procedure TLFTPClient.EvaluateAnswer(const Ans: string);
   
   procedure Eventize(const aStatus: TLFTPStatus; const Res: Boolean);
   begin
+    FStatus.Remove;
     if Res then begin
       if Assigned(FOnSuccess) and (aStatus in FStatusSet) then
         FOnSuccess(FData.Iterator, aStatus);
@@ -578,6 +684,9 @@ begin
   x := GetNum;
   Writedbg(['WOULD EVAL: ', FTPStatusStr[FStatus.First.Status], ' with value: ',
             x, ' from "', Ans, '"']);
+  if FStatus.First.Status = fsFeat then
+    FFeatureString := FFeatureString + Ans + FLE; // we need to parse this later
+
   if ValidResponse(Ans) then
     if not FStatus.Empty then begin
       Writedbg(['EVAL: ', FTPStatusStr[FStatus.First.Status], ' with value: ', x]);
@@ -587,13 +696,11 @@ begin
                      begin
                        FStatusFlags[FStatus.First.Status] := True;
                        Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
                      end;
                    else
                      begin
                        FStatusFlags[FStatus.First.Status] := False;
                        Eventize(FStatus.First.Status, False);
-                       FStatus.Remove;
                      end;
                  end;
 
@@ -602,7 +709,6 @@ begin
                      begin
                        FStatusFlags[FStatus.First.Status] := True;
                        Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
                      end;
                    331,
                    332:
@@ -614,7 +720,6 @@ begin
                      begin
                        FStatusFlags[FStatus.First.Status] := False;
                        Eventize(FStatus.First.Status, False);
-                       FStatus.Remove;
                      end;
                  end;
                  
@@ -623,13 +728,11 @@ begin
                      begin
                        FStatusFlags[FStatus.First.Status] := True;
                        Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
                      end;
                    else
                      begin
                        FStatusFlags[FStatus.First.Status] := False;
                        Eventize(FStatus.First.Status, False);
-                       FStatus.Remove;
                      end;
                  end;
 
@@ -642,12 +745,10 @@ begin
                    200:
                      begin
                        Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
                      end;
                    else
                      begin
                        Eventize(FStatus.First.Status, False);
-                       FStatus.Remove;
                      end;
                  end;
 
@@ -657,12 +758,10 @@ begin
                        FStatusFlags[FStatus.First.Status] := FExpectedBinary;
                        Writedbg(['Binary mode: ', FExpectedBinary]);
                        Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
                      end;
                    else
                      begin
                        Eventize(FStatus.First.Status, False);
-                       FStatus.Remove;
                      end;
                  end;
 
@@ -671,14 +770,12 @@ begin
                    226:
                      begin
                        Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
                      end;
                    else
                      begin
-                       FData.Disconnect;
+                       FData.Disconnect(True);  // break on purpose, otherwise we get invalidated ugly
                        Writedbg(['Disconnecting data connection']);
                        Eventize(FStatus.First.Status, False);
-                       FStatus.Remove; // error after connection established
                      end;
                  end;
 
@@ -688,12 +785,10 @@ begin
                    226:
                      begin
                        Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
                      end;
                    else
                      begin
-                       Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
+                       Eventize(FStatus.First.Status, False);
                      end;
                  end;
 
@@ -702,27 +797,50 @@ begin
                      begin
                        FStatusFlags[FStatus.First.Status] := True;
                        Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
                      end;
                    else
                      begin
                        FStatusFlags[FStatus.First.Status] := False;
                        Eventize(FStatus.First.Status, False);
-                       FStatus.Remove;
                      end;
                  end;
-                 
+
+        fsPWD  : case x of
+                   257:
+                     begin
+                       ParsePWD(Ans);
+                       FStatusFlags[FStatus.First.Status] := True;
+                       Eventize(FStatus.First.Status, True);
+                     end;
+                   else
+                     begin
+                       FStatusFlags[FStatus.First.Status] := False;
+                       Eventize(FStatus.First.Status, False);
+                     end;
+                 end;
+
+        fsHelp  : case x of
+                   211, 214:
+                     begin
+                       FStatusFlags[FStatus.First.Status] := True;
+                       Eventize(FStatus.First.Status, True);
+                     end;
+                   else
+                     begin
+                       FStatusFlags[FStatus.First.Status] := False;
+                       Eventize(FStatus.First.Status, False);
+                     end;
+                 end;
+
         fsList : case x of
                    125, 150: begin { do nothing } end;
                    226:
                      begin
                        Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
                      end;
                    else
                      begin
                        Eventize(FStatus.First.Status, False);
-                       FStatus.Remove;
                      end;
                  end;
                  
@@ -731,13 +849,11 @@ begin
                      begin
                        FStatusFlags[FStatus.First.Status] := True;
                        Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
                      end;
                    else
                      begin
                        FStatusFlags[FStatus.First.Status] := False;
                        Eventize(FStatus.First.Status, False);
-                       FStatus.Remove;
                      end;
                  end;
                  
@@ -747,13 +863,11 @@ begin
                      begin
                        FStatusFlags[FStatus.First.Status] := True;
                        Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
                      end;
                    else
                      begin
                        FStatusFlags[FStatus.First.Status] := False;
                        Eventize(FStatus.First.Status, False);
-                       FStatus.Remove;
                      end;
                  end;
                  
@@ -762,12 +876,10 @@ begin
                      begin
                        FStatusFlags[FStatus.First.Status] := True;
                        Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
                      end;
                    else
                      begin
                        Eventize(FStatus.First.Status, False);
-                       FStatus.Remove;
                      end;
                  end;
                  
@@ -776,12 +888,23 @@ begin
                      begin
                        FStatusFlags[FStatus.First.Status] := True;
                        Eventize(FStatus.First.Status, True);
-                       FStatus.Remove;
                      end;
                    else
                      begin
                        Eventize(FStatus.First.Status, False);
-                       FStatus.Remove;
+                     end;
+                 end;
+        fsFeat : case x of
+                   200..299:
+                     begin
+                       FStatusFlags[FStatus.First.Status] := True;
+                       EvaluateFeatures;
+                       Eventize(FStatus.First.Status, True);
+                     end;
+                   else
+                     begin
+                       FFeatureString := '';
+                       Eventize(FStatus.First.Status, False);
                      end;
                  end;
       end;
@@ -807,10 +930,10 @@ procedure TLFTPClient.PasvPort;
 begin
   if FTransferMethod = ftActive then begin
     Writedbg(['Sent PORT']);
-    FData.Disconnect;
+    FData.Disconnect(True);
     FData.Listen(FLastPort);
-    FControl.SendMessage('PORT ' + StringIP + StringPair(FLastPort) + FLE);
     FStatus.Insert(MakeStatusRec(fsPort, '', ''));
+    FControl.SendMessage('PORT ' + StringIP + StringPair(FLastPort) + FLE);
 
     if FLastPort < 65535 then
       Inc(FLastPort)
@@ -818,8 +941,8 @@ begin
       FLastPort := FStartPort;
   end else begin
     Writedbg(['Sent PASV']);
-    FControl.SendMessage('PASV' + FLE);
     FStatus.Insert(MakeStatusRec(fsPasv, '', ''));
+    FControl.SendMessage('PASV' + FLE);
   end;
 end;
 
@@ -827,8 +950,8 @@ function TLFTPClient.User(const aUserName: string): Boolean;
 begin
   Result := not FPipeLine;
   if CanContinue(fsUser, aUserName, '') then begin
-    FControl.SendMessage('USER ' + aUserName + FLE);
     FStatus.Insert(MakeStatusRec(fsUser, '', ''));
+    FControl.SendMessage('USER ' + aUserName + FLE);
     Result := True;
   end;
 end;
@@ -837,8 +960,8 @@ function TLFTPClient.Password(const aPassword: string): Boolean;
 begin
   Result := not FPipeLine;
   if CanContinue(fsPass, aPassword, '') then begin
-    FControl.SendMessage('PASS ' + aPassword + FLE);
     FStatus.Insert(MakeStatusRec(fsPass, '', ''));
+    FControl.SendMessage('PASS ' + aPassword + FLE);
     Result := True;
   end;
 end;
@@ -863,7 +986,7 @@ begin
       FreeAndNil(FStoreFile);
       FSending := False;
       {$hint this one calls freeinstance which doesn't pass}
-      FData.Disconnect;
+      FData.Disconnect(False);
     end;
   until (n = 0) or (Sent = 0);
 end;
@@ -887,20 +1010,22 @@ begin
       fsPWD  : PresentWorkingDirectory;
       fsHelp : Help(Args[1]);
       fsType : SetBinary(StrToBool(Args[1]));
-      fsFeat : FeatureList;
+      fsFeat : ListFeatures;
     end;
   FCommandFront.Remove;
 end;
 
-function TLFTPClient.Get(var aData; const aSize: Integer; aSocket: TLSocket): Integer;
+function TLFTPClient.Get(out aData; const aSize: Integer; aSocket: TLSocket): Integer;
 var
   s: string;
 begin
-  Result := FControl.Get(aData, aSize, aSocket);
-  if Result > 0 then begin
+  Result := 0;
+
+  if FControl.Get(aData, aSize, aSocket) > 0 then begin
     SetLength(s, Result);
     Move(aData, PChar(s)^, Result);
-    CleanInput(s);
+    Result := CleanInput(s);
+    Move(s[1], aData, Min(Length(s), aSize));
   end;
 end;
 
@@ -923,7 +1048,7 @@ begin
   Result := FControl.SendMessage(msg);
 end;
 
-function TLFTPClient.GetData(var aData; const aSize: Integer): Integer;
+function TLFTPClient.GetData(out aData; const aSize: Integer): Integer;
 begin
   Result := FData.Iterator.Get(aData, aSize);
 end;
@@ -938,7 +1063,7 @@ end;
 function TLFTPClient.Connect(const aHost: string; const aPort: Word): Boolean;
 begin
   Result := False;
-  Disconnect;
+  Disconnect(True);
   if FControl.Connect(aHost, aPort) then begin
     FHost := aHost;
     FPort := aPort;
@@ -965,8 +1090,8 @@ begin
   Result := not FPipeLine;
   if CanContinue(fsRetr, FileName, '') then begin
     PasvPort;
-    FControl.SendMessage('RETR ' + FileName + FLE);
     FStatus.Insert(MakeStatusRec(fsRetr, '', ''));
+    FControl.SendMessage('RETR ' + FileName + FLE);
     Result := True;
   end;
 end;
@@ -977,8 +1102,8 @@ begin
   if FileExists(FileName) and CanContinue(fsStor, FileName, '') then begin
     FStoreFile := TFileStream.Create(FileName, fmOpenRead);
     PasvPort;
-    FControl.SendMessage('STOR ' + ExtractFileName(FileName) + FLE);
     FStatus.Insert(MakeStatusRec(fsStor, '', ''));
+    FControl.SendMessage('STOR ' + ExtractFileName(FileName) + FLE);
     Result := True;
   end;
 end;
@@ -987,9 +1112,9 @@ function TLFTPClient.ChangeDirectory(const DestPath: string): Boolean;
 begin
   Result := not FPipeLine;
   if CanContinue(fsCWD, DestPath, '') then begin
-    FControl.SendMessage('CWD ' + DestPath + FLE);
     FStatus.Insert(MakeStatusRec(fsCWD, '', ''));
     FStatusFlags[fsCWD] := False;
+    FControl.SendMessage('CWD ' + DestPath + FLE);
     Result := True;
   end;
 end;
@@ -998,9 +1123,9 @@ function TLFTPClient.MakeDirectory(const DirName: string): Boolean;
 begin
   Result := not FPipeLine;
   if CanContinue(fsMKD, DirName, '') then begin
-    FControl.SendMessage('MKD ' + DirName + FLE);
     FStatus.Insert(MakeStatusRec(fsMKD, '', ''));
     FStatusFlags[fsMKD] := False;
+    FControl.SendMessage('MKD ' + DirName + FLE);
     Result := True;
   end;
 end;
@@ -1009,9 +1134,9 @@ function TLFTPClient.RemoveDirectory(const DirName: string): Boolean;
 begin
   Result := not FPipeLine;
   if CanContinue(fsRMD, DirName, '') then begin
-    FControl.SendMessage('RMD ' + DirName + FLE);
     FStatus.Insert(MakeStatusRec(fsRMD, '', ''));
     FStatusFlags[fsRMD] := False;
+    FControl.SendMessage('RMD ' + DirName + FLE);
     Result := True;
   end;
 end;
@@ -1020,9 +1145,9 @@ function TLFTPClient.DeleteFile(const FileName: string): Boolean;
 begin
   Result := not FPipeLine;
   if CanContinue(fsDEL, FileName, '') then begin
-    FControl.SendMessage('DELE ' + FileName + FLE);
     FStatus.Insert(MakeStatusRec(fsDEL, '', ''));
     FStatusFlags[fsDEL] := False;
+    FControl.SendMessage('DELE ' + FileName + FLE);
     Result := True;
   end;
 end;
@@ -1031,13 +1156,13 @@ function TLFTPClient.Rename(const FromName, ToName: string): Boolean;
 begin
   Result := not FPipeLine;
   if CanContinue(fsRNFR, FromName, ToName) then begin
-    FControl.SendMessage('RNFR ' + FromName + FLE);
     FStatus.Insert(MakeStatusRec(fsRNFR, '', ''));
     FStatusFlags[fsRNFR] := False;
+    FControl.SendMessage('RNFR ' + FromName + FLE);
 
-    FControl.SendMessage('RNTO ' + ToName + FLE);
     FStatus.Insert(MakeStatusRec(fsRNTO, '', ''));
     FStatusFlags[fsRNTO] := False;
+    FControl.SendMessage('RNTO ' + ToName + FLE);
 
     Result := True;
   end;
@@ -1073,34 +1198,37 @@ begin
     FControl.SendMessage('SYST' + FLE);
 end;
 
-procedure TLFTPClient.FeatureList;
+procedure TLFTPClient.ListFeatures;
 begin
-  if CanContinue(fsFeat, '', '') then
+  if CanContinue(fsFeat, '', '') then begin
+    FStatus.Insert(MakeStatusRec(fsFeat, '', ''));
     FControl.SendMessage('FEAT' + FLE);
+  end;
 end;
 
 procedure TLFTPClient.PresentWorkingDirectory;
 begin
-  if CanContinue(fsPWD, '', '') then
+  if CanContinue(fsPWD, '', '') then begin
+    FStatus.Insert(MakeStatusRec(fsPWD, '', ''));
     FControl.SendMessage('PWD' + FLE);
+  end;
 end;
 
 procedure TLFTPClient.Help(const Arg: string);
 begin
-  if CanContinue(fsHelp, Arg, '') then
+  if CanContinue(fsHelp, Arg, '') then begin
+    FStatus.Insert(MakeStatusRec(fsHelp, Arg, ''));
     FControl.SendMessage('HELP ' + Arg + FLE);
+  end;
 end;
 
-procedure TLFTPClient.Disconnect;
-var
-  s: TLFTPStatus;
+procedure TLFTPClient.Disconnect(const Forced: Boolean = True);
 begin
-  FControl.Disconnect;
+  FControl.Disconnect(Forced);
   FStatus.Clear;
-  FData.Disconnect;
+  FData.Disconnect(Forced);
   FLastPort := FStartPort;
-  for s := fsNone to fsLast do
-    FStatusFlags[s] := False;
+  ClearStatusFlags;
   FCommandFront.Clear;
 end;
 

utils/fppkg/lnet/lhttp.pp

@@ -1,6 +1,6 @@
 { HTTP server and client components
 
-  Copyright (C) 2006-2007 Micha Nelissen
+  Copyright (C) 2006-2008 Micha Nelissen
 
   This library is Free software; you can redistribute it and/or modify it
   under the terms of the GNU Library General Public License as published by
@@ -298,7 +298,6 @@ type
     procedure AddContentLength(ALength: integer); virtual; abstract;
     function  CalcAvailableBufferSpace: integer;
     procedure DelayFree(AOutputItem: TOutputItem);
-    procedure Disconnect; override;
     procedure DoneBuffer(AOutput: TBufferOutput); virtual;
     procedure FreeDelayFreeItems;
     procedure LogAccess(const AMessage: string); virtual;
@@ -323,6 +322,7 @@ type
     destructor Destroy; override;
 
     procedure AddToOutput(AOutputItem: TOutputItem);
+    procedure Disconnect(const Forced: Boolean = True); override;
     procedure PrependOutput(ANewItem, AItem: TOutputItem);
     procedure RemoveOutput(AOutputItem: TOutputItem);
     procedure HandleReceive;
@@ -459,6 +459,8 @@ type
     destructor Destroy; override;
 
     procedure AddExtraHeader(const AHeader: string);
+    procedure AddCookie(const AName, AValue: string; const APath: string = '';
+      const ADomain: string = ''; const AVersion: string = '0');
     procedure ResetRange;
     procedure SendRequest;
 
@@ -559,6 +561,11 @@ begin
   AValue := Val;
 end;
 
+function EscapeCookie(const AInput: string): string;
+begin
+  Result := StringReplace(AInput, ';', '%3B', [rfReplaceAll]);
+end;
+
 { TURIHandler }
 
 constructor TURIHandler.Create;
@@ -969,11 +976,12 @@ begin
   FreeMem(FBuffer);
 end;
 
-procedure TLHTTPSocket.Disconnect;
+procedure TLHTTPSocket.Disconnect(const Forced: Boolean = True);
 var
   lOutput: TOutputItem;
 begin
-  inherited Disconnect;
+  inherited Disconnect(Forced);
+
   while FCurrentOutput <> nil do
   begin
     lOutput := FCurrentOutput;
@@ -999,6 +1007,9 @@ end;
 procedure TLHTTPSocket.DelayFree(AOutputItem: TOutputItem);
 begin
   if AOutputItem = nil then exit;
+  { check whether already in delayed free list }
+  if AOutputItem = FDelayFreeItems then exit;
+  if AOutputItem.FPrevDelayFree <> nil then exit;
   if FDelayFreeItems <> nil then
     FDelayFreeItems.FPrevDelayFree := AOutputItem;
   AOutputItem.FNextDelayFree := FDelayFreeItems;
@@ -1318,29 +1329,39 @@ end;
 function TLHTTPSocket.ProcessEncoding: boolean;
 var
   lCode: integer;
+  lParam: pchar;
 begin
   Result := true;
-  if FParameters[hpContentLength] <> nil then
+  lParam := FParameters[hpContentLength];
+  if lParam <> nil then
   begin
     FParseBuffer := @ParseEntityPlain;
-    Val(FParameters[hpContentLength], FInputRemaining, lCode);
+    Val(lParam, FInputRemaining, lCode);
     if lCode <> 0 then
-    begin
       WriteError(hsBadRequest);
-      exit;
-    end;
-  end else 
-  if FParameters[hpTransferEncoding] <> nil then
+    exit;
+  end;
+
+  lParam := FParameters[hpTransferEncoding];
+  if lParam <> nil then
   begin
-    if (StrIComp(FParameters[hpTransferEncoding], 'chunked') = 0) then
+    if StrIComp(lParam, 'chunked') = 0 then
     begin
       FParseBuffer := @ParseEntityChunked;
       FChunkState := csInitial;
-    end else begin
+    end else
       Result := false;
-    end;
-  end else begin
-    FRequestInputDone := true;
+    exit;
+  end;
+
+  { only if keep-alive, then user must specify either of above headers to 
+    indicate next header's start }
+  lParam := FParameters[hpConnection];
+  FRequestInputDone := (lParam <> nil) and (StrIComp(lParam, 'keep-alive') = 0);
+  if not FRequestInputDone then
+  begin
+    FParseBuffer := @ParseEntityPlain;
+    FInputRemaining := high(FInputRemaining);
   end;
 end;
 
@@ -1404,7 +1425,7 @@ begin
     end;
 
     { if we cannot send, then the send buffer is full }
-    if not FCanSend or not FConnected then
+    if (FConnectionStatus <> scConnected) or not (ssCanSend in FSocketState) then
       break;
 
     case FCurrentOutput.WriteBlock of
@@ -1638,7 +1659,7 @@ end;
 procedure TLHTTPServerSocket.ProcessHeaders;
   { process request }
 var
-  lPos: pchar;
+  lPos, lConnParam: pchar;
 begin
   { do HTTP/1.1 Host-field present check }
   if (FRequestInfo.Version > 10) and (FParameters[hpHost] = nil) then
@@ -1655,12 +1676,13 @@ begin
   end;
 
   FKeepAlive := FRequestInfo.Version > 10;
-  if FParameters[hpConnection] <> nil then
+  lConnParam := FParameters[hpConnection];
+  if lConnParam <> nil then
   begin
-    if StrIComp(FParameters[hpConnection], 'keep-alive') = 0 then
+    if StrIComp(lConnParam, 'keep-alive') = 0 then
       FKeepAlive := true
     else
-    if StrIComp(FParameters[hpConnection], 'close') = 0 then
+    if StrIComp(lConnParam, 'close') = 0 then
       FKeepAlive := false;
   end;
   
@@ -2067,6 +2089,12 @@ begin
     AppendString(lMessage, lTemp);
   end;
   AppendString(lMessage, #13#10);
+  if FHeaderOut^.ContentLength > 0 then
+  begin
+    AppendString(lMessage, 'Content-Length: ');
+    Str(FHeaderOut^.ContentLength, lTemp);
+    AppendString(lMessage, lTemp+#13#10);
+  end;
   hasRangeStart := TLHTTPClient(FCreator).RangeStart <> high(qword);
   hasRangeEnd := TLHTTPClient(FCreator).RangeEnd <> high(qword);
   if hasRangeStart or hasRangeEnd then
@@ -2083,6 +2111,7 @@ begin
       Str(TLHTTPClient(FCreator).RangeEnd, lTemp);
       AppendString(lMessage, lTemp);
     end;
+    AppendString(lMessage, #13#10);
   end;
   with FHeaderOut^.ExtraHeaders do
     AppendString(lMessage, Memory, Pos-Memory);
@@ -2195,6 +2224,19 @@ begin
   AppendString(FHeaderOut.ExtraHeaders, #13#10);
 end;
 
+procedure TLHTTPClient.AddCookie(const AName, AValue: string; const APath: string = '';
+  const ADomain: string = ''; const AVersion: string = '0');
+var
+  lHeader: string;
+begin
+  lHeader := 'Cookie: $Version='+AVersion+'; '+AName+'='+EscapeCookie(AValue);
+  if Length(APath) > 0 then
+    lHeader := lHeader+';$Path='+APath;
+  if Length(ADomain) > 0 then
+    lHeader := lHeader+';$Domain='+ADomain;
+  AddExtraHeader(lHeader);
+end;
+
 procedure TLHTTPClient.ConnectEvent(aSocket: TLHandle);
 begin
   inherited;
@@ -2237,10 +2279,10 @@ end;
 
 function  TLHTTPClient.InitSocket(aSocket: TLSocket): TLSocket;
 begin
-  Result := inherited;
   TLHTTPClientSocket(aSocket).FHeaderOut := @FHeaderOut;
   TLHTTPClientSocket(aSocket).FRequest := @FRequest;
   TLHTTPClientSocket(aSocket).FResponse := @FResponse;
+  Result := inherited;
 end;
 
 procedure TLHTTPClient.InternalSendRequest;

utils/fppkg/lnet/lhttputil.pp

@@ -1,6 +1,6 @@
 { Utility routines for HTTP server component
 
-  Copyright (C) 2006-2007 Micha Nelissen
+  Copyright (C) 2006-2008 by Micha Nelissen
 
   This library is Free software; you can redistribute it and/or modify it
   under the terms of the GNU Library General Public License as published by
@@ -51,7 +51,7 @@ type
   function HTTPEncode(const AStr: string): string;
   function HexToNum(AChar: char): byte;
   
-  procedure DecomposeURL(const URL: string; out Host, URI: string; out Port: Word);
+  function DecomposeURL(const URL: string; out Host, URI: string; out Port: Word): Boolean;
   function ComposeURL(Host, URI: string; const Port: Word): string;
 
 implementation
@@ -232,27 +232,53 @@ begin
   until false;
 end;
 
-procedure DecomposeURL(const URL: string; out Host, URI: string; out Port: Word);
+function DecomposeURL(const URL: string; out Host, URI: string; out Port: Word): Boolean;
 var
-  index: Integer;
+  n: Integer;
+  tmp: string;
 begin
-  index := PosEx('/', URL, 8);
-  Host := Copy(URL, 8, index-8);
-  URI := Copy(URL, index, Length(URL)+1-index);
+  Result := False;
 
-  index := Pos(':', Host);
-  if index > 0 then begin
-    Port := StrToIntDef(Copy(Host, index+1, Length(Host)-index), -1);
+  try
+    tmp := Trim(URL);
+    if Length(tmp) < 1 then // don't do empty
+      Exit;
 
-    SetLength(Host, index-1);
-  end else
     Port := 80;
+    if tmp[Length(tmp)] = '/' then // remove trailing /
+      Delete(tmp, Length(tmp), 1);
+
+    if Pos('https://', tmp) = 1 then begin // check for HTTPS
+      Result := True;
+      Port := 443;
+      Delete(tmp, 1, 8); // delete the https part for parsing reasons
+    end else if Pos('http://', tmp) = 1 then begin
+      Delete(tmp, 1, 7); // delete the http part for parsing reasons
+    end;
+
+    n := Pos(':', tmp); // find if we have a port at the end
+    if n > 0 then begin
+      Port := StrToInt(Copy(tmp, n + 1, Length(tmp)));
+      Delete(tmp, n, Length(tmp));
+    end;
+
+    n := Pos('/', tmp); // find if we have a uri section
+    if n > 0 then begin
+      URI := Copy(tmp, n, Length(tmp));
+      Delete(tmp, n, Length(tmp));
+    end;
+    Host := tmp;
+  except
+    Host := 'error';
+    URI := '';
+    Port := 0;
+  end;
 end;
 
 function ComposeURL(Host, URI: string; const Port: Word): string;
 begin
   Host := Trim(Host);
-  URI := Trim(URI);
+  URI := StringReplace(Trim(URI), '%20', ' ', [rfReplaceAll]);
 
   if (Pos('http://', Host) <> 1)
   and (Pos('https://', Host) <> 1) then

utils/fppkg/lnet/lmimestreams.pp

@@ -1,6 +1,6 @@
 { MIME Streams
 
-  CopyRight (C) 2006-2007 Micha Nelissen
+  CopyRight (C) 2006-2008 Micha Nelissen
 
   This library is Free software; you can rediStribute it and/or modify it
   under the terms of the GNU Library General Public License as published by

utils/fppkg/lnet/lmimetypes.pp

@@ -1,6 +1,6 @@
 { Mime types helper
 
-  Copyright (C) 2006-2007 Micha Nelissen
+  Copyright (C) 2006-2008 Micha Nelissen
 
   This library is Free software; you can redistribute it and/or modify it
   under the terms of the GNU Library General Public License as published by

utils/fppkg/lnet/lmimewrapper.pp

@@ -1,6 +1,6 @@
 { lNet MIME Wrapper
 
-  CopyRight (C) 2007 Ales Katona
+  CopyRight (C) 2007-2008 by Ales Katona
 
   This library is Free software; you can rediStribute it and/or modify it
   under the terms of the GNU Library General Public License as published by
@@ -612,8 +612,6 @@ begin
 end;
 
 procedure TMimeStream.DoRead(const aSize: Integer);
-var
-  n: Integer;
 begin
   ActivateFirstSection;
   

utils/fppkg/lnet/lprocess.pp

@@ -1,6 +1,6 @@
 { Asynchronous process support
 
-  Copyright (C) 2006-2007 Micha Nelissen
+  Copyright (C) 2006-2008 Micha Nelissen
 
   This library is Free software; you can redistribute it and/or modify it
   under the terms of the GNU Library General Public License as published by

utils/fppkg/lnet/lsmtp.pp

@@ -1,6 +1,6 @@
 { lNet SMTP unit
 
-  CopyRight (C) 2005-2007 Ales Katona
+  CopyRight (C) 2005-2008 Ales Katona
 
   This library is Free software; you can rediStribute it and/or modify it
   under the terms of the GNU Library General Public License as published by
@@ -29,14 +29,15 @@ unit lsmtp;
 interface
 
 uses
-  Classes, SysUtils, Contnrs, lNet, lEvents, lCommon, lMimeWrapper, lMimeStreams;
+  Classes, SysUtils, Contnrs, Base64,
+  lNet, lEvents, lCommon, lMimeWrapper, lMimeStreams;
   
 type
   TLSMTP = class;
   TLSMTPClient = class;
   
-  TLSMTPStatus = (ssNone, ssCon, ssHelo, ssEhlo, ssMail,
-                  ssRcpt, ssData, ssRset, ssQuit);
+  TLSMTPStatus = (ssNone, ssCon, ssHelo, ssEhlo, ssAuthLogin, ssAuthPlain,
+                  ssStartTLS, ssMail, ssRcpt, ssData, ssRset, ssQuit, ssLast);
 
   TLSMTPStatusSet = set of TLSMTPStatus;
 
@@ -73,6 +74,7 @@ type
     procedure AddStreamSection(aStream: TStream; const FreeStream: Boolean = False);
     procedure DeleteSection(const i: Integer);
     procedure RemoveSection(aSection: TMimeSection);
+    procedure Reset;
    public
     property MailText: string read FMailText write FMailText; deprecated; // use sections!
     property Sender: string read FSender write FSender;
@@ -85,10 +87,15 @@ type
   TLSMTP = class(TLComponent)
    protected
     FConnection: TLTcp;
+    FFeatureList: TStringList;
    protected
     function GetTimeout: Integer;
     procedure SetTimeout(const AValue: Integer);
     
+    function GetSession: TLSession;
+    procedure SetSession(const AValue: TLSession);
+    procedure SetCreator(AValue: TLComponent); override;
+
     function GetConnected: Boolean;
 
     function GetSocketClass: TLSocketClass;
@@ -99,6 +106,8 @@ type
    public
     constructor Create(aOwner: TComponent); override;
     destructor Destroy; override;
+    
+    function HasFeature(aFeature: string): Boolean;
    public
     property Connected: Boolean read GetConnected;
     property Connection: TLTcp read FConnection;
@@ -106,6 +115,8 @@ type
     property SocketClass: TLSocketClass read GetSocketClass write SetSocketClass;
     property Eventer: TLEventer read GetEventer write SetEventer;
     property Timeout: Integer read GetTimeout write SetTimeout;
+    property Session: TLSession read GetSession write SetSession;
+    property FeatureList: TStringList read FFeatureList;
   end;
 
   { TLSMTPClient }
@@ -115,6 +126,7 @@ type
     FStatus: TLSMTPStatusFront;
     FCommandFront: TLSMTPStatusFront;
     FPipeLine: Boolean;
+    FAuthStep: Integer;
 
     FOnConnect: TLSocketEvent;
     FOnReceive: TLSocketEvent;
@@ -128,6 +140,7 @@ type
     FStatusSet: TLSMTPStatusSet;
     FBuffer: string;
     FDataBuffer: string; // intermediate wait buffer on DATA command
+    FTempBuffer: string; // used independently from FBuffer for feature list
     FCharCount: Integer; // count of chars from last CRLF
     FStream: TStream;
    protected
@@ -141,12 +154,14 @@ type
     
     function CleanInput(var s: string): Integer;
     
+    procedure EvaluateServer;
+    procedure EvaluateFeatures;
     procedure EvaluateAnswer(const Ans: string);
-    
     procedure ExecuteFrontCommand;
     
-    procedure ClearCR_LF;
+    procedure AddToBuffer(s: string);
     procedure SendData(const FromStream: Boolean = False);
+    function EncodeBase64(const s: string): string;
    public
     constructor Create(aOwner: TComponent); override;
     destructor Destroy; override;
@@ -163,13 +178,16 @@ type
     
     procedure Helo(aHost: string = '');
     procedure Ehlo(aHost: string = '');
+    procedure StartTLS;
+    procedure AuthLogin(aName, aPass: string);
+    procedure AuthPlain(aName, aPass: string);
     procedure Mail(const From: string);
     procedure Rcpt(const RcptTo: string);
     procedure Data(const Msg: string);
     procedure Rset;
     procedure Quit;
     
-    procedure Disconnect; override;
+    procedure Disconnect(const Forced: Boolean = True); override;
     
     procedure CallAction; override;
    public
@@ -193,8 +211,9 @@ const
 
 function StatusToStr(const aStatus: TLSMTPStatus): string;
 const
-  STATAR: array[ssNone..ssQuit] of string = ('ssNone', 'ssCon', 'ssHelo', 'ssEhlo', 'ssMail',
-                                             'ssRcpt', 'ssData', 'ssRset', 'ssQuit');
+  STATAR: array[ssNone..ssLast] of string = ('ssNone', 'ssCon', 'ssHelo', 'ssEhlo',
+                                             'ssStartTLS', 'ssAuthLogin', 'ssAuthPlain',
+                                             'ssMail', 'ssRcpt', 'ssData', 'ssRset', 'ssQuit', 'ssLast');
 begin
   Result := STATAR[aStatus];
 end;
@@ -208,6 +227,23 @@ end;
 
 { TLSMTP }
 
+function TLSMTP.GetSession: TLSession;
+begin
+  Result := FConnection.Session;
+end;
+
+procedure TLSMTP.SetSession(const AValue: TLSession);
+begin
+  FConnection.Session := aValue;
+end;
+
+procedure TLSMTP.SetCreator(AValue: TLComponent);
+begin
+  inherited SetCreator(AValue);
+  
+  FConnection.Creator := AValue;
+end;
+
 function TLSMTP.GetTimeout: Integer;
 begin
   Result := FConnection.Timeout;
@@ -247,23 +283,62 @@ constructor TLSMTP.Create(aOwner: TComponent);
 begin
   inherited Create(aOwner);
   
+  FFeatureList := TStringList.Create;
   FConnection := TLTcp.Create(nil);
+  FConnection.Creator := Self;
+  // TODO: rework to use the new TLSocketTCP
+  FConnection.SocketClass := TLSocket;
 end;
 
 destructor TLSMTP.Destroy;
 begin
+  FFeatureList.Free;
   FConnection.Free;
 
   inherited Destroy;
 end;
 
+function TLSMTP.HasFeature(aFeature: string): Boolean;
+var
+  tmp: TStringList;
+  i, j: Integer;
+  AllArgs: Boolean;
+begin
+  Result := False;
+  try
+    tmp := TStringList.Create;
+    aFeature := UpperCase(aFeature);
+    aFeature := StringReplace(aFeature, ' ', ',', [rfReplaceAll]);
+    tmp.CommaText := aFeature;
+    for i := 0 to FFeatureList.Count - 1 do begin
+      if Pos(tmp[0], FFeatureList[i]) = 1 then begin
+        if tmp.Count = 1 then // no arguments, feature found, just exit true
+          Exit(True)
+        else begin // check arguments
+          AllArgs := True;
+          for j := 1 to tmp.Count - 1 do
+            if Pos(tmp[j], FFeatureList[i]) <= 0 then begin // some argument not found
+              AllArgs := False;
+              Break;
+            end;
+          if AllArgs then
+            Exit(True);
+        end;
+      end;
+    end;
+
+  finally
+    tmp.Free;
+  end;
+end;
+
 { TLSMTPClient }
 
 constructor TLSMTPClient.Create(aOwner: TComponent);
 begin
   inherited Create(aOwner);
   FPort := 25;
-  FStatusSet := []; // empty set for "ok/not-ok" Event
+  FStatusSet := [ssNone..ssLast]; // full set
   FSL := TStringList.Create;
 //  {$warning TODO: fix pipelining support when server does it}
   FPipeLine := False;
@@ -280,7 +355,8 @@ end;
 
 destructor TLSMTPClient.Destroy;
 begin
-  Quit;
+  if FConnection.Connected then
+    Quit;
   FSL.Free;
   FStatus.Free;
   FCommandFront.Free;
@@ -290,6 +366,12 @@ end;
 
 procedure TLSMTPClient.OnEr(const msg: string; aSocket: TLSocket);
 begin
+  if Assigned(FOnFailure) then begin
+    while not FStatus.Empty do
+      FOnFailure(aSocket, FStatus.Remove.Status);
+  end else
+    FStatus.Clear;
+
   if Assigned(FOnError) then
     FOnError(msg, aSocket);
 end;
@@ -329,8 +411,14 @@ var
   i: Integer;
 begin
   FSL.Text := s;
+
+  case FStatus.First.Status of // TODO: clear this to a proper place, the whole thing needs an overhaul
+    ssCon,
+    ssEhlo: FTempBuffer := FTempBuffer + UpperCase(s);
+  end;
+
   if FSL.Count > 0 then
-    for i := 0 to FSL.Count-1 do
+    for i := 0 to FSL.Count - 1 do
       if Length(FSL[i]) > 0 then EvaluateAnswer(FSL[i]);
   s := StringReplace(s, CRLF, LineEnding, [rfReplaceAll]);
   i := Pos('PASS', s);
@@ -339,6 +427,41 @@ begin
   Result := Length(s);
 end;
 
+procedure TLSMTPClient.EvaluateServer;
+begin
+  FFeatureList.Clear;
+  if Length(FTempBuffer) = 0 then
+    Exit;
+
+  if Pos('ESMTP', FTempBuffer) > 0 then
+    FFeatureList.Append('EHLO');
+  FTempBuffer := '';
+end;
+
+procedure TLSMTPClient.EvaluateFeatures;
+var
+  i: Integer;
+begin
+  FFeatureList.Clear;
+  if Length(FTempBuffer) = 0 then
+    Exit;
+
+  FFeatureList.Text := FTempBuffer;
+  FTempBuffer := '';
+  FFeatureList.Delete(0);
+
+  i := 0;
+  while i < FFeatureList.Count do begin;
+    FFeatureList[i] := Copy(FFeatureList[i], 5, Length(FFeatureList[i])); // delete the response code crap
+    FFeatureList[i] := StringReplace(FFeatureList[i], '=', ' ', [rfReplaceAll]);
+    if FFeatureList.IndexOf(FFeatureList[i]) <> i then begin
+      FFeatureList.Delete(i);
+      Continue;
+    end;
+    Inc(i);
+  end;
+end;
+
 procedure TLSMTPClient.EvaluateAnswer(const Ans: string);
 
   function GetNum: Integer;
@@ -363,6 +486,7 @@ procedure TLSMTPClient.EvaluateAnswer(const Ans: string);
   
   procedure Eventize(const aStatus: TLSMTPStatus; const Res: Boolean);
   begin
+    FStatus.Remove;
     if Res then begin
       if Assigned(FOnSuccess) and (aStatus in FStatusSet) then
         FOnSuccess(FConnection.Iterator, aStatus);
@@ -376,55 +500,102 @@ var
   x: Integer;
 begin
   x := GetNum;
+
   if ValidResponse(Ans) and not FStatus.Empty then
     case FStatus.First.Status of
       ssCon,
       ssHelo,
       ssEhlo: case x of
+                200..299: begin
+                            case FStatus.First.Status of
+                              ssCon  : EvaluateServer;
+                              ssEhlo : EvaluateFeatures;
+                            end;
+                            Eventize(FStatus.First.Status, True);
+                          end;
+              else        begin
+                            Eventize(FStatus.First.Status, False);
+                            Disconnect(False);
+                            FFeatureList.Clear;
+                            FTempBuffer := '';
+                          end;
+              end;
+              
+      ssStartTLS:
+              case x of
+                200..299: begin
+                            Eventize(FStatus.First.Status, True);
+                            FConnection.Iterator.SetState(ssSSLActive);
+                          end;
+              else        begin
+                            Eventize(FStatus.First.Status, False);
+                          end;
+              end;
+              
+      ssAuthLogin:
+              case x of
                 200..299: begin
                             Eventize(FStatus.First.Status, True);
-                            FStatus.Remove;
+                          end;
+                300..399: if FAuthStep = 0 then begin
+                            AddToBuffer(FStatus.First.Args[1] + CRLF);
+                            Inc(FAuthStep);
+                            SendData;
+                          end else if FAuthStep = 1 then begin
+                            AddToBuffer(FStatus.First.Args[2] + CRLF);
+                            Inc(FAuthStep);
+                            SendData;
+                          end else begin
+                            Eventize(FStatus.First.Status, False);
                           end;
               else        begin
                             Eventize(FStatus.First.Status, False);
-                            Disconnect;
                           end;
               end;
-               
+              
+      ssAuthPlain:
+              case x of
+                200..299: begin
+                            Eventize(FStatus.First.Status, True);
+                          end;
+                300..399: begin
+                            AddToBuffer(FStatus.First.Args[1] + FStatus.First.Args[2] + CRLF);
+                            SendData;
+                          end;
+              else        begin
+                            Eventize(FStatus.First.Status, False);
+                          end;
+              end;
+
       ssMail,
       ssRcpt: begin
                 Eventize(FStatus.First.Status, (x >= 200) and (x < 299));
-                FStatus.Remove;
               end;
 
       ssData: case x of
                 200..299: begin
                             Eventize(FStatus.First.Status, True);
-                            FStatus.Remove;
                           end;
                 300..399: begin
-                            FBuffer := FDataBuffer;
+                            AddToBuffer(FDataBuffer);
                             FDataBuffer := '';
                             SendData(True);
                           end;
               else        begin
                             FDataBuffer := '';
                             Eventize(FStatus.First.Status, False);
-                            FStatus.Remove;
                           end;
               end;
               
       ssRset: begin
                 Eventize(FStatus.First.Status, (x >= 200) and (x < 299));
-                FStatus.Remove;
               end;
               
       ssQuit: begin
                 Eventize(FStatus.First.Status, (x >= 200) and (x < 299));
-                FStatus.Remove;
-                if Assigned(FOnDisconnect) then
-                  FOnDisconnect(FConnection.Iterator);
-                Disconnect;
+{                if Assigned(FOnDisconnect) then
+                  FOnDisconnect(FConnection.Iterator);}
+                Disconnect(False);
               end;
     end;
     
@@ -447,40 +618,42 @@ begin
   FCommandFront.Remove;
 end;
 
-procedure TLSMTPClient.ClearCR_LF;
+procedure TLSMTPClient.AddToBuffer(s: string);
 var
   i: Integer;
   Skip: Boolean = False;
 begin
-  for i := 1 to Length(FBuffer) do begin
+  for i := 1 to Length(s) do begin
     if Skip then begin
       Skip := False;
       Continue;
     end;
-    
-    if (FBuffer[i] = #13) or (FBuffer[i] = #10) then begin
-      if FBuffer[i] = #13 then
-        if (i < Length(FBuffer)) and (FBuffer[i + 1] = #10) then begin
+
+    if (s[i] = #13) or (s[i] = #10) then begin
+      if s[i] = #13 then
+        if (i < Length(s)) and (s[i + 1] = #10) then begin
           FCharCount := 0;
           Skip := True; // skip the crlf
         end else begin // insert LF to a standalone CR
-          System.Insert(#10, FBuffer, i + 1);
+          System.Insert(#10, s, i + 1);
           FCharCount := 0;
           Skip := True; // skip the new crlf
         end;
-        
-      if FBuffer[i] = #10 then begin
-        System.Insert(#13, FBuffer, i);
+
+      if s[i] = #10 then begin
+        System.Insert(#13, s, i);
         FCharCount := 0;
         Skip := True; // skip the new crlf
       end;
     end else if FCharCount >= 1000 then begin // line too long
-      System.Insert(CRLF, FBuffer, i);
+      System.Insert(CRLF, s, i);
       FCharCount := 0;
       Skip := True;
     end else
       Inc(FCharCount);
   end;
+  
+  FBuffer := FBuffer + s;
 end;
 
 procedure TLSMTPClient.SendData(const FromStream: Boolean = False);
@@ -494,10 +667,10 @@ const
     SetLength(s, SBUF_SIZE - Length(FBuffer));
     SetLength(s, FStream.Read(s[1], Length(s)));
     
-    FBuffer := FBuffer + s;
+    AddToBuffer(s);
     
     if FStream.Position = FStream.Size then begin // we finished the stream
-      FBuffer := FBuffer + CRLF + '.' + CRLF;
+      AddToBuffer(CRLF + '.' + CRLF);
       FStream := nil;
     end;
   end;
@@ -512,8 +685,6 @@ begin
   n := 1;
   Sent := 0;
   while (Length(FBuffer) > 0) and (n > 0) do begin
-    ClearCR_LF;
-  
     n := FConnection.SendMessage(FBuffer);
     Sent := Sent + n;
     if n > 0 then
@@ -527,11 +698,32 @@ begin
     FOnSent(FConnection.Iterator, Sent);
 end;
 
+function TLSMTPClient.EncodeBase64(const s: string): string;
+var
+  Dummy: TBogusStream;
+  Enc: TBase64EncodingStream;
+begin
+  Result := '';
+  if Length(s) = 0 then
+    Exit;
+  
+  Dummy := TBogusStream.Create;
+  Enc := TBase64EncodingStream.Create(Dummy);
+
+  Enc.Write(s[1], Length(s));
+  Enc.Free;
+  SetLength(Result, Dummy.Size);
+  Dummy.Read(Result[1], Dummy.Size);
+
+  Dummy.Free;
+end;
+
 function TLSMTPClient.Connect(const aHost: string; const aPort: Word = 25): Boolean;
 begin
   Result := False;
-  Disconnect;
+  Disconnect(True);
   if FConnection.Connect(aHost, aPort) then begin
+    FTempBuffer := '';
     FHost := aHost;
     FPort := aPort;
     FStatus.Insert(MakeStatusRec(ssCon, '', ''));
@@ -577,8 +769,7 @@ begin
     FSL.CommaText := StringReplace(Recipients, ' ', ',', [rfReplaceAll]);
     for i := 0 to FSL.Count-1 do
       Rcpt(FSL[i]);
-    Data('From: ' + From + CRLF + 'Subject: ' + Subject + CRLF + 'To: ' + FSL.CommaText + CRLF + Msg);
-    Rset;
+    Data('From: ' + From + CRLF + 'Subject: ' + Subject + CRLF + 'To: ' + FSL.CommaText + CRLF + CRLF + Msg);
   end;
 end;
 
@@ -598,7 +789,6 @@ begin
     for i := 0 to FSL.Count-1 do
       Rcpt(FSL[i]);
     Data('From: ' + From + CRLF + 'Subject: ' + Subject + CRLF + 'To: ' + FSL.CommaText + CRLF);
-    Rset;
   end;
 end;
 
@@ -612,10 +802,11 @@ end;
 
 procedure TLSMTPClient.Helo(aHost: string = '');
 begin
-  if Length(Host) = 0 then
+  if Length(aHost) = 0 then
     aHost := FHost;
+
   if CanContinue(ssHelo, aHost, '') then begin
-    FBuffer := FBuffer + 'HELO ' + aHost + CRLF;
+    AddToBuffer('HELO ' + aHost + CRLF);
     FStatus.Insert(MakeStatusRec(ssHelo, '', ''));
     SendData;
   end;
@@ -626,16 +817,52 @@ begin
   if Length(aHost) = 0 then
     aHost := FHost;
   if CanContinue(ssEhlo, aHost, '') then begin
-    FBuffer := FBuffer + 'EHLO ' + aHost + CRLF;
+    FTempBuffer := ''; // for ehlo response
+    AddToBuffer('EHLO ' + aHost + CRLF);
     FStatus.Insert(MakeStatusRec(ssEhlo, '', ''));
     SendData;
   end;
 end;
 
+procedure TLSMTPClient.StartTLS;
+begin
+  if CanContinue(ssStartTLS, '', '') then begin
+    AddToBuffer('STARTTLS' + CRLF);
+    FStatus.Insert(MakeStatusRec(ssStartTLS, '', ''));
+    SendData;
+  end;
+end;
+
+procedure TLSMTPClient.AuthLogin(aName, aPass: string);
+begin
+  aName := EncodeBase64(aName);
+  aPass := EncodeBase64(aPass);
+  FAuthStep := 0; // first, send username
+  
+  if CanContinue(ssAuthLogin, aName, aPass) then begin
+    AddToBuffer('AUTH LOGIN' + CRLF);
+    FStatus.Insert(MakeStatusRec(ssAuthLogin, aName, aPass));
+    SendData;
+  end;
+end;
+
+procedure TLSMTPClient.AuthPlain(aName, aPass: string);
+begin
+  aName := EncodeBase64(#0 + aName);
+  aPass := EncodeBase64(#0 + aPass);
+  FAuthStep := 0;
+
+  if CanContinue(ssAuthPlain, aName, aPass) then begin
+    AddToBuffer('AUTH PLAIN' + CRLF);
+    FStatus.Insert(MakeStatusRec(ssAuthPlain, aName, aPass));
+    SendData;
+  end;
+end;
+
 procedure TLSMTPClient.Mail(const From: string);
 begin
   if CanContinue(ssMail, From, '') then begin
-    FBuffer := FBuffer + 'MAIL FROM:' + '<' + From + '>' + CRLF;
+    AddToBuffer('MAIL FROM:' + '<' + From + '>' + CRLF);
     FStatus.Insert(MakeStatusRec(ssMail, '', ''));
     SendData;
   end;
@@ -644,7 +871,7 @@ end;
 procedure TLSMTPClient.Rcpt(const RcptTo: string);
 begin
   if CanContinue(ssRcpt, RcptTo, '') then begin
-    FBuffer := FBuffer + 'RCPT TO:' + '<' + RcptTo + '>' + CRLF;
+    AddToBuffer('RCPT TO:' + '<' + RcptTo + '>' + CRLF);
     FStatus.Insert(MakeStatusRec(ssRcpt, '', ''));
     SendData;
   end;
@@ -653,7 +880,7 @@ end;
 procedure TLSMTPClient.Data(const Msg: string);
 begin
   if CanContinue(ssData, Msg, '') then begin
-    FBuffer := 'DATA ' + CRLF;
+    AddToBuffer('DATA ' + CRLF);
     FDataBuffer := '';
 
     if Assigned(FStream) then begin
@@ -670,7 +897,7 @@ end;
 procedure TLSMTPClient.Rset;
 begin
   if CanContinue(ssRset, '', '') then begin
-    FBuffer := FBuffer + 'RSET' + CRLF;
+    AddToBuffer('RSET' + CRLF);
     FStatus.Insert(MakeStatusRec(ssRset, '', ''));
     SendData;
   end;
@@ -679,15 +906,15 @@ end;
 procedure TLSMTPClient.Quit;
 begin
   if CanContinue(ssQuit, '', '') then begin
-    FBuffer := FBuffer + 'QUIT' + CRLF;
+    AddToBuffer('QUIT' + CRLF);
     FStatus.Insert(MakeStatusRec(ssQuit, '', ''));
     SendData;
   end;
 end;
 
-procedure TLSMTPClient.Disconnect;
+procedure TLSMTPClient.Disconnect(const Forced: Boolean = True);
 begin
-  FConnection.Disconnect;
+  FConnection.Disconnect(Forced);
   FStatus.Clear;
   FCommandFront.Clear;
 end;
@@ -749,6 +976,11 @@ begin
   FMailStream.Remove(aSection);
 end;
 
+procedure TMail.Reset;
+begin
+  FMailStream.Reset;
+end;
+
 
 end.
 

utils/fppkg/lnet/lspawnfcgi.pp

@@ -1,6 +1,6 @@
 { lNet FastCGI Spawner
 
-  CopyRight (C) 2006-2007 Ales Katona
+  CopyRight (C) 2006-2008 Ales Katona
 
   This library is Free software; you can rediStribute it and/or modify it
   under the terms of the GNU Library General Public License as published by

utils/fppkg/lnet/lstrbuffer.pp

@@ -1,6 +1,6 @@
 { Efficient string buffer helper
 
-  Copyright (C) 2006-2007 Micha Nelissen
+  Copyright (C) 2006-2008 Micha Nelissen
 
   This library is Free software; you can redistribute it and/or modify it
   under the terms of the GNU Library General Public License as published by

utils/fppkg/lnet/ltelnet.pp

@@ -1,4 +1,4 @@
-{ lTelnet CopyRight (C) 2004-2007 Ales Katona
+{ lTelnet CopyRight (C) 2004-2008 Ales Katona
 
   This library is Free software; you can rediStribute it and/or modify it
   under the terms of the GNU Library General Public License as published by
@@ -76,7 +76,7 @@ type
     FStack: TLControlStack;
     FConnection: TLTcp;
     FPossible: TLTelnetControlChars;
-    FActive: TLTelnetControlChars;
+    FActiveOpts: TLTelnetControlChars;
     FOutput: TMemoryStream;
     FOperation: Char;
     FCommandCharIndex: Byte;
@@ -86,25 +86,30 @@ type
     FOnError: TLSocketErrorEvent;
     FCommandArgs: string[3];
     FOrders: TLTelnetControlChars;
-    FConnected: Boolean;
-    FBuffer: string;
-
+    FBuffer: array of Char;
+    FBufferIndex: Integer;
+    FBufferEnd: Integer;
+    procedure InflateBuffer;
+    function AddToBuffer(const aStr: string): Boolean; inline;
+    
     function Question(const Command: Char; const Value: Boolean): Char;
     
+    function GetConnected: Boolean;
+    
     function GetTimeout: Integer;
     procedure SetTimeout(const Value: Integer);
 
     function GetSocketClass: TLSocketClass;
     procedure SetSocketClass(Value: TLSocketClass);
-    
+
+    function GetSession: TLSession;
+    procedure SetSesssion(const AValue: TLSession);
+    procedure SetCreator(AValue: TLComponent); override;
+
     procedure StackFull;
-    
     procedure DoubleIAC(var s: string);
-    
-    procedure TelnetParse(const msg: string);
-    
+    function TelnetParse(const msg: string): Integer;
     procedure React(const Operation, Command: Char); virtual; abstract;
-    
     procedure SendCommand(const Command: Char; const Value: Boolean); virtual; abstract;
 
     procedure OnCs(aSocket: TLSocket);
@@ -112,7 +117,7 @@ type
     constructor Create(aOwner: TComponent); override;
     destructor Destroy; override;
     
-    function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
+    function Get(out aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
     function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; virtual; abstract;
     
     function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
@@ -123,12 +128,12 @@ type
     procedure SetOption(const Option: Char);
     procedure UnSetOption(const Option: Char);
     
-    procedure Disconnect; override;
+    procedure Disconnect(const Forced: Boolean = True); override;
     
     procedure SendCommand(const aCommand: Char; const How: TLHowEnum); virtual;
    public
     property Output: TMemoryStream read FOutput;
-    property Connected: Boolean read FConnected;
+    property Connected: Boolean read GetConnected;
     property Timeout: Integer read GetTimeout write SetTimeout;
     property OnReceive: TLSocketEvent read FOnReceive write FOnReceive;
     property OnDisconnect: TLSocketEvent read FOnDisconnect write FOnDisconnect;
@@ -136,6 +141,7 @@ type
     property OnError: TLSocketErrorEvent read FOnError write FOnError;
     property Connection: TLTCP read FConnection;
     property SocketClass: TLSocketClass read GetSocketClass write SetSocketClass;
+    property Session: TLSession read GetSession write SetSesssion;
   end;
 
   { TLTelnetClient }
@@ -157,7 +163,7 @@ type
     function Connect(const anAddress: string; const aPort: Word): Boolean;
     function Connect: Boolean;
     
-    function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
+    function Get(out aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
     function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; override;
     
     function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
@@ -171,7 +177,7 @@ type
 implementation
 
 uses
-  SysUtils;
+  SysUtils, Math;
 
 var
   zz: Char;
@@ -183,7 +189,8 @@ constructor TLTelnet.Create(aOwner: TComponent);
 begin
   inherited Create(aOwner);
   
-  FConnection := TLTCP.Create(aOwner);
+  FConnection := TLTCP.Create(nil);
+  FConnection.Creator := Self;
   FConnection.OnCanSend := @OnCs;
   
   FOutput := TMemoryStream.Create;
@@ -194,13 +201,53 @@ end;
 
 destructor TLTelnet.Destroy;
 begin
-  Disconnect;
+  Disconnect(True);
   FOutput.Free;
   FConnection.Free;
   FStack.Free;
   inherited Destroy;
 end;
 
+function TLTelnet.GetConnected: Boolean;
+begin
+  Result := FConnection.Connected;
+end;
+
+function TLTelnet.GetSession: TLSession;
+begin
+  Result := FConnection.Session;
+end;
+
+procedure TLTelnet.SetSesssion(const AValue: TLSession);
+begin
+  FConnection.Session := aValue;
+end;
+
+procedure TLTelnet.SetCreator(AValue: TLComponent);
+begin
+  inherited SetCreator(AValue);
+  FConnection.Creator := aValue;
+end;
+
+procedure TLTelnet.InflateBuffer;
+var
+  n: Integer;
+begin
+  n := Max(Length(FBuffer), 25);
+  SetLength(FBuffer, n * 10);
+end;
+
+function TLTelnet.AddToBuffer(const aStr: string): Boolean; inline;
+begin
+  Result := False;
+  
+  while Length(aStr) + FBufferEnd > Length(FBuffer) do
+    InflateBuffer;
+    
+  Move(aStr[1], FBuffer[FBufferEnd], Length(aStr));
+  Inc(FBufferEnd, Length(aStr));
+end;
+
 function TLTelnet.Question(const Command: Char; const Value: Boolean): Char;
 begin
   Result := TS_NOP;
@@ -265,18 +312,21 @@ begin
     end;
 end;
 
-procedure TLTelnet.TelnetParse(const msg: string);
+function TLTelnet.TelnetParse(const msg: string): Integer;
 var
   i: Longint;
 begin
+  Result := 0;
   for i := 1 to Length(msg) do
     if (FStack.ItemIndex > 0) or (msg[i] = TS_IAC) then begin
       if msg[i] = TS_GA then
         FStack.Clear
       else
         FStack.Push(msg[i])
-    end else
+    end else begin
       FOutput.WriteByte(Byte(msg[i]));
+      Inc(Result);
+    end;
 end;
 
 procedure TLTelnet.OnCs(aSocket: TLSocket);
@@ -285,18 +335,24 @@ var
 begin
   n := 1;
 
-  while n > 0 do begin
-    n := FConnection.SendMessage(FBuffer);
+  while (n > 0) and (FBufferIndex < FBufferEnd) do begin
+    n := FConnection.Send(FBuffer[FBufferIndex], FBufferEnd - FBufferIndex);
 
     if n > 0 then
-      System.Delete(FBuffer, 1, n);
+      Inc(FBufferIndex, n);
+  end;
+  
+  if FBufferEnd - FBufferIndex < FBufferIndex then begin // if we can move the "right" side of the buffer back to the left
+    Move(FBuffer[FBufferIndex], FBuffer[0], FBufferEnd - FBufferIndex);
+    FBufferEnd := FBufferEnd - FBufferIndex;
+    FBufferIndex := 0;
   end;
 end;
 
 function TLTelnet.OptionIsSet(const Option: Char): Boolean;
 begin
   Result := False;
-  Result := Option in FActive;
+  Result := Option in FActiveOpts;
 end;
 
 function TLTelnet.RegisterOption(const aOption: Char;
@@ -323,10 +379,9 @@ begin
     SendCommand(Option, False);
 end;
 
-procedure TLTelnet.Disconnect;
+procedure TLTelnet.Disconnect(const Forced: Boolean = True);
 begin
-  FConnection.Disconnect;
-  FConnected := False;
+  FConnection.Disconnect(Forced);
 end;
 
 procedure TLTelnet.SendCommand(const aCommand: Char; const How: TLHowEnum);
@@ -334,7 +389,7 @@ begin
   {$ifdef debug}
   Writeln('**SENT** ', TNames[Char(How)], ' ', TNames[aCommand]);
   {$endif}
-  FBuffer := FBuffer + TS_IAC + Char(How) + aCommand;
+  AddToBuffer(TS_IAC + Char(How) + aCommand);
   OnCs(nil);
 end;
 
@@ -348,9 +403,8 @@ begin
   FConnection.OnReceive := @OnRe;
   FConnection.OnConnect := @OnCo;
 
-  FConnected := False;
   FPossible := [TS_ECHO, TS_HYI, TS_SGA];
-  FActive := [];
+  FActiveOpts := [];
   FOrders := [];
 end;
 
@@ -372,16 +426,13 @@ procedure TLTelnetClient.OnRe(aSocket: TLSocket);
 var
   s: string;
 begin
-  if aSocket.GetMessage(s) > 0 then begin
-    TelnetParse(s);
-    if Assigned(FOnReceive) then
+  if aSocket.GetMessage(s) > 0 then
+    if (TelnetParse(s) > 0) and Assigned(FOnReceive) then
       FOnReceive(aSocket);
-  end;
 end;
 
 procedure TLTelnetClient.OnCo(aSocket: TLSocket);
 begin
-  FConnected := True;
   if Assigned(FOnConnect) then
     FOnConnect(aSocket);
 end;
@@ -390,21 +441,21 @@ procedure TLTelnetClient.React(const Operation, Command: Char);
 
   procedure Accept(const Operation, Command: Char);
   begin
-    FActive := FActive + [Command];
+    FActiveOpts := FActiveOpts + [Command];
     {$ifdef debug}
     Writeln('**SENT** ', TNames[Operation], ' ', TNames[Command]);
     {$endif}
-    FBuffer := FBuffer + TS_IAC + Operation + Command;
+    AddToBuffer(TS_IAC + Operation + Command);
     OnCs(nil);
   end;
   
   procedure Refuse(const Operation, Command: Char);
   begin
-    FActive := FActive - [Command];
+    FActiveOpts := FActiveOpts - [Command];
     {$ifdef debug}
     Writeln('**SENT** ', TNames[Operation], ' ', TNames[Command]);
     {$endif}
-    FBuffer := FBuffer + TS_IAC + Operation + Command;
+    AddToBuffer(TS_IAC + Operation + Command);
     OnCs(nil);
   end;
   
@@ -418,23 +469,23 @@ begin
               
     TS_DONT : if Command in FPossible then Refuse(TS_WONT, Command);
     
-    TS_WILL : if Command in FPossible then FActive := FActive + [Command]
+    TS_WILL : if Command in FPossible then FActiveOpts := FActiveOpts + [Command]
               else Refuse(TS_DONT, Command);
                  
-    TS_WONT : if Command in FPossible then FActive := FActive - [Command];
+    TS_WONT : if Command in FPossible then FActiveOpts := FActiveOpts - [Command];
   end;
 end;
 
 procedure TLTelnetClient.SendCommand(const Command: Char; const Value: Boolean);
 begin
-  if FConnected then begin
+  if Connected then begin
     {$ifdef debug}
     Writeln('**SENT** ', TNames[Question(Command, Value)], ' ', TNames[Command]);
     {$endif}
     case Question(Command, Value) of
-      TS_WILL : FActive := FActive + [Command];
+      TS_WILL : FActiveOpts := FActiveOpts + [Command];
     end;
-    FBuffer := FBuffer + TS_IAC + Question(Command, Value) + Command;
+    AddToBuffer(TS_IAC + Question(Command, Value) + Command);
     OnCs(nil);
   end;
 end;
@@ -449,7 +500,7 @@ begin
   Result  :=  FConnection.Connect(FHost, FPort);
 end;
 
-function TLTelnetClient.Get(var aData; const aSize: Integer; aSocket: TLSocket): Integer;
+function TLTelnetClient.Get(out aData; const aSize: Integer; aSocket: TLSocket): Integer;
 begin
   Result := FOutput.Read(aData, aSize);
   if FOutput.Position = FOutput.Size then
@@ -484,7 +535,7 @@ begin
     if LocalEcho and (not OptionIsSet(TS_ECHO)) and (not OptionIsSet(TS_HYI)) then
       FOutput.Write(PChar(Tmp)^, Length(Tmp));
       
-    FBuffer := FBuffer + Tmp;
+    AddToBuffer(Tmp);
     OnCs(nil);
     
     Result := aSize;

utils/fppkg/lnet/ltimer.pp

@@ -1,6 +1,6 @@
 { lNet Timer
 
-  CopyRight (C) 2006-2007 Micha Nelissen
+  CopyRight (C) 2006-2008 Micha Nelissen
 
   This library is Free software; you can rediStribute it and/or modify it
   under the terms of the GNU Library General Public License as published by

utils/fppkg/lnet/lwebserver.pp

@@ -1,6 +1,6 @@
 { Web server component, built on the HTTP server component
 
-  Copyright (C) 2006-2007 Micha Nelissen
+  Copyright (C) 2006-2008 Micha Nelissen
 
   This library is Free software; you can redistribute it and/or modify it
   under the terms of the GNU Library General Public License as published by
@@ -30,7 +30,7 @@ interface
 
 uses
   sysutils, classes, lhttp, lhttputil, lmimetypes, levents,
-  lprocess, process, lfastcgi, fastcgi;
+  lprocess, process, lfastcgi, fastcgi_base;
 
 type
   TLMultipartParameter = (mpContentType, mpContentDisposition, mpContentTransferEncoding,
@@ -642,15 +642,17 @@ end;
 
 procedure TCGIOutput.StartRequest;
 var
-  lServerSocket: TLHTTPServerSocket absolute FSocket;
+  lServerSocket: TLHTTPServerSocket;
   tempStr: string;
 begin
+  lServerSocket := TLHTTPServerSocket(FSocket);
 {
   FProcess.Environment.Add('SERVER_ADDR=');
   FProcess.Environment.Add('SERVER_ADMIN=');
   FProcess.Environment.Add('SERVER_NAME=');
   FProcess.Environment.Add('SERVER_PORT=');
 }
+  Self := nil;
   tempStr := TLHTTPServer(lServerSocket.Creator).ServerSoftware;
   if Length(tempStr) > 0 then
     AddEnvironment('SERVER_SOFTWARE', tempStr);
@@ -702,7 +704,7 @@ var
   iEnd, lCode: integer;
   lStatus, lLength: dword;
   pLineEnd, pNextLine, pValue: pchar;
-  lServerSocket: TLHTTPServerSocket absolute FSocket;
+  lServerSocket: TLHTTPServerSocket;
 
   procedure AddExtraHeader;
   begin
@@ -711,6 +713,7 @@ var
   end;
 
 begin
+  lServerSocket := TLHTTPServerSocket(FSocket);
   repeat
     iEnd := IndexByte(FParsePos^, @FBuffer[FReadPos]-FParsePos, 10);
     if iEnd = -1 then exit(false);
@@ -874,8 +877,9 @@ end;
 
 procedure TSimpleCGIOutput.CGIOutputError;
 var
-  ServerSocket: TLHTTPServerSocket absolute FSocket;
+  ServerSocket: TLHTTPServerSocket;
 begin
+  ServerSocket := TLHTTPServerSocket(FSocket);
   if FProcess.ExitStatus = 127 then
     ServerSocket.FResponseInfo.Status := hsNotFound
   else

utils/fppkg/lnet/lws2tcpip.pp

@@ -0,0 +1,70 @@
+unit lws2tcpip;
+
+{$mode delphi}
+
+interface
+
+uses
+  WinSock2;
+
+const
+  ws2tcpip = 'ws2_32.dll';
+
+  AI_PASSIVE     = $1;
+  AI_CANONNAME   = $2;
+  AI_NUMERICHOST = $4;
+
+type
+  LPADDRINFO = ^addrinfo;
+  addrinfo = record
+    ai_flags: Integer;
+    ai_family: Integer;
+    ai_socktype: Integer;
+    ai_protocol: Integer;
+    ai_addrlen: size_t;
+    ai_canonname: PChar;
+    ai_addr: PSockAddr;
+    ai_next: LPADDRINFO;
+  end;
+  TAddrInfo = addrinfo;
+  PAddrInfo = LPADDRINFO;
+
+function getaddrinfo(nodename, servname: PChar; hints: PAddrInfo; var res: PAddrInfo): Integer; stdcall;
+procedure freeaddrinfo(ai: PAddrInfo); stdcall;
+
+implementation
+
+uses
+  dynlibs;
+
+type
+  TGetAddrInfoFunc = function (nodename, servname: PChar; hints: PAddrInfo; var res: PAddrInfo): Integer; stdcall;
+  TFreeAddrInfoProc = procedure (ai: PAddrInfo); stdcall;
+
+var
+  _lib: TLibHandle;
+  _getaddrinfo: TGetAddrInfoFunc;
+  _freeaddrinfo: TFreeAddrInfoProc;
+
+function getaddrinfo(nodename, servname: PChar; hints: PAddrInfo;
+  var res: PAddrInfo): Integer; stdcall;
+begin
+  _getaddrinfo(nodename, servname, hints, res);
+end;
+
+procedure freeaddrinfo(ai: PAddrInfo); stdcall;
+begin
+
+end;
+
+initialization
+  _lib := LoadLibrary(ws2tcpip);
+  _getaddrinfo := GetProcedureAddress(_lib, 'getaddrinfo');
+  _freeaddrinfo := GetProcedureAddress(_lib, 'freeaddrinfo');
+
+finalization
+  UnloadLibrary(_lib);
+
+
+end.
+

utils/fppkg/lnet/sys/lepolleventer.inc

@@ -32,14 +32,14 @@ begin
   FEpollReadFD := epoll_create(BASE_SIZE);
   FEpollMasterFD := epoll_create(2);
   if (FEPollFD < 0) or (FEpollReadFD < 0) or (FEpollMasterFD < 0) then
-    raise Exception.Create('Unable to create epoll');
+    raise Exception.Create('Unable to create epoll: ' + StrError(fpgeterrno));
   lEvent.events := EPOLLIN or EPOLLOUT or EPOLLPRI or EPOLLERR or EPOLLHUP or EPOLLET;
   lEvent.data.fd := FEpollFD;
   if epoll_ctl(FEpollMasterFD, EPOLL_CTL_ADD, FEpollFD, @lEvent) < 0 then
-    raise Exception.Create('Unable to add FDs to master epoll FD');
+    raise Exception.Create('Unable to add FDs to master epoll FD: ' + StrError(fpGetErrno));
   lEvent.data.fd := FEpollReadFD;
   if epoll_ctl(FEpollMasterFD, EPOLL_CTL_ADD, FEpollReadFD, @lEvent) < 0 then
-    raise Exception.Create('Unable to add FDs to master epoll FD');
+    raise Exception.Create('Unable to add FDs to master epoll FD: ' + StrError(fpGetErrno));
 end;
 
 destructor TLEpollEventer.Destroy;

utils/fppkg/lnet/sys/lkqueueeventer.inc

@@ -13,7 +13,7 @@ begin
   FTimeout.tv_nsec := 0;
   FQueue := KQueue;
   if FQueue < 0 then
-    raise Exception.Create('Unable to create kqueue');
+    raise Exception.Create('Unable to create kqueue: ' + StrError(fpGetErrno));
 end;
 
 destructor TLKQueueEventer.Destroy;

utils/fppkg/lnet/sys/lspawnfcgiunix.inc

@@ -21,7 +21,7 @@ begin
       Exit(LSocketError);
 
     TheSocket:=TLSocket.Create;
-    TheSocket.Blocking:=True;
+    TheSocket.SetState(ssBlocking);
 
     if not TheSocket.Listen(aPort) then
       Exit(LSocketError);