Browse Source

* update lnet to near 0.5 before the freeze

git-svn-id: trunk@6870 -
Almindor 18 years ago
parent
commit
5a6eabcd6c

+ 48 - 47
utils/fppkg/lnet/lcommon.pp

@@ -91,11 +91,11 @@ const
   
   
   procedure FillAddressInfo(var aAddrInfo: TInetSockAddr; const aFamily: sa_family_t;
   procedure FillAddressInfo(var aAddrInfo: TInetSockAddr; const aFamily: sa_family_t;
                             const Address: string; const aPort: Word); inline;
                             const Address: string; const aPort: Word); inline;
-
+                            
 implementation
 implementation
 
 
 uses
 uses
-  lNet
+  StrUtils, lNet
   
   
 {$IFNDEF UNIX}
 {$IFNDEF UNIX}
 
 
@@ -107,14 +107,14 @@ var
   Tmp: string;
   Tmp: string;
   TmpW: widestring;
   TmpW: widestring;
 begin
 begin
-  Result:='[' + IntToStr(Ernum) + '] ';
+  Result := '[' + IntToStr(Ernum) + '] ';
   if USEUtf8 then begin
   if USEUtf8 then begin
     SetLength(TmpW, 256);
     SetLength(TmpW, 256);
     SetLength(TmpW, FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM or
     SetLength(TmpW, FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM or
                                    FORMAT_MESSAGE_IGNORE_INSERTS or
                                    FORMAT_MESSAGE_IGNORE_INSERTS or
                                    FORMAT_MESSAGE_ARGUMENT_ARRAY,
                                    FORMAT_MESSAGE_ARGUMENT_ARRAY,
                                    nil, Ernum, 0, @TmpW[1], 256, nil));
                                    nil, Ernum, 0, @TmpW[1], 256, nil));
