UnitTest( acl.asp )

Output

Building and saving the access control scenario
-----------------------------------------------
True - should be true, because sorceress are able to cast hydras
False - should be false, because druids are not able to cast hydras

False - should be false, because kryfie is not in the registry
False - should be false, because usually fire-spells are denied
True - should be true, because hydra is allowed
True - should be true, because nagaozen is also a druid
False - should be false, because assert states that being a summoner is a bad thing, so always return false


Loading from the persistence layer
----------------------------------
False - should be false, because kryfie is not in the registry
False - should be false, because usually fire-spells are denied
True - should be true, because hydra is allowed
True - should be true, because nagaozen is also a druid


Directly editing the registry
-----------------------------

Before purge call
{
  "sorceress": {
    "fire-spells": {
      "cast": [
        "DENY",
        null
      ]
    },
    "hydra": {
      "cast": [
        "ALLOW",
        null
      ]
    }
  },
  "druid": {
    "elemental": {
      "be": [
        "ALLOW",
        null
      ]
    },
    "summoning": {
      "be": [
        "ALLOW",
        "function(role, resource, privilege){return false;}"
      ]
    }
  }
}

After purge call
{
  "sorceress": {
    "fire-spells": {
      "cast": [
        "DENY",
        null
      ]
    },
    "hydra": {
      "cast": [
        "ALLOW",
        null
      ]
    }
  }
}

Sources

/axe-ut/acl.unit.test.asp

<!--#include virtual="/lib/unit-tests.asp"-->
<!--#include virtual="/lib/axe/classes/interface.asp"-->
<!--#include virtual="/lib/axe/classes/Parsers/json2.asp"-->
<!--#include virtual="/lib/axe/classes/Utilities/acl.asp"-->
<!--#include virtual="/lib/axe/classes/Utilities/Acl/interface.asp"-->
<!--#include virtual="/lib/axe/classes/Utilities/Acl/Medias/json.asp"-->
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xml:lang="en">
    <head>
        <title>AXE - Unit Test - Acl</title>
        <!--// meta tags //-->
        <meta http-equiv="content-type" content="text/html; charset=UTF-8" />
        <!--// link tags //-->
        <link rel="stylesheet" type="text/css" media="screen" href="/lib/unit-tests.css" />
    </head>
    <body>
        <div id="container">
            <div id="container-hd">
                <h1>UnitTest( acl.asp )</h1>
            </div>
            <div id="container-bd">
 
<h2>Output</h2>
<div class="code"><pre><%
 
Response.write( "Building and saving the access control scenario" & vbNewline )
Response.write( "-----------------------------------------------" & vbNewline )
 
dim D2 : set D2 = new ACL
 
 
'.
'.Diablo II roles
'.
call D2.addRole("amazon", null)
call D2.addRole("assassin", null)
call D2.addRole("necromancer", null)
call D2.addRole("barbarian", null)
call D2.addRole("paladin", null)
call D2.addRole("sorceress", null)
call D2.addRole("druid", null)
 
 
'.
'.Sorceress skill trees
'.
call D2.addResource("for-sorceress", null)
 
call D2.addResource("cold-spells", "for-sorceress")
call D2.addResource("lightning-spells", "for-sorceress")
call D2.addResource("fire-spells", "for-sorceress")
 
call D2.addResource("ice-bolt", "cold-spells")
call D2.addResource("frozen-armor", "cold-spells")
call D2.addResource("frost-nova", "cold-spells")
call D2.addResource("ice-blast", "cold-spells")
call D2.addResource("shiver-armor", "cold-spells")
call D2.addResource("glacial-spike", "cold-spells")
call D2.addResource("blizzard", "cold-spells")
call D2.addResource("chilling-armor", "cold-spells")
call D2.addResource("frozen-orb", "cold-spells")
call D2.addResource("cold-mastery", "cold-spells")
 
call D2.addResource("charged-bolt", "lightning-spells")
call D2.addResource("static-field", "lightning-spells")
call D2.addResource("telekinesis", "lightning-spells")
call D2.addResource("nova", "lightning-spells")
call D2.addResource("lightning", "lightning-spells")
call D2.addResource("chain-lightning", "lightning-spells")
call D2.addResource("teleport", "lightning-spells")
call D2.addResource("thunder-storm", "lightning-spells")
call D2.addResource("energy-field", "lightning-spells")
call D2.addResource("lightning-mastery", "lightning-spells")
 
call D2.addResource("fire-bolt", "fire-spells")
call D2.addResource("warmth", "fire-spells")
call D2.addResource("inferno", "fire-spells")
call D2.addResource("blaze", "fire-spells")
call D2.addResource("fire-ball", "fire-spells")
call D2.addResource("fire-wall", "fire-spells")
call D2.addResource("enchant", "fire-spells")
call D2.addResource("meteor", "fire-spells")
call D2.addResource("fire-mastery", "fire-spells")
call D2.addResource("hydra", "fire-spells")
 
 
'.
'.Druid skill trees
'.
call D2.addResource("for-druid", null)
 
