Przeglądaj źródła

* microhttp server

Michael VAN CANNEYT 2 lat temu
rodzic
commit
b94b078683

+ 81 - 20
packages/fcl-web/src/base/custmicrohttpapp.pp

@@ -105,6 +105,7 @@ Type
   TMicroHTTPHandler = class(TWebHandler)
   TMicroHTTPHandler = class(TWebHandler)
   Private
   Private
     FAcceptHandler: TAcceptHandler;
     FAcceptHandler: TAcceptHandler;
+    FAddress: String;
     FExtraHeaders: TStrings;
     FExtraHeaders: TStrings;
     FOnRequestError: TRequestErrorHandler;
     FOnRequestError: TRequestErrorHandler;
     FPort : Word;
     FPort : Word;
@@ -144,17 +145,21 @@ Type
     Property OnRequestError : TRequestErrorHandler Read FOnRequestError Write FOnRequestError;
     Property OnRequestError : TRequestErrorHandler Read FOnRequestError Write FOnRequestError;
     // Extra non-standard headers which can be accepted as part of requests
     // Extra non-standard headers which can be accepted as part of requests
     Property ExtraHeaders : TStrings Read FExtraHeaders Write SetExtraHeaders;
     Property ExtraHeaders : TStrings Read FExtraHeaders Write SetExtraHeaders;
+    // Interface Address to listen on
+    Property Address : String Read FAddress Write FAddress;
   end;
   end;
 
 
   { TCustomMicroHTTPApplication }
   { TCustomMicroHTTPApplication }
 
 
   TCustomMicroHTTPApplication = Class(TCustomWebApplication)
   TCustomMicroHTTPApplication = Class(TCustomWebApplication)
   private
   private
+    function GetAddress: String;
     function GetExtraHeaders: TStrings;
     function GetExtraHeaders: TStrings;
     function GetHostName: String;
     function GetHostName: String;
     function GetOptions: TMicroServerOptions;
     function GetOptions: TMicroServerOptions;
     function GetPort: Word;
     function GetPort: Word;
     function GetUseSSL: Boolean;
     function GetUseSSL: Boolean;
+    procedure SetAddress(AValue: String);
     procedure SetExtraHeaders(AValue: TStrings);
     procedure SetExtraHeaders(AValue: TStrings);
     procedure SetHostName(const AValue: String);
     procedure SetHostName(const AValue: String);
     procedure SetOptions(AValue: TMicroServerOptions);
     procedure SetOptions(AValue: TMicroServerOptions);
@@ -175,6 +180,8 @@ Type
     Property UseSSL : Boolean Read GetUseSSL Write SetUSeSSL;
     Property UseSSL : Boolean Read GetUseSSL Write SetUSeSSL;
     // Extra non-standard headers which can be accepted as part of requests
     // Extra non-standard headers which can be accepted as part of requests
     Property ExtraHeaders : TStrings Read GetExtraHeaders Write SetExtraHeaders;
     Property ExtraHeaders : TStrings Read GetExtraHeaders Write SetExtraHeaders;
+    // Interface Address to listen on
+    Property Address : String Read GetAddress Write SetAddress;
   end;
   end;
 
 
 
 
@@ -193,7 +200,7 @@ Const
   MHD_USE_DEBUG,
   MHD_USE_DEBUG,
   MHD_USE_SSL,
   MHD_USE_SSL,
   MHD_USE_THREAD_PER_CONNECTION,
   MHD_USE_THREAD_PER_CONNECTION,
-  MHD_USE_SELECT_INTERNALLY,
+  MHD_USE_INTERNAL_POLLING_THREAD,
   MHD_USE_IPv6,
   MHD_USE_IPv6,
   MHD_USE_PEDANTIC_CHECKS,
   MHD_USE_PEDANTIC_CHECKS,
   MHD_USE_POLL,
   MHD_USE_POLL,