-    Tmp:=UTF8Encode(TmpW);
+    Tmp := UTF8Encode(TmpW);
   end else begin
   end else begin
     SetLength(Tmp, 256);
     SetLength(Tmp, 256);
     SetLength(Tmp, FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or
     SetLength(Tmp, FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or
@@ -124,7 +124,7 @@ begin
   end;
   end;
   if Length(Tmp) > 2 then
   if Length(Tmp) > 2 then
     Delete(Tmp, Length(Tmp)-1, 2);
     Delete(Tmp, Length(Tmp)-1, 2);
-  Result:=Tmp;
+  Result := Tmp;
 end;
 end;
 
 
 function TZSeconds: integer; inline;
 function TZSeconds: integer; inline;
@@ -143,37 +143,37 @@ end;
   
   
 function LStrError(const Ernum: Longint; const UseUTF8: Boolean = False): string;
 function LStrError(const Ernum: Longint; const UseUTF8: Boolean = False): string;
 begin
 begin
-  Result:=IntToStr(Ernum); // TODO: fix for non-windows winsock users
+  Result := IntToStr(Ernum); // TODO: fix for non-windows winsock users
 end;
 end;
 
 
 function TZSeconds: integer; inline;
 function TZSeconds: integer; inline;
 begin
 begin
-  Result:=0; // todo: fix for non-windows non unix
+  Result := 0; // todo: fix for non-windows non unix
 end;
 end;
 
 
 {$ENDIF}
 {$ENDIF}
 
 
 function LSocketError: Longint;
 function LSocketError: Longint;
 begin
 begin
-  Result:=WSAGetLastError;
+  Result := WSAGetLastError;
 end;
 end;
 
 
 function CleanError(const Ernum: Longint): Byte;
 function CleanError(const Ernum: Longint): Byte;
 begin
 begin
-  Result:=Byte(Ernum - 10000);
+  Result := Byte(Ernum - 10000);
 end;
 end;
 
 
 function fpSelect(const nfds: Integer; const readfds, writefds, exceptfds: PFDSet;
 function fpSelect(const nfds: Integer; const readfds, writefds, exceptfds: PFDSet;
                   const timeout: PTimeVal): Longint; inline;
                   const timeout: PTimeVal): Longint; inline;
 begin
 begin
-  Result:=Select(nfds, readfds, writefds, exceptfds, timeout);
+  Result := Select(nfds, readfds, writefds, exceptfds, timeout);
 end;
 end;
 
 
 function fpFD_ISSET(const Socket: Longint; var FDSet: TFDSet): Integer; inline;
 function fpFD_ISSET(const Socket: Longint; var FDSet: TFDSet): Integer; inline;
 begin
 begin
-  Result:=0;
+  Result := 0;
   if FD_ISSET(Socket, FDSet) then
   if FD_ISSET(Socket, FDSet) then
-    Result:=1;
+    Result := 1;
 end;
 end;
 
 
 procedure fpFD_SET(const Socket: Longint; var FDSet: TFDSet); inline;
 procedure fpFD_SET(const Socket: Longint; var FDSet: TFDSet); inline;
@@ -191,12 +191,12 @@ var
   HE: PHostEnt;
   HE: PHostEnt;
   Addr: DWord;
   Addr: DWord;
 begin
 begin
-  Result:='';
-  HE:=nil;
-  Addr:=inet_addr(PChar(Address));
-  HE:=gethostbyaddr(@Addr, SizeOf(Addr), AF_INET);
+  Result := '';
+  HE := nil;
+  Addr := inet_addr(PChar(Address));
+  HE := gethostbyaddr(@Addr, SizeOf(Addr), AF_INET);
   if Assigned(HE) then
   if Assigned(HE) then
-    Result:=HE^.h_name;
+    Result := HE^.h_name;
 end;
 end;
 
 
 function GetHostIP(const Name: string): string;
 function GetHostIP(const Name: string): string;
@@ -204,12 +204,12 @@ var
   HE: PHostEnt;
   HE: PHostEnt;
   P: PDWord;
   P: PDWord;
 begin
 begin
-  Result:='';
-  HE:=nil;
-  HE:=gethostbyname(PChar(Name));
+  Result := '';
+  HE := nil;
+  HE := gethostbyname(PChar(Name));
   if Assigned(HE) then begin
   if Assigned(HE) then begin
-    P:=Pointer(HE^.h_addr_list[0]);
-    Result:=NetAddrToStr(P^);
+    P := Pointer(HE^.h_addr_list[0]);
+    Result := NetAddrToStr(P^);
   end;
   end;
 end;
 end;
 
 
@@ -219,15 +219,15 @@ const
 var
 var
   opt: DWord;
   opt: DWord;
 begin
 begin
-  opt:=BlockAr[aValue];
+  opt := BlockAr[aValue];
   if ioctlsocket(aHandle, FIONBIO, opt) = SOCKET_ERROR then
   if ioctlsocket(aHandle, FIONBIO, opt) = SOCKET_ERROR then
     Exit(False);
     Exit(False);
-  Result:=True;
+  Result := True;
 end;
 end;
 
 
 function IsBlockError(const anError: Integer): Boolean; inline;
 function IsBlockError(const anError: Integer): Boolean; inline;
 begin
 begin
-  Result:=anError = WSAEWOULDBLOCK;
+  Result := anError = WSAEWOULDBLOCK;
 end;
 end;
 
 
 {$ELSE}
 {$ELSE}
@@ -238,62 +238,62 @@ end;
 
 
 function LStrError(const Ernum: Longint; const UseUTF8: Boolean = False): string;
 function LStrError(const Ernum: Longint; const UseUTF8: Boolean = False): string;
 begin
 begin
-  Result:='[' + IntToStr(Ernum) + '] ' + Errors.StrError(Ernum);
+  Result := '[' + IntToStr(Ernum) + '] ' + Errors.StrError(Ernum);
 end;
 end;
 
 
 function LSocketError: Longint;
 function LSocketError: Longint;
 begin
 begin
-  Result:=fpgeterrno;
+  Result := fpgeterrno;
 end;
 end;
 
 
 function CleanError(const Ernum: Longint): Longint; inline;
 function CleanError(const Ernum: Longint): Longint; inline;
 begin
 begin
-  Result:=Byte(Ernum);
+  Result := Byte(Ernum);
 end;
 end;
 
 
 function GetHostName(const Address: string): string;
 function GetHostName(const Address: string): string;
 var
 var
   HE: THostEntry;
   HE: THostEntry;
 begin
 begin
-  Result:='';
+  Result := '';
   if GetHostbyAddr(in_addr(StrToHostAddr(Address)), HE) then
   if GetHostbyAddr(in_addr(StrToHostAddr(Address)), HE) then
-    Result:=HE.Name
+    Result := HE.Name
   else if ResolveHostbyAddr(in_addr(StrToHostAddr(Address)), HE) then
   else if ResolveHostbyAddr(in_addr(StrToHostAddr(Address)), HE) then
-    Result:=HE.Name;
+    Result := HE.Name;
 end;
 end;
 
 
 function GetHostIP(const Name: string): string;
 function GetHostIP(const Name: string): string;
 var
 var
   HE: THostEntry;
   HE: THostEntry;
 begin
 begin
-  Result:='';
+  Result := '';
   if GetHostByName(Name, HE) then
   if GetHostByName(Name, HE) then
-    Result:=HostAddrToStr(Cardinal(HE.Addr)) // for localhost
+    Result := HostAddrToStr(Cardinal(HE.Addr)) // for localhost
   else if ResolveHostByName(Name, HE) then
   else if ResolveHostByName(Name, HE) then
-    Result:=NetAddrToStr(Cardinal(HE.Addr));
+    Result := NetAddrToStr(Cardinal(HE.Addr));
 end;
 end;
 
 
 function SetBlocking(const aHandle: Integer; const aValue: Boolean): Boolean;
 function SetBlocking(const aHandle: Integer; const aValue: Boolean): Boolean;
 var
 var
   opt: cInt;
   opt: cInt;
 begin
 begin
-  opt:=fpfcntl(aHandle, F_GETFL);
+  opt := fpfcntl(aHandle, F_GETFL);
   if opt = SOCKET_ERROR then
   if opt = SOCKET_ERROR then
     Exit(False);
     Exit(False);
     
     
   if aValue then
   if aValue then
-    opt:=opt and not O_NONBLOCK
+    opt := opt and not O_NONBLOCK
   else
   else
-    opt:=opt or O_NONBLOCK;
+    opt := opt or O_NONBLOCK;
 
 
   if fpfcntl(aHandle, F_SETFL, opt) = SOCKET_ERROR then
   if fpfcntl(aHandle, F_SETFL, opt) = SOCKET_ERROR then
     Exit(False);
     Exit(False);
-  Result:=True;
+  Result := True;
 end;
 end;
 
 
 function IsBlockError(const anError: Integer): Boolean; inline;
 function IsBlockError(const anError: Integer): Boolean; inline;
 begin
 begin
-  Result:=(anError = ESysEWOULDBLOCK) or (anError = ESysENOBUFS);
+  Result := (anError = ESysEWOULDBLOCK) or (anError = ESysENOBUFS);
 end;
 end;
 
 
 function TZSeconds: Integer; inline;
 function TZSeconds: Integer; inline;
@@ -305,34 +305,35 @@ end;
 
 
 function StrToHostAddr(const IP: string): Cardinal; inline;
 function StrToHostAddr(const IP: string): Cardinal; inline;
 begin
 begin
-  Result:=Cardinal(Sockets.StrToHostAddr(IP));
+  Result := Cardinal(Sockets.StrToHostAddr(IP));
 end;
 end;
 
 
 function HostAddrToStr(const Entry: Cardinal): string; inline;
 function HostAddrToStr(const Entry: Cardinal): string; inline;
 begin
 begin
-  Result:=Sockets.HostAddrToStr(in_addr(Entry));
+  Result := Sockets.HostAddrToStr(in_addr(Entry));
 end;
 end;
 
 
 function StrToNetAddr(const IP: string): Cardinal; inline;
 function StrToNetAddr(const IP: string): Cardinal; inline;
 begin
 begin
-  Result:=Cardinal(Sockets.StrToNetAddr(IP));
+  Result := Cardinal(Sockets.StrToNetAddr(IP));
 end;
 end;
 
 
 function NetAddrToStr(const Entry: Cardinal): string; inline;
 function NetAddrToStr(const Entry: Cardinal): string; inline;
 begin
 begin
-  Result:=Sockets.NetAddrToStr(in_addr(Entry));
+  Result := Sockets.NetAddrToStr(in_addr(Entry));
 end;
 end;
 
 
 procedure FillAddressInfo(var aAddrInfo: TInetSockAddr; const aFamily: sa_family_t;
 procedure FillAddressInfo(var aAddrInfo: TInetSockAddr; const aFamily: sa_family_t;
   const Address: string; const aPort: Word); inline;
   const Address: string; const aPort: Word); inline;
 begin
 begin
-  aAddrInfo.family:=AF_INET;
-  aAddrInfo.Port:=htons(aPort);
-  aAddrInfo.Addr:=StrToNetAddr(Address);
+  aAddrInfo.family := AF_INET;
+  aAddrInfo.Port := htons(aPort);
+  aAddrInfo.Addr := StrToNetAddr(Address);
   
   
   if (Address <> LADDR_ANY) and (aAddrInfo.Addr = 0) then
   if (Address <> LADDR_ANY) and (aAddrInfo.Addr = 0) then
-    aAddrInfo.Addr:=StrToNetAddr(GetHostIP(Address));
+    aAddrInfo.Addr := StrToNetAddr(GetHostIP(Address));
 end;
 end;
 
 
+
 end.
 end.
 
 

+ 118 - 115
utils/fppkg/lnet/levents.pp

@@ -202,7 +202,7 @@ uses
 procedure TLHandle.SetIgnoreError(const aValue: Boolean);
 procedure TLHandle.SetIgnoreError(const aValue: Boolean);
 begin
 begin
   if FIgnoreError <> aValue then begin
   if FIgnoreError <> aValue then begin
-    FIgnoreError:=aValue;
+    FIgnoreError := aValue;
     if Assigned(FEventer) then
     if Assigned(FEventer) then
       FEventer.HandleIgnoreError(Self);
       FEventer.HandleIgnoreError(Self);
   end;
   end;
@@ -211,7 +211,7 @@ end;
 procedure TLHandle.SetIgnoreWrite(const aValue: Boolean);
 procedure TLHandle.SetIgnoreWrite(const aValue: Boolean);
 begin
 begin
   if FIgnoreWrite <> aValue then begin
   if FIgnoreWrite <> aValue then begin
-    FIgnoreWrite:=aValue;
+    FIgnoreWrite := aValue;
     if Assigned(FEventer) then
     if Assigned(FEventer) then
       FEventer.HandleIgnoreWrite(Self);
       FEventer.HandleIgnoreWrite(Self);
   end;
   end;
@@ -220,7 +220,7 @@ end;
 procedure TLHandle.SetIgnoreRead(const aValue: Boolean);
 procedure TLHandle.SetIgnoreRead(const aValue: Boolean);
 begin
 begin
   if FIgnoreRead <> aValue then begin
   if FIgnoreRead <> aValue then begin
-    FIgnoreRead:=aValue;
+    FIgnoreRead := aValue;
     if Assigned(FEventer) then
     if Assigned(FEventer) then
       FEventer.HandleIgnoreRead(Self);
       FEventer.HandleIgnoreRead(Self);
   end;
   end;
@@ -228,19 +228,19 @@ end;
 
 
 constructor TLHandle.Create;
 constructor TLHandle.Create;
 begin
 begin
-  FOnRead:=nil;
-  FOnWrite:=nil;
-  FOnError:=nil;
-  FUserData:=nil;
-  FEventer:=nil;
-  FPrev:=nil;
-  FNext:=nil;
-  FFreeNext:=nil;
-  FFreeing:=False;
-  FDispose:=False;
-  FIgnoreWrite:=False;
-  FIgnoreRead:=False;
-  FIgnoreError:=False;
+  FOnRead := nil;
+  FOnWrite := nil;
+  FOnError := nil;
+  FUserData := nil;
+  FEventer := nil;
+  FPrev := nil;
+  FNext := nil;
+  FFreeNext := nil;
+  FFreeing := False;
+  FDispose := False;
+  FIgnoreWrite := False;
+  FIgnoreRead := False;
+  FIgnoreError := False;
 end;
 end;
 
 
 destructor TLHandle.Destroy;
 destructor TLHandle.Destroy;
@@ -291,12 +291,12 @@ end;
 
 
 constructor TLEventer.Create;
 constructor TLEventer.Create;
 begin
 begin
-  FRoot:=nil;
-  FFreeRoot:=nil;
-  FFreeIter:=nil;
-  FInLoop:=False;
-  FCount:=0;
-  FReferences:=1;
+  FRoot := nil;
+  FFreeRoot := nil;
+  FFreeIter := nil;
+  FInLoop := False;
+  FCount := 0;
+  FReferences := 1;
 end;
 end;
 
 
 destructor TLEventer.Destroy;
 destructor TLEventer.Destroy;
@@ -306,7 +306,7 @@ end;
 
 
 function TLEventer.GetTimeout: DWord;
 function TLEventer.GetTimeout: DWord;
 begin
 begin
-  Result:=0;
+  Result := 0;
 end;
 end;
 
 
 procedure TLEventer.SetTimeout(const Value: DWord);
 procedure TLEventer.SetTimeout(const Value: DWord);
@@ -323,13 +323,13 @@ end;
 procedure TLEventer.AddForFree(aHandle: TLHandle);
 procedure TLEventer.AddForFree(aHandle: TLHandle);
 begin
 begin
   if not aHandle.FFreeing then begin
   if not aHandle.FFreeing then begin
-    aHandle.FFreeing:=True;
+    aHandle.FFreeing := True;
     if not Assigned(FFreeIter) then begin
     if not Assigned(FFreeIter) then begin
-      FFreeIter:=aHandle;
-      FFreeRoot:=aHandle;
+      FFreeIter := aHandle;
+      FFreeRoot := aHandle;
     end else begin
     end else begin
-      FFreeIter.FreeNext:=aHandle;
-      FFreeIter:=aHandle;
+      FFreeIter.FreeNext := aHandle;
+      FFreeIter := aHandle;
     end;
     end;
   end;
   end;
 end;
 end;
@@ -338,14 +338,14 @@ procedure TLEventer.FreeHandles;
 var
 var
   Temp, Temp2: TLHandle;
   Temp, Temp2: TLHandle;
 begin
 begin
-  Temp:=FFreeRoot;
+  Temp := FFreeRoot;
   while Assigned(Temp) do begin
   while Assigned(Temp) do begin
-    Temp2:=Temp.FreeNext;
+    Temp2 := Temp.FreeNext;
     Temp.Free;
     Temp.Free;
-    Temp:=Temp2;
+    Temp := Temp2;
   end;
   end;
-  FFreeRoot:=nil;
-  FFreeIter:=nil;
+  FFreeRoot := nil;
+  FFreeIter := nil;
 end;
 end;
 
 
 procedure TLEventer.HandleIgnoreError(aHandle: TLHandle);
 procedure TLEventer.HandleIgnoreError(aHandle: TLHandle);
@@ -365,42 +365,42 @@ end;
 
 
 function TLEventer.GetInternalData(aHandle: TLHandle): Pointer;
 function TLEventer.GetInternalData(aHandle: TLHandle): Pointer;
 begin
 begin
-  Result:=aHandle.FInternalData;
+  Result := aHandle.FInternalData;
 end;
 end;
 
 
 procedure TLEventer.SetInternalData(aHandle: TLHandle; const aData: Pointer);
 procedure TLEventer.SetInternalData(aHandle: TLHandle; const aData: Pointer);
 begin
 begin
-  aHandle.FInternalData:=aData;
+  aHandle.FInternalData := aData;
 end;
 end;
 
 
 procedure TLEventer.SetHandleEventer(aHandle: TLHandle);
 procedure TLEventer.SetHandleEventer(aHandle: TLHandle);
 begin
 begin
-  aHandle.FEventer:=Self;
+  aHandle.FEventer := Self;
 end;
 end;
 
 
 function TLEventer.AddHandle(aHandle: TLHandle): Boolean;
 function TLEventer.AddHandle(aHandle: TLHandle): Boolean;
 begin
 begin
-  Result:=False;
+  Result := False;
   if not Assigned(aHandle.FEventer) then begin
   if not Assigned(aHandle.FEventer) then begin
     if not Assigned(FRoot) then begin
     if not Assigned(FRoot) then begin
-      FRoot:=aHandle;
+      FRoot := aHandle;
     end else begin
     end else begin
       if Assigned(FRoot.FNext) then begin
       if Assigned(FRoot.FNext) then begin
-        FRoot.FNext.FPrev:=aHandle;
-        aHandle.FNext:=FRoot.FNext;
+        FRoot.FNext.FPrev := aHandle;
+        aHandle.FNext := FRoot.FNext;
       end;
       end;
-      FRoot.FNext:=aHandle;
-      aHandle.FPrev:=FRoot;
+      FRoot.FNext := aHandle;
+      aHandle.FPrev := FRoot;
     end;
     end;
-    aHandle.FEventer:=Self;
+    aHandle.FEventer := Self;
     Inc(FCount);
     Inc(FCount);
-    Result:=True;
+    Result := True;
   end;
   end;
 end;
 end;
 
 
 function TLEventer.CallAction: Boolean;
 function TLEventer.CallAction: Boolean;
 begin
 begin
-  Result:=True;
+  Result := True;
   // override in ancestor
   // override in ancestor
 end;
 end;
 
 
@@ -412,16 +412,16 @@ end;
 procedure TLEventer.UnplugHandle(aHandle: TLHandle);
 procedure TLEventer.UnplugHandle(aHandle: TLHandle);
 begin
 begin
   if aHandle.FEventer = Self then begin
   if aHandle.FEventer = Self then begin
-    aHandle.FEventer:=nil; // avoid recursive AV
+    aHandle.FEventer := nil; // avoid recursive AV
     if Assigned(aHandle.FPrev) then begin
     if Assigned(aHandle.FPrev) then begin
-      aHandle.FPrev.FNext:=aHandle.FNext;
+      aHandle.FPrev.FNext := aHandle.FNext;
       if Assigned(aHandle.FNext) then
       if Assigned(aHandle.FNext) then
-        aHandle.FNext.FPrev:=aHandle.FPrev;
+        aHandle.FNext.FPrev := aHandle.FPrev;
     end else if Assigned(aHandle.FNext) then begin
     end else if Assigned(aHandle.FNext) then begin
-      aHandle.FNext.FPrev:=aHandle.FPrev;
+      aHandle.FNext.FPrev := aHandle.FPrev;
       if aHandle = FRoot then
       if aHandle = FRoot then
-        FRoot:=aHandle.FNext;
-    end else FRoot:=nil;
+        FRoot := aHandle.FNext;
+    end else FRoot := nil;
     if FCount > 0 then
     if FCount > 0 then
       Dec(FCount);
       Dec(FCount);
   end;
   end;
@@ -430,22 +430,22 @@ end;
 procedure TLEventer.LoadFromEventer(aEventer: TLEventer);
 procedure TLEventer.LoadFromEventer(aEventer: TLEventer);
 begin
 begin
   Clear;
   Clear;
-  FRoot:=aEventer.FRoot;
-  FOnError:=aEventer.FOnError;
+  FRoot := aEventer.FRoot;
+  FOnError := aEventer.FOnError;
 end;
 end;
 
 
 procedure TLEventer.Clear;
 procedure TLEventer.Clear;
 var
 var
   Temp1, Temp2: TLHandle;
   Temp1, Temp2: TLHandle;
 begin
 begin
-  Temp1:=FRoot;
-  Temp2:=FRoot;
+  Temp1 := FRoot;
+  Temp2 := FRoot;
   while Assigned(Temp2) do begin
   while Assigned(Temp2) do begin
-    Temp1:=Temp2;
-    Temp2:=Temp1.FNext;
+    Temp1 := Temp2;
+    Temp2 := Temp1.FNext;
     Temp1.Free;
     Temp1.Free;
   end;
   end;
-  FRoot:=nil;
+  FRoot := nil;
 end;
 end;
 
 
 procedure TLEventer.AddRef;
 procedure TLEventer.AddRef;
@@ -466,19 +466,19 @@ end;
 constructor TLSelectEventer.Create;
 constructor TLSelectEventer.Create;
 begin
 begin
   inherited Create;
   inherited Create;
-  FTimeout.tv_sec:=0;
-  FTimeout.tv_usec:=0;
+  FTimeout.tv_sec := 0;
+  FTimeout.tv_usec := 0;
 end;
 end;
 
 
 function TLSelectEventer.GetTimeout: DWord;
 function TLSelectEventer.GetTimeout: DWord;
 begin
 begin
-  Result:=(FTimeout.tv_sec * 1000) + FTimeout.tv_usec;
+  Result := (FTimeout.tv_sec * 1000) + FTimeout.tv_usec;
 end;
 end;
 
 
 procedure TLSelectEventer.SetTimeout(const Value: DWord);
 procedure TLSelectEventer.SetTimeout(const Value: DWord);
 begin
 begin
-  FTimeout.tv_sec:=Value div 1000;
-  FTimeout.tv_usec:=Value mod 1000;
+  FTimeout.tv_sec := Value div 1000;
+  FTimeout.tv_usec := Value mod 1000;
 end;
 end;
 
 
 procedure TLSelectEventer.ClearSets;
 procedure TLSelectEventer.ClearSets;
@@ -494,61 +494,64 @@ var
   MaxHandle, n: Integer;
   MaxHandle, n: Integer;
   TempTime: TTimeVal;
   TempTime: TTimeVal;
 begin
 begin
-  if Assigned(FRoot) then begin
-    FInLoop:=True;
-    Temp:=FRoot;
-    MaxHandle:=0;
-    ClearSets;
-    while Assigned(Temp) do begin
-      if  (not Temp.FDispose       )  // handle still valid
-      and (   (not Temp.IgnoreWrite)  // check write or
-           or (not Temp.IgnoreRead )  // check read or
-           or (not Temp.IgnoreError)) // check for errors
-      then begin
-        if not Temp.IgnoreWrite then
-          fpFD_SET(Temp.FHandle, FWriteFDSet);
-        if not Temp.IgnoreRead then
-          fpFD_SET(Temp.FHandle, FReadFDSet);
-        if not Temp.IgnoreError then
-          fpFD_SET(Temp.FHandle, FErrorFDSet);
-        if Temp.FHandle > MaxHandle then
-          MaxHandle:=Temp.FHandle;
-      end;
-      Temp2:=Temp;
-      Temp:=Temp.FNext;
-      if Temp2.FDispose then
-        Temp2.Free;
+  if not Assigned(FRoot) then begin
+    Sleep(FTimeout.tv_sec * 1000 + FTimeout.tv_usec div 1000);
+    Exit;
+  end;
+
+  FInLoop := True;
+  Temp := FRoot;
+  MaxHandle := 0;
+  ClearSets;
+  while Assigned(Temp) do begin
+    if  (not Temp.FDispose       )  // handle still valid
+    and (   (not Temp.IgnoreWrite)  // check write or
+         or (not Temp.IgnoreRead )  // check read or
+         or (not Temp.IgnoreError)) // check for errors
+    then begin
+      if not Temp.IgnoreWrite then
+        fpFD_SET(Temp.FHandle, FWriteFDSet);
+      if not Temp.IgnoreRead then
+        fpFD_SET(Temp.FHandle, FReadFDSet);
+      if not Temp.IgnoreError then
+        fpFD_SET(Temp.FHandle, FErrorFDSet);
+      if Temp.FHandle > MaxHandle then
+        MaxHandle := Temp.FHandle;
     end;
     end;
+    Temp2 := Temp;
+    Temp := Temp.FNext;
+    if Temp2.FDispose then
+      Temp2.Free;
+  end;
 
 
-    TempTime:=FTimeout;
-    n:=fpSelect(MaxHandle + 1, @FReadFDSet, @FWriteFDSet, @FErrorFDSet, @TempTime);
-    
-    if n < 0 then
-      Bail('Error on select', LSocketError);
-    Result:=n > 0;
-    
-    if Result then begin
-      Temp:=FRoot;
-      while Assigned(Temp) do begin
-        if not Temp.FDispose and (fpFD_ISSET(Temp.FHandle, FWriteFDSet) <> 0) then
-          if Assigned(Temp.FOnWrite) and not Temp.IgnoreWrite then
-            Temp.FOnWrite(Temp);
-        if not Temp.FDispose and (fpFD_ISSET(Temp.FHandle, FReadFDSet) <> 0) then
-          if Assigned(Temp.FOnRead) and not Temp.IgnoreRead then
-            Temp.FOnRead(Temp);
-        if not Temp.FDispose and (fpFD_ISSET(Temp.FHandle, FErrorFDSet) <> 0) then
-          if Assigned(Temp.FOnError) and not Temp.IgnoreError then
-            Temp.FOnError(Temp, 'Handle error' + LStrError(LSocketError));
-        Temp2:=Temp;
-        Temp:=Temp.FNext;
-        if Temp2.FDispose then
-          AddForFree(Temp2);
-      end;
+  TempTime := FTimeout;
+  n := fpSelect(MaxHandle + 1, @FReadFDSet, @FWriteFDSet, @FErrorFDSet, @TempTime);
+  
+  if n < 0 then
+    Bail('Error on select', LSocketError);
+  Result := n > 0;
+  
+  if Result then begin
+    Temp := FRoot;
+    while Assigned(Temp) do begin
+      if not Temp.FDispose and (fpFD_ISSET(Temp.FHandle, FWriteFDSet) <> 0) then
+        if Assigned(Temp.FOnWrite) and not Temp.IgnoreWrite then
+          Temp.FOnWrite(Temp);
+      if not Temp.FDispose and (fpFD_ISSET(Temp.FHandle, FReadFDSet) <> 0) then
+        if Assigned(Temp.FOnRead) and not Temp.IgnoreRead then
+          Temp.FOnRead(Temp);
+      if not Temp.FDispose and (fpFD_ISSET(Temp.FHandle, FErrorFDSet) <> 0) then
+        if Assigned(Temp.FOnError) and not Temp.IgnoreError then
+          Temp.FOnError(Temp, 'Handle error' + LStrError(LSocketError));
+      Temp2 := Temp;
+      Temp := Temp.FNext;
+      if Temp2.FDispose then
+        AddForFree(Temp2);
     end;
     end;
-    FInLoop:=False;
-    if Assigned(FFreeRoot) then
-      FreeHandles;
   end;
   end;
+  FInLoop := False;
+  if Assigned(FFreeRoot) then
+    FreeHandles;
 end;
 end;
 
 
 {$i sys/lkqueueeventer.inc}
 {$i sys/lkqueueeventer.inc}
@@ -558,7 +561,7 @@ end;
 
 
 function BestEventerClass: TLEventerClass;
 function BestEventerClass: TLEventerClass;
 begin
 begin
-  Result:=TLSelectEventer;
+  Result := TLSelectEventer;
 end;
 end;
 
 
 {$endif}
 {$endif}

+ 39 - 30
utils/fppkg/lnet/lftp.pp

@@ -35,7 +35,7 @@ type
   TLFTP = class;
   TLFTP = class;
   TLFTPClient = class;
   TLFTPClient = class;
 
 
-  TLFTPStatus = (fsNone, fsCon, fsAuth, fsPass, fsPasv, fsPort, fsList, fsRetr,
+  TLFTPStatus = (fsNone, fsCon, fsUser, fsPass, fsPasv, fsPort, fsList, fsRetr,
                  fsStor, fsType, fsCWD, fsMKD, fsRMD, fsDEL, fsRNFR, fsRNTO,
                  fsStor, fsType, fsCWD, fsMKD, fsRMD, fsDEL, fsRNFR, fsRNTO,
                  fsSYS, fsFeat, fsPWD, fsHelp, fsLast);
                  fsSYS, fsFeat, fsPWD, fsHelp, fsLast);
                  
                  
@@ -153,6 +153,9 @@ type
 
 
     procedure PasvPort;
     procedure PasvPort;
 
 
+    function User(const aUserName: string): Boolean;
+    function Password(const aPassword: string): Boolean;
+
     procedure SendChunk(const Event: Boolean);
     procedure SendChunk(const Event: Boolean);
 
 
     procedure ExecuteFrontCommand;
     procedure ExecuteFrontCommand;
@@ -166,13 +169,11 @@ type
     function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
     function Send(const aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; override;
     function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; override;
     function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; override;
     
     
-    function Connect(const aHost: string; const aPort: Word = 21): Boolean; virtual;
-    function Connect: Boolean; virtual;
+    function Connect(const aHost: string; const aPort: Word = 21): Boolean; virtual; overload;
+    function Connect: Boolean; virtual; overload;
     
     
     function Authenticate(const aUsername, aPassword: string): Boolean;
     function Authenticate(const aUsername, aPassword: string): Boolean;
     
     
-    function SendPassword(const aPassword: string): Boolean;
-
     function GetData(var aData; const aSize: Integer): Integer;
     function GetData(var aData; const aSize: Integer): Integer;
     function GetDataMessage: string;
     function GetDataMessage: string;
     
     
@@ -594,7 +595,7 @@ begin
                      end;
                      end;
                  end;
                  end;
 
 
-        fsAuth : case x of
+        fsUser : case x of
                    230:
                    230:
                      begin
                      begin
                        FStatusFlags[FStatus.First.Status] := True;
                        FStatusFlags[FStatus.First.Status] := True;
@@ -602,7 +603,11 @@ begin
                        FStatus.Remove;
                        FStatus.Remove;
                      end;
                      end;
                    331,
                    331,
-                   332: SendPassword(FPassword);
+                   332:
+                     begin
+                       FStatus.Remove;
+                       Password(FPassword);
+                     end;
                    else
                    else
                      begin
                      begin
                        FStatusFlags[FStatus.First.Status] := False;
                        FStatusFlags[FStatus.First.Status] := False;
@@ -660,7 +665,7 @@ begin
                  end;
                  end;
 
 
         fsRetr : case x of
         fsRetr : case x of
-                   150: begin { Do nothing } end;
+                   125, 150: begin { Do nothing } end;
                    226:
                    226:
                      begin
                      begin
                        Eventize(FStatus.First.Status, True);
                        Eventize(FStatus.First.Status, True);
@@ -676,7 +681,7 @@ begin
                  end;
                  end;
 
 
         fsStor : case x of
         fsStor : case x of
-                   150: SendFile;
+                   125, 150: SendFile;
                    
                    
                    226:
                    226:
                      begin
                      begin
@@ -706,7 +711,7 @@ begin
                  end;
                  end;
                  
                  
         fsList : case x of
         fsList : case x of
-                   150: begin end;
+                   125, 150: begin { do nothing } end;
                    226:
                    226:
                      begin
                      begin
                        Eventize(FStatus.First.Status, True);
                        Eventize(FStatus.First.Status, True);
@@ -816,6 +821,26 @@ begin
   end;
   end;
 end;
 end;
 
 
+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, '', ''));
+    Result := True;
+  end;
+end;
+
+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, '', ''));
+    Result := True;
+  end;
+end;
+
 procedure TLFTPClient.SendChunk(const Event: Boolean);
 procedure TLFTPClient.SendChunk(const Event: Boolean);
 var
 var
   Buf: array[0..65535] of Byte;
   Buf: array[0..65535] of Byte;
