Delphi CodeCoverage Coverage Report

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 covered	176
Number of lines with code gen	186
Line coverage	94%

// Copyright 2018 by John Kouraklis and Contributors. All Rights Reserved.
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//      http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
unit Casbin.Parser;

interface

uses
  Casbin.Core.Base.Types, Casbin.Parser.Types, Casbin.Core.Logger.Types, Casbin.Parser.AST.Types;

type
  TParser = class (TBaseInterfacedObject, IParser)
  private
    fLogger: ILogger;
    fErrorMessage: string;
    fParseString: string;
    fParseType: TParseType;
    fStatus: TParserStatus;
    fNodes: TNodeCollection;
    procedure cleanWhiteSpace; //PALOFF
    procedure checkSyntaxErrors; //PALOFF
    procedure checkHeaders;  //PALOFF
    procedure parseContent;
  private
{$REGION 'Interface'}
    function getErrorMessage: string;
    function getLogger: ILogger;
    function getParseType: TParseType;
    procedure parse;
    procedure setLogger(const aValue: ILogger);
    function getStatus: TParserStatus;
    function getNodes: TNodeCollection;
{$ENDREGION}
  public
    constructor Create(const aParseString: string; const aParseType: TParseType);
    destructor Destroy; override;
  end;

implementation

uses
  Casbin.Core.Logger.Default, System.IniFiles, System.Classes,
  Casbin.Core.Defaults, Casbin.Core.Strings, System.StrUtils,
  Casbin.Model.Sections.Types,
  Casbin.Model.Sections.Default, Casbin.Parser.AST, Casbin.Effect.Types,
  System.Math, Casbin.Core.Utilities, System.SysUtils;

constructor TParser.Create(const aParseString: string; const aParseType:
    TParseType);
begin
  inherited Create;
  fParseString:=aParseString;
  fParseType:=aParseType;
  fLogger:=TDefaultLogger.Create;
  fStatus:=psIdle;
  fNodes:=TNodeCollection.Create;
end;

destructor TParser.Destroy;
begin
  fNodes.Free;
  inherited;
end;

procedure TParser.checkHeaders;
var
  headerSet: TSectionTypeSet;
  section: TSectionType;
  sectionObj: TSection;
  fileString: string;
begin
  case fParseType of
    ptModel: begin
               headerSet:= modelSections;
               fileString:=modelFileString;
             end;
    ptPolicy: begin
                headerSet:= policySections;
                fileString:=policyFileString;
              end;
    ptConfig: begin
                headerSet:= configSections;
                fileString:=configFileString;
              end;
  end;

  for section in headerSet do
  begin
    sectionObj:=createDefaultSection(section);
    if (Pos(UpperCase(sectionObj.Header), UpperCase(fParseString)) = 0) and
                                              sectionObj.Required then
    begin
      fErrorMessage:=Format(errorSectionNotFound,
                            [sectionObj.Header, fileString]);
      fStatus:=psError;
    end;
    sectionObj.Free;
    if fStatus=psError then
      Exit;
  end;
end;

procedure TParser.checkSyntaxErrors;
var
  insideHeader: Boolean;
  ch: Char;
  fileString: string;
  numLSquare: integer;
  posX: Integer;
  posY: Integer;
  strList: TStringList;
  showError: Boolean;
begin
  case fParseType of
    ptModel: fileString:=modelFileString;
    ptPolicy: fileString:=policyFileString;
    ptConfig: fileString:=configFileString;
  end;

  insideHeader:=False;
  numLSquare:=0;
  posX:=Low(string);
  posY:=1;
  for ch in fParseString do
  begin
    showError:=False;
    case ch of
      '[': if insideHeader then
             showError:=True
           else
           begin
            insideHeader:=True;
            Inc(numLSquare);
           end;
      ']': begin
             insideHeader:=False;
             if numLSquare = 0 then
              showError:=True;
           end;
    end;

    if showError then
    begin
      fErrorMessage:=format(errorWrongHeaderFormat, [PosX, PosY, fileString]);
      fStatus:=psError;
      Exit;
    end;

    if SameText(Copy(fParseString, posX, Length(EOL)), EOL) then
    begin
      posX:=Low(string);
      Inc(posY);
    end
    else
      Inc(posX);
  end;

  // If there is no section in the beginning add the default
  // to keep the parser happy
  strList:=TStringList.Create;
  try
    strList.Text:=fParseString;
    if (strList.Count>0) and (strList.Strings[0][Low(string)]<>'[') then
      fParseString:='['+DefaultSection.Header+']'+EOL+fParseString;
  finally
    strList.Free;
  end;
end;

procedure TParser.cleanWhiteSpace;
var
  index: integer;
  assignmentIndex: integer;
  i: Integer;
  lenPosition: Integer;
  matchersPosEnd: Integer;
  nextSectionPos: Integer;
  section: TSection;
  testStr: string;
