From 3b0d2b329a8edcdfda5005bac6fcf1fbe2070ff5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= Date: Fri, 30 Aug 2024 22:51:21 +0200 Subject: [PATCH] * Webassembly HTTP request API --- packages/fpmake_add.inc | 1 + packages/fpmake_proc.inc | 6 + .../wasm-utils/demo/http/wasmhttpdemo.lpi | 83 ++ packages/wasm-utils/demo/http/wasmhttpdemo.pp | 67 ++ packages/wasm-utils/fpmake.pp | 41 + packages/wasm-utils/src/wasm.http.api.pas | 136 ++++ packages/wasm-utils/src/wasm.http.objects.pas | 732 ++++++++++++++++++ packages/wasm-utils/src/wasm.http.shared.pas | 93 +++ 8 files changed, 1159 insertions(+) create mode 100644 packages/wasm-utils/demo/http/wasmhttpdemo.lpi create mode 100644 packages/wasm-utils/demo/http/wasmhttpdemo.pp create mode 100644 packages/wasm-utils/fpmake.pp create mode 100644 packages/wasm-utils/src/wasm.http.api.pas create mode 100644 packages/wasm-utils/src/wasm.http.objects.pas create mode 100644 packages/wasm-utils/src/wasm.http.shared.pas diff --git a/packages/fpmake_add.inc b/packages/fpmake_add.inc index 36bad269af..0e855e545b 100644 --- a/packages/fpmake_add.inc +++ b/packages/fpmake_add.inc @@ -157,5 +157,6 @@ add_gstreamer(ADirectory+IncludeTrailingPathDelimiter('gstreamer')); add_testinsight(ADirectory+IncludeTrailingPathDelimiter('testinsight')); add_wasm_job(ADirectory+IncludeTrailingPathDelimiter('wasm-job')); + add_wasm_utils(ADirectory+IncludeTrailingPathDelimiter('wasm-utils')); add_wasm_oi(ADirectory+IncludeTrailingPathDelimiter('wasm-oi')); add_fcl_jsonschema(ADirectory+IncludeTrailingPathDelimiter('fcl-jsonschema')); diff --git a/packages/fpmake_proc.inc b/packages/fpmake_proc.inc index 7a39d56ae1..23bfece968 100644 --- a/packages/fpmake_proc.inc +++ b/packages/fpmake_proc.inc @@ -882,6 +882,12 @@ begin {$include wasm-job/fpmake.pp} end; +procedure add_wasm_utils(const ADirectory: string); +begin + with Installer do +{$include wasm-utils/fpmake.pp} +end; + procedure add_wasm_oi(const ADirectory: string); begin with Installer do diff --git a/packages/wasm-utils/demo/http/wasmhttpdemo.lpi b/packages/wasm-utils/demo/http/wasmhttpdemo.lpi new file mode 100644 index 0000000000..fc7320ab7c --- /dev/null +++ b/packages/wasm-utils/demo/http/wasmhttpdemo.lpi @@ -0,0 +1,83 @@ + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <BuildModes> + <Item Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <Units> + <Unit> + <Filename Value="wasmhttpdemo.pp"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="../../src/wasm.http.api.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="../../src/wasm.http.shared.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="../../src/wasm.http.objects.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="wasmhttpdemo.wasm" ApplyConventions="False"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="../../src"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <TargetCPU Value="wasm32"/> + <TargetOS Value="wasi"/> + <Subtarget Value="browser"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + <DebugInfoType Value="dsDwarf3"/> + </Debugging> + <Options> + <ExecutableType Value="Library"/> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions> + <Item> + <Name Value="EAbort"/> + </Item> + <Item> + <Name Value="ECodetoolError"/> + </Item> + <Item> + <Name Value="EFOpenError"/> + </Item> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/packages/wasm-utils/demo/http/wasmhttpdemo.pp b/packages/wasm-utils/demo/http/wasmhttpdemo.pp new file mode 100644 index 0000000000..3c582356b5 --- /dev/null +++ b/packages/wasm-utils/demo/http/wasmhttpdemo.pp @@ -0,0 +1,67 @@ +{ + This file is part of the Free Component Library + + Webassembly HTTP API - demo program + Copyright (c) 2024 by Michael Van Canneyt michael@freepascal.org + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +library wasmhttpdemo; + +uses basenenc, sysutils, classes, wasm.http.api, wasm.http.shared, wasm.http.objects; + + + +Procedure HandleResponseCallback(Resp : TWasmHTTPResponse); + +var + H : String; + +begin + Writeln('Got response on request ID: ',Resp.RequestID); + Writeln('Status: ',Resp.Status,' ',Resp.StatusText); + Writeln('Headers (',Resp.Headers.Count,'):'); + For H in Resp.Headers do + Writeln(H); + if Pos('text/',Trim(Resp.Headers.Values['content-type']))=1 then + begin + Writeln('Body is text (Assumed UTF8):'); + Writeln(Resp.BodyAsUTF8); + end + else + begin + Writeln('Body is not text, base64 content:'); + Writeln(Base64.Encode(Resp.Body)); + end; + Writeln('') +end; + +procedure StartTest; + +Var + Req : TWasmHTTPRequest; + ID : TWasmHTTPRequestID; + +begin + Writeln('Creating request'); + Req:=TWasmHTTPRequest.Create('index.html'); + Writeln('Executing request'); + ID:=Req.Execute(@HandleResponseCallback); + Writeln('Got request ID :',ID); + // Request is freed once the return was processed. +end; + +var + Buf : Array[1..64*1024] of byte; + +begin + SetTextBuf(output,buf,SizeOf(Buf)); + StartTest; +end. + diff --git a/packages/wasm-utils/fpmake.pp b/packages/wasm-utils/fpmake.pp new file mode 100644 index 0000000000..77d67c9100 --- /dev/null +++ b/packages/wasm-utils/fpmake.pp @@ -0,0 +1,41 @@ +{$ifndef ALLPACKAGES} +{$mode objfpc}{$H+} +program fpmake; + +uses {$ifdef unix}cthreads,{$endif} fpmkunit; + + +Var + P : TPackage; + T : TTarget; +begin + With Installer do + begin +{$endif ALLPACKAGES} + + P:=AddPackage('wasm-utils'); + P.Dependencies.Add('rtl-objpas'); + P.Dependencies.Add('fcl-base'); + P.ShortName:='wasmutil'; + P.Description := 'Various utility units for webassembly.'; +{$ifdef ALLPACKAGES} + P.Directory:=ADirectory; +{$endif ALLPACKAGES} + P.Version:='3.3.1'; + P.OSes:=[wasi]; + P.CPUs:=[wasm32]; + P.SourcePath.Add('src'); + + T:=P.Targets.AddUnit('wasm.http.shared.pas'); + + T:=P.Targets.AddUnit('wasm.http.api.pas'); + T.Dependencies.AddUnit('wasm.http.shared'); + + T:=P.Targets.AddUnit('wasm.http.objects.pas'); + T.Dependencies.AddUnit('wasm.http.api'); + T.Dependencies.AddUnit('wasm.http.shared'); +{$ifndef ALLPACKAGES} + Run; + end; +end. +{$endif ALLPACKAGES} diff --git a/packages/wasm-utils/src/wasm.http.api.pas b/packages/wasm-utils/src/wasm.http.api.pas new file mode 100644 index 0000000000..1e9aab7cdb --- /dev/null +++ b/packages/wasm-utils/src/wasm.http.api.pas @@ -0,0 +1,136 @@ +{ + This file is part of the Free Component Library + + Webassembly HTTP API - imported functions and structures. + Copyright (c) 2024 by Michael Van Canneyt michael@freepascal.org + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +unit wasm.http.api; + +{$mode ObjFPC}{$H+} + +interface + +uses wasm.http.shared; + +Type + TWasmHTTPLogLevel = (hllTrace, hllDebug, hllInfo, hllWarning, hllError, hllCritical); + TWasmHTTPLogLevels = set of TWasmHTTPLogLevel; + + TWasmString = record + Data : PAnsiChar; + Len : Longint; + end; + PWasmString = ^TWasmString; + + TWasmBuffer = record + Data : PByte; + Len : Longint; + end; + PWasmBuffer = ^TWasmBuffer; + + TWasmHTTPApiRequest = Record + Url : TWasmString; + Method : TWasmString; + HeaderCount : Longint; + Headers : PWasmString; + Body : TWasmBuffer; + Integrity : TWasmString; + Redirect : Longint; + Cache : Longint; + KeepAlive : Longint; + Mode : Longint; + Priority : Longint; + Referrer : TWasmString; + ReferrerPolicy : TWasmString; + AbortSignal : Longint; + Credentials: Longint; + end; + PWasmHTTPAPIRequest = ^TWasmHTTPApiRequest; + + TWasmHTTPResponseEvent = procedure(aRequestID : Longint; aUserData : Pointer; aStatus : TWasmHTTPResponseStatus; var Deallocate : Boolean) of object; + TWasmHTTPResponseCallback = procedure(aRequestID : Longint; aUserData : Pointer; aStatus : TWasmHTTPResponseStatus; var Deallocate : Boolean); + TWasmHTTPLogHook = procedure (Level : TWasmHTTPLogLevel; const Msg : string) of object; + +function __wasmhttp_request_allocate(aRequest : PWasmHTTPAPIRequest; aUserData : Pointer; aRequestID : PWasmHTTPRequestID) : TWasmHTTPResult; external httpExportName name httpFN_RequestAllocate; +function __wasmhttp_request_execute(aRequestID : TWasmHTTPRequestID) : TWasmHTTPResult; external httpExportName name httpFN_RequestExecute; +function __wasmhttp_request_deallocate(aRequestID : TWasmHTTPRequestID) : TWasmHTTPResult; external httpExportName name httpFN_RequestDeAllocate; +function __wasmhttp_request_abort(aRequestID : TWasmHTTPRequestID) : TWasmHTTPResult; external httpExportName name httpFN_RequestAbort; + +function __wasmhttp_response_get_status(aRequestID : TWasmHTTPRequestID; aStatus : PLongint) : TWasmHTTPResult; external httpExportName name httpFN_ResponseGetStatus; +function __wasmhttp_response_get_statustext(aRequestID : TWasmHTTPRequestID; aStatusText : PByte; aMaxHeaderTextLen : PLongint) : TWasmHTTPResult; external httpExportName name httpFN_ResponseGetStatusText; +function __wasmhttp_response_get_headercount(aRequestID : TWasmHTTPRequestID; var aHeaderCount : Longint) : TWasmHTTPResult; external httpExportName name httpFN_ResponseGetHeaderCount; +function __wasmhttp_response_get_headername(aRequestID : TWasmHTTPRequestID; aHeaderIdx: Longint; aHeader : PByte; aMaxHeaderLen : PLongint) : TWasmHTTPResult; external httpExportName name httpFN_ResponseGetHeaderName; +function __wasmhttp_response_get_header(aRequestID : TWasmHTTPRequestID; aHeaderName: PByte; aHeaderLen : Longint; aHeader : PByte; aMaxHeaderLen : PLongint) : TWasmHTTPResult; external httpExportName name httpFN_ResponseGetHeader; +function __wasmhttp_response_get_body(aRequestID : TWasmHTTPRequestID; aBody : PByte; MaxBodyLen : PLongint) : TWasmHTTPResult; external httpExportName name httpFN_ResponseGetBody; + +function __wasmhttp_response_callback(aRequestID : TWasmHTTPRequestID; aUserData : Pointer; aStatus : TWasmHTTPResponseStatus) : TWasmHTTPResponseResult; + + +procedure __wasmhttp_log(level : TWasmHTTPLogLevel; const Msg : String); +procedure __wasmhttp_log(level : TWasmHTTPLogLevel; const Fmt : String; Args : Array of const); + +var + OnWasmHTTPResponse : TWasmHTTPResponseEvent; + WasmHTTPResponseCallback : TWasmHTTPResponseCallback; + OnWasmHTTPLog : TWasmHTTPLogHook; + +implementation + +{$IFDEF FPC_DOTTEDUNITS} +uses System.SysUtils; +{$ELSE} +uses sysutils; +{$ENDIF} + +procedure __wasmhttp_log(level : TWasmHTTPLogLevel; const Msg : String); + +begin + If assigned(OnWasmHTTPLog) then + OnWasmHTTPLog(level,Msg); +end; + +procedure __wasmhttp_log(level : TWasmHTTPLogLevel; const Fmt : String; Args : Array of const); + +begin + If assigned(OnWasmHTTPLog) then + OnWasmHTTPLog(level,SafeFormat(Fmt,Args)); +end; + +function __wasmhttp_response_callback(aRequestID : TWasmHTTPRequestID; aUserData : Pointer; aStatus : TWasmHTTPResponseStatus) : TWasmHTTPResponseResult; + +var + B : Boolean; + +begin + B:=True; + try + if Assigned(OnWasmHTTPResponse) then + OnWasmHTTPResponse(aRequestID,aUSerData,aStatus,B) + else if Assigned(WasmHTTPResponseCallback) then + WasmHTTPResponseCallback(aRequestID,aUSerData,aStatus,B); + if B then + Result:=WASMHTTP_RESPONSE_DEALLOCATE + else + Result:=WASMHTTP_RESPONSE_SUCCESS; + except + on E : exception do + begin + __wasmhttp_log(hllError,'Exception %s during response callback: %s',[E.ClassName,E.Message]); + Result:=WASMHTTP_RESPONSE_ERROR; + end; + end; +end; + +exports __wasmhttp_response_callback; + +end. + diff --git a/packages/wasm-utils/src/wasm.http.objects.pas b/packages/wasm-utils/src/wasm.http.objects.pas new file mode 100644 index 0000000000..e857912f7b --- /dev/null +++ b/packages/wasm-utils/src/wasm.http.objects.pas @@ -0,0 +1,732 @@ +{ + This file is part of the Free Component Library + + Webassembly HTTP API - object-oriented interface. + Copyright (c) 2024 by Michael Van Canneyt michael@freepascal.org + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +unit wasm.http.objects; + +{$mode ObjFPC} +{$h+} +{$modeswitch functionreferences} + +interface + +uses +{$IFDEF FPC_DOTTEDUNITS} + System.Classes, System.SysUtils, System.Contnrs, +{$ELSE} + Classes, sysutils, contnrs, +{$ENDIF} + wasm.http.shared, wasm.http.api; + +Type + EWasmHTTP = Class(Exception); + + TWasmHTTPHeaders = Class; + TWasmHTTPRequest = Class; + TWasmHTTPResponse = Class; + + // Keep these in the same order as the definition in wasm.http.shared ! + TWasmHTTPCache = (whcDefault,whcNoStore,whcReload,whcNoCache,whcForceCache,whcOnlyIfCached); + TWasmHTTPCredentials = (whrSameOrigin,whrOmit,whrInclude); + TWasmHTTPMode = (whmCors,whmSameOrigin,whmNoCors,whmNavigate,whmWebSocket); + TWasmHTTPPriority = (whpAuto,whpLow,whpHigh); + TWasmHTTPRedirect = (whdFollow,whdError,whdManual); + + { TWasmHTTPHeaders } + + TWasmHTTPHeaders = Class(TPersistent) + private + FBody: TBytes; + FHeaders: TStrings; + procedure SetBody(AValue: TBytes); + procedure SetHeaders(AValue: TStrings); + Public + Constructor Create; virtual; + Destructor Destroy; override; + Procedure Assign(aSource : TPersistent); override; + Function BodyAsUTF8 : UTF8String; + Property Headers : TStrings Read FHeaders Write SetHeaders; + Property Body : TBytes Read FBody Write SetBody; + end; + + { TWasmHTTPResponse } + TWasmHTTPResponse = Class(TWasmHTTPHeaders) + private + FRequest: TWasmHTTPRequest; + FStatus: Longint; + FStatusText: String; + FRequestID: TWasmHTTPRequestID; + protected + function CheckRes(Res: TWasmHTTPResult; const aOperation: String): Boolean; virtual; + function GetBody: boolean; virtual; + function GetHeaderName(aIndex: Integer; out aValue: String): Boolean; virtual; + function GetHeaderValue(const aName: String; out aValue: String): Boolean; virtual; + function GetStatus: Boolean; virtual; + function GetStatusText: Boolean; virtual; + function Init: Boolean; virtual; + function StdBodyLength : Longint; virtual; + Public + const + DefaultBodyLength = 64*1024; // 64Kb + public + Constructor Create(aRequest : TWasmHTTPRequest); reintroduce; + Destructor Destroy; override; + Procedure Assign(aSource : TPersistent); override; + Property RequestID : TWasmHTTPRequestID Read FRequestID; + Property Request : TWasmHTTPRequest Read FRequest; + Property StatusText : String Read FStatusText; + Property Status : Integer Read FStatus; + end; + + + // The response object (and corresponding + TOnWasmHTTPResponseEvent = Procedure (aResponse : TWasmHTTPResponse) of Object; + TOnWasmHTTPResponseCallback = Procedure (aResponse : TWasmHTTPResponse); + TOnWasmHTTPResponseHandler = Reference to Procedure (aResponse : TWasmHTTPResponse); + + + { TWasmHTTPRequest } + + TWasmHTTPRequest = Class(TWasmHTTPHeaders) + private + FAbortSignal: Boolean; + FCache: TWasmHTTPCache; + FCredentials: TWasmHTTPCredentials; + FIntegrity: String; + FKeepAlive: Boolean; + FMethod: String; + FMode: TWasmHTTPMode; + FPriority: TWasmHTTPPriority; + FRedirect: TWasmHTTPRedirect; + FReferrer: String; + FReferrerPolicy: String; + FURL: String; + FApiBytes : Array of TBytes; + FApiHeaders : Array of TWasmString; + FScheduled : Boolean; + FRequestID : TWasmHTTPRequestID; + Protected + function AsAPIRequest : TWasmHTTPApiRequest; + Function Scheduled : Boolean; + procedure CheckNotScheduled; + Public + constructor Create(const aURL : String); + Procedure Assign(aSource : TPersistent); override; + Function Execute(OnResponse : TOnWasmHTTPResponseEvent): TWasmHTTPRequestID; + Function Execute(OnResponse : TOnWasmHTTPResponseCallback): TWasmHTTPRequestID; + Function Execute(OnResponse : TOnWasmHTTPResponseHandler): TWasmHTTPRequestID; + function ToString : RTLString; override; + Property URL : String Read FURL Write FURL; + Property Method : String Read FMethod Write FMethod; + Property Cache : TWasmHTTPCache Read FCache Write FCache; + Property Credentials : TWasmHTTPCredentials Read FCredentials Write FCredentials; + Property Mode: TWasmHTTPMode Read FMode Write FMode; + Property Priority : TWasmHTTPPriority Read FPriority Write FPriority; + Property Redirect : TWasmHTTPRedirect Read FRedirect Write FRedirect; + Property Referrer : String Read FReferrer Write FReferrer; + Property ReferrerPolicy : String Read FReferrerPolicy Write FReferrerPolicy; + Property Integrity : String Read FIntegrity Write FIntegrity; + Property KeepAlive : Boolean Read FKeepAlive Write FKeepAlive; + Property AbortSignal : Boolean Read FAbortSignal Write FAbortSignal; + end; + + + + TWasmHTTP = Class(TObject) + Private + Type + + { TRequest } + + TRequest = Class(TObject) + Private + FResponse: TWasmHTTPResponse; + Public + constructor Create(aRequest : TWasmHTTPRequest); + procedure DoCallBack; Virtual; abstract; + procedure CallBack; + end; + + { TEventedRequest } + + TEventedRequest = class(TRequest) + FEvent : TOnWasmHTTPResponseEvent; + constructor Create(aRequest : TWasmHTTPRequest; aEvent: TOnWasmHTTPResponseEvent); reintroduce; + procedure DoCallBack; override; + end; + + { TCallbackedRequest } + + TCallbackedRequest = class(TRequest) + FEvent : TOnWasmHTTPResponseCallback; + constructor Create(aRequest : TWasmHTTPRequest; aEvent: TOnWasmHTTPResponseCallback); reintroduce; + procedure DoCallBack; override; + end; + + { THandleRequest } + + THandleRequest = class(TRequest) + FEvent : TOnWasmHTTPResponseHandler; + constructor Create(aRequest : TWasmHTTPRequest; aEvent: TOnWasmHTTPResponseHandler); reintroduce; + procedure DoCallBack; override; + end; + + class var + _list : TFPObjectList; + class function DoHTTPRequest(aRequest: TRequest): TWasmHTTPRequestID; + class procedure HandleResponse(aRequestID : Longint; aUserData : Pointer; aStatus : TWasmHTTPResponseStatus; var Deallocate : Boolean); static; + class procedure LogResponseError(aResponse : TWasmHTTPResponse; E : Exception); + public + Class Constructor Init; + Class Destructor Done; + // Ownership of aRequest is transferred to TWasmHTTP, it will free the request once the response is handled. + Class Function HTTPRequest(aRequest : TWasmHTTPRequest; OnResponse : TOnWasmHTTPResponseEvent): TWasmHTTPRequestID; + Class Function HTTPRequest(aRequest : TWasmHTTPRequest; OnResponse : TOnWasmHTTPResponseCallback): TWasmHTTPRequestID; + Class Function HTTPRequest(aRequest : TWasmHTTPRequest; OnResponse : TOnWasmHTTPResponseHandler): TWasmHTTPRequestID; + end; + + + +implementation + +{ TWasmHTTPHeaders } + +procedure TWasmHTTPHeaders.SetHeaders(AValue: TStrings); +begin + + if FHeaders=AValue then Exit; + FHeaders.Assign(AValue); +end; + +procedure TWasmHTTPHeaders.SetBody(AValue: TBytes); +begin + + if FBody=AValue then Exit; + FBody:=AValue; + +end; + +constructor TWasmHTTPHeaders.Create; +begin + FHeaders:=TStringList.Create; + FHeaders.NameValueSeparator:=':'; +end; + +destructor TWasmHTTPHeaders.Destroy; +begin + FreeAndNil(FHeaders); + inherited Destroy; +end; + +procedure TWasmHTTPHeaders.Assign(aSource: TPersistent); + +var + Src : TWasmHTTPHeaders absolute aSource; + +begin + + if aSource is TWasmHTTPHeaders then + begin + Headers.Assign(Src.Headers); + Body:=Copy(Src.Body,0,Length(Src.Body)); + end + else + inherited Assign(aSource); + +end; + +function TWasmHTTPHeaders.BodyAsUTF8: UTF8String; +begin + Result:=TEncoding.UTF8.GetAnsiString(FBody); +end; + +{ TWasmHTTPResponse } + +function TWasmHTTPResponse.CheckRes(Res: TWasmHTTPResult; const aOperation: String): Boolean; + +begin + Result:=False; + if Res=WASMHTTP_RESULT_INPROGRESS then + begin + __wasmhttp_log(hllError,'Request %d still in progress',[RequestID]); + exit; + end; + if Res=WASMHTTP_RESULT_INVALIDID then + begin + __wasmhttp_log(hllError,'Request %d does not exist',[RequestID]); + exit; + end; + if Res<>WASMHTTP_RESULT_SUCCESS then + begin + __wasmhttp_log(hllWarning,'Failed to %s : request %d does not exist',[aOperation,RequestID]); + exit; + end; + Result:=True; + +end; + +function TWasmHTTPResponse.GetHeaderName(aIndex: Integer; out aValue: String): Boolean; + +var + S : String = ''; + sLen : Longint; + Res : TWasmHTTPResult; + +begin + + SLen:=256; + SetLength(S,sLen); + Res:=__wasmhttp_response_get_headername(RequestID,aIndex,PByte(S),@sLen); + if (Res=WASMHTTP_RESULT_INSUFFICIENTMEM) then + begin + SetLength(S,sLen); + Res:=__wasmhttp_response_get_headername(RequestID,aIndex,PByte(S),@sLen); + end; + Result:=CheckRes(Res,'Get header name'); + if not Result then + aValue:='' + else + begin + if (SLen<>Length(S)) then + SetLength(S,sLen); + aValue:=S; + end; + +end; + +function TWasmHTTPResponse.GetHeaderValue(const aName: String; out aValue: String): Boolean; + +var + S : UTF8String = ''; + sLen : Longint; + Res : TWasmHTTPResult; + +begin + + SLen:=256; + SetLength(S,sLen); + Res:=__wasmhttp_response_get_header(RequestID,PByte(aName),Length(aName),PByte(S),@sLen); + if (Res=WASMHTTP_RESULT_INSUFFICIENTMEM) then + begin + SetLength(S,sLen); + Res:=__wasmhttp_response_get_header(RequestID,PByte(aName),Length(aName),PByte(S),@sLen); + end; + Result:=CheckRes(Res,'Get header value'); + if not Result then + aValue:='' + else + begin + if (SLen<>Length(S)) then + SetLength(S,sLen); + aValue:=S; + end +end; + +function TWasmHTTPResponse.GetStatus : Boolean; + +begin + Result:=CheckRes(__wasmhttp_response_get_status(RequestID,@FStatus),'get status'); +end; + +function TWasmHTTPResponse.GetStatusText : Boolean; + +var + S : UTF8String = ''; + sLen : Longint; + Res : TWasmHTTPResult; + +begin + SLen:=256; + SetLength(S,sLen); + Res:=__wasmhttp_response_get_statustext(RequestID,PByte(S),@sLen); + if (Res=WASMHTTP_RESULT_INSUFFICIENTMEM) then + begin + SetLength(S,sLen); + Res:=__wasmhttp_response_get_statustext(RequestID,PByte(S),@sLen); + end; + Result:=CheckRes(Res,'Get status text'); + if not result then + exit; + if sLen<>Length(S) then + SetLength(S,sLen); + FStatusText:=S; + +end; + +function TWasmHTTPResponse.StdBodyLength: Longint; + +begin + Result:=DefaultBodyLength; +end; + +function TWasmHTTPResponse.GetBody: boolean; + +var + B : TBytes; + bLen : Longint; + Res : TWasmHTTPResult; + +begin + B:=[]; + bLen:=StdBodyLength; + SetLength(B,bLen); + Res:=__wasmhttp_response_get_body(RequestID,PByte(B),@bLen); + if (Res=WASMHTTP_RESULT_INSUFFICIENTMEM) then + begin + SetLength(B,bLen); + Res:=__wasmhttp_response_get_body(RequestID,PByte(B),@bLen); + end; + Result:=CheckRes(Res,'Get status text'); + if not result then + exit; + if bLen<>Length(B) then + SetLength(B,BLen); + FBody:=B; +end; + +function TWasmHTTPResponse.Init : Boolean; + +var + H,N : String; + i,aCount : Longint; + +begin + Result:=False; + aCount:=0; + if not GetStatus then + exit; + if not GetStatusText then + exit; + if not CheckRes(__wasmhttp_response_get_headercount(RequestID,aCount),'get header count') then + exit; + For I:=0 to aCount-1 do + begin + if not GetHeaderName(I,N) then + exit; + if not GetHeaderValue(N,H) then + exit; + FHeaders.Values[N]:=H; + end; + if not GetBody then + exit; + Result:=True; +end; + +constructor TWasmHTTPResponse.Create(aRequest: TWasmHTTPRequest); +begin + Inherited Create(); + FRequest:=aRequest; +end; + +destructor TWasmHTTPResponse.Destroy; +begin + FreeAndNil(FRequest); + inherited Destroy; +end; + +procedure TWasmHTTPResponse.Assign(aSource: TPersistent); +var + Src : TWasmHTTPResponse absolute aSource; +begin + if aSource is TWasmHTTPResponse then + begin + FStatus:=Src.Status; + FStatusText:=Src.StatusText; + end; + inherited Assign(aSource); +end; + + +class procedure TWasmHTTP.HandleResponse(aRequestID: Longint; aUserData: Pointer; aStatus: TWasmHTTPResponseStatus; var Deallocate: Boolean); + +var + Req : TRequest; + +begin + DeAllocate:=True; + Req:=TRequest(aUserData); + try + if aRequestID<>Req.Fresponse.RequestID then + Raise EWasmHTTP.CreateFmt('Inconsistent data: Response Request ID %d is not the stored ID %d',[Req.Fresponse.RequestID]); + Req.FResponse.Init; + except + On E : Exception do + LogResponseError(Req.FResponse,E); + end; + Req.Callback; + _List.Remove(Req); +end; + +class procedure TWasmHTTP.LogResponseError(aResponse: TWasmHTTPResponse; E: Exception); + +var + Msg : String; + +begin + With aResponse do + Msg:=SafeFormat('Error %s handling response of %d ("%s %s") : %s',[RequestID,E.ClassName,Request.Method,Request.URL,E.Message]); + __wasmhttp_log(hllError,Msg); +end; + +class constructor TWasmHTTP.Init; +begin + WasmHTTPResponseCallback:=@HandleResponse; + _list:=TFPObjectList.Create(True); +end; + +class destructor TWasmHTTP.Done; +begin + WasmHTTPResponseCallback:=Nil; + FreeAndNil(_List); +end; + + +class function TWasmHTTP.DoHTTPRequest(aRequest: TRequest): TWasmHTTPRequestID; + +var + lResp : TWasmHTTPResponse; + lReq : TWasmHTTPRequest; + WasmReq : TWasmHTTPApiRequest; + ID : TWasmHTTPRequestID; + Res : TWasmHTTPResult; + Msg : String; + +begin + lResp:=aRequest.FResponse; + lReq:=lResp.Request; + WasmReq:=lReq.AsAPIRequest; + Res:=__wasmhttp_request_allocate(@WasmReq,aRequest,@ID); + if Res=WASMHTTP_RESULT_SUCCESS then + begin + lReq.FScheduled:=True; + lResp.FRequestID:=ID; + _list.Add(aRequest); + Res:=__wasmhttp_request_execute(ID); + if Res<>WASMHTTP_RESULT_SUCCESS then + begin + msg:=SafeFormat('Failed to execute request for request %s %s',[lReq.Method,lReq.URL]); + __wasmhttp_log(hllError,Msg); + end; + Result:=ID; + end + else + begin + msg:=SafeFormat('Failed to allocate request for request %s %s',[lReq.Method,lReq.URL]); + __wasmhttp_log(hllError,Msg); + aRequest.Free; + Raise EWasmHTTP.Create(Msg); + end; + +end; + +class function TWasmHTTP.HTTPRequest(aRequest: TWasmHTTPRequest; OnResponse: TOnWasmHTTPResponseEvent): TWasmHTTPRequestID; + + +begin + Result:=DoHTTPRequest(TEventedRequest.Create(aRequest,OnResponse)); +end; + +class function TWasmHTTP.HTTPRequest(aRequest: TWasmHTTPRequest; OnResponse: TOnWasmHTTPResponseCallback): TWasmHTTPRequestID; + +begin + Result:=DoHTTPRequest(TCallbackedRequest.Create(aRequest,OnResponse)); +end; + + +class function TWasmHTTP.HTTPRequest(aRequest: TWasmHTTPRequest; OnResponse: TOnWasmHTTPResponseHandler): TWasmHTTPRequestID; +begin + Result:=DoHTTPRequest(THandleRequest.Create(aRequest,OnResponse)); +end; + +{ TWasmHTTP.TRequest } + +constructor TWasmHTTP.TRequest.Create(aRequest: TWasmHTTPRequest); + +var + Resp : TWasmHTTPResponse; + +begin + Resp:=TWasmHTTPResponse.Create(aRequest); + FResponse:=Resp; +end; + + +procedure TWasmHTTP.TRequest.CallBack; +begin + try + DoCallback + except + On E : Exception Do + LogResponseError(FResponse,E) + end; +end; + +{ TWasmHTTP.TEventedRequest } + +constructor TWasmHTTP.TEventedRequest.Create(aRequest: TWasmHTTPRequest; aEvent: TOnWasmHTTPResponseEvent); +begin + Inherited Create(aRequest); + FEvent:=aEvent; +end; + +procedure TWasmHTTP.TEventedRequest.DoCallBack; +begin + FEvent(FResponse); +end; + +{ TWasmHTTP.TCallbackedRequest } + +constructor TWasmHTTP.TCallbackedRequest.Create(aRequest: TWasmHTTPRequest; aEvent: TOnWasmHTTPResponseCallback); +begin + Inherited Create(aRequest); + FEvent:=aEvent; +end; + +procedure TWasmHTTP.TCallbackedRequest.DoCallBack; +begin + FEvent(FResponse); +end; + +{ TWasmHTTP.THandleRequest } + +constructor TWasmHTTP.THandleRequest.Create(aRequest: TWasmHTTPRequest; aEvent: TOnWasmHTTPResponseHandler); +begin + Inherited Create(aRequest); + FEvent:=aEvent; +end; + +procedure TWasmHTTP.THandleRequest.DoCallBack; +begin + FEvent(FResponse); +end; + +{ TWasmHTTPRequest } + +function TWasmHTTPRequest.AsAPIRequest: TWasmHTTPApiRequest; + + + Function StringToWasmString(var Idx : Integer; const S : String): TWasmString; + + var + B : TBytes; + + begin + {$IF SIZEOF(CHAR)=2} + B:=TEncoding.UTF8.GetBytes(S); + {$ELSE} + B:=TEncoding.UTF8.GetAnsiBytes(S); + {$ENDIF} + FAPIBytes[Idx]:=B; + Result.Len:=Length(B); + Result.Data:=PAnsiChar(PByte(B)); + Inc(Idx); + end; + +var + Idx,Idx2 : Integer; + H : String; + +begin + Idx:=0; + Result:=Default(TWasmHTTPApiRequest); + SetLength(FAPIBytes,FHeaders.Count+5); + Result.Url:=StringToWasmString(Idx,URL); + Result.Method:=StringToWasmString(Idx,Method); + Result.Referrer:=StringToWasmString(Idx,Referrer); + Result.ReferrerPolicy:=StringToWasmString(Idx,ReferrerPolicy); + Result.Integrity:=StringToWasmString(Idx,Integrity); + Result.HeaderCount:=0; + SetLength(FAPIHeaders,FHeaders.Count); + Idx2:=0; + For H in FHeaders do + begin + FAPIHeaders[Idx2]:=StringToWasmString(Idx,URL); + Inc(Idx2); + end; + Result.AbortSignal:=Ord(AbortSignal); + Result.KeepAlive:=Ord(KeepAlive); + Result.Cache:=Ord(Cache); + Result.Mode:=Ord(Mode); + Result.Priority:=Ord(Priority); + Result.Redirect:=Ord(Redirect); + Result.Credentials:=Ord(Credentials); +end; + +function TWasmHTTPRequest.Scheduled: Boolean; +begin + Result:=FScheduled; +end; + +constructor TWasmHTTPRequest.Create(const aURL: String); +begin + Inherited Create; + FURL:=aURL; + Method:='GET'; +end; + +procedure TWasmHTTPRequest.Assign(aSource: TPersistent); + +var + Src : TWasmHTTPRequest absolute aSource; + +begin + if aSource is TWasmHTTPRequest then + begin + URL:=Src.URL; + Method:=Src.Method; + Cache:=Src.Cache; + Credentials:=Src.Credentials; + Mode:=Src.Mode; + Priority:=Src.Priority; + Redirect:=Src.Redirect; + Referrer:=Src.Referrer; + ReferrerPolicy:=Src.ReferrerPolicy; + Integrity:=Src.Integrity; + KeepAlive:=Src.KeepAlive; + AbortSignal:=Src.AbortSignal; + end; + inherited Assign(aSource); +end; + +procedure TWasmHTTPRequest.CheckNotScheduled; + +begin + If Fscheduled then + Raise EWasmHTTP.CreateFmt('Request "%s" is already scheduled with ID: %d',[ToString,FRequestID]); +end; + +function TWasmHTTPRequest.Execute(OnResponse: TOnWasmHTTPResponseEvent): TWasmHTTPRequestID; +begin + CheckNotScheduled; + Result:=TWasmHTTP.HTTPRequest(Self,OnResponse); +end; + +function TWasmHTTPRequest.Execute(OnResponse: TOnWasmHTTPResponseCallback): TWasmHTTPRequestID; +begin + CheckNotScheduled; + Result:=TWasmHTTP.HTTPRequest(Self,OnResponse); +end; + +function TWasmHTTPRequest.Execute(OnResponse: TOnWasmHTTPResponseHandler): TWasmHTTPRequestID; +begin + CheckNotScheduled; + Result:=TWasmHTTP.HTTPRequest(Self,OnResponse); +end; + +function TWasmHTTPRequest.ToString: RTLString; +begin + Result:=Method +' '+URL; +end; + +end. + diff --git a/packages/wasm-utils/src/wasm.http.shared.pas b/packages/wasm-utils/src/wasm.http.shared.pas new file mode 100644 index 0000000000..b79306b884 --- /dev/null +++ b/packages/wasm-utils/src/wasm.http.shared.pas @@ -0,0 +1,93 @@ +{ + This file is part of the Free Component Library + + Webassembly HTTP API - shared constants + Copyright (c) 2024 by Michael Van Canneyt michael@freepascal.org + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +unit wasm.http.shared; + +{$mode ObjFPC}{$H+} + +interface + +Const + WASMHTTP_CACHE_DEFAULT = 0; + WASMHTTP_CACHE_NO_STORE = 1; + WASMHTTP_CACHE_RELOAD = 2; + WASMHTTP_CACHE_NO_CACHE = 3; + WASMHTTP_CACHE_FORCE_CACHE = 4; + WASMHTTP_CACHE_ONLY_IF_CACHED = 5; + + WASMHTTP_CREDENTIALS_SAME_ORIGIN = 0; + WASMHTTP_CREDENTIALS_OMIT = 1; + WASMHTTP_CREDENTIALS_INCLUDE = 2; + + WASMHTTP_MODE_CORS = 0; + WASMHTTP_MODE_SAME_ORIGIN = 1; + WASMHTTP_MODE_NO_CORS = 2; + WASMHTTP_MODE_NAVIGATE = 3; + WASMHTTP_MODE_WEBSOCKET = 4; + + WASMHTTP_PRIORITY_AUTO = 0; + WASMHTTP_PRIORITY_LOW = 1; + WASMHTTP_PRIORITY_HIGH = 2; + + WASMHTTP_REDIRECT_FOLLOW = 0; + WASMHTTP_REDIRECT_ERROR = 1; + WASMHTTP_REDIRECT_MANUAL = 2; + + WASMHTTP_ABORTSIGNAL_NO = 0; + WASMHTTP_ABORTSIGNAL_YES = 1; + + WASMHTTP_RESULT_SUCCESS = 0; + WASMHTTP_RESULT_ERROR = -1; + WASMHTTP_RESULT_NO_URL = -2; + WASMHTTP_RESULT_INVALIDID = -3; + WASMHTTP_RESULT_INPROGRESS = -4; + WASMHTTP_RESULT_INSUFFICIENTMEM = -5; + + WASMHTTP_RESPONSE_SUCCESS = 0; + WASMHTTP_RESPONSE_DEALLOCATE = 1; + WASMHTTP_RESPONSE_ERROR = -1; + +Type + TWasmHTTPRequestID = Longint; + {$IFDEF PAS2JS} + TWasmPointer = Longint; + PWasmHTTPRequestID = TWasmPointer; + {$ELSE} + PWasmHTTPRequestID = ^TWasmHTTPRequestID; + {$ENDIF} + + TWasmHTTPResult = Longint; + TWasmHTTPResponseResult = Longint; + TWasmHTTPResponseStatus = Longint; + TWasmHTTPResponseInfoType = Longint; + +const + httpExportName = 'http'; + httpFN_RequestAllocate = 'request_allocate'; + httpFN_RequestExecute = 'request_execute'; + httpFN_RequestDeAllocate = 'request_deallocate'; + httpFN_RequestAbort = 'request_abort'; + httpFN_ResponseGetStatus = 'response_get_status'; + httpFN_ResponseGetStatusText = 'response_get_status_text'; + httpFN_ResponseGetHeaderName = 'response_get_header_name'; + httpFN_ResponseGetHeaderCount = 'response_get_header_count'; + httpFN_ResponseGetHeader = 'response_get_header'; + httpFN_ResponseGetBody = 'response_get_body'; + httpFN_ResponseCallback = '__wasmhttp_response_callback'; + +implementation + +end. +