@@ -846,8 +871,8 @@ begin
   with FCommandFront.First do
   with FCommandFront.First do
     case Status of
     case Status of
       fsNone : Exit;
       fsNone : Exit;
-      fsAuth : Authenticate(Args[1], Args[2]);
-      fsPass : SendPassword(Args[1]);
+      fsUser : User(Args[1]);
+      fsPass : Password(Args[1]);
       fsList : List(Args[1]);
       fsList : List(Args[1]);
       fsRetr : Retrieve(Args[1]);
       fsRetr : Retrieve(Args[1]);
       fsStor : Put(Args[1]);
       fsStor : Put(Args[1]);
@@ -929,26 +954,10 @@ end;
 
 
 function TLFTPClient.Authenticate(const aUsername, aPassword: string): Boolean;
 function TLFTPClient.Authenticate(const aUsername, aPassword: string): Boolean;
 begin
 begin
-  Result := not FPipeLine;
-  if CanContinue(fsAuth, aUserName, aPassword) then begin
-    FPassword := aPassword;
-    FControl.SendMessage('USER ' + aUserName + FLE + 'PASS ' + aPassword + FLE);
-    FStatus.Insert(MakeStatusRec(fsAuth, '', ''));
-    Result := True;
-  end;
-end;
-
-function TLFTPClient.SendPassword(const aPassword: string): Boolean;
-begin
-  Result := not FPipeLine;
-  if CanContinue(fsPass, aPassword, '') then begin
-    FControl.SendMessage('PASS ' + aPassword + FLE);
-    FStatus.Insert(MakeStatusRec(fsPass, '', ''));
-    Result := True;
-  end;
+  FPassword := aPassWord;
+  Result := User(aUserName);
 end;
 end;
 
 