call D2.addResource("elemental", "for-druid")
call D2.addResource("shape-shifting", "for-druid")
call D2.addResource("summoning", "for-druid")
 
call D2.addResource("firestorm", "elemental")
call D2.addResource("molten-boulder", "elemental")
call D2.addResource("artic-blast", "elemental")
call D2.addResource("fissure", "elemental")
call D2.addResource("cyclone-armor", "elemental")
call D2.addResource("twister", "elemental")
call D2.addResource("volcano", "elemental")
call D2.addResource("tornado", "elemental")
call D2.addResource("armageddon", "elemental")
call D2.addResource("hurricane", "elemental")
 
call D2.addResource("werewolf", "shape-shifting")
call D2.addResource("lycanthropy", "shape-shifting")
call D2.addResource("werebear", "shape-shifting")
call D2.addResource("feral-rage", "shape-shifting")
call D2.addResource("maul", "shape-shifting")
call D2.addResource("rabies", "shape-shifting")
call D2.addResource("fire-claws", "shape-shifting")
call D2.addResource("hunger", "shape-shifting")
call D2.addResource("shoch-wave", "shape-shifting")
call D2.addResource("fury", "shape-shifting")
 
call D2.addResource("raven", "summoning")
call D2.addResource("poison-creeper", "summoning")
call D2.addResource("oak-sage", "summoning")
call D2.addResource("summon-spirit-wolf", "summoning")
call D2.addResource("carrion-vine", "summoning")
call D2.addResource("heart-of-wolverine", "summoning")
call D2.addResource("summon-dire-wolf", "summoning")
call D2.addResource("solar-creeper", "summoning")
call D2.addResource("spirit-of-barbs", "summoning")
call D2.addResource("summon-grizzly", "summoning")
 
'call D2.remResource("hydra")' removes a leaf
'call D2.remResource("fire-spells")' removes a middle node
'call D2.remResource("for-sorceress")' removes a root node
 
'call D2.assign("foo", "bar")' triggers an error
call D2.assign("kryfie", "sorceress")
call D2.assign("nagaozen", array("sorceress", "druid"))
call D2.assign("nagaozen", "necromancer")
 
'Response.write( JSON.stringify( D2.[_Roles], null, 2 ) )' change from private to public in the class to view this
'Response.write( vbNewline )
 
'Response.write( vbNewline )
 
'Response.write( JSON.stringify( D2.[_Resources], null, 2 ) )' same as above
'Response.write( vbNewline )
 
'Response.write( vbNewline )
 
'Response.write( JSON.stringify( D2.[_Users], null, 2 ) )' same as above
'Response.write( vbNewline )
 
'Response.write( vbNewline )
 
'Response.write( dump( D2.[_Users].get("nagaozen").enumerate() ) )' same as above
'Response.write( vbNewline )
 
'Response.write( vbNewline )
 
call D2.unassign("kryfie", "sorceress")' should remove kryfie from the registry
call D2.unassign("nagaozen", "necromancer")' should remove only necromancer role from nagaozen
 
'Response.write( JSON.stringify( D2.[_Users], null, 2 ) )' used to verify the registry after the unassignments
'Response.write( vbNewline )
 
'Response.write( vbNewline )
 
call D2.deny("sorceress", "fire-spells", "cast", null)
call D2.allow("sorceress", "hydra", "cast", null)
call D2.allow("druid", "elemental", "be", null)
call D2.allow("druid", "summoning", "be", "function(role, resource, privilege){return false;}")' it's allowed but assert always return false
 
'call D2.remDeny("sorceress", "fire-spells", "cast")
'call D2.remAllow("sorceress", "hydra", "cast")
 
'Response.write( JSON.stringify( D2.[_Rules], null, 2 ) )' used to verify the rules registry after the setup
'Response.write( vbNewline )
 
Response.write( D2.isRoleAllowed("sorceress", "hydra", "cast") )
Response.write( " - should be true, because sorceress are able to cast hydras" )
Response.write( vbNewline )
 
Response.write( D2.isRoleAllowed("druid", "hydra", "cast") )
Response.write( " - should be false, because druids are not able to cast hydras" )
Response.write( vbNewline )
 
Response.write( vbNewline )
 
Response.write( D2.isAllowed("kryfie", "cold-spells", "cast") )
Response.write( " - should be false, because kryfie is not in the registry" )
Response.write( vbNewline )
 
Response.write( D2.isAllowed("nagaozen", "fire-spells", "cast") )
Response.write( " - should be false, because usually fire-spells are denied" )
Response.write( vbNewline )
 
Response.write( D2.isAllowed("nagaozen", "hydra", "cast") )
Response.write( " - should be true, because hydra is allowed" )
Response.write( vbNewline )
 
Response.write( D2.isAllowed("nagaozen", "elemental", "be") )
Response.write( " - should be true, because nagaozen is also a druid" )
Response.write( vbNewline )
 
Response.write( D2.isAllowed("nagaozen", "summoning", "be") )
Response.write( " - should be false, because assert states that being a summoner is a bad thing, so always return false" )
Response.write( vbNewline )
 
