Coverage report for Casbin.Parser.

Generated at 18/02/2019 12:10:19 by DelphiCodeCoverage - an open source tool for Delphi Code Coverage.

Statistics for Casbin.Parser.pas

Number of lines covered176
Number of lines with code gen186
Line coverage94%


1
// Copyright 2018 by John Kouraklis and Contributors. All Rights Reserved.
2
//
3
// Licensed under the Apache License, Version 2.0 (the "License");
4
// you may not use this file except in compliance with the License.
5
// You may obtain a copy of the License at
6
//
7
//      http://www.apache.org/licenses/LICENSE-2.0
8
//
9
// Unless required by applicable law or agreed to in writing, software
10
// distributed under the License is distributed on an "AS IS" BASIS,
11
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12
// See the License for the specific language governing permissions and
13
// limitations under the License.
14
unit Casbin.Parser;
15
16
interface
17
18
uses
19
  Casbin.Core.Base.Types, Casbin.Parser.Types, Casbin.Core.Logger.Types, Casbin.Parser.AST.Types;
20
21
type
22
  TParser = class (TBaseInterfacedObject, IParser)
23
  private
24
    fLogger: ILogger;
25
    fErrorMessage: string;
26
    fParseString: string;
27
    fParseType: TParseType;
28
    fStatus: TParserStatus;
29
    fNodes: TNodeCollection;
30
    procedure cleanWhiteSpace; //PALOFF
31
    procedure checkSyntaxErrors; //PALOFF
32
    procedure checkHeaders;  //PALOFF
33
    procedure parseContent;
34
  private
35
{$REGION 'Interface'}
36
    function getErrorMessage: string;
37
    function getLogger: ILogger;
38
    function getParseType: TParseType;
39
    procedure parse;
40
    procedure setLogger(const aValue: ILogger);
41
    function getStatus: TParserStatus;
42
    function getNodes: TNodeCollection;
43
{$ENDREGION}
44
  public
45
    constructor Create(const aParseString: string; const aParseType: TParseType);
46
    destructor Destroy; override;
47
  end;
48
49
implementation
50
51
uses
52
  Casbin.Core.Logger.Default, System.IniFiles, System.Classes,
53
  Casbin.Core.Defaults, Casbin.Core.Strings, System.StrUtils,
54
  Casbin.Model.Sections.Types,
55
  Casbin.Model.Sections.Default, Casbin.Parser.AST, Casbin.Effect.Types,
56
  System.Math, Casbin.Core.Utilities, System.SysUtils;
57
58
constructor TParser.Create(const aParseString: string; const aParseType:
59
    TParseType);
60
begin
61
  inherited Create;
62
  fParseString:=aParseString;
63
  fParseType:=aParseType;
64
  fLogger:=TDefaultLogger.Create;
65
  fStatus:=psIdle;
66
  fNodes:=TNodeCollection.Create;
67
end;
68
69
destructor TParser.Destroy;
70
begin
71
  fNodes.Free;
72
  inherited;
73
end;
74
75
procedure TParser.checkHeaders;
76
var
77
  headerSet: TSectionTypeSet;
78
  section: TSectionType;
79
  sectionObj: TSection;
80
  fileString: string;
81
begin
82
  case fParseType of
83
    ptModel: begin
84
               headerSet:= modelSections;
85
               fileString:=modelFileString;
86
             end;
87
    ptPolicy: begin
88
                headerSet:= policySections;
89
                fileString:=policyFileString;
90
              end;
91
    ptConfig: begin
92
                headerSet:= configSections;
93
                fileString:=configFileString;
94
              end;
95
  end;
96
97
  for section in headerSet do
98
  begin
99
    sectionObj:=createDefaultSection(section);
100
    if (Pos(UpperCase(sectionObj.Header), UpperCase(fParseString)) = 0) and
101
                                              sectionObj.Required then
102
    begin
103
      fErrorMessage:=Format(errorSectionNotFound,
104
                            [sectionObj.Header, fileString]);
105
      fStatus:=psError;
106
    end;
107
    sectionObj.Free;
108
    if fStatus=psError then
109
      Exit;
110
  end;
111
end;
112
113
procedure TParser.checkSyntaxErrors;
114
var
115
  insideHeader: Boolean;
116
  ch: Char;
117
  fileString: string;
118
  numLSquare: integer;
119
  posX: Integer;
120
  posY: Integer;
121
  strList: TStringList;
122
  showError: Boolean;
123
begin
124
  case fParseType of
125
    ptModel: fileString:=modelFileString;
126
    ptPolicy: fileString:=policyFileString;
127
    ptConfig: fileString:=configFileString;
128
  end;
129
130
  insideHeader:=False;
131
  numLSquare:=0;