-
 function TLFTPClient.Retrieve(const FileName: string): Boolean;
 function TLFTPClient.Retrieve(const FileName: string): Boolean;
 begin
 begin
   Result := not FPipeLine;
   Result := not FPipeLine;

+ 2 - 1
utils/fppkg/lnet/lhttp.pp

@@ -1894,6 +1894,7 @@ var
 begin
 begin
   inherited Create(AOwner);
   inherited Create(AOwner);
 
 
+  FPort := 80; // default port
   SocketClass := TLHTTPServerSocket;
   SocketClass := TLHTTPServerSocket;
   if TZSeconds >= 0 then
   if TZSeconds >= 0 then
     TZSign := '+'
     TZSign := '+'
@@ -2168,9 +2169,9 @@ end;
 
 
 constructor TLHTTPClient.Create(AOwner: TComponent);
 constructor TLHTTPClient.Create(AOwner: TComponent);
 begin
 begin
-  FPort:=80;
   inherited;
   inherited;
 
 
+  FPort := 80;
   SocketClass := TLHTTPClientSocket;
   SocketClass := TLHTTPClientSocket;
   FRequest.Method := hmGet;
   FRequest.Method := hmGet;
   FHeaderOut.ExtraHeaders := InitStringBuffer(256);
   FHeaderOut.ExtraHeaders := InitStringBuffer(256);