set D2.Media = new Acl_Media_Json
D2.Media.path = Server.mapPath("/cache/axe-acl.json")
call D2.save()
set D2.Media = nothing
 
set D2 = nothing
 
Response.write( vbNewline )
Response.write( vbNewline )
 
Response.write( "Loading from the persistence layer" & vbNewline )
Response.write( "----------------------------------" & vbNewline )
 
set D2 = new ACL
set D2.Media = new Acl_Media_Json
D2.Media.path = Server.mapPath("/cache/axe-acl.json")
call D2.load()
 
Response.write( D2.isAllowed("kryfie", "cold-spells", "cast") )
Response.write( " - should be false, because kryfie is not in the registry" )
Response.write( vbNewline )
 
Response.write( D2.isAllowed("nagaozen", "fire-spells", "cast") )
Response.write( " - should be false, because usually fire-spells are denied" )
Response.write( vbNewline )
 
Response.write( D2.isAllowed("nagaozen", "hydra", "cast") )
Response.write( " - should be true, because hydra is allowed" )
Response.write( vbNewline )
 
Response.write( D2.isAllowed("nagaozen", "elemental", "be") )
Response.write( " - should be true, because nagaozen is also a druid" )
Response.write( vbNewline )
 
Response.write( vbNewline )
Response.write( vbNewline )
 
Response.write( "Directly editing the registry" & vbNewline )
Response.write( "-----------------------------" & vbNewline )
Response.write( vbNewline )
 
Response.write( "Before purge call" )
Response.write( vbNewline )
 
Response.write( JSON.stringify( D2.getRules() , null, 2) )
Response.write( vbNewline )
 
D2.getRules().purge("druid")
Response.write( vbNewline )
 
Response.write( "After purge call" )
Response.write( vbNewline )
 
Response.write( JSON.stringify( D2.getRules() , null, 2) )
Response.write( vbNewline )
 
set D2.Media = nothing
set D2 = nothing
 
%></pre></div>
 
            </div>
            <div id="container-ft">
                <h2>Sources</h2>
                <h3><%= Request.ServerVariables("SCRIPT_NAME") %></h3>
                <div class="code"><%= geshify( loadTextFile( Server.mapPath( Request.ServerVariables("SCRIPT_NAME") ) ), "asp" ) %></div>
                <h3>/lib/axe/classes/Utilities/acl.asp</h3>
                <div class="code"><%= geshify( loadTextFile( Server.mapPath( "/lib/axe/classes/Utilities/acl.asp" ) ), "asp" ) %></div>
                <h3>/lib/axe/classes/Utilities/Acl/interface.asp</h3>
                <div class="code"><%= geshify( loadTextFile( Server.mapPath( "/lib/axe/classes/Utilities/Acl/interface.asp" ) ), "asp" ) %></div>
                <h3>/lib/axe/classes/Utilities/Acl/Medias/json.asp</h3>
                <div class="code"><%= geshify( loadTextFile( Server.mapPath( "/lib/axe/classes/Utilities/Acl/Medias/json.asp" ) ), "asp" ) %></div>
            </div>
        </div>
        <!--// javascript tags //-->
    </body>
</html>
 

/lib/axe/classes/Utilities/acl.asp

<%
 
' File: acl.asp
'
' AXE(ASP Xtreme Evolution) implementation of RBAC utility.
'
' License:
'
' This file is part of ASP Xtreme Evolution.
' Copyright (C) 2007-2012 Fabio Zendhi Nagao
'
' ASP Xtreme Evolution is free software: you can redistribute it and/or modify
' it under the terms of the GNU Lesser General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' ASP Xtreme Evolution is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU Lesser General Public License for more details.
'
' You should have received a copy of the GNU Lesser General Public License
' along with ASP Xtreme Evolution. If not, see <http://www.gnu.org/licenses/>.
 
 
 