132
  posX:=Low(string);
133
  posY:=1;
134
  for ch in fParseString do
135
  begin
136
    showError:=False;
137
    case ch of
138
      '[': if insideHeader then
139
             showError:=True
140
           else
141
           begin
142
            insideHeader:=True;
143
            Inc(numLSquare);
144
           end;
145
      ']': begin
146
             insideHeader:=False;
147
             if numLSquare = 0 then
148
              showError:=True;
149
           end;
150
    end;
151
152
    if showError then
153
    begin
154
      fErrorMessage:=format(errorWrongHeaderFormat, [PosX, PosY, fileString]);
155
      fStatus:=psError;
156
      Exit;
157
    end;
158
159
    if SameText(Copy(fParseString, posX, Length(EOL)), EOL) then
160
    begin
161
      posX:=Low(string);
162
      Inc(posY);
163
    end
164
    else
165
      Inc(posX);
166
  end;
167
168
  // If there is no section in the beginning add the default
169
  // to keep the parser happy
170
  strList:=TStringList.Create;
171
  try
172
    strList.Text:=fParseString;
173
    if (strList.Count>0) and (strList.Strings[0][Low(string)]<>'[') then
174
      fParseString:='['+DefaultSection.Header+']'+EOL+fParseString;
175
  finally
176
    strList.Free;
177
  end;
178
end;
179
180
procedure TParser.cleanWhiteSpace;
181
var
182
  index: integer;
183
  assignmentIndex: integer;
184
  i: Integer;
185
  lenPosition: Integer;
186
  matchersPosEnd: Integer;
187
  nextSectionPos: Integer;
188
  section: TSection;
189
  testStr: string;
190
begin
191
  // Clean EOL in front of the string
192
  while (Length(fParseString)>0) and (Length(fParseString)>=Length(EOL)) and
193
    (Copy(fParseString, Low(string), Length(EOL)) = EOL) do
194
    fParseString:=Copy(fParseString, Length(EOL)+1, Length(fParseString));
195
196
  // Clean multiline chars
197
  index:= Pos(DefaultMultilineCharacters, fParseString, Low(string));
198
  while index<>0 do
199
  begin
200
    testStr:=Copy(fParseString, index+Length(DefaultMultilineCharacters),
201
                                                                  Length(EOL));
202
    if testStr=EOL then
203
      Delete(fParseString, index+Length(DefaultMultilineCharacters),
204
                                                                  Length(EOL));
205
    Delete(fParseString, index, Length(DefaultMultilineCharacters));
206
    index:= Pos(DefaultMultilineCharacters, fParseString, Low(string));
207
  end;
208
209
  // Clean tabs