+ 46 - 0
utils/fppkg/lnet/lhttputil.pp

@@ -50,6 +50,9 @@ type
   function HTTPDecode(AStr: pchar): pchar;
   function HTTPDecode(AStr: pchar): pchar;
   function HTTPEncode(const AStr: string): string;
   function HTTPEncode(const AStr: string): string;
   function HexToNum(AChar: char): byte;
   function HexToNum(AChar: char): byte;
+  
+  procedure DecomposeURL(const URL: string; out Host, URI: string; out Port: Word);
+  function ComposeURL(Host, URI: string; const Port: Word): string;
 
 
 implementation
 implementation
 
 
@@ -229,4 +232,47 @@ begin
   until false;
   until false;
 end;
 end;
 
 
+procedure DecomposeURL(const URL: string; out Host, URI: string; out Port: Word);
+var
+  index: Integer;
+begin
+  index := PosEx('/', URL, 8);
+  Host := Copy(URL, 8, index-8);
+  URI := Copy(URL, index, Length(URL)+1-index);
+
+  index := Pos(':', Host);
+  if index > 0 then begin
+    Port := StrToIntDef(Copy(Host, index+1, Length(Host)-index), -1);
+
+    if (Port < 0) or (Port > 65535) then
+      Port := 80;
+
+    SetLength(Host, index-1);
+  end else
+    Port := 80;
+end;
+
+function ComposeURL(Host, URI: string; const Port: Word): string;
+begin
+  Host := Trim(Host);
+  URI := Trim(URI);
+
+  if (Pos('http://', Host) <> 1)
+  and (Pos('https://', Host) <> 1) then
+    Host := 'http://' + Host;
+
+  if URI[Length(URI)] = '/' then
+    Delete(URI, Length(URI), 1);
+
+  if  (Host[Length(Host)] = '/')
+  and (URI[1] = '/') then
+    Delete(Host, Length(Host), 1)
+  else if (URI[1] <> '/')
+  and     (Host[Length(Host)] <> '/') then
+    Host := Host + '/';
+
+  Result := Host + URI + ':' + IntToStr(Port);
+end;
+
+
 end.
 end.