' Class: Acl
'
' Acl provides a flexible Role Based Access Control (RBAC) implementation for
' privileges management. In general, an application may utilize this utility to
' control access to certain protected objects by other requesting objects.
'
' The features provided by this class are widely discussed and studied by the
' National Institute of Standard and Technology (NIST). For the papers and more
' info visit <http://csrc.nist.gov/groups/SNS/rbac/>.
'
' Dependencies:
'
'	- JSON2 class (/lib/axe/classes/Parsers/json2.asp)
'
' About:
'
'	- Written by Fabio Zendhi Nagao <http://zend.lojcomm.com.br> @ Dec 2010
'
class Acl
 
	' Property: classType
	'
	' Class type.
	'
	' Contains:
	'
	'	(string) - type
	'
	public property get classType
		classType = typename(Me)
	end property
 
	' Property: classVersion
	'
	' Class version.
	'
	' Contains:
	'
	'	(string) - version in terms of http://semver.org/#semantic-versioning-200
	'
	public property get classVersion
		classVersion = "2.0.0"
	end property
 
	' Property: Media
	'
	' Acl_Interface implementation
	'
	' Contains:
	'
	'	(Acl_Interface) - Media implementing Acl_Interface
	'
	public Media
 
	' Function: getUsers
	'
	' Returns the Users registry.
	'
	' Returns:
	'
	'	(Object) - Users
	'
	public function getUsers()
		set getUsers = [_Users]
	end function
 
	' Function: getRoles
	'
	' Returns the Roles registry.
	'
	' Returns:
	'
	'	(Object) - Roles
	'
	public function getRoles()
		set getRoles = [_Roles]
	end function
 
	' Function: getResources
	'
	' Returns the Resources registry.
	'
	' Returns:
	'
	'	(Object) - Resources
	'
	public function getResources()
		set getResources = [_Resources]
	end function
 
	' Function: getRules
	'
	' Returns the Rules registry.
	'
	' Returns:
	'
	'	(Object) - Rules
	'
	public function getRules()
		set getRules = [_Rules]
	end function
 
	' Subroutine: addRole
	'
	' Adds a role having an identifier unique to the roles registry.
	'
	' Parameters:
	'
	'	(string) - role identifier
	'	(string) - role identifier or null
	'
	public sub addRole(byVal role, byVal parent)
		if( not isEmpty( [_Roles].get(role) ) ) then
			Err.raise 17, "Evolved AXE ACL runtime error", strsubstitute( _
				"Can't perform requested operation. The role id '{0}' already exists.", _
				array(role) _
			)
		end if
 
		if( not isNull(parent) ) then
			if( isEmpty( [_Roles].get(parent) ) ) then
				Err.raise 17, "Evolved AXE ACL runtime error", strsubstitute( _
					"Can't perform requested operation. The role parent id '{0}' does not exists.", _
					array(parent) _
				)
			end if
 
			call ( [_Roles].get(parent).get(1) ).set(role, null)
		end if
 
		call [_Roles].set( role, array( parent, JSON.parse("{}") ) )
	end sub
 
	' Subroutine: remRole
	'
	' Removes the role from the registry.
	'
	' Parameters:
	'
	'	(string) - role identifier
	'
	public sub remRole(byVal role)
		dim user, parent, child
 
		' remove from users
		for each user in [_Users].enumerate()
			call unassign(user, role)
		next
 
		' remove role from it's parent
		parent = [_Roles].get(role).get("0")
		if( not isNull(parent) ) then
			[_Roles].get(parent).get(1).purge(role)
		end if
 
		' remove role children
		for each child in [_Roles].get(role).get(1).enumerate()
			call remRole(child)
		next
 
		' remove from roles
		call [_Roles].purge(role)
 
		' remove from rules
		call [_Rules].purge(role)
	end sub
 
	' Subroutine: addResource
	'
	' Adds a resource having an identifier unique to the resources registry.
	'
	' Parameters:
	'
	'	(string) - resource identifier
	'	(string) - resource identifier or null
	'
	public sub addResource(byVal resource, byVal parent)
		if( not isEmpty( [_Resources].get(resource) ) ) then
			Err.raise 17, "Evolved AXE ACL runtime error", strsubstitute( _
				"Can't perform requested operation. The resource id '{0}' already exists.", _
				array(resource) _
			)
		end if
 
		if( not isNull(parent) ) then
			if( isEmpty( [_Resources].get(parent) ) ) then
				Err.raise 17, "Evolved AXE ACL runtime error", strsubstitute( _
					"Can't perform requested operation. The resource parent id '{0}' does not exists.", _
					array(parent) _
				)
			end if
 
			call ( [_Resources].get(parent).get(1) ).set(resource, null)
		end if
 
		call [_Resources].set( resource, array( parent, JSON.parse("{}") ) )
	end sub
 
	' Subroutine: remResource
	'
	' Removes the resource from the registry.
	'
	' Parameters:
	'
	'	(string) - resource identifier
	'
	public sub remResource(byVal resource)
		dim parent, child, role
 
		' remove resource from it's parent
		parent = [_Resources].get(resource).get(0)
		if( not isNull(parent) ) then
			[_Resources].get(parent).get(1).purge(resource)
		end if
 
		' remove resource children
		for each child in [_Resources].get(resource).get(1).enumerate()
			call remResource(child)
		next
 
		' remove from resources
		call [_Resources].purge(resource)
 
		' remove from rules
		for each role in [_Rules].enumerate()
			[_Rules].get(role).purge(resource)
		next
	end sub
 
	' Subroutine: assign
	'
	' Assigns role(s) to the user. NOTE: In the case of more than one role, the
	' roles list precedence works as a queue. (eg. array("Role_A", "Role_B"): if
	' Role_A have a feature deny and Role_B have a feature allow, deny prevails)
	'
	' Parameters:
	'
	'	(string)   - user identifier
	'	(string[]) - the chain of roles
	'
	public sub assign(byVal user, byVal roles)
		if( not isArray(roles) ) then
			roles = array(roles)
		end if
 
		if( isEmpty( [_Users].get(user) ) ) then
			call [_Users].set(user, JSON.parse("{}"))
		end if
 
		dim role : for each role in roles
			if( isEmpty( [_Roles].get(role) ) ) then
				Err.raise 17, "Evolved AXE ACL runtime error", strsubstitute( _
					"Can't perform requested operation. The role id '{0}' does not exists.", _
					array(role) _
				)
			end if
			call [_Users].get(user).set(role, null)
		next
	end sub
 
	' Subroutine: unassign
	'
	' Unnasigns role or roles to the user.
	'
	' Parameters:
	'
	'	(string)   - user identifier
	'	(string[]) - the chain of roles
	'
	public sub unassign(byVal user, byVal roles)
		if( not isEmpty( [_Users].get(user) ) ) then
			if( not isArray(roles) ) then
				roles = array(roles)
			end if
 
			dim role : for each role in roles
				call [_Users].get(user).purge(role)
			next
 
			if( ubound( [_Users].get(user).enumerate() ) = -1 ) then
				call [_Users].purge(user)
			end if
		end if
	end sub
 
	' Function: is
	'
	' Checks if a user belongs to a role.
	'
	' Parameters:
	'
	'	(string) - user identifier
	'	(string) - role identifier
	'
	' Returns:
	'
	'	(boolean) - true, if he belongs; false otherwise.
	'
	public function [is](byVal user, byVal role)
		[is] = false
		if( not isEmpty( [_Users].get(user) ) ) then
			dim entry : for each entry in [_Users].get(user).enumerate()
				if( entry = role ) then
					[is] = true
					exit function
				end if
			next
		end if
	end function
 
	' Subroutine: allow
	'
	' Adds an "allow" rule to the ACL.
	'
	' Parameters:
	'
	'	(string)   - role identifier
	'	(string)   - resource identifier
	'	(string)   - privilege identifier
	'	(function) - assert
	'
	public sub allow(byVal role, byVal resource, byVal privilege, byRef assert)
		call [](role, resource, privilege, assert, "ADD", "ALLOW")
	end sub
 
	' Subroutine: remAllow
	'
	' Removes an "allow" rule from the ACL.
	'
	' Parameters:
	'
	'	(string)   - role identifier
	'	(string)   - resource identifier
	'	(string)   - privilege identifier
	'
	public sub remAllow(byVal role, byVal resource, byVal privilege)
		call [](role, resource, privilege, assert, "REM", "ALLOW")
	end sub
 
	' Subroutine: deny
	'
	' Adds a "deny" rule to the ACL.
	'
	' Parameters:
	'
	'	(string)   - role identifier
	'	(string)   - resource identifier
	'	(string)   - privilege identifier
	'	(function) - assert
	'
	public sub deny(byVal role, byVal resource, byVal privilege, byRef assert)
		call [](role, resource, privilege, assert, "ADD", "DENY")
	end sub
 
	' Subroutine: remDeny
	'
	' Removes a "deny" rule from the ACL.
	'
	' Parameters:
	'
	'	(string) - role identifier
	'	(string) - resource identifier
	'	(string) - privilege identifier
	'
	public sub remDeny(byVal role, byVal resource, byVal privilege)
		call [](role, resource, privilege, assert, "REM", "DENY")
	end sub
 
	' Function: isAllowed
	'
	' Checks if the user has access to the resource.
	'
	' Parameters:
	'
	'	(string) - user identifier
	'	(string) - resource identifier
	'	(string) - privilege identifier
	'
	' Returns:
	'
	'	(boolean) - true, if it's allowed; false otherwise
	'
	' Example:
	'
	' (start code)
	'
	' dim AC : set AC = new ACL
	' set AC.Media = new ACL_Media_MSSQL
	' AC.Media.connectionString = "Provider=SQLOLEDB;..."
	'
	' call AC.load()
	' Response.write( AC.isAllowed("nagaozen", "fire-spells", "cast") )
	'
	' set AC = nothing
	'
	' (end code)
	'
	public function isAllowed(byVal user, byVal resource, byVal privilege)
		isAllowed = null
 
		dim this, role, roles, resources
 
		with Server.createObject("Scripting.Dictionary")
			if( not isEmpty( [_Users].get(user) ) ) then
				for each role in [_Users].get(user).enumerate()
					this = role
					do
						.add this, null
						this = [_Roles].get(this).get(0)
					loop while( not isNull(this) )
				next
			end if
			roles = .keys()
 
			call .removeAll()
 
			this = resource
			do
				if( isEmpty( [_Resources].get(this) ) ) then
					this = null
				else
					.add this, null
					this = [_Resources].get(this).get(0)
				end if
			loop while( not isNull(this) )
			resources = .keys()
		end with
 
		if( ( not isEmpty(roles) ) and ( not isEmpty(resources) ) ) then
			isAllowed = [](roles, resources, privilege)
		end if
 
		if( isNull(isAllowed) ) then
			isAllowed = false
		end if
	end function
 
	' Function: isRoleAllowed
	'
	' Checks if the role has access to the resource.
	'
	' Parameters:
	'
	'	(string) - role identifier
	'	(string) - resource identifier
	'	(string) - privilege identifier
	'
	' Returns:
	'
	'	(boolean) - true, if it's allowed; false otherwise
	'
	' Example:
	'
	' (start code)
	'
	' dim AC : set AC = new ACL
	' set AC.Media = new ACL_Media_MSSQL
	' AC.Media.connectionString = "Provider=SQLOLEDB;..."
	'
	' call AC.load()
	' Response.write( AC.isRoleAllowed("sorceress", "fire-spells", "cast") )
	'
	' set AC = nothing
	'
	' (end code)
	'
	public function isRoleAllowed(byVal role, byVal resource, byVal privilege)
		isRoleAllowed = null
 
		dim this, roles, resources
 
		with Server.createObject("Scripting.Dictionary")
			call .removeAll()
 
			this = role
			do
				if( isEmpty( [_Roles].get(this) ) ) then
					this = null
				else
					.add this, null
					this = [_Roles].get(this).get(0)
				end if
			loop while( not isNull(this) )
			roles = .keys()
 
			this = resource
			do
				if( isEmpty( [_Resources].get(this) ) ) then
					this = null
				else
					.add this, null
					this = [_Resources].get(this).get(0)
				end if
			loop while( not isNull(this) )
			resources = .keys()
		end with
 
		if( ( not isEmpty(roles) ) and ( not isEmpty(resources) ) ) then
			isRoleAllowed = [](roles, resources, privilege)
		end if
 
		if( isNull(isRoleAllowed) ) then
			isRoleAllowed = false
		end if
	end function
 
	' Subroutine: load
	'
	' Retrieves the Acl image from the persistence layer.
	'
	' Example:
	'
	' (start code)
	'
	' dim AC : set AC = new ACL
	' set AC.Media = new ACL_Media_MSSQL
	' AC.Media.connectionString = "Provider=SQLOLEDB;..."
	'
	' call AC.load()
	' Response.write( AC.isAllowed("nagaozen", "fire-spells", "cast") )
	'
	' set AC = nothing
	'
	' (end code)
	'
	public sub load() : []
		dim Image : set Image = JSON.parse( Media.load() )
 
		set [_Users] = Image.get("Users")
		set [_Roles] = Image.get("Roles")
		set [_Resources] = Image.get("Resources")
		set [_Rules] = Image.get("Rules")
 
		set Image = nothing
	end sub
 
	' Subroutine: save
	'
	' Writes the Acl image in the persistence layer.
	'
	' Example:
	'
	' (start code)
	'
	' dim AC : set AC = new ACL
	' set AC.Media = new ACL_Media_MSSQL
	' AC.Media.connectionString = "Provider=SQLOLEDB;..."
	'
	' '.
	' '.Diablo II roles
	' '.
	' call AC.addRole("amazon", null)
	' call AC.addRole("assassin", null)
	' call AC.addRole("necromancer", null)
	' call AC.addRole("barbarian", null)
	' call AC.addRole("paladin", null)
	' call AC.addRole("sorceress", null)
	' call AC.addRole("druid", null)
	'
	' '.
	' '.Sorceress skill trees
	' '.
	' call AC.addResource("for-sorceress", null)
	'
	' call AC.addResource("cold-spells", "for-sorceress")
	' call AC.addResource("lightning-spells", "for-sorceress")
	' call AC.addResource("fire-spells", "for-sorceress")
	'
	' '.
	' '.Druid skill trees
	' '.
	' call AC.addResource("for-druid", null)
	'
	' call AC.addResource("elemental", "for-druid")
	' call AC.addResource("shape-shifting", "for-druid")
	' call AC.addResource("summoning", "for-druid")
	'
	' call AC.assign("kryfie", "sorceress")
	' call AC.assign("nagaozen", array("sorceress", "druid"))
	'
	' call AC.allow("sorceress", "cold-spells", "cast", null)
	' call AC.deny("sorceress", "lightning-spells", "cast", null)
	' call AC.deny("sorceress", "fire-spells", "cast", null)
	'
	' call AC.save()
	'
	' set AC = nothing
	'
	' (end code)
	'
	public sub save() : []
		dim Image : set Image = JSON.parse("{}")
 
		call Image.set("Users", [_Users])
		call Image.set("Roles", [_Roles])
		call Image.set("Resources", [_Resources])
		call Image.set("Rules", [_Rules])
 
		call Media.save( JSON.stringify(Image) )
 
		set Image = nothing
	end sub
 
