mormot1.18 THttpApiServer

mormot1.18 THttpApiServer

官方已经推荐使用mormot2，mormot1.18已经进入只修正bug的阶段。

THttpApiServer是对windows http.sys通信的封装，因此只适用于windows。

//cxg 2023-2-12
//mormot1.18 http.sys 适用于WINDOWS2003,XP SP2及以后版本

unit sock.httpsys;

interface

uses
  System.JSON, Json.help, keyValue.serialize, api.router,
  inifiles, SynCrtSock, Classes, SysUtils;

var
  BinApis: TJSONObject;    //二进制API
  RestApis: TJSONObject;   //REST API，包括json,protobuf

const  //content-type
  cBin = 'application/octet-stream; charset=utf-8';
  cJson = 'application/json; charset=utf-8';
  cProtobuf = 'application/protobuf; charset=utf-8';

type
  THttpsys = class
  private
    fServer: THttpApiServer;
    function Process(Ctxt: THttpServerRequest): Cardinal;
  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation

function strof(const aBytes: TBytes): RawByteString; overload;
begin
  SetLength(Result, Length(aBytes));
  Move(aBytes[0], Result[1], Length(aBytes));
end;

function ReadJsonFile(const FileName: string): string;
begin
  var f: TStringList := TStringList.Create;
  f.LoadFromFile(FileName, TEncoding.UTF8);
  Result := f.Text;
  f.Free;
end;

procedure setHeader(const Ctxt: THttpServerRequest; const ContentType: string);
begin
  Ctxt.OutContentType := ContentType;
  Ctxt.OutCustomHeaders := 'Access-Control-Allow-Origin:*' + #13#10 + 'Access-Control-Allow-Methods:*' + #13#10 + 'Access-Control-Allow-Headers:*';
end;

procedure router(const Ctxt: THttpServerRequest);
begin
  if Pos('/bin', Ctxt.URL) > 0 then      //二进制 API
  begin
    setHeader(Ctxt, cBin);
    var req: TSerialize := tserialize.Create;
    var res: TSerialize := tserialize.Create;
    if Ctxt.InContent > '' then
      req.unMarshal(Ctxt.InContent);
    var url: string := Ctxt.URL;
    var arr: TArray<string> := url.Split(['/']);
    var funcName: string := arr[2];
    var ja: TJSONArray := BinApis.A['bin'];
    for var i: Integer := 0 to ja.Count - 1 do
    begin
      var o: TJSONObject := ja.Items[i] as TJSONObject;
      if o.S['funcname'] = funcName then
      begin
        RouterAPI(o.S['classname'], o.S['funcname'], [req, res]);
        Break;
      end;
    end;
    Ctxt.OutContent := res.marshal3;
    req.Free;
    res.Free;
  end
  else if Pos('/rest', Ctxt.URL) > 0 then    //JSON API
  begin
    setHeader(Ctxt, cJson);
    var url: string := Ctxt.URL;
    var arr: TArray<string> := url.Split(['/']);
    var resource: string := arr[2];
    var req: TSerialize := tserialize.Create;
    var res: TSerialize := tserialize.Create;
    req.asStr['url'] := url;
    if Ctxt.InContent > '' then
      req.asStr['body'] := Ctxt.InContent;
    req.asStr['type'] := 'json';
    var ja: TJSONArray := RestApis.A[resource];
    for var i: Integer := 0 to ja.Count - 1 do
    begin
      var o: TJSONObject := ja.Items[i] as TJSONObject;
      if o.S['method'] = Ctxt.Method then
      begin
        RouterAPI(o.S['classname'], o.S['funcname'], [req, res]);
        Break;
      end;
    end;
    Ctxt.OutContent := UTF8Encode(res.asStr['res']);
    req.Free;
    res.Free;
  end
  else if Pos('/protobuf', Ctxt.URL) > 0 then   //PROTOBUF API
  begin
    setHeader(Ctxt, cProtobuf);
    var url: string := Ctxt.URL;
    var arr: TArray<string> := url.Split(['/']);
    var resource: string := arr[2];
    var req: TSerialize := tserialize.Create;
    var res: TSerialize := tserialize.Create;
    req.asStr['url'] := url;
    if Ctxt.InContent > '' then
      req.asBytes['body'] := BytesOf(Ctxt.InContent);
    req.asStr['type'] := 'protobuf';
    var ja: TJSONArray := RestApis.A[resource];
    for var i: Integer := 0 to ja.Count - 1 do
    begin
      var o: TJSONObject := ja.Items[i] as TJSONObject;
      if o.S['method'] = Ctxt.Method then
      begin
        RouterAPI(o.S['classname'], o.S['funcname'], [req, res]);
        Break;
      end;
    end;
    Ctxt.OutContent := strof(res.asBytes['res']);
    req.Free;
    res.Free;
  end;
end;

{ THttpsys }

function THttpsys.Process(Ctxt: THttpServerRequest): Cardinal;
begin
  router(Ctxt);
  Result := 200;
end;

constructor THttpsys.Create;
var
  ini: tinifile;
  httpport: string;
  threadnum: integer;
  ssl: Boolean;
begin
  ini := tinifile.create(extractfilepath(paramstr(0)) + 'server.conf');
  httpport := ini.readstring('config', 'httpport', '1122');
  threadnum := ini.readinteger('config', 'threadnum', 32);
  if threadnum > 256 then
    threadnum := 256;
  ssl := ini.ReadBool('config', 'ssl', False);
  fServer := THttpApiServer.Create(False);
  if not ssl then
    fServer.AddUrl('', httpport, False, '+', True)
  else
    fServer.AddUrl('', httpport, True, '+', True);
  fServer.OnRequest := Process;
  fServer.Clone(threadnum);
  ini.free;
  {$IFDEF console}
  Writeln('New http.sys server');
  Writeln('Http port: ', httpport);
  Writeln('Thread num: ', threadnum);
  {$ENDIF}
end;

destructor THttpsys.Destroy;
begin
  inherited Destroy;
end;

initialization
  binapis := TJSONObject.Create;
  restapis := TJSONObject.Create;
  binapis.Parse(ReadJsonFile(ExtractFilePath(ParamStr(0)) + 'binrouter.json'));
  restapis.Parse(ReadJsonFile(ExtractFilePath(ParamStr(0)) + 'restrouter.json'));

finalization
  FreeAndNil(binapis);
  FreeAndNil(restapis);

end.