Linux-TDC2019/Linux.ServerModule.pas at master · toppermitz/Linux-TDC2019 · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
unit Linux.ServerModule;

interface

uses
  System.SysUtils, System.Classes, IdBaseComponent, IdComponent, IdCustomTCPServer,
  IdCustomHTTPServer, IdHTTPServer, Stats.SystemInfo, System.IOUtils,
  System.JSON.Serializers, Stats.Config, IdContext, Linux.Utils, Stats.Types;

type
  TServerModule = class(TDataModule)
    HTTPServer: TIdHTTPServer;
    procedure HTTPServerCommandGet(AContext: TIdContext;
      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure HTTPServerCommandOther(AContext: TIdContext;
      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    FConfig : TStatsConfig;
    function Auth(var ARequestInfo : TIdHTTPRequestInfo; var AResponseInfo : TIdHttpResponseInfo): Boolean;
    function NeedAuth(AUri : string) : Boolean;
    procedure GetFile(ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure OnCommand(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
  public
    procedure ConfigurePort(APort: Integer = -1);
    procedure Start;
    procedure Stop;
    class procedure InstallService(const ADistro : TLinuxDistro; const APath :String);static;
  end;

var
  ServerModule: TServerModule;

implementation

{%CLASSGROUP 'System.Classes.TPersistent'}

{$R *.dfm}

function TServerModule.Auth(var ARequestInfo: TIdHTTPRequestInfo;
  var AResponseInfo: TIdHttpResponseInfo): Boolean;
begin
  Result := ARequestInfo.AuthExists and (ARequestInfo.AuthUsername = 'master') and (ARequestInfo.AuthPassword = 'senha');

  if Result then
  begin
    AResponseInfo.ResponseNo := 200;
  end else begin
    AResponseInfo.AuthRealm := 'Linux Stats Monitor';
  end;
end;

procedure TServerModule.ConfigurePort(APort: Integer = -1);
begin
  Stop;
  if APort = -1 then
  begin
    FConfig.Free;
    FConfig := TStatsConfig.LoadFromJSON(TLinuxUtils.GetApplicationPath + TStatsConfig.ConfigFileName,seUTF8);
    HTTPServer.DefaultPort := FConfig.HTTPPort;
  end else begin
    HTTPServer.DefaultPort := APort;
  end;
  Start;
end;

procedure TServerModule.DataModuleCreate(Sender: TObject);
begin
  FConfig := TStatsConfig.LoadFromJSON(TLinuxUtils.GetApplicationPath + TStatsConfig.ConfigFileName,seUTF8);
end;

procedure TServerModule.DataModuleDestroy(Sender: TObject);
begin
  FConfig.Free;
end;

procedure TServerModule.GetFile(ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  FileStream: TFileStream;
  FileName : String;
begin
  FileName := ARequestInfo.URI;

  if Copy(FileName, FileName.Length - 1 , 1) = '/' then
      FileName := FileName + 'index.html';

  if NeedAuth(FileName) and not Auth(ARequestInfo,AResponseInfo) then
    Exit;

  if TFile.Exists(FConfig.WebPath + FileName) then
  begin
    FileStream := TFile.Open(FConfig.WebPath + FileName,TFileMode.fmOpen);
    AResponseInfo.ContentStream := FileStream;
    AResponseInfo.ContentLength := FileStream.Size;
    AResponseInfo.ContentType := AResponseInfo.HTTPServer.MIMETable.GetFileMIMEType(FConfig.WebPath + FileName) + '; charset=UTF-8';
  end
  else
    AResponseInfo.ResponseNo := 404;
end;


procedure TServerModule.HTTPServerCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  OnCommand(AContext, ARequestInfo, AResponseInfo);
end;

procedure TServerModule.HTTPServerCommandOther(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  OnCommand(AContext, ARequestInfo, AResponseInfo);
end;

class procedure TServerModule.InstallService(const ADistro: TLinuxDistro;const APath: String);
begin

end;

function TServerModule.NeedAuth(AUri: string): Boolean;
begin
  Result := true;
  if AUri.ToLower = '/img/favicon.png' then
    Result := false;
end;

procedure TServerModule.OnCommand(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  SystemInfo : TSystemInfo;
  Serializer : TJsonSerializer;
begin
  if ARequestInfo.URI.ToLower = '/get/server' then
  begin
    SystemInfo := TSystemInfo.Create;
    try
      Serializer := TJsonSerializer.Create;
      try
        AResponseInfo.ContentType := 'application/json';
        AResponseInfo.ContentText := Serializer.Serialize(SystemInfo);
      finally
        if Assigned(Serializer) then
          Serializer.Free;
      end;
    finally
      if Assigned(SystemInfo) then
        SystemInfo.Free;
    end;
  end else begin
    GetFile(ARequestInfo, AResponseInfo);
  end;
end;

procedure TServerModule.Start;
begin
  if HTTPServer <> nil then
    if not HTTPServer.Active then
      HTTPServer.Active := True;
end;

procedure TServerModule.Stop;
begin
  HTTPServer.Active := False;
end;

end.