' --[ Private section ]---------------------------------------------------------
 
	private sub Class_initialize()
		set [_Users] = JSON.parse("{}")
		set [_Roles] = JSON.parse("{}")
		set [_Resources] = JSON.parse("{}")
		set [_Rules] = JSON.parse("{}")
	end sub
 
	private sub Class_terminate()
		set [_Rules] = nothing
		set [_Resources] = nothing
		set [_Roles] = nothing
		set [_Users] = nothing
	end sub
 
	' Property: [_Users]
	'
	' {private} User → [_Roles] mappings.
	'
	' Contains:
	'
	'	(Object) - in memory user -> roles mappings
	'
	private [_Users]
 
	' Property: [_Roles]
	'
	' {private} [_Roles] hierarchy.
	'
	' Contains:
	'
	'	(Object) - in memory roles hierarchy tree
	'
	private [_Roles]
 
	' Property: [_Resources]
	'
	' {private} [_Resources] hierarchy.
	'
	' Contains:
	'
	'	(Object) - in memory resources hierarchy tree
	'
	private [_Resources]
 
	' Property: [_Rules]
	'
	' {private} [_Rules] between roles and resources.
	'
	' Contains:
	'
	'	(Object) - in memory permission assignments between roles and resources
	'
	private [_Rules]
 
	' Subroutine: [_ε]
	'
	' {private} Checks for an media assignment.
	'
	private sub []
		if( isEmpty(Media) ) then _
			Err.raise 5, "Evolved AXE runtime error", "Invalid procedure call or argument. Missing a Acl_Interface media."
	end sub
 
	' Subroutine: [_ƒ]
	'
	' {private} Adds or removes an "allow" or "deny" rule to the ACL.
	'
	' Parameters:
	'
	'	(string)   - role identifier
	'	(string)   - resource identifier
	'	(string)   - privilege identifier
	'	(function) - assert
	'	(string)   - action identifier
	'	(string)   - access identifier
	'
	private sub [](byVal role, byVal resource, byVal privilege, byRef assert, byVal action, byVal access)
		if( isEmpty( [_Roles].get(role) ) ) then _
			Err.raise 17, "Evolved AXE ACL runtime error", strsubstitute( _
				"Can't perform requested operation. The role id '{0}' does not exists.", _
				array(role) _
			)
 
		if( isEmpty( [_Resources].get(resource) ) ) then _
			Err.raise 17, "Evolved AXE ACL runtime error", strsubstitute( _
				"Can't perform requested operation. The resource id '{0}' does not exists.", _
				array(resource) _
			)
 
		if( isEmpty( [_Rules].get(role) ) ) then _
			call [_Rules].set(role, JSON.parse("{}"))
 
		if( isEmpty( [_Rules].get(role).get(resource) ) ) then _
			call [_Rules].get(role).set(resource, JSON.parse("{}"))
 
		select case action
			case "ADD"
				call [_Rules].get(role).get(resource).set(privilege, array(access, assert))
 
			case "REM"
				call [_Rules].get(role).get(resource).purge(privilege)
		end select
 
		if( ubound( [_Rules].get(role).get(resource).enumerate() ) = -1 ) then _
			call [_Rules].get(role).purge(resource)
 
		if( ubound( [_Rules].get(role).enumerate() ) = -1 ) then _
			call [_Rules].purge(role)
	end sub
 
	' Function: [_φ]
	'
	' {private} Evaluates an access against a roles x resources matrix.
	'
	' Parameters:
	'
	'	(string[]) - the chain of roles
	'	(string[]) - the chain of resources
	'	(string)   - the privilege
	'
	' Returns:
	'
	'	(mixed) - true, if an "allow" is found; false, if a "deny" is found; null otherwise
	'
	private function [](byVal roles, byVal resources, byVal privilege)
		[] = null
 
		dim role, resource, assert
 
		for each role in roles
			for each resource in resources
				if( not isEmpty( [_Rules].get(role) ) ) then
					if( not isEmpty( [_Rules].get(role).get(resource) ) ) then
						if( not isEmpty( [_Rules].get(role).get(resource).get(privilege) ) ) then
							if( isNull( [_Rules].get(role).get(resource).get(privilege).get(1) ) ) then
								assert = true
							else
								assert = lambda( [_Rules].get(role).get(resource).get(privilege).get(1) )(role, resource, privilege)
							end if
							if( assert ) then
								select case [_Rules].get(role).get(resource).get(privilege).get(0)
									case "ALLOW"
										[] = true
									case "DENY"
										[] = false
								end select
								exit function
							end if
						end if
					end if
				end if
			next
		next
	end function
 