+ 9 - 3
utils/fppkg/lnet/lnet.pp

@@ -266,10 +266,11 @@ type
     constructor Create(aOwner: TComponent); override;
     constructor Create(aOwner: TComponent); override;
     destructor Destroy; override;
     destructor Destroy; override;
     
     
-    function Connect(const Address: string; const APort: Word): Boolean; virtual;
-    function Connect: Boolean; virtual;
+    function Connect(const Address: string; const APort: Word): Boolean; virtual; overload;
+    function Connect: Boolean; virtual; overload;
     
     
-    function Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean; virtual; abstract;
+    function Listen(const APort: Word; const AIntf: string = LADDR_ANY): Boolean; virtual; abstract; overload;
+    function Listen: Boolean; virtual; overload;
     
     
     function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
     function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; abstract;
     function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; virtual; abstract;
     function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; virtual; abstract;
@@ -684,6 +685,11 @@ begin
   Result := Connect(FHost, FPort);
   Result := Connect(FHost, FPort);
 end;
 end;
 
 
+function TLConnection.Listen: Boolean;
+begin
+  Result := Listen(FPort, FHost);
+end;
+
 function TLConnection.InitSocket(aSocket: TLSocket): TLSocket;
 function TLConnection.InitSocket(aSocket: TLSocket): TLSocket;
 begin
 begin
   aSocket.OnRead := @ReceiveAction;
   aSocket.OnRead := @ReceiveAction;

+ 161 - 3
utils/fppkg/lnet/lsmtp.pp

@@ -29,7 +29,7 @@ unit lsmtp;
 interface
 interface
 
 
 uses
 uses
-  Classes, lNet, lEvents, lCommon;
+  Classes, Contnrs, lNet, lEvents, lCommon;
   
   
 type
 type
   TLSMTP = class;
   TLSMTP = class;
@@ -52,6 +52,61 @@ type
 
 
   TLSMTPClientStatusEvent = procedure (aSocket: TLSocket;
   TLSMTPClientStatusEvent = procedure (aSocket: TLSocket;
                                        const aStatus: TLSMTPStatus) of object;
                                        const aStatus: TLSMTPStatus) of object;
+                                       
+  { TAttachment }
+
+  TAttachment = class
+   protected
+    FData: TStringList;
+    function GetAsText: string; virtual;
+   public
+    constructor Create;
+    destructor Destroy; override;
+    function LoadFromFile(const aFileName: string): Boolean;
+   public
+    property AsText: string read GetAsText;
+  end;
+  
+  { TAttachmentList }
+
+  TAttachmentList = class
+   protected
+    FItems: TFPObjectList;
+    function GetCount: Integer;
+    function GetItem(i: Integer): TAttachment;
+    procedure SetItem(i: Integer; const AValue: TAttachment);
+   public
+    constructor Create;
+    destructor Destroy; override;
+    function Add(anAttachment: TAttachment): Integer;
+    function AddFromFile(const aFileName: string): Integer;
+    function Remove(anAttachment: TAttachment): Integer;
+    procedure Delete(const i: Integer);
+    procedure Clear;
+   public
+    property Count: Integer read GetCount;
+    property Items[i: Integer]: TAttachment read GetItem write SetItem; default;
+  end;
+
+  { TMail }
+
+  TMail = class
+   protected
+    FMailText: string;
+    FRecipients: string;
+    FSender: string;
+    FSubject: string;
+    FAttachments: TAttachmentList;
+   public
+    constructor Create;
+    destructor Destroy; override;
+   public
+    property Attachments: TAttachmentList read FAttachments;
+    property MailText: string read FMailText write FMailText;
+    property Sender: string read FSender write FSender;
+    property Recipients: string read FRecipients write FRecipients;
+    property Subject: string read FSubject write FSubject;
+  end;
 
 
   TLSMTP = class(TLComponent)
   TLSMTP = class(TLComponent)
    protected
    protected
@@ -114,13 +169,15 @@ type
     constructor Create(aOwner: TComponent); override;
     constructor Create(aOwner: TComponent); override;
     destructor Destroy; override;
     destructor Destroy; override;
     
     
-    function Connect(const aHost: string; const aPort: Word = 25): Boolean; virtual;
-    function Connect: Boolean; virtual;
+    function Connect(const aHost: string; const aPort: Word = 25): Boolean; virtual; overload;
+    function Connect: Boolean; virtual; overload;
     
     
     function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual;
     function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual;
     function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; virtual;
     function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; virtual;
 
 
     procedure SendMail(const From, Recipients, Subject, Msg: string);
     procedure SendMail(const From, Recipients, Subject, Msg: string);
+    procedure SendMail(aMail: TMail);
+    
     procedure Helo(aHost: string = '');
     procedure Helo(aHost: string = '');
     procedure Ehlo(aHost: string = '');
     procedure Ehlo(aHost: string = '');
     procedure Mail(const From: string);
     procedure Mail(const From: string);
@@ -452,6 +509,12 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure TLSMTPClient.SendMail(aMail: TMail);
+begin
+  // TODO: incorporate attachments + encoding
+  SendMail(aMail.Sender, aMail.Recipients, aMail.Subject, aMail.MailText);
+end;
+
 procedure TLSMTPClient.Helo(aHost: string = '');
 procedure TLSMTPClient.Helo(aHost: string = '');
 begin
 begin
   if Length(Host) = 0 then
   if Length(Host) = 0 then
@@ -526,5 +589,100 @@ begin
   FConnection.CallAction;
   FConnection.CallAction;
 end;
 end;
 
 
+{ TMail }
+
+constructor TMail.Create;
+begin
+
+end;
+
+destructor TMail.Destroy;
+begin
+
+end;
+
+{ TAttachment }
+
+function TAttachment.GetAsText: string;
+begin
+  Result := '';
+  raise Exception.Create('Not yet implemented');
+end;
+
+constructor TAttachment.Create;
+begin
+  FData := TStringList.Create;
+end;
+
+destructor TAttachment.Destroy;
+begin
+  FData.Free;
+  inherited Destroy;
+end;
+
+function TAttachment.LoadFromFile(const aFileName: string): Boolean;
+begin
+  Result := False;
+  raise Exception.Create('Not yet implemented');
+end;
+
+{ TAttachmentList }
+
+function TAttachmentList.GetCount: Integer;
+begin
+  Result := FItems.Count;
+end;
+
+function TAttachmentList.GetItem(i: Integer): TAttachment;
+begin
+  Result := TAttachment(FItems[i]);
+end;
+
+procedure TAttachmentList.SetItem(i: Integer; const AValue: TAttachment);
+begin
+  FItems[i] := aValue;
+end;
+
+constructor TAttachmentList.Create;
+begin
+  FItems := TFPObjectList.Create(True);
+end;
+
+destructor TAttachmentList.Destroy;
+begin
+  FItems.Free;
+  inherited Destroy;
+end;
+
+function TAttachmentList.Add(anAttachment: TAttachment): Integer;
+begin
+  Result := FItems.Add(anAttachment);
+end;
+
+function TAttachmentList.AddFromFile(const aFileName: string): Integer;
+var
+  Tmp: TAttachment;
+begin
+  Tmp := TAttachment.Create;
+  
+  if Tmp.LoadFromFile(aFileName) then
+    Result := FItems.Add(Tmp);
+end;
+
+function TAttachmentList.Remove(anAttachment: TAttachment): Integer;
+begin
+  Result := FItems.Remove(anAttachment);
+end;
+
+procedure TAttachmentList.Delete(const i: Integer);
+begin
+  FItems.Delete(i);
+end;
+
+procedure TAttachmentList.Clear;
+begin
+  FItems.Clear;
+end;
+
 end.
 end.
 
 

+ 1 - 1
utils/fppkg/lnet/lwebserver.pp

@@ -29,7 +29,7 @@ unit lwebserver;
 interface
 interface
 
 
 uses
 uses
-  sysutils, classes, lnet, lhttp, lhttputil, lmimetypes, levents, 
+  sysutils, classes, lhttp, lhttputil, lmimetypes, levents,
   lprocess, process, lfastcgi, fastcgi;
   lprocess, process, lfastcgi, fastcgi;
 
 
 type
 type