@@ -210,9 +217,18 @@ Const
   libmicrohttp Callbacks
   libmicrohttp Callbacks
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
-Function MaybeS(p : pchar) : String;
+Function MaybeS(p : PAnsiChar) : String;
+
+Var
+  S : AnsiString;
+
 begin
 begin
-  if Assigned(P) then Result:=P else Result:='';
+  if Assigned(P) then S:=P else S:='';
+  {$IF SIZEOF(CHAR)=2}
+  Result:=UTF8Decode(S);
+  {$ELSE}
+  Result:=S;
+  {$ENDIF}
 end;
 end;
 
 
 function GetRequestData(cls: Pointer; kind: MHD_ValueKind; key: Pcchar; value: Pcchar): cint; cdecl;
 function GetRequestData(cls: Pointer; kind: MHD_ValueKind; key: Pcchar; value: Pcchar): cint; cdecl;
@@ -221,6 +237,7 @@ var
   K,V : String;
   K,V : String;
 
 
 
 
+
 begin
 begin
   K:=MaybeS(key);
   K:=MaybeS(key);
   V:=MaybeS(Value);
   V:=MaybeS(Value);
@@ -340,15 +357,23 @@ end;
 function TMicroRequest.AddData(Data: PAnsiChar; DataSize: Size_t): Size_t;
 function TMicroRequest.AddData(Data: PAnsiChar; DataSize: Size_t): Size_t;
 
 
 Var
 Var
-  C : String;
+  C : RawByteString;
   L : Integer;
   L : Integer;
 
 
 begin
 begin
+  {$IF SIZEOF(CHAR)=2}
+  C:=UTF8Encode(Content);
+  {$ELSE}
   C:=Content;
   C:=Content;
+  {$ENDIF}
   L:=Length(C);
   L:=Length(C);
   SetLength(C,L+Datasize);
   SetLength(C,L+Datasize);
   Move(Data^,C[L+1],DataSize);
   Move(Data^,C[L+1],DataSize);
+  {$IF SIZEOF(CHAR)=2}
+  InitContent(UTF8Decode(C));
+  {$ELSE}
   InitContent(C);
   InitContent(C);
+  {$ENDIF}
   Result:=Datasize;
   Result:=Datasize;
 end;
 end;
 
 
@@ -364,18 +389,33 @@ end;
 procedure TMicroRequest.InitRequestVars;
 procedure TMicroRequest.InitRequestVars;
 
 
 Var
 Var
-  P : Pchar;
-  N,S  : String;
+  P : PAnsiChar;
+  N  : AnsiString;
+  HN,S,V : String;
   I : integer;
   I : integer;
 
 
 begin
 begin
   MHD_get_connection_values(FHandler.FConnection, MHD_GET_ARGUMENT_KIND,@GetRequestData,Self);
   MHD_get_connection_values(FHandler.FConnection, MHD_GET_ARGUMENT_KIND,@GetRequestData,Self);
   MHD_get_connection_values(FHandler.FConnection, MHD_HEADER_KIND,@GetRequestData,Self);
   MHD_get_connection_values(FHandler.FConnection, MHD_HEADER_KIND,@GetRequestData,Self);
-  for N in FHandler.WebHandler.ExtraHeaders do
+  for S in FHandler.WebHandler.ExtraHeaders do
     begin
     begin
-    P:=MHD_lookup_connection_value(FHandler.FConnection, MHD_HEADER_KIND,Pchar(N));
+    {$IF SIZEOF(Char)=2}
+    N:=UTF8Encode(S);
+    {$ELSE}
+    N:=S;
+    {$ENDIF}
+    P:=MHD_lookup_connection_value(FHandler.FConnection, MHD_HEADER_KIND,PAnsiChar(N));
     If P<>Nil then
     If P<>Nil then