end class
 
%>
 

/lib/axe/classes/Utilities/Acl/interface.asp

<%
 
' File: interface.asp
'
' AXE(ASP Xtreme Evolution) Acl interface definition.
'
' License:
'
' This file is part of ASP Xtreme Evolution.
' Copyright (C) 2007-2012 Fabio Zendhi Nagao
'
' ASP Xtreme Evolution is free software: you can redistribute it and/or modify
' it under the terms of the GNU Lesser General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' ASP Xtreme Evolution is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU Lesser General Public License for more details.
'
' You should have received a copy of the GNU Lesser General Public License
' along with ASP Xtreme Evolution. If not, see <http://www.gnu.org/licenses/>.
 
 
 
' Class: Acl_Interface
'
' Defines the common specifications required to implement a working media of
' Acl class.
'
' About:
'
'	- Written by Fabio Zendhi Nagao <http://zend.lojcomm.com.br> @ Dec 2010
'
class Acl_Interface' extends Interface
 
' --[ Interface definition ]----------------------------------------------------
 
	' Function: load
	'
	' Returns the serialized Acl from the persistence layer.
	'
	' Returns:
	'
	'	(string) - Acl serialized content
	'
	public function load()
		load = "(string)"
	end function
 
	' Subroutine: save
	'
	' Media writing routine.
	'
	' Parameters:
	'
	'	(string) - Acl serialized content
	'
	public sub save(byVal content)
	end sub
 
	' Property: classType
	'
	' Class type.
	'
	' Contains:
	'
	'	(string) - type
	'
	public property get classType
		classType = typename(Me)
	end property
 
	' Property: classVersion
	'
	' Class version.
	'
	' Contains:
	'
	'	(string) - version in terms of http://semver.org/#semantic-versioning-200
	'
	public property get classVersion
		classVersion = "2.0.0"
	end property
 