+ 41 - 41
utils/fppkg/lnet/sys/lepolleventer.inc

@@ -25,19 +25,19 @@ var
   lEvent: TEpollEvent;
   lEvent: TEpollEvent;
 begin
 begin
   inherited Create;
   inherited Create;
-  FFreeList:=TFPObjectList.Create;
+  FFreeList := TFPObjectList.Create;
   Inflate;
   Inflate;
-  FTimeout:=0;
-  FEpollFD:=epoll_create(BASE_SIZE);
-  FEpollReadFD:=epoll_create(BASE_SIZE);
-  FEpollMasterFD:=epoll_create(2);
+  FTimeout := 0;
+  FEpollFD := epoll_create(BASE_SIZE);
+  FEpollReadFD := epoll_create(BASE_SIZE);
+  FEpollMasterFD := epoll_create(2);
   if (FEPollFD < 0) or (FEpollReadFD < 0) or (FEpollMasterFD < 0) then
   if (FEPollFD < 0) or (FEpollReadFD < 0) or (FEpollMasterFD < 0) then
     raise Exception.Create('Unable to create epoll');
     raise Exception.Create('Unable to create epoll');
-  lEvent.events:=EPOLLIN or EPOLLOUT or EPOLLPRI or EPOLLERR or EPOLLHUP or EPOLLET;
-  lEvent.data.fd:=FEpollFD;
+  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
   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');
-  lEvent.data.fd:=FEpollReadFD;
+  lEvent.data.fd := FEpollReadFD;
   if epoll_ctl(FEpollMasterFD, EPOLL_CTL_ADD, FEpollReadFD, @lEvent) < 0 then
   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');
 end;
 end;
@@ -51,20 +51,20 @@ end;
 
 
 function TLEpollEventer.GetTimeout: DWord;
 function TLEpollEventer.GetTimeout: DWord;
 begin
 begin
-  Result:=DWord(FTimeout);
+  Result := DWord(FTimeout);
 end;
 end;
 
 
 procedure TLEpollEventer.SetTimeout(const Value: DWord);
 procedure TLEpollEventer.SetTimeout(const Value: DWord);
 begin
 begin
-  FTimeout:=cInt(Value);
+  FTimeout := cInt(Value);
 end;
 end;
 
 
 procedure TLEpollEventer.HandleIgnoreRead(aHandle: TLHandle);
 procedure TLEpollEventer.HandleIgnoreRead(aHandle: TLHandle);
 var
 var
   lEvent: TEpollEvent;
   lEvent: TEpollEvent;
 begin
 begin
-  lEvent.data.ptr:=aHandle;
-  lEvent.events:=EPOLLIN or EPOLLPRI or EPOLLHUP;
+  lEvent.data.ptr := aHandle;
+  lEvent.events := EPOLLIN or EPOLLPRI or EPOLLHUP;
   if not aHandle.IgnoreRead then begin
   if not aHandle.IgnoreRead then begin
     if epoll_ctl(FEpollReadFD, EPOLL_CTL_ADD, aHandle.Handle, @lEvent) < 0 then
     if epoll_ctl(FEpollReadFD, EPOLL_CTL_ADD, aHandle.Handle, @lEvent) < 0 then
       Bail('Error modifying handle for reads', LSocketError);
       Bail('Error modifying handle for reads', LSocketError);
@@ -78,7 +78,7 @@ procedure TLEpollEventer.Inflate;
 var
 var
   OldLength: Integer;
   OldLength: Integer;
 begin
 begin
-  OldLength:=Length(FEvents);
+  OldLength := Length(FEvents);
   if OldLength > 1 then
   if OldLength > 1 then
     SetLength(FEvents, Sqr(OldLength))
     SetLength(FEvents, Sqr(OldLength))
   else
   else
@@ -91,14 +91,14 @@ function TLEpollEventer.AddHandle(aHandle: TLHandle): Boolean;
 var
 var
   lEvent: TEpollEvent;
   lEvent: TEpollEvent;
 begin
 begin
-  Result:=inherited AddHandle(aHandle);
+  Result := inherited AddHandle(aHandle);
   if Result then begin
   if Result then begin
-    Result:=False;
-    lEvent.events:=EPOLLET or EPOLLOUT or EPOLLERR;
-    lEvent.data.ptr:=aHandle;
+    Result := False;
+    lEvent.events := EPOLLET or EPOLLOUT or EPOLLERR;
+    lEvent.data.ptr := aHandle;
     if epoll_ctl(FEpollFD, EPOLL_CTL_ADD, aHandle.FHandle, @lEvent) < 0 then
     if epoll_ctl(FEpollFD, EPOLL_CTL_ADD, aHandle.FHandle, @lEvent) < 0 then
       Bail('Error adding handle to epoll', LSocketError);
       Bail('Error adding handle to epoll', LSocketError);
-    lEvent.events:=EPOLLIN or EPOLLPRI or EPOLLHUP;
+    lEvent.events := EPOLLIN or EPOLLPRI or EPOLLHUP;
     if not aHandle.IgnoreRead then begin
     if not aHandle.IgnoreRead then begin
       if epoll_ctl(FEpollReadFD, EPOLL_CTL_ADD, aHandle.FHandle, @lEvent) < 0 then
       if epoll_ctl(FEpollReadFD, EPOLL_CTL_ADD, aHandle.FHandle, @lEvent) < 0 then
         Bail('Error adding handle to epoll', LSocketError);
         Bail('Error adding handle to epoll', LSocketError);
@@ -111,9 +111,9 @@ end;
 function Max(const a, b: Integer): Integer; inline;
 function Max(const a, b: Integer): Integer; inline;
 begin
 begin
   if a > b then
   if a > b then
-    Result:=a
+    Result := a
   else
   else
-    Result:=b;
+    Result := b;
 end;
 end;
 
 
 function TLEpollEventer.CallAction: Boolean;
 function TLEpollEventer.CallAction: Boolean;
@@ -122,29 +122,29 @@ var
   Temp, TempRead: TLHandle;
   Temp, TempRead: TLHandle;
   MasterEvents: array[0..1] of TEpollEvent;
   MasterEvents: array[0..1] of TEpollEvent;
 begin
 begin
-  Result:=False;
-  Changes:=0;
-  ReadChanges:=0;
+  Result := False;
+  Changes := 0;
+  ReadChanges := 0;
 
 
-  MasterChanges:=epoll_wait(FEpollMasterFD, @MasterEvents[0], 2, FTimeout);
+  MasterChanges := epoll_wait(FEpollMasterFD, @MasterEvents[0], 2, FTimeout);
 
 
   if MasterChanges > 0 then begin
   if MasterChanges > 0 then begin
-    for i:=0 to MasterChanges-1 do
+    for i := 0 to MasterChanges-1 do
       if MasterEvents[i].Data.fd = FEpollFD then
       if MasterEvents[i].Data.fd = FEpollFD then
-        Changes:=epoll_wait(FEpollFD, @FEvents[0], FCount, 0)
+        Changes := epoll_wait(FEpollFD, @FEvents[0], FCount, 0)
       else
       else
-        ReadChanges:=epoll_wait(FEpollReadFD, @FEventsRead[0], FCount, 0);
+        ReadChanges := epoll_wait(FEpollReadFD, @FEventsRead[0], FCount, 0);
     if (Changes < 0) or (ReadChanges < 0) then
     if (Changes < 0) or (ReadChanges < 0) then
       Bail('Error on epoll: ', LSocketError)
       Bail('Error on epoll: ', LSocketError)
     else
     else
-      Result:=Changes + ReadChanges > 0;
+      Result := Changes + ReadChanges > 0;
       
       
     if Result then begin
     if Result then begin
-      FInLoop:=True;
-      for i:=0 to Max(Changes, ReadChanges)-1 do begin
-        Temp:=nil;
+      FInLoop := True;
+      for i := 0 to Max(Changes, ReadChanges)-1 do begin
+        Temp := nil;
         if i < Changes then begin
         if i < Changes then begin
-          Temp:=TLHandle(FEvents[i].data.ptr);
+          Temp := TLHandle(FEvents[i].data.ptr);
 
 
           if  (not Temp.FDispose)
           if  (not Temp.FDispose)
           and (FEvents[i].events and EPOLLOUT = EPOLLOUT) then
           and (FEvents[i].events and EPOLLOUT = EPOLLOUT) then
