cross socket ICrossHttpServer

cross socket ICrossHttpServer

cross socket是delphi跨平台的一个socket库。

/// <author>cxg 2023-2-12</author>
/// TStream(ARequest.body)，auto be free

unit sock.CrossHttpSvr;

interface

uses
  system.JSON, json.help, keyValue.serialize, api.router,
  Net.CrossSocket.Base, global, yn.log, Net.CrossHttpServer,
  Net.CrossSslSocket, Net.CrossSslDemoCert, System.Math,
  System.IniFiles, System.SysUtils, System.Classes;

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
  TcrossHttpSvr = class
  private
    FHttpServer: ICrossHttpServer;
    FShutdown: Boolean;
    procedure Process;
  public
    constructor Create; overload;
    destructor Destroy; override;
  public
    procedure Start;
    procedure Stop;
    property HttpServer: ICrossHttpServer read FHttpServer;
  end;

implementation

function strof(const aStream: TStream): RawByteString; overload;
begin
  SetLength(Result, aStream.Size);
  aStream.Position := 0;
  aStream.Read(Result[1], aStream.Size);
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: ICrossHttpResponse; const ContentType: string);
begin
  Ctxt.Header['Access-Control-Allow-Origin'] := '*';
  Ctxt.Header['Access-Control-Allow-Methods'] := '*';
  Ctxt.Header['Access-Control-Allow-Headers'] := '*';
  Ctxt.ContentType := ContentType;
end;

procedure router(const Ctxt: ICrossHttpRequest; const Ctxt2: ICrossHttpResponse);
begin
  if Pos('/bin', Ctxt.RawPathAndParams) > 0 then      //二进制 API
  begin
    setHeader(Ctxt2, cBin);
    var req: TSerialize := tserialize.Create;
    var res: TSerialize := tserialize.Create;
    var ms: TStream := TStream(Ctxt.Body);
    if ms <> nil then
      req.unMarshal(ms);
    var url: string := Ctxt.RawPathAndParams;
    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;
    Ctxt2.Send(res.marshal2,
      procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
      begin
        req.Free;
        res.Free;
      end);
  end
  else if Pos('/rest', Ctxt.RawPathAndParams) > 0 then    //JSON API
  begin
    setHeader(Ctxt2, cJson);
    var url: string := Ctxt.RawPathAndParams;
    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;
    var ms: TStream := TStream(Ctxt.Body);
    var body: RawByteString;
    if ms <> nil then
      body := strof(ms);
    req.asStr['body'] := body;
    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;
    Ctxt2.Send(UTF8Encode(res.asStr['res']),
      procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
      begin
        req.Free;
        res.Free;
      end);
  end
  else if Pos('/protobuf', Ctxt.RawPathAndParams) > 0 then   //PROTOBUF API
  begin
    setHeader(Ctxt2, cProtobuf);
    var url: string := Ctxt.RawPathAndParams;
    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;
    var ms: TStream := TStream(Ctxt.Body);
    var body: TBytes;
    if ms <> nil then
      strof(ms);
    req.asBytes['body'] := body;
    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;
    Ctxt2.Send(res.asBytes['res'],
      procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
      begin
        req.Free;
        res.Free;
      end);
  end;
end;

constructor TcrossHttpSvr.Create;
begin
  var ini: TIniFile := TIniFile.create(SvrCfg);
  var threadnum: Integer := ini.readinteger('config', 'threadnum', 32);
  if threadnum > 256 then
    threadnum := 256;
  var ssl: Boolean := ini.readbool('config', 'ssl', False);
  FHttpServer := TCrossHttpServer.create(threadnum, ssl); // New http server
  if FHttpServer.SSL then
  begin
    FHttpServer.SetCertificate(SSL_SERVER_CERT);
    FHttpServer.SetPrivateKey(SSL_SERVER_PKEY);
  end;

  FHttpServer.Addr := IPv4v6_ALL;
  FHttpServer.Port := ini.readinteger('config', 'httpport', 0); // port
  ini.Free;
  {$IFDEF console}
  Writeln('New cross http server');
  Writeln('Http port: ', FHttpServer.Port);
  Writeln('Thread num: ', threadnum);
  {$ENDIF}
  FHttpServer.Compressible := True; // zip?
  Process;
  Self.Start;
end;

destructor TcrossHttpSvr.Destroy;
begin
  Self.Stop;
  FHttpServer := nil;
  inherited;
end;

procedure TcrossHttpSvr.Start;
begin
  FHttpServer.Start;
end;

procedure TcrossHttpSvr.Stop;
begin
  FHttpServer.Stop;
  FShutdown := True;
  Sleep(150);
end;

procedure TcrossHttpSvr.Process;
begin
  try
    FHttpServer.All('*',
      procedure(const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse)
      begin
        router(ARequest, AResponse);
      end);
  except
    on E: Exception do
    begin
      writelog('TcrossHttpSvr.Process()' + E.message);
    end;
  end;
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.