' --[ Delegation ]--------------------------------------------------------------
 
	public property get requireds
		requireds = Parent.requireds
	end property
 
	public function check(byRef Implementation)
		check = Parent.check(Implementation)
	end function
 
' --[ Private section ]---------------------------------------------------------
 
	private Parent
 
	private sub Class_initialize()
		set Parent = new Interface
		Parent.requireds = array("load","save")
	end sub
 
	private sub Class_terminate()
		set Parent = nothing
	end sub
 
end class
 
%>
 

/lib/axe/classes/Utilities/Acl/Medias/json.asp

<%
 
' File: json.asp
'
' AXE(ASP Xtreme Evolution) json file media.
'
' License:
'
' This file is part of ASP Xtreme Evolution.
' Copyright (C) 2007-2012 Fabio Zendhi Nagao
'
' ASP Xtreme Evolution is free software: you can redistribute it and/or modify
' it under the terms of the GNU Lesser General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' ASP Xtreme Evolution is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU Lesser General Public License for more details.
'
' You should have received a copy of the GNU Lesser General Public License
' along with ASP Xtreme Evolution. If not, see <http://www.gnu.org/licenses/>.
 
 
 
' Class: Acl_Media_Json
'
' This class enables Acl to persist data using json files.
'
' About:
'
'	- Written by Fabio Zendhi Nagao <http://zend.lojcomm.com.br> @ Nov 2010
'
class Acl_Media_Json' implements Acl_Interface
 