@@ -156,7 +156,7 @@ begin
         end; // writes
         end; // writes
 
 
         if i < ReadChanges then begin
         if i < ReadChanges then begin
-          TempRead:=TLHandle(FEventsRead[i].data.ptr);
+          TempRead := TLHandle(FEventsRead[i].data.ptr);
 
 
           if  (not TempRead.FDispose)
           if  (not TempRead.FDispose)
           and ((FEventsRead[i].events and EPOLLIN = EPOLLIN)
           and ((FEventsRead[i].events and EPOLLIN = EPOLLIN)
@@ -171,7 +171,7 @@ begin
         
         
         if i < Changes then begin
         if i < Changes then begin
           if not Assigned(Temp) then
           if not Assigned(Temp) then
-            Temp:=TLHandle(FEvents[i].data.ptr);
+            Temp := TLHandle(FEvents[i].data.ptr);
 
 
           if  (not Temp.FDispose)
           if  (not Temp.FDispose)
           and (FEvents[i].events and EPOLLERR = EPOLLERR) then
           and (FEvents[i].events and EPOLLERR = EPOLLERR) then
@@ -182,7 +182,7 @@ begin
             AddForFree(Temp);
             AddForFree(Temp);
         end; // errors
         end; // errors
       end;
       end;
-      FInLoop:=False;
+      FInLoop := False;
       if Assigned(FFreeRoot) then
       if Assigned(FFreeRoot) then
         FreeHandles;
         FreeHandles;
     end;
     end;
@@ -198,14 +198,14 @@ function BestEventerClass: TLEventerClass;
   var
   var
     i: Integer;
     i: Integer;
   begin
   begin
-    s:=StringReplace(s, '.', '', [rfReplaceAll]);
-    i:=1;
+    s := StringReplace(s, '.', '', [rfReplaceAll]);
+    i := 1;
     while (i <= Length(s)) and (s[i] in Numbers) do
     while (i <= Length(s)) and (s[i] in Numbers) do
       Inc(i);
       Inc(i);
-    s:=Copy(s, 1, i - 1);
+    s := Copy(s, 1, i - 1);
     if Length(s) < 4 then // varies OS to OS
     if Length(s) < 4 then // varies OS to OS
       Insert('0', s, 3); // in linux, last part can be > 10
       Insert('0', s, 3); // in linux, last part can be > 10
-    Result:=StrToInt(s);
+    Result := StrToInt(s);
   end;
   end;
 
 
 {$ifndef DISABLE_EPOLL}
 {$ifndef DISABLE_EPOLL}
@@ -213,11 +213,11 @@ var
   u: TUTSName;
   u: TUTSName;
 {$endif}
 {$endif}
 begin
 begin
-  Result:=TLSelectEventer;
+  Result := TLSelectEventer;
 {$ifndef DISABLE_EPOLL}
 {$ifndef DISABLE_EPOLL}
   if fpUname(u) = 0 then   // check for 2.6+
   if fpUname(u) = 0 then   // check for 2.6+
     if GetVersion(u.release) >= 2600 then
     if GetVersion(u.release) >= 2600 then
-      Result:=TLEpollEventer;
+      Result := TLEpollEventer;
 {$endif}
 {$endif}
 end;
 end;
 
 

+ 17 - 17
utils/fppkg/lnet/sys/lkqueueeventer.inc

@@ -8,10 +8,10 @@ constructor TLKQueueEventer.Create;
 begin
 begin
   inherited Create;
   inherited Create;
   Inflate;
   Inflate;
-  FFreeSlot:=0;
-  FTimeout.tv_sec:=0;
-  FTimeout.tv_nsec:=0;
-  FQueue:=KQueue;
+  FFreeSlot := 0;
+  FTimeout.tv_sec := 0;
+  FTimeout.tv_nsec := 0;
+  FQueue := KQueue;
   if FQueue < 0 then
   if FQueue < 0 then
     raise Exception.Create('Unable to create kqueue');
     raise Exception.Create('Unable to create kqueue');
 end;
 end;
@@ -24,13 +24,13 @@ end;
 
 
 function TLKQueueEventer.GetTimeout: DWord;
 function TLKQueueEventer.GetTimeout: DWord;
 begin
 begin
-  Result:=FTimeout.tv_sec + FTimeout.tv_nsec * 1000 * 1000;
+  Result := FTimeout.tv_sec + FTimeout.tv_nsec * 1000 * 1000;
 end;
 end;
 
 
 procedure TLKQueueEventer.SetTimeout(const Value: DWord);
 procedure TLKQueueEventer.SetTimeout(const Value: DWord);
 begin
 begin
-  FTimeout.tv_sec:=Value div 1000;
-  FTimeout.tv_nsec:=(Value mod 1000) * 1000;
+  FTimeout.tv_sec := Value div 1000;
+  FTimeout.tv_nsec := (Value mod 1000) * 1000;
 end;
 end;
 
 
 procedure TLKQueueEventer.HandleIgnoreRead(aHandle: TLHandle);
 procedure TLKQueueEventer.HandleIgnoreRead(aHandle: TLHandle);
@@ -51,7 +51,7 @@ const
 var
 var
   OldLength: Integer;
   OldLength: Integer;
 begin
 begin
-  OldLength:=Length(FChanges);
+  OldLength := Length(FChanges);
   if OldLength > 1 then begin
   if OldLength > 1 then begin
     SetLength(FChanges, Sqr(OldLength));
     SetLength(FChanges, Sqr(OldLength));
     SetLength(FEvents, Sqr(OldLength));
     SetLength(FEvents, Sqr(OldLength));
@@ -63,7 +63,7 @@ end;
 
 
 function TLKQueueEventer.AddHandle(aHandle: TLHandle): Boolean;
 function TLKQueueEventer.AddHandle(aHandle: TLHandle): Boolean;
 begin
 begin
-  Result:=inherited AddHandle(aHandle);
+  Result := inherited AddHandle(aHandle);
 
 
   if FFreeSlot > Length(FChanges) then
   if FFreeSlot > Length(FChanges) then
     Inflate;
     Inflate;
@@ -85,16 +85,16 @@ var
   i, n: Integer;
   i, n: Integer;
   Temp: TLHandle;
   Temp: TLHandle;
 begin
 begin
-  n:=KEvent(FQueue, @FChanges[0], FFreeSlot,
+  n := KEvent(FQueue, @FChanges[0], FFreeSlot,
             @FEvents[0], Length(FEvents), @FTimeout);
             @FEvents[0], Length(FEvents), @FTimeout);
-  FFreeSlot:=0;
+  FFreeSlot := 0;
   if n < 0 then
   if n < 0 then
     Bail('Error on kqueue: ', LSocketError);
     Bail('Error on kqueue: ', LSocketError);
-  Result:=n > 0;
+  Result := n > 0;
   if Result then begin
   if Result then begin
-    FInLoop:=True;
-    for i:=0 to n-1 do begin
-      Temp:=TLHandle(FEvents[i].uData);
+    FInLoop := True;
+    for i := 0 to n-1 do begin
+      Temp := TLHandle(FEvents[i].uData);
       
       
       if  (not Temp.FDispose)
       if  (not Temp.FDispose)
       and (FEvents[i].Filter = EVFILT_WRITE) then
       and (FEvents[i].Filter = EVFILT_WRITE) then
@@ -114,7 +114,7 @@ begin
       if Temp.FDispose then
       if Temp.FDispose then
         AddForFree(Temp);
         AddForFree(Temp);
     end;
     end;
-    FInLoop:=False;
+    FInLoop := False;
     if Assigned(FFreeRoot) then
     if Assigned(FFreeRoot) then
       FreeHandles;
       FreeHandles;
   end;
   end;
@@ -122,7 +122,7 @@ end;
 
 
 function BestEventerClass: TLEventerClass;
 function BestEventerClass: TLEventerClass;
 begin
 begin
-  Result:=TLKQueueEventer;
+  Result := TLKQueueEventer;
 end;
 end;
 
 
 {$endif} // BSD
 {$endif} // BSD