270 lines
9.1 KiB
ObjectPascal
270 lines
9.1 KiB
ObjectPascal
/// sample program which will serve content on http://localhost:888/root
|
|
// - in case of *.md file, execute Showdown template engine in JavaScript
|
|
program JSHttpApiServer;
|
|
|
|
{
|
|
---------------------------------------------------------------------------
|
|
Download the SpiderMonkey library at https://synopse.info/files/synsm.7z
|
|
and put mozjs-24.dll and libnspr4.dll files with your JSHttpApiServer.exe
|
|
---------------------------------------------------------------------------
|
|
}
|
|
|
|
{$APPTYPE CONSOLE}
|
|
|
|
{$ifdef WIN64}
|
|
begin
|
|
writeln('SpiderMonkey is not handled in 64 bit mode yet');
|
|
|
|
{$else}
|
|
|
|
// first line of uses clause must be {$I SynDprUses.inc}
|
|
uses
|
|
{$I SynDprUses.inc}
|
|
Windows,
|
|
SysUtils,
|
|
SynCommons,
|
|
SynTable,
|
|
SynZip,
|
|
SynCrtSock,
|
|
SynSM,
|
|
SynSMAPI;
|
|
//mORMotSM;
|
|
|
|
{$I Synopse.inc}
|
|
|
|
type
|
|
TTestServer = class
|
|
protected
|
|
fPath: TFileName;
|
|
fServer: THttpApiServer;
|
|
fSMManager: TSMEngineManager;
|
|
fShowDownLib: SynUnicode;
|
|
fCalls: integer;
|
|
function Process(Ctxt: THttpServerRequest): cardinal;
|
|
/// here we can add some functions / libraries to SM
|
|
procedure DoOnNewEngine(const Engine: TSMEngine);
|
|
/// implement a loadfile() JavaScript function in Delphi
|
|
// - expect 1 string argument as filePath
|
|
function LoadFile(const This: variant; const Args: array of variant): variant;
|
|
/// this function will use JSON encoding, instead of variants
|
|
function LoadFileJSON(const This: TSMObject; const Args: RawUTF8): RawUTF8;
|
|
public
|
|
constructor Create(const Path: TFileName);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
|
|
{ TTestServer }
|
|
|
|
constructor TTestServer.Create(const Path: TFileName);
|
|
begin
|
|
fPath := IncludeTrailingPathDelimiter(Path);
|
|
fServer := THttpApiServer.Create(false);
|
|
fSMManager := TSMEngineManager.Create;
|
|
fSMManager.OnNewEngine := DoOnNewEngine;
|
|
fShowDownLib := AnyTextFileToSynUnicode(ExeVersion.ProgramFilePath+'showdown.js');
|
|
fServer.AddUrl('root','888',false,'+',true);
|
|
fServer.RegisterCompress(CompressDeflate); // our server will deflate html :)
|
|
fServer.OnRequest := Process;
|
|
fServer.Clone(31); // will use a thread pool of 32 threads in total
|
|
end;
|
|
|
|
destructor TTestServer.Destroy;
|
|
begin
|
|
fSMManager.Free;
|
|
fServer.Free;
|
|
inherited;
|
|
end;
|
|
|
|
/// native loadFile() function used to load file from disc
|
|
// - same as TTestServer.LoadFile() method, but lower-level (I'm quite confident
|
|
// you would appreciate the difference in length and complexity!)
|
|
// - expect 1 string argument as filePath
|
|
function nsm_loadFile(cx: PJSContext; argc: uintN; vp: Pjsval): JSBool; cdecl;
|
|
var in_argv: PjsvalVector;
|
|
filePath: TFileName;
|
|
begin
|
|
TSynFPUException.ForDelphiCode;
|
|
try
|
|
if argc<>1 then
|
|
raise Exception.Create('Invalid number of args for loadFile(): required 1 (file path)');
|
|
in_argv := JS_ARGV(cx,vp);
|
|
filePath := JSVAL_TO_STRING(in_argv[0]).ToString(cx);
|
|
JS_SET_RVAL(cx, vp, cx^.NewJSString(AnyTextFileToSynUnicode(filePath)).ToJSVal);
|
|
Result := JS_TRUE;
|
|
except
|
|
on E: Exception do begin // all exceptions MUST be catched on Delphi side
|
|
JS_SET_RVAL(cx, vp, JSVAL_VOID);
|
|
JSError(cx, E);
|
|
Result := JS_FALSE;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// see how easy it is, when compared to nsm_loadFile() low-level function!
|
|
function TTestServer.LoadFile(const This: variant; const Args: array of variant): variant;
|
|
begin
|
|
if length(Args)<>1 then
|
|
raise Exception.Create('Invalid number of args for loadFile(): required 1 (file path)');
|
|
result := AnyTextFileToSynUnicode(Args[0]);
|
|
end;
|
|
|
|
// here using JSON has no advantage (it will be used for interface-based call)
|
|
function TTestServer.LoadFileJSON(const This: TSMObject; const Args: RawUTF8): RawUTF8;
|
|
var input: TDocVariantData; // easy access to JSON array
|
|
begin
|
|
input.InitJSON(Args);
|
|
if input.Count<>1 then
|
|
raise Exception.Create('Invalid number of args for loadFile(): required 1 (file path)');
|
|
result:= JSONEncodeArrayOfConst([AnyTextFileToSynUnicode(input.Values[0])],true);
|
|
end;
|
|
|
|
procedure TTestServer.DoOnNewEngine(const Engine: TSMEngine);
|
|
var showDownRunner: SynUnicode;
|
|
begin
|
|
// add external JavaScript library to engine (port of the Markdown library)
|
|
Engine.Evaluate(fShowDownLib, 'showdown.js');
|
|
|
|
// add the bootstrap function calling loadfile() then showdown's makeHtml()
|
|
showDownRunner := AnyTextFileToSynUnicode(ExeVersion.ProgramFilePath+'showDownRunner.js');
|
|
Engine.Evaluate(showDownRunner, 'showDownRunner.js');
|
|
|
|
// add native function to the engine (we show the 3 ways)
|
|
Engine.RegisterMethod(Engine.GlobalObj,'loadFile',LoadFile,1);
|
|
//Engine.RegisterMethod(Engine.GlobalObj,'loadFile',LoadFileJSON,1);
|
|
//Engine.GlobalObject.DefineNativeMethod('loadFile', nsm_loadFile, 1);
|
|
end;
|
|
|
|
{$WARN SYMBOL_PLATFORM OFF}
|
|
|
|
function TTestServer.Process(Ctxt: THttpServerRequest): cardinal;
|
|
var W: TTextWriter;
|
|
FileName, FileExt: TFileName;
|
|
FN, SRName, href: RawUTF8;
|
|
content: variant;
|
|
i: integer;
|
|
SR: TSearchRec;
|
|
engine: TSMEngine;
|
|
timer: TPrecisionTimer;
|
|
|
|
procedure hrefCompute;
|
|
begin
|
|
SRName := StringToUTF8(SR.Name);
|
|
href := FN+StringReplaceChars(SRName,'\','/');
|
|
end;
|
|
|
|
begin
|
|
// most of this method content is taken from sample "09 - HttpApi web server"
|
|
if not IdemPChar(pointer(Ctxt.URL),'/ROOT') then begin
|
|
result := 404;
|
|
exit;
|
|
end;
|
|
FN := StringReplaceChars(UrlDecode(copy(Ctxt.URL,7,maxInt)),'/','\');
|
|
if PosEx('..',FN)>0 then begin
|
|
result := 404; // circumvent obvious potential security leak
|
|
exit;
|
|
end;
|
|
while (FN<>'') and (FN[1]='\') do
|
|
delete(FN,1,1);
|
|
while (FN<>'') and (FN[length(FN)]='\') do
|
|
delete(FN,length(FN),1);
|
|
FileName := fPath+UTF8ToString(FN);
|
|
|
|
// 1. either reply directory listing as html
|
|
if DirectoryExists(FileName) then begin
|
|
W := TTextWriter.CreateOwnedStream;
|
|
try
|
|
W.Add('<html><body style="font-family: Arial">'+
|
|
'<h3>%</h3><p><table>',[FN]);
|
|
FN := StringReplaceChars(FN,'\','/');
|
|
if FN<>'' then
|
|
FN := FN+'/';
|
|
if FindFirst(FileName+'\*.*',faDirectory,SR)=0 then begin
|
|
repeat
|
|
if (SR.Attr and faDirectory<>0) and (SR.Name<>'.') then begin
|
|
hrefCompute;
|
|
if SRName='..' then begin
|
|
i := length(FN);
|
|
while (i>0) and (FN[i]='/') do dec(i);
|
|
while (i>0) and (FN[i]<>'/') do dec(i);
|
|
href := copy(FN,1,i);
|
|
end;
|
|
W.Add('<tr><td><b><a href="/root/%">[%]</a></b></td></tr>',[href,SRName]);
|
|
end;
|
|
until FindNext(SR)<>0;
|
|
FindClose(SR);
|
|
end;
|
|
if FindFirst(FileName+'\*.*',faAnyFile-faDirectory-faHidden,SR)=0 then begin
|
|
repeat
|
|
hrefCompute;
|
|
if SR.Attr and faDirectory=0 then
|
|
W.Add('<tr><td><b><a href="/root/%">%</a></b></td><td>%</td><td>%</td></td></tr>',
|
|
[href,SRName,KB(SR.Size),DateTimeToStr(
|
|
{$ifdef ISDELPHIXE2}SR.TimeStamp{$else}FileDateToDateTime(SR.Time){$endif})]);
|
|
until FindNext(SR)<>0;
|
|
FindClose(SR);
|
|
end;
|
|
W.AddShort(
|
|
'</table></p><gr><p><small>Powered by <a href=http://mormot.net>'+
|
|
XPOWEREDPROGRAM+'</a></small></p></body></html>');
|
|
Ctxt.OutContent := W.Text;
|
|
Ctxt.OutContentType := HTML_CONTENT_TYPE;
|
|
result := 200;
|
|
finally
|
|
W.Free;
|
|
end;
|
|
end else begin
|
|
|
|
// 2. or SpiderMonkey is used to render the *.md file as HTML :)
|
|
FileExt := ExtractFileExt(FileName);
|
|
if FileExt='.md' then begin
|
|
timer.Start;
|
|
|
|
// 2.1 ensure automatic garbage collection
|
|
engine := fSMManager.ThreadSafeEngine;
|
|
i := InterlockedIncrement(fCalls);
|
|
// in a real application should better be per-thread counter
|
|
if i mod 10=0 then // better to place this counter inside each thread
|
|
engine.GarbageCollect else // naive trigger of GC
|
|
engine.MaybeGarbageCollect; // perform garbage collection if needed
|
|
|
|
// 2.2 execute showDownRunner() JavaScript function (via late-binding!)
|
|
content := engine.Global.showDownRunner(FileName);
|
|
//former line of code is the same as the slightly faster:
|
|
//content := engine.GlobalObject.Run('showDownRunner',[SynUnicode(FileName)]);
|
|
|
|
// 2.3 return HTML content
|
|
Ctxt.OutContent := FormatUTF8(
|
|
'% <hr><p><small><a href=/root/%s>%</a> rendered by '+
|
|
'<a href=/root/showdown.js>showdown.js</a> '+
|
|
'on <a href=http://mormot.net>'+XPOWEREDPROGRAM+
|
|
'</a> server in % using SpiderMonkey %</small></p></body></html>',
|
|
[content,FN,ExtractFileName(FileName),Timer.Stop,engine.cx.VersionToString]);
|
|
Ctxt.OutContentType := HTML_CONTENT_TYPE;
|
|
end else begin;
|
|
|
|
// 3. or http.sys will send the specified file from kernel mode
|
|
if FileExt='.mds' then
|
|
SetLength(FileName,length(FileName)-1);
|
|
Ctxt.OutContent := StringToUTF8(FileName);
|
|
Ctxt.OutContentType := HTTP_RESP_STATICFILE;
|
|
// THttpApiServer.Execute will return 404 if not found
|
|
end;
|
|
result := 200;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
with TTestServer.Create(ExeVersion.ProgramFilePath) do
|
|
try
|
|
write('Server is now running on http://localhost:888/root'#13#10#13#10+
|
|
'Press [Enter] to quit');
|
|
readln;
|
|
finally
|
|
Free;
|
|
end;
|
|
|
|
{$endif WIN64}
|
|
end.
|
|
|