' --[ Implementation ]----------------------------------------------------------
 
	' Function: load
	'
	' Returns the serialized Acl from the json file.
	'
	' Returns:
	'
	'	(string) - Acl serialized content
	'
	public function load()
		if(varType(path) = vbEmpty) then _
			Err.raise 5, "Evolved AXE runtime error", strsubstitute( _
				"Invalid procedure call or argument. '{0}' property 'path' isn't defined", _
				array(classType) _
			)
 
		with Server.createObject("Scripting.FileSystemObject")
			if( .fileExists(path) ) then
				with Server.createObject("ADODB.Stream")
					.type = adTypeText
					.mode = adModeReadWrite
					.charset = "UTF-8"
					.open()
 
					.loadFromFile(path)
					.position = 0
					load = .readText()
 
					.close()
				end with
			else
				load = "{ ""Users"": {}, ""Roles"": {}, ""Resources"": {}, ""Rules"": {} }"
			end if
		end with
	end function
 
	' Subroutine: save
	'
	' Media writing routine.
	'
	' Parameters:
	'
	'	(string) - Acl serialized content
	'
	public sub save(byVal content)
		if(varType(path) = vbEmpty) then _
			Err.raise 5, "Evolved AXE runtime error", strsubstitute( _
				"Invalid procedure call or argument. '{0}' property 'path' isn't defined", _
				array(classType) _
			)
 
		with Server.createObject("ADODB.Stream")
			.charset = encoding
			.type = adTypeText
			.mode = adModeReadWrite
			.open()
 
			call .writeText(content, adWriteLine)
			.setEOS()
			.position = 0
			call .saveToFile(path, adSaveCreateOverWrite)
 
			.close()
		end with
	end sub
 
	' Property: encoding
	'
	' Text encoding
	'
	' Contains:
	'
	'	(Stream.charset) - text encoding. Defaults to UTF-8
	'
	public encoding
 
	' Property: path
	'
	' File System physical path
	'
	' Contains:
	'
	'	(string) - file system physical path
	'
	public path
 
	' Property: classType
	'
	' Class type.
	'
	' Contains:
	'
	'	(string) - type
	'
	public property get classType
		classType = typename(Me)
	end property
 
	' Property: classVersion
	'
	' Class version.
	'
	' Contains:
	'
	'	(string) - version in terms of http://semver.org/#semantic-versioning-200
	'
	public property get classVersion
		classVersion = "2.0.0"
	end property
 
' --[ Private section ]---------------------------------------------------------
 
	private Interface
 
	private sub Class_initialize()
		set Interface = new Acl_Interface
		if( not Interface.check(Me) ) then _
			Err.raise 17, "Evolved AXE runtime error", strsubstitute( _
				"Can't perform requested operation. '{0}' is a bad interface implementation of '{1}'", _
				array(classType, typename(Interface)) _
			)
 
		encoding = "UTF-8"
	end sub
 
	private sub Class_terminate()
		set Interface = nothing
	end sub
 
end class
 
%>