begin
  // Clean EOL in front of the string
  while (Length(fParseString)>0) and (Length(fParseString)>=Length(EOL)) and
    (Copy(fParseString, Low(string), Length(EOL)) = EOL) do
    fParseString:=Copy(fParseString, Length(EOL)+1, Length(fParseString));

  // Clean multiline chars
  index:= Pos(DefaultMultilineCharacters, fParseString, Low(string));
  while index<>0 do
  begin
    testStr:=Copy(fParseString, index+Length(DefaultMultilineCharacters),
                                                                  Length(EOL));
    if testStr=EOL then
      Delete(fParseString, index+Length(DefaultMultilineCharacters),
                                                                  Length(EOL));
    Delete(fParseString, index, Length(DefaultMultilineCharacters));
    index:= Pos(DefaultMultilineCharacters, fParseString, Low(string));
  end;

  // Clean tabs
  index:= Pos(#9, fParseString, Low(string));
  while index<>0 do
  begin
    Delete(fParseString, index, 1);
    index:= Pos(#9, fParseString, Low(string));
  end;

  // Clean spaces
  // Except in Config file if spaces are in values
  // Except in Matchers section
  lenPosition:=0;
  index:= Pos(#32, fParseString, Low(string));
  while (index<>0) and (lenPosition<=Length(fParseString)) do
  begin
    if fParseType=ptConfig then
    begin
      assignmentIndex:=Pos(AssignmentCharForConfig, fParseString, Low(string));
      if (assignmentIndex<>0) and (assignmentIndex>index) then
        Delete(fParseString, index, 1)
      else
        Break;
    end
    else
    begin
      section:=createDefaultSection(stMatchers);
      matchersPosEnd:=Pos(UpperCase(section.Header), UpperCase(fParseString),
                                                low(string));
      if matchersPosEnd>0 then
        matchersPosEnd:=matchersPosEnd+Length(section.Header+']');
      section.Free;
      nextSectionPos:=0;
      for i:=matchersPosEnd to Length(fParseString)-1 do
      begin
        if fParseString[i]='[' then
        begin
          nextSectionPos:=i;
          Break;
        end;
      end;
      if (index<matchersPosEnd) then
        Delete(fParseString, index, 1)
      else
        if (nextSectionPos<>0) and (index>nextSectionPos) then
            Delete(fParseString, index, 1);
    end;
    index:= Pos(#32, fParseString, Low(string));
    Inc(lenPosition);
  end;

  // Clean quotes
  // Single Quote
  index:= Pos(#39, fParseString, Low(string));
  while index<>0 do
  begin
    Delete(fParseString, index, 1);
    index:= Pos(#39, fParseString, Low(string));
  end;

  // Double Quote
  index:= Pos(#34, fParseString, Low(string));
  while index<>0 do
  begin
    Delete(fParseString, index, 1);
    index:= Pos(#34, fParseString, Low(string));
  end;


end;

{ TParser }

function TParser.getErrorMessage: string;
begin
  Result:=fErrorMessage;
end;

function TParser.getLogger: ILogger;
begin
  Result:=fLogger;
end;

function TParser.getNodes: TNodeCollection;
begin
  Result:=fNodes;
end;

function TParser.getParseType: TParseType;
begin
  Result:=fParseType;
end;

function TParser.getStatus: TParserStatus;
begin
  Result:=fStatus;
end;

procedure TParser.parse;
begin
  fErrorMessage:='';
  fNodes.Headers.Clear;
  fStatus:=psRunning;
  fLogger.log('Parser started');


  fLogger.log('Cleaning whitespace...');
  cleanWhiteSpace;
  fLogger.log('Cleaning of whitespace finished');

  if fStatus<>psError then
  begin
    fLogger.log('Checking for Syntax Errors...');
    checkSyntaxErrors;
    fLogger.log('Syntax error check completed');
  end;

  if fStatus<>psError then
  begin
    fLogger.log('Checking headers...');
    checkHeaders;
    fLogger.log('Check of headers completed');
  end;

  if fStatus<>psError then
  begin
    fLogger.log('Parsing content...');
    parseContent;
    fLogger.log('Content parse completed');
  end;

  if fStatus=psError then
  begin
    fLogger.log('Error while parsing: '+fErrorMessage+EOL+'Parsing failed');
  end
  else
    fStatus:=psIdle;

  fLogger.log('Parser finished');
end;

procedure TParser.parseContent;
var
  mainLines: TStringList;
  line: string;
  tmpStr: string;
  header: THeaderNode;   //PALOFF
  startPos: Integer;
  endPos: Integer;
begin
  mainLines:=TStringList.Create;
  try
    mainLines.Text:=fParseString;

    startPos:=findStartPos;
    for line in mainLines do
    begin
      endPos:=findEndPos(line);
      if (Trim(line)<>'') and (line[Low(string)]='[') and (line[endPos]=']') then
      begin
        tmpStr:=Copy(Copy(line, startPos, endPos-1), startPos+1,
                                                          endPos-1);
        header:=THeaderNode.Create;  //PALOFF
        header.Value:=tmpStr;
        case IndexStr(UpperCase(tmpStr),
                      [UpperCase(defaultSection.Header),
                       UpperCase(requestDefinition.Header),
                       UpperCase(policyDefinition.Header),
                       UpperCase(roleDefinition.Header),
                       UpperCase(policyEffectDefinition.Header),
                       UpperCase(matchersDefinition.Header)]) of
          0: header.SectionType:=stDefault;
          1: header.SectionType:=stRequestDefinition;
          2: header.SectionType:=stPolicyDefinition;
          3: header.SectionType:=stRoleDefinition;
          4: header.SectionType:=stPolicyEffect;
          5: header.SectionType:=stMatchers;
        else
          header.SectionType:=stUnknown;
        end;
        fNodes.Headers.Add(header);
      end
      else
      begin
        if Assigned(header) then
        begin
          if fParseType=ptPolicy then
            header.SectionType:=stPolicyRules;
          if Trim(line)<>'' then
          begin
            addAssertion(header, line);
            if (header.SectionType=stPolicyEffect) and
              ((header.ChildNodes.Items
                  [header.ChildNodes.Count-1] as TEffectNode)
                                              .EffectCondition=ecUnknown) then
            begin
              fErrorMessage:=format(errorUnknownAssertion, [line]);
              fStatus:=psError;
              Exit;
            end;
          end;
        end;
      end;
    end;
  finally
    mainLines.Free;
  end;
end;

procedure TParser.setLogger(const aValue: ILogger);
begin
  fLogger:=aValue;
end;

end.

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.