-      SetCustomHeader(N,P);
+      begin
+      {$IF SIZEOF(Char)=2}
+      HN:=UTF8Decode(N);
+      V:=UTF8Decode(P);
+      {$ELSE}
+      HN:=N;
+      V:=P;
+      {$ENDIF}
+      SetCustomHeader(HN,V);
+      end;
     end;
     end;
   S:=URL;
   S:=URL;
   I:=Pos('?',S);
   I:=Pos('?',S);
@@ -400,7 +440,7 @@ procedure TMicroResponse.MaybeAllocateResponse;
 
 
 Var
 Var
   L : Integer;
   L : Integer;
-  P : PChar;
+  P : PAnsiChar;
   B : TBytes;
   B : TBytes;
 
 
 begin
 begin
@@ -416,14 +456,15 @@ begin
       begin
       begin
       SetLength(B,L);
       SetLength(B,L);
       ContentStream.ReadBuffer(B[0],L);
       ContentStream.ReadBuffer(B[0],L);
-      P:=Pchar(B);
+      P:=PAnsiChar(B);
       FResponse:=MHD_create_response_from_buffer(L,P,MHD_RESPMEM_MUST_COPY);
       FResponse:=MHD_create_response_from_buffer(L,P,MHD_RESPMEM_MUST_COPY);
       end;
       end;
     end
     end
   else
   else
     begin
     begin
-    L:=Length(Content);
-    P:=PChar(Content);
+    B:=TEncoding.UTF8.GetAnsiBytes(Content);
+    L:=Length(B);
+    P:=PAnsiChar(B);
     FResponse:=MHD_create_response_from_buffer(L,P,MHD_RESPMEM_MUST_COPY);
     FResponse:=MHD_create_response_from_buffer(L,P,MHD_RESPMEM_MUST_COPY);
     end;
     end;
 end;
 end;
@@ -433,6 +474,8 @@ procedure TMicroResponse.DoSendHeaders(Headers: TStrings);
 Var
 Var
   I : Integer;
   I : Integer;
   N,V : String;
   N,V : String;
+  NA : RawByteString {$IF SIZEOF(CHAR)=1}absolute N{$ENDIF};
+  VA : RawByteString {$IF SIZEOF(CHAR)=1}absolute V{$ENDIF};
 
 
 begin
 begin
   // Note that if the response is allocated, then you cannot set the content stream any more...
   // Note that if the response is allocated, then you cannot set the content stream any more...
@@ -441,7 +484,11 @@ begin
   For I:=0 to Headers.Count-1 do
   For I:=0 to Headers.Count-1 do
     begin
     begin
     Headers.GetNameValue(I,N,V);
     Headers.GetNameValue(I,N,V);
-    MHD_add_response_header(FResponse,PAnsiChar(N),PAnsiChar(V));
+    {$IF SIZEOF(CHAR)=2}
+    NA:=UTF8Encode(N);
+    VA:=UTF8Encode(V);
+    {$ENDIF}
+    MHD_add_response_header(FResponse,PAnsiChar(NA),PAnsiChar(VA));
     end;
     end;
 end;
 end;
 
 
@@ -536,7 +583,9 @@ begin
   end;
   end;
 end;
 end;
 
 
-function TMicroHTTPHandler.DoRequest(connection: PMHD_Connection; Const aUrl,aMethod,aVersion: String; Data: PAnsiChar; var DataSize: Size_t) : TRequestHandler;
+function TMicroHTTPHandler.DoRequest(connection: PMHD_Connection; const aUrl,
+  aMethod, aVersion: String; Data: PAnsiChar; var DataSize: Size_t
+  ): TRequestHandler;
 
 
 begin
 begin
   Result:=TRequestHandler.Create(Self,Connection);
   Result:=TRequestHandler.Create(Self,Connection);
@@ -609,7 +658,8 @@ begin
   AResponse:=Nil;
   AResponse:=Nil;
 end;
 end;
 
 
-Function TMicroHTTPHandler.DoAcceptConnection(Addr : PSockAddr; addrLen : socklen_t) : Boolean;
+function TMicroHTTPHandler.DoAcceptConnection(Addr: PSockAddr;
+  addrLen: socklen_t): Boolean;
 
 
 begin
 begin
   Result:=True;
   Result:=True;
