Delphi CodeCoverage Coverage Report

Coverage report for Casbin.Model.

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

Statistics for Casbin.Model.pas

Number of lines covered	141
Number of lines with code gen	148
Line coverage	95%

// 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.Model;

interface

uses
  Casbin.Core.Base.Types, Casbin.Model.Types, Casbin.Adapter.Types,
  Casbin.Parser.Types, Casbin.Parser.AST.Types, Casbin.Model.Sections.Types,
  System.Generics.Collections, Casbin.Effect.Types, Casbin.Watcher.Types;

type
  TModel = class (TBaseInterfacedObject, IModel)
  private
    fAdapter: IAdapter;  //PALOFF
    fParser: IParser;    //PALOFF
    fNodes: TNodeCollection;
    fAssertions: TList<string>;
    fWatchers: TList<IWatcher>;

    procedure checkSection(const aSection: TSectionType);
    procedure loadNodes(const aAdapter: IAdapter);
  protected
{$REGION 'Interface'}
    function section(const aSection: TSectionType; const aSlim: Boolean = true):
        string;
    function assertions(const aSection: TSectionType): TList<System.string>;
    function effectCondition: TEffectCondition;
    procedure addDefinition (const aSection: TSectionType; const aTag: string;
                              const aAssertion: string); overload;
    procedure addDefinition (const aSection: TSectionType;
                              const aAssertion: string); overload;
    procedure addModel(const aModel: string);
    function assertionExists (const aAssertion: string): Boolean;
    function toOutputString: string;

    // Watchers
    procedure registerWatcher (const aWatcher: IWatcher);
    procedure unregisterWatcher (const aWatcher: IWatcher);
    procedure notifyWatchers;
{$ENDREGION}
  public
    constructor Create(const aModelFilename: string); overload;
    constructor Create(const aAdapter: IAdapter); overload;
    constructor Create; overload;
    destructor Destroy; override;
  end;

implementation

uses
  Casbin.Exception.Types, Casbin.Adapter.Filesystem,
  System.IOUtils, System.Classes, Casbin.Parser, Casbin.Core.Utilities,
  SysUtils, Casbin.Parser.AST, Casbin.Model.Sections.Default, Casbin.Adapter.Memory;

constructor TModel.Create(const aModelFilename: string);
begin
  Create(TFileAdapter.Create(aModelFilename));
end;

procedure TModel.addDefinition(const aSection: TSectionType;
  const aAssertion: string);
var
  arrStr: TArray<string>;
begin
  if trim(aAssertion)='' then
    raise ECasbinException.Create('The Assertion is empty');
  arrStr:=aAssertion.Split(['=']);
  if Length(arrStr)<>2 then
    raise ECasbinException.Create('The Assertion '+aAssertion+' is wrong');
  addDefinition(aSection, arrStr[0], arrStr[1]);
end;

procedure TModel.addModel(const aModel: string);
begin
  if Trim(aModel)='' then
    Exit;
  fAdapter.Assertions.Clear;
  fAdapter.Assertions.AddRange(aModel.Split([sLineBreak]));
  loadNodes(fAdapter);
  fAssertions.Clear;
end;

procedure TModel.addDefinition(const aSection: TSectionType; const aTag,
  aAssertion: string);
var
  header: THeaderNode;
  assertion: string;
  foundHeader: Boolean;
  sec: TSection;