210
  index:= Pos(#9, fParseString, Low(string));
211
  while index<>0 do
212
  begin
213
    Delete(fParseString, index, 1);
214
    index:= Pos(#9, fParseString, Low(string));
215
  end;
216
217
  // Clean spaces
218
  // Except in Config file if spaces are in values
219
  // Except in Matchers section
220
  lenPosition:=0;
221
  index:= Pos(#32, fParseString, Low(string));
222
  while (index<>0) and (lenPosition<=Length(fParseString)) do
223
  begin
224
    if fParseType=ptConfig then
225
    begin
226
      assignmentIndex:=Pos(AssignmentCharForConfig, fParseString, Low(string));
227
      if (assignmentIndex<>0) and (assignmentIndex>index) then
228
        Delete(fParseString, index, 1)
229
      else
230
        Break;
231
    end
232
    else
233
    begin
234
      section:=createDefaultSection(stMatchers);
235
      matchersPosEnd:=Pos(UpperCase(section.Header), UpperCase(fParseString),
236
                                                low(string));
237
      if matchersPosEnd>0 then
238
        matchersPosEnd:=matchersPosEnd+Length(section.Header+']');
239
      section.Free;
240
      nextSectionPos:=0;
241
      for i:=matchersPosEnd to Length(fParseString)-1 do
242
      begin
243
        if fParseString[i]='[' then
244
        begin
245
          nextSectionPos:=i;
246
          Break;
247
        end;
248
      end;
249
      if (index<matchersPosEnd) then
250
        Delete(fParseString, index, 1)
251
      else
252
        if (nextSectionPos<>0) and (index>nextSectionPos) then
253
            Delete(fParseString, index, 1);
254
    end;
255
    index:= Pos(#32, fParseString, Low(string));
256
    Inc(lenPosition);
257
  end;
258
259
  // Clean quotes
260
  // Single Quote
261
  index:= Pos(#39, fParseString, Low(string));
262
  while index<>0 do
263
  begin
264
    Delete(fParseString, index, 1);
265
    index:= Pos(#39, fParseString, Low(string));
266
  end;
267
268
  // Double Quote
269
  index:= Pos(#34, fParseString, Low(string));
270
  while index<>0 do
271
  begin
272
    Delete(fParseString, index, 1);
273
    index:= Pos(#34, fParseString, Low(string));
274
  end;
275
276
277
end;
278
279
{ TParser }
280
281
function TParser.getErrorMessage: string;
282
begin
283
  Result:=fErrorMessage;
284
end;
285
286
function TParser.getLogger: ILogger;
287
begin
288
  Result:=fLogger;
289
end;
290
291
function TParser.getNodes: TNodeCollection;
292
begin
293
  Result:=fNodes;
294
end;
295
296
function TParser.getParseType: TParseType;
297
begin
298
  Result:=fParseType;
299
end;
300
301
function TParser.getStatus: TParserStatus;
302
begin
303
  Result:=fStatus;
304
end;
305
306
procedure TParser.parse;
307
begin
308
  fErrorMessage:='';
309
  fNodes.Headers.Clear;
310
  fStatus:=psRunning;
311
  fLogger.log('Parser started');
312
313
314
  fLogger.log('Cleaning whitespace...');
315
  cleanWhiteSpace;
316
  fLogger.log('Cleaning of whitespace finished');
317
318
  if fStatus<>psError then
319
  begin
320
    fLogger.log('Checking for Syntax Errors...');
321
    checkSyntaxErrors;
322
    fLogger.log('Syntax error check completed');
323
  end;
324
325
  if fStatus<>psError then
326
  begin
327
    fLogger.log('Checking headers...');
328
    checkHeaders;
329
    fLogger.log('Check of headers completed');
330
  end;
331
332
  if fStatus<>psError then
333
  begin
334
    fLogger.log('Parsing content...');
335
    parseContent;
336
    fLogger.log('Content parse completed');
337
  end;
338
339
  if fStatus=psError then
340
  begin
341
    fLogger.log('Error while parsing: '+fErrorMessage+EOL+'Parsing failed');
342
  end
343
  else
344
    fStatus:=psIdle;
345
346
  fLogger.log('Parser finished');
347
end;
348
349
procedure TParser.parseContent;
350
var
351
  mainLines: TStringList;
352
  line: string;
353
  tmpStr: string;
354
  header: THeaderNode;   //PALOFF
355
  startPos: Integer;
356
  endPos: Integer;
357
begin
358
  mainLines:=TStringList.Create;
359
  try
360
    mainLines.Text:=fParseString;
361
362
    startPos:=findStartPos;
363
    for line in mainLines do
364
    begin
365
      endPos:=findEndPos(line);
366
      if (Trim(line)<>'') and (line[Low(string)]='[') and (line[endPos]=']') then
367
      begin
368
        tmpStr:=Copy(Copy(line, startPos, endPos-1), startPos+1,
369
                                                          endPos-1);
370
        header:=THeaderNode.Create;  //PALOFF
371
        header.Value:=tmpStr;
372
        case IndexStr(UpperCase(tmpStr),
373
                      [UpperCase(defaultSection.Header),
374
                       UpperCase(requestDefinition.Header),
375
                       UpperCase(policyDefinition.Header),
376
                       UpperCase(roleDefinition.Header),
377
                       UpperCase(policyEffectDefinition.Header),
378
                       UpperCase(matchersDefinition.Header)]) of
379
          0: header.SectionType:=stDefault;
380
          1: header.SectionType:=stRequestDefinition;
381
          2: header.SectionType:=stPolicyDefinition;
382
          3: header.SectionType:=stRoleDefinition;
383
          4: header.SectionType:=stPolicyEffect;
384
          5: header.SectionType:=stMatchers;
385
        else
386
          header.SectionType:=stUnknown;
387
        end;
388
        fNodes.Headers.Add(header);
389
      end
390
      else
391
      begin
392
        if Assigned(header) then
393
        begin
394
          if fParseType=ptPolicy then
395
            header.SectionType:=stPolicyRules;
396
          if Trim(line)<>'' then
397
          begin
398
            addAssertion(header, line);
399
            if (header.SectionType=stPolicyEffect) and
400
              ((header.ChildNodes.Items
401
                  [header.ChildNodes.Count-1] as TEffectNode)
402
                                              .EffectCondition=ecUnknown) then
403
            begin
404
              fErrorMessage:=format(errorUnknownAssertion, [line]);
405
              fStatus:=psError;
406
              Exit;
407
            end;
408
          end;
409
        end;
410
      end;
411
    end;
412
  finally
413
    mainLines.Free;
414
  end;
415
end;
416
417
procedure TParser.setLogger(const aValue: ILogger);
418
begin
419
  fLogger:=aValue;
420
end;
421
422
end.