@@ -634,7 +684,8 @@ end;
 function TMicroHTTPHandler.CreateServer: PMHD_Daemon;
 function TMicroHTTPHandler.CreateServer: PMHD_Daemon;
 
 
 Var
 Var
-  F,P : Integer;
+  F : Integer;
+  P : Word;
 
 
 begin
 begin
   F:=OptionsToFlags;
   F:=OptionsToFlags;
@@ -642,8 +693,8 @@ begin
   Result:= MHD_start_daemon(F,P,
   Result:= MHD_start_daemon(F,P,
     @AcceptCallBack, Self,
     @AcceptCallBack, Self,
     @DoMHDRequest, Self,
     @DoMHDRequest, Self,
-    MHD_OPTION_NOTIFY_COMPLETED, @HandleRequestCompleted,
-    Nil,MHD_OPTION_END);
+    MHD_OPTION_NOTIFY_COMPLETED, @HandleRequestCompleted, Nil,
+    MHD_OPTION_END,Nil);
 end;
 end;
 
 
 procedure TMicroHTTPHandler.Run;
 procedure TMicroHTTPHandler.Run;
@@ -702,7 +753,7 @@ begin
   HTTPHandler.Port:=aValue;
   HTTPHandler.Port:=aValue;
 end;
 end;
 
 
-procedure TCustomMicroHTTPApplication.SetUSeSSL(AValue: Boolean);
+procedure TCustomMicroHTTPApplication.SetUseSSL(AValue: Boolean);
 begin
 begin
   if AValue then
   if AValue then
     Options:=Options+[mcoSSL]
     Options:=Options+[mcoSSL]
@@ -720,6 +771,11 @@ begin
   Result:=mcoSSL in Options;
   Result:=mcoSSL in Options;
 end;
 end;
 
 
+procedure TCustomMicroHTTPApplication.SetAddress(AValue: String);
+begin
+  HTTPHandler.Address:=aValue;
+end;
+
 procedure TCustomMicroHTTPApplication.SetExtraHeaders(AValue: TStrings);
 procedure TCustomMicroHTTPApplication.SetExtraHeaders(AValue: TStrings);
 begin
 begin
   HTTPHandler.ExtraHeaders.Assign(AValue);
   HTTPHandler.ExtraHeaders.Assign(AValue);
@@ -747,6 +803,11 @@ begin
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
+function TCustomMicroHTTPApplication.GetAddress: String;
+begin
+  Result:=HTTPHandler.Address;
+end;
+
 function TCustomMicroHTTPApplication.GetExtraHeaders: TStrings;
 function TCustomMicroHTTPApplication.GetExtraHeaders: TStrings;
 begin
 begin
   Result:=HTTPHandler.ExtraHeaders;
   Result:=HTTPHandler.ExtraHeaders;

+ 2 - 1
packages/libmicrohttpd/src/libmicrohttpd.pp

@@ -209,7 +209,8 @@ const
   MHD_USE_DEBUG = 1;
   MHD_USE_DEBUG = 1;
   MHD_USE_SSL = 2;
   MHD_USE_SSL = 2;
   MHD_USE_THREAD_PER_CONNECTION = 4;
   MHD_USE_THREAD_PER_CONNECTION = 4;
-  MHD_USE_SELECT_INTERNALLY = 8;
+  MHD_USE_INTERNAL_POLLING_THREAD = 8;
+  MHD_USE_SELECT_INTERNALLY = 8 deprecated 'use MHD_USE_INTERNAL_POLLING_THREAD';
   MHD_USE_IPv6 = 16;
   MHD_USE_IPv6 = 16;
   MHD_USE_PEDANTIC_CHECKS = 32;
   MHD_USE_PEDANTIC_CHECKS = 32;
   MHD_USE_POLL = 64;
   MHD_USE_POLL = 64;