paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 21:28:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Webassembly HTTP request API

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-08-30 22:51:21 +02:00
parent d8278b1699
commit 3b0d2b329a
8 changed files with 1159 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
packages/fpmake_add.inc
View File

@ -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'));

6
packages/fpmake_proc.inc
View File

@ -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

83
packages/wasm-utils/demo/http/wasmhttpdemo.lpi Normal file
View File

@ -0,0 +1,83 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="WebAssembly HTTP API demo"/>
<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>

67
packages/wasm-utils/demo/http/wasmhttpdemo.pp Normal file
View File

@ -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.

41
packages/wasm-utils/fpmake.pp Normal file
View File

@ -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}

136
packages/wasm-utils/src/wasm.http.api.pas Normal file
View File

@ -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.

732
packages/wasm-utils/src/wasm.http.objects.pas Normal file
View File

@ -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.

93
packages/wasm-utils/src/wasm.http.shared.pas Normal file
View File

@ -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.