begin
  foundHeader:=False;
  if trim(aTag)='' then
    raise ECasbinException.Create('The Tag is empty');
  if trim(aAssertion)='' then
    raise ECasbinException.Create('The Assertion is empty');
  if (aSection=stDefault) or (aSection=stUnknown) or
      (aSection=stPolicyRules) or (aSection=stRoleRules) then
    raise ECasbinException.Create('Wrong section type');

  assertion:= Trim(aTag)+'='+trim(aAssertion);

  if not (aSection=stMatchers) then
    while Pos(#32, assertion, findStartPos)<>0 do
      Delete(assertion, Pos(#32, assertion, findStartPos), 1);

  if assertionExists(assertion) then
    Exit
  else
  begin
    for header in fNodes.Headers do
      if header.SectionType=aSection then
      begin
        addAssertion(header, assertion);
        foundHeader:=True;
        Break;
      end;
    if not foundHeader then
    begin
      sec:=createDefaultSection(aSection);
      header:=THeaderNode.Create;
      header.Value:=sec.Header;
      header.SectionType:=aSection;
      fNodes.Headers.Add(header);

      addAssertion(header, assertion);
      sec.Free;
    end;
    notifyWatchers;
  end;
end;

function TModel.assertionExists(const aAssertion: string): Boolean;
var
  child: TChildNode;
  header: THeaderNode;
begin
  Result:=false;
  if Trim(aAssertion)='' then
    Exit;

  for header in fNodes.Headers do
  begin
    for child in header.ChildNodes do
    begin
      Result:= Trim(child.toOutputString) = Trim(aAssertion);

      if Result then
        Exit;
    end;
  end;
end;

function TModel.assertions(const aSection: TSectionType): TList<System.string>;
var
  node: TChildNode;
  headerNode: THeaderNode;
  assertionNode: TAssertionNode;
  assertion: string;
begin
  fAssertions.Clear;
  checkSection(aSection);
  for headerNode in fNodes.Headers do
    if headerNode.SectionType=aSection then
    begin
      for node in headerNode.ChildNodes do
      begin
        if node.AssertionList.Count=0 then
          fAssertions.add(node.Value)
        else
        begin
          for assertionNode in node.AssertionList do
          begin
            assertion:=node.Key+'.'+assertionNode.Value;
            fAssertions.Add(assertion);
          end;
        end;
      end;
      Break;
    end;
  Result:=fAssertions;
end;

constructor TModel.Create(const aAdapter: IAdapter);
begin
  if not Assigned(aAdapter) then
    raise ECasbinException.Create('Adapter is nil in '+Self.ClassName);
  inherited Create;
  loadNodes(aAdapter);
  fAssertions:=TList<string>.Create;
  fWatchers:=TList<IWatcher>.Create;
end;

constructor TModel.Create;
begin
  Create(TMemoryAdapter.Create);
end;

destructor TModel.Destroy;
begin
  fAssertions.Free;
  fWatchers.Free;
  inherited;
end;

function TModel.effectCondition: TEffectCondition;
var
  headerNode: THeaderNode;
begin
  Result:=ecUnknown;
  for headerNode in fParser.Nodes.Headers do
  begin
    if headerNode.SectionType=stPolicyEffect then
    begin
      if (headerNode.ChildNodes.Count>=0) and
        (headerNode.ChildNodes.Items[0] is TEffectNode) then
      begin
        Result:=(headerNode.ChildNodes.Items[0] as TEffectNode).EffectCondition;
      end;
    end;
  end;
end;

procedure TModel.checkSection(const aSection: TSectionType);
begin
  if not (aSection in [stRequestDefinition, stPolicyDefinition,
                       stPolicyEffect, stMatchers,
                       stRoleDefinition]) then
    raise ECasbinException.Create('Wrong section type');
end;

procedure TModel.loadNodes(const aAdapter: IAdapter);
begin
  fAdapter:=aAdapter;
  fAdapter.load;
  fParser:=TParser.Create(fAdapter.toOutputString, ptModel);
  fParser.parse;
  if fParser.Status=psError then
    raise ECasbinException.Create('Parsing error in Model: '+fParser.ErrorMessage);
  fNodes:=fParser.Nodes;
end;

procedure TModel.notifyWatchers;
var
  watcher: IWatcher;
begin
  for watcher in fWatchers do
    watcher.update;
end;

procedure TModel.registerWatcher(const aWatcher: IWatcher);
begin
  if not fWatchers.Contains(aWatcher) then
    fWatchers.Add(aWatcher);
end;

function TModel.section(const aSection: TSectionType; const aSlim: Boolean =
    true): string;
var
  headerNode: THeaderNode;
  strList: TStringList;
begin
  Result:='';
  if fNodes.Headers.Count=0 then
    Exit;
  checkSection(aSection);
  for headerNode in fNodes.Headers do
    if headerNode.SectionType=aSection then
    begin
      Result:=headerNode.toOutputString;
      strList:=TStringList.Create;
      strList.Text:=Result;
      if (strList.Count>1) then
        if aSlim and (strList.Strings[0][findStartPos]='[') then
          Result:=strList.Strings[1];
      strList.Free;
      Exit;
    end;
end;

function TModel.toOutputString: string;
var
  secType: TSectionType;
begin
  result:='';
  for secType in modelSections do
  begin
    if (secType=stRoleDefinition) then
    begin
        if (section(stRoleDefinition, False))<>'' then
        begin
          Result:=Result+section(secType, false)+sLineBreak;
        end;
    end
    else
      Result:=Result+section(secType, false)+sLineBreak;
  end;
end;

procedure TModel.unregisterWatcher(const aWatcher: IWatcher);
begin
  if fWatchers.Contains(aWatcher) then
    fWatchers.Remove(aWatcher);
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.Model;
15
16	interface
17
18	uses
19	Casbin.Core.Base.Types, Casbin.Model.Types, Casbin.Adapter.Types,
20	Casbin.Parser.Types, Casbin.Parser.AST.Types, Casbin.Model.Sections.Types,
21	System.Generics.Collections, Casbin.Effect.Types, Casbin.Watcher.Types;
22
23	type
24	TModel = class (TBaseInterfacedObject, IModel)
25	private
26	fAdapter: IAdapter; //PALOFF
27	fParser: IParser; //PALOFF
28	fNodes: TNodeCollection;
29	fAssertions: TList<string>;
30	fWatchers: TList<IWatcher>;
31
32	procedure checkSection(const aSection: TSectionType);
33	procedure loadNodes(const aAdapter: IAdapter);
34	protected
35	{$REGION 'Interface'}
36	function section(const aSection: TSectionType; const aSlim: Boolean = true):
37	string;
38	function assertions(const aSection: TSectionType): TList<System.string>;
39	function effectCondition: TEffectCondition;
40	procedure addDefinition (const aSection: TSectionType; const aTag: string;
41	const aAssertion: string); overload;
42	procedure addDefinition (const aSection: TSectionType;
43	const aAssertion: string); overload;
44	procedure addModel(const aModel: string);
45	function assertionExists (const aAssertion: string): Boolean;
46	function toOutputString: string;
47
48	// Watchers
49	procedure registerWatcher (const aWatcher: IWatcher);
50	procedure unregisterWatcher (const aWatcher: IWatcher);
51	procedure notifyWatchers;
52	{$ENDREGION}
53	public
54	constructor Create(const aModelFilename: string); overload;
55	constructor Create(const aAdapter: IAdapter); overload;
56	constructor Create; overload;
57	destructor Destroy; override;
58	end;
59
60	implementation
61
62	uses
63	Casbin.Exception.Types, Casbin.Adapter.Filesystem,
64	System.IOUtils, System.Classes, Casbin.Parser, Casbin.Core.Utilities,
65	SysUtils, Casbin.Parser.AST, Casbin.Model.Sections.Default, Casbin.Adapter.Memory;
66
67	constructor TModel.Create(const aModelFilename: string);
68	begin
69	Create(TFileAdapter.Create(aModelFilename));
70	end;
71
72	procedure TModel.addDefinition(const aSection: TSectionType;
73	const aAssertion: string);
74	var
75	arrStr: TArray<string>;
76	begin
77	if trim(aAssertion)='' then
78	raise ECasbinException.Create('The Assertion is empty');
79	arrStr:=aAssertion.Split(['=']);
80	if Length(arrStr)<>2 then
81	raise ECasbinException.Create('The Assertion '+aAssertion+' is wrong');
82	addDefinition(aSection, arrStr[0], arrStr[1]);
83	end;
84
85	procedure TModel.addModel(const aModel: string);
86	begin
87	if Trim(aModel)='' then
88	Exit;
89	fAdapter.Assertions.Clear;
90	fAdapter.Assertions.AddRange(aModel.Split([sLineBreak]));
91	loadNodes(fAdapter);
92	fAssertions.Clear;
93	end;
94
95	procedure TModel.addDefinition(const aSection: TSectionType; const aTag,
96	aAssertion: string);
97	var
98	header: THeaderNode;
99	assertion: string;
100	foundHeader: Boolean;
101	sec: TSection;
102	begin
103	foundHeader:=False;
104	if trim(aTag)='' then
105	raise ECasbinException.Create('The Tag is empty');
106	if trim(aAssertion)='' then
107	raise ECasbinException.Create('The Assertion is empty');
108	if (aSection=stDefault) or (aSection=stUnknown) or
109	(aSection=stPolicyRules) or (aSection=stRoleRules) then
110	raise ECasbinException.Create('Wrong section type');
111
112	assertion:= Trim(aTag)+'='+trim(aAssertion);
113
114	if not (aSection=stMatchers) then
115	while Pos(#32, assertion, findStartPos)<>0 do
116	Delete(assertion, Pos(#32, assertion, findStartPos), 1);
117
118	if assertionExists(assertion) then
119	Exit
120	else
121	begin
122	for header in fNodes.Headers do
123	if header.SectionType=aSection then
124	begin
125	addAssertion(header, assertion);
126	foundHeader:=True;
127	Break;
128	end;
129	if not foundHeader then
130	begin
131	sec:=createDefaultSection(aSection);
132	header:=THeaderNode.Create;
133	header.Value:=sec.Header;
134	header.SectionType:=aSection;
135	fNodes.Headers.Add(header);
136
137	addAssertion(header, assertion);
138	sec.Free;
139	end;
140	notifyWatchers;
141	end;
142	end;
143
144	function TModel.assertionExists(const aAssertion: string): Boolean;
145	var
146	child: TChildNode;
147	header: THeaderNode;
148	begin
149	Result:=false;
150	if Trim(aAssertion)='' then
151	Exit;
152
153	for header in fNodes.Headers do
154	begin
155	for child in header.ChildNodes do
156	begin
157	Result:= Trim(child.toOutputString) = Trim(aAssertion);
158
159	if Result then
160	Exit;
161	end;
162	end;
163	end;
164
165	function TModel.assertions(const aSection: TSectionType): TList<System.string>;
166	var
167	node: TChildNode;
168	headerNode: THeaderNode;
169	assertionNode: TAssertionNode;
170	assertion: string;
171	begin
172	fAssertions.Clear;
173	checkSection(aSection);
174	for headerNode in fNodes.Headers do
175	if headerNode.SectionType=aSection then
176	begin
177	for node in headerNode.ChildNodes do
178	begin
179	if node.AssertionList.Count=0 then
180	fAssertions.add(node.Value)
181	else
182	begin
183	for assertionNode in node.AssertionList do
184	begin
185	assertion:=node.Key+'.'+assertionNode.Value;
186	fAssertions.Add(assertion);
187	end;
188	end;
189	end;
190	Break;
191	end;
192	Result:=fAssertions;
193	end;
194
195	constructor TModel.Create(const aAdapter: IAdapter);
196	begin
197	if not Assigned(aAdapter) then
198	raise ECasbinException.Create('Adapter is nil in '+Self.ClassName);
199	inherited Create;
200	loadNodes(aAdapter);
201	fAssertions:=TList<string>.Create;
202	fWatchers:=TList<IWatcher>.Create;
203	end;
204
205	constructor TModel.Create;
206	begin
207	Create(TMemoryAdapter.Create);
208	end;
209
210	destructor TModel.Destroy;
211	begin
212	fAssertions.Free;
213	fWatchers.Free;
214	inherited;
215	end;
216
217	function TModel.effectCondition: TEffectCondition;
218	var
219	headerNode: THeaderNode;
220	begin
221	Result:=ecUnknown;
222	for headerNode in fParser.Nodes.Headers do
223	begin
224	if headerNode.SectionType=stPolicyEffect then
225	begin
226	if (headerNode.ChildNodes.Count>=0) and
227	(headerNode.ChildNodes.Items[0] is TEffectNode) then
228	begin
229	Result:=(headerNode.ChildNodes.Items[0] as TEffectNode).EffectCondition;
230	end;
231	end;
232	end;
233	end;
234
235	procedure TModel.checkSection(const aSection: TSectionType);
236	begin
237	if not (aSection in [stRequestDefinition, stPolicyDefinition,
238	stPolicyEffect, stMatchers,
239	stRoleDefinition]) then
240	raise ECasbinException.Create('Wrong section type');
241	end;
242
243	procedure TModel.loadNodes(const aAdapter: IAdapter);
244	begin
245	fAdapter:=aAdapter;
246	fAdapter.load;
247	fParser:=TParser.Create(fAdapter.toOutputString, ptModel);
248	fParser.parse;
249	if fParser.Status=psError then
250	raise ECasbinException.Create('Parsing error in Model: '+fParser.ErrorMessage);
251	fNodes:=fParser.Nodes;
252	end;
253
254	procedure TModel.notifyWatchers;
255	var
256	watcher: IWatcher;
257	begin
258	for watcher in fWatchers do
259	watcher.update;
260	end;
261
262	procedure TModel.registerWatcher(const aWatcher: IWatcher);
263	begin
264	if not fWatchers.Contains(aWatcher) then
265	fWatchers.Add(aWatcher);
266	end;
267
268	function TModel.section(const aSection: TSectionType; const aSlim: Boolean =
269	true): string;
270	var
271	headerNode: THeaderNode;
272	strList: TStringList;
273	begin
274	Result:='';
275	if fNodes.Headers.Count=0 then
276	Exit;
277	checkSection(aSection);
278	for headerNode in fNodes.Headers do
279	if headerNode.SectionType=aSection then
280	begin
281	Result:=headerNode.toOutputString;
282	strList:=TStringList.Create;
283	strList.Text:=Result;
284	if (strList.Count>1) then
285	if aSlim and (strList.Strings[0][findStartPos]='[') then
286	Result:=strList.Strings[1];
287	strList.Free;
288	Exit;
289	end;
290	end;
291
292	function TModel.toOutputString: string;
293	var
294	secType: TSectionType;
295	begin
296	result:='';
297	for secType in modelSections do
298	begin
299	if (secType=stRoleDefinition) then
300	begin
301	if (section(stRoleDefinition, False))<>'' then
302	begin
303	Result:=Result+section(secType, false)+sLineBreak;
304	end;
305	end
306	else
307	Result:=Result+section(secType, false)+sLineBreak;
308	end;
309	end;
310
311	procedure TModel.unregisterWatcher(const aWatcher: IWatcher);
312	begin
313	if fWatchers.Contains(aWatcher) then
314	fWatchers.Remove(aWatcher);
315	end;
316
317	end.