head	1.13;
access;
symbols
	AS_AFTER_RESTRUCTURING:1.13;
locks; strict;
comment	@# @;


1.13
date	2002.10.10.15.26.43;	author thl;	state Exp;
branches;
next	1.12;

1.12
date	2002.10.10.15.10.18;	author thl;	state Exp;
branches;
next	1.11;

1.11
date	2002.10.10.15.08.54;	author thl;	state Exp;
branches;
next	1.10;

1.10
date	2002.10.10.14.05.03;	author thl;	state Exp;
branches;
next	1.9;

1.9
date	2002.10.10.11.49.31;	author thl;	state Exp;
branches;
next	1.8;

1.8
date	2002.10.10.11.42.27;	author thl;	state Exp;
branches;
next	1.7;

1.7
date	2002.10.10.08.32.22;	author thl;	state Exp;
branches;
next	1.6;

1.6
date	2002.10.10.07.23.00;	author thl;	state Exp;
branches;
next	1.5;

1.5
date	2002.10.10.07.12.46;	author thl;	state Exp;
branches;
next	1.4;

1.4
date	2002.10.10.06.59.26;	author thl;	state Exp;
branches;
next	1.3;

1.3
date	2002.10.10.06.57.12;	author thl;	state Exp;
branches;
next	1.2;

1.2
date	2002.10.09.14.15.44;	author thl;	state Exp;
branches;
next	1.1;

1.1
date	2002.10.09.14.12.11;	author thl;	state Exp;
branches;
next	;


desc
@@


1.13
log
@relation overriding through distance works as designed, at least for some arbitrary test cases
@
text
@#!/bin/sh -- # -*- perl -*-
eval 'exec perl -S $0 ${1+"$@@"}'
    if $running_under_some_shell;
##
##  AS -- Accounting System
##  Copyright (c) 2002 Cable & Wireless Deutschland <http://www.cw.com/de/>
##  Copyright (c) 2002 Ralf S. Engelschall <rse@@engelschall.com>
##
##  This file is part of AS, an accounting system which can be
##  found at http://as.is.eu.cw.com/
##
##  This program is free software; you can redistribute it and/or
##  modify it under the terms of the GNU General Public License
##  as published by the Free Software Foundation; either version
##  2.0 of the License, or (at your option) any later version.
##
##  This program 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
##  General Public License for more details.
##
##  You should have received a copy of the GNU General Public License
##  along with this program; if not, write to the Free Software
##  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
##  USA, or contact The OSSP Project <ossp@@ossp.org>.
##
##  orm.pl: object relation model
##

require 5.006;
use strict;
use Getopt::Long;
use IO;

#   default configuration
my $cfg = {
    "verbose" => 0
};

#   command line parsing
Getopt::Long::Configure("bundling");
my $result = GetOptions(
    'v|verbose' => \$cfg->{verbose},
) || die "option parsing failed";

#     RS_i ns    b R     nt RT_i
# A_i ----->* S =====> T *<---- Z_i
#
# A_i    equivalence object(s)
# RS_i   source equivalence relationship(s)
# ns     equivalence maximum distance from source S
# S      source object
# b      relationship include/exclude
# R      relationship
# T      target object
# RT_i   target scope relationship(s)
# nt     scope maximum distance from target T
# Z_i    scope object(s)

# class / uuid[] mapping
my $CU = {
    "user"      => [ "u1", "u2", "u3", "u4" ],
    "group"     => [ "g1", "g2" ],
    "account"   => [ "a1", "a2" ],
    "role"      => [ "r1" ],
    "container" => [ "c1", "c2", "c3" ]
};

# uuid / class mapping
my $UC = {};
foreach my $c (keys(%{$CU})) {
    foreach my $u (@@{$CU->{$c}}) {
        $UC->{$u} = $c;
    }
};

sub getclass
{
    my ($UC, $u) = @@_;
    my $c = $UC->{$u};
    return $c;
}

# defined class relations
# @@DR := { <RS_i,S,R,T,RT_i> } = { ... }
# S,R,T primary key
# S,T possibly wildcards

my $DR = [
    # direct user and recursive search for proxy
    # has read and write access
    # account and every object having this account as_parent
    {
    "RS_i" => [ "proxy" ],
    "S"    => [ "user" ],
    "R"    => [ "read", "write" ],
    "T"    => [ "account" ],
    "RT_i" => [ "parent" ]
    },
    # group and every object that is_member_of
    # has _read/write_access_to an
    # account and every object having this account as_parent
    {
    "RS_i" => [ "member" ],
    "S"    => [ "group" ],
    "R"    => [ "read", "write" ],
    "T"    => [ "account" ],
    "RT_i" => [ "parent" ]
    },
    # group and every object that is_member_of
    # has _read/write_access_to an
    # account and every object having this account as_parent
    {
    "RS_i" => [ "occupant", "proxy" ],
    "S"    => [ "role" ],
    "R"    => [ "read", "write", "manage" ],
    "T"    => [ "account" ],
    "RT_i" => [ "parent" ]
    },
    # group and every object that is_member_of
    # has _read/write_access_to an
    # account and every object having this account as_parent
    {
    "RS_i" => [ "occupant" ],
    "S"    => [ "role" ],
    "R"    => [ "manage" ],
    "T"    => [ "*" ],
    "RT_i" => [ "parent" ]
    },
    # user
    # is_proxy_of
    # user
    {
    "RS_i" => [ "proxy" ],
    "S"    => [ "user" ],
    "R"    => [ "proxy" ],
    "T"    => [ "user" ],
    "RT_i" => [ ]
    },
    # user
    # is_occupant_of
    # role
    {
    "RS_i" => [ ],
    "S"    => [ "user" ],
    "R"    => [ "occupant" ],
    "T"    => [ "role" ],
    "RT_i" => [ ]
    },
    # account
    # has as_parent an
    # account
    {
    "RS_i" => [ "account" ],
    "S"    => [ "account" ],
    "R"    => [ "*" ],
    "T"    => [ "account" ],
    "RT_i" => [ ]
    },
    # user and group
    # can be memberof
    # group
    {
    "RS_i" => [ ],
    "S"    => [ "user", "group" ],
    "R"    => [ "member" ],
    "T"    => [ "group" ],
    "RT_i" => [ ]
    },
    # user and every object that is_proxy_of
    # can_manage
    # anything and every object having this thing as parent
    {
    "RS_i" => [ "proxy" ],
    "S"    => [ "user" ],
    "R"    => [ "manage" ],
    "T"    => [ "*" ],
    "RT_i" => [ "parent" ]
    }
];
dumpdefinedrelations($DR);
sub dumpdefinedrelations
{
    my ($DR) = @@_;
    print "\ndumping defined relations\n";
    dumpdefinedrelation("RS_i", "S"   , "R",    "T"   , "RT_i");
    dumpdefinedrelation("-"x80, "-"x80, "-"x80, "-"x80, "-"x80);
    foreach my $i (@@{$DR}) {
        foreach my $rsi (defined @@{$i->{"RS_i"}} ? @@{$i->{"RS_i"}} : " - ") {
        foreach my $s   (@@{$i->{"S"}}) {
        foreach my $r   (@@{$i->{"R"}}) {
        foreach my $t   (@@{$i->{"T"}}) {
        foreach my $rti (defined @@{$i->{"RT_i"}} ? @@{$i->{"RT_i"}} : " - ") {
            dumpdefinedrelation($rsi, $s, $r, $t, $rti);
        }
        }
        }
        }
        }
    }
}

sub dumpdefinedrelation
{
    my ($RS_i, $S, $R, $T, $RT_i) = @@_;
    print " " . substr $RS_i . " "x80, 0, 15;
    print " " . substr $S    . " "x80, 0, 15;
    print " " . substr $R    . " "x80, 0, 20;
    print " " . substr $T    . " "x80, 0, 15;
    print " " . substr $RT_i . " "x80, 0, 15;
    print " \n";
}

# set instance relations
# @@SR := { <S,ns,b,R,nt,T> } = { ... }
# SR = n
my $SR = [
    # trustees
    { "S" => "g1", "ns" => "oo", "b" => "+", "R" => "read",   "nt" => "oo", "T" => "a1" },
    { "S" => "u1", "ns" => "oo", "b" => "+", "R" => "write",  "nt" => "oo", "T" => "a2" },
    { "S" => "r1", "ns" => "oo", "b" => "+", "R" => "manage", "nt" => "oo", "T" => "a1" },
    { "S" => "u4", "ns" => "oo", "b" => "-", "R" => "read",   "nt" => "oo", "T" => "a1" },
    { "S" => "u4", "ns" => "oo", "b" => "+", "R" => "read",   "nt" => "oo", "T" => "a2" },
    # account structure
    { "S" => "a1", "ns" => "oo", "b" => "+", "R" => "parent", "nt" => "oo", "T" => "a2" },
    # group membership
    { "S" => "u1", "ns" => "oo", "b" => "+", "R" => "member", "nt" => "oo", "T" => "g1" },
    { "S" => "g2", "ns" => "oo", "b" => "+", "R" => "member", "nt" => "oo", "T" => "g1" },
    { "S" => "u2", "ns" => "oo", "b" => "+", "R" => "member", "nt" => "oo", "T" => "g2" },
    { "S" => "u4", "ns" => "oo", "b" => "+", "R" => "member", "nt" => "oo", "T" => "g2" },
    # proxies                                                                   
    { "S" => "u2", "ns" => "oo", "b" => "+", "R" => "proxy",  "nt" => "oo", "T" => "u1" },
    { "S" => "u3", "ns" => "oo", "b" => "+", "R" => "proxy",  "nt" => "oo", "T" => "u2" }
];
dumpsetrelations($SR);
sub dumpsetrelations
{
    my ($SR) = @@_;
    print "\ndumping set relations\n";
    dumpsetrelation("S"   , "ns"  , "b"   , "R"   , "nt"  , "T"   );
    dumpsetrelation("-"x80, "-"x80, "-"x80, "-"x80, "-"x80, "-"x80);
    foreach my $i (@@{$SR}) {
        dumpsetrelation($i->{S}, $i->{ns}, $i->{b}, $i->{R}, $i->{nt}, $i->{T});
    }
}

sub dumpsetrelation
{
    my ($S, $ns,$b, $R, $nt, $T) = @@_;
    print " " . substr $S  . " "x80, 0, 15;
    print " " . substr $ns . " "x80, 0,  2;
    print " " . substr $b  . " "x80, 0,  1;
    print " " . substr $R  . " "x80, 0, 20;
    print " " . substr $nt . " "x80, 0,  2;
    print " " . substr $T  . " "x80, 0, 15;
    print " \n";
}

#   FUNCTION querysetrelations($SR, $S, $R, $T, @@Q);
#   INPUT
#    function takes $SR (set relations),
#    a $S (source), $R (relation), $T (target) triple and
#    an array listing the desired result fields as input.
#    Any of $S, $R and $T may be wildcards.
#   OUTPUT
#    It returns an array of arrays holding the desired fields.
#   EXAMPLE
#    querysetrelations($SR, "*", "*", "g1", ["S", "R"]); exit;
sub querysetrelations
{
    my ($SR, $S, $R, $T, $Q) = @@_;
    my @@O = ();

    #printf "querysetrelations(..., %s, %s, %s, ...)\n", rightstr(" ", $S, 3), rightstr(" ", $R, 10), rightstr(" ", $T, 3) if($cfg->{verbose} == 1);
    foreach my $sr (@@{$SR}) {
        if (   ($S eq "*" || $S eq $sr->{S})
            && ($R eq "*" || $R eq $sr->{R})
            && ($T eq "*" || $T eq $sr->{T})
              ) {
            my @@o = ();
            foreach my $q (@@{$Q}) {
                push @@o, $sr->{$q};
            }
            push @@O, \@@o;
        }
    }

    if($cfg->{verbose} == 1) {
        foreach my $o (@@O) {
            print "querysetrelations=";
            foreach my $i (@@{$o}) {
                print "***$i*** ";
            }
            print "\n";
        }
    }

    return @@O;
}

# FUNCTION getimmediateequiv($UC, $DR, $S, $R, $T);
# INPUT
#  function takes $UC (uuid/class lookup), $DR (defined relations) and
#  a $S (source), $R (relation), $T (target) triple as input.
# OUTPUT
#  It returns an array of all immediate (non recursive) equivalences
# FIXME
# strategy issue: when hunting down $DR for relationships multiple matches
# could be found. Three options to handle them came into my mind
# 1.) the closest match is a default only and the most general match is taken
# 2.) the closest match is the most individual and is taken over more general matches
# 3.) the summary of all matches are taken
# The first two will require a definition of what a "closest match" is.
# Currently, only the third is implemented
# 
sub getimmediateextensions
{
    my ($UC, $DR, $S, $R, $T) = @@_;

    #printf "getimmediateextensions(...) object relation %s %s %s ", rightstr(" ", $S, 3), rightstr(" ", $R, 6), rightstr(" ", $T, 3);
    $S = getclass($UC, $S);
    $T = getclass($UC, $T);
    #printf "becomes class relation %s %s %s:", rightstr(" ", $S, 7), rightstr(" ", $R, 6), rightstr(" ", $T, 7);
    my $rsi = {};
    my $rti = {};
    foreach my $dr (@@{$DR}) {
        foreach my $s (@@{$dr->{"S"}}) {
        foreach my $r (@@{$dr->{"R"}}) {
        foreach my $t (@@{$dr->{"T"}}) {
            if (   ($s eq "*" || $s eq $S)
                && ($r eq "*" || $r eq $R)
                && ($t eq "*" || $t eq $T)
                  ) {
                foreach my $i (@@{$dr->{"RS_i"}}) {
                    $rsi->{$i} = 1;
                };
                foreach my $i (@@{$dr->{"RT_i"}}) {
                    $rti->{$i} = 1;
                };
            }
        }
        }
        }
    }
    my @@RSI = ();
    foreach my $i (keys %{$rsi}) {
        push @@RSI, $i;
        #print " $i";
        }
    #print "; ";
    my @@RTI = ();
    foreach my $i (keys %{$rti}) {
        push @@RTI, $i;
        #print " $i";
        }
    #print "\n";
    return \@@RSI, \@@RTI;
}

sub rightstr
{
        my ($f, $s, $l) = @@_;
        my $r = $f x $l . $s;
        $r = substr($r, length($r) - $l, $l);
        return $r;
}

# configured to effective relationship algorithm
#function drcr2er(@@DR, @@SR): @@ER { // O(n^3)
my $ER = geteffectiverelations($UC, $DR, $SR);
dumpeffectiverelations($ER);
sub dumpeffectiverelations
{
    my ($ER) = @@_;
    print "\ndumping effective relations\n";
    dumpeffectiverelation("S"   , "ns"  , "b"   , "R"   , "nt"  , "T"   );
    dumpeffectiverelation("-"x80, "-"x80, "-"x80, "-"x80, "-"x80, "-"x80);
    foreach my $i (sort keys %{$ER}) {
        my $x = $ER->{$i};
        dumpeffectiverelation($x->{S}, $x->{ns}, $x->{b}, $x->{R}, $x->{nt}, $x->{T});
    }
}
sub dumpeffectiverelation
{
    my ($S, $ns, $b, $R, $nt, $T,) = @@_;
    print " " . substr $S  . " "x80, 0, 15;
    print " " . substr $ns . " "x80, 0,  2;
    print " " . substr $b  . " "x80, 0,  1;
    print " " . substr $R  . " "x80, 0, 20;
    print " " . substr $nt . " "x80, 0,  2;
    print " " . substr $T  . " "x80, 0, 15;
    print " \n";
}

#    effective relationships (calculated result)
#    @@ER := { <ds,S,b,R,T,dt> } = 0
sub geteffectiverelations
{
    my ($UC, $DR, $SR) = @@_;

    my $ER = {};
    foreach my $sr (@@{$SR}) {
        if($cfg->{verbose} == 1) {
            print "geteffectiverelations processing set relationship";
            dumpsetrelation($sr->{"S"}, $sr->{"ns"}, $sr->{"b"}, $sr->{"R"}, $sr->{"nt"}, $sr->{"T"});
        }
        # equivalence
        my $EQR = {};
        addequivrelation($EQR, $sr->{"S"}, 0);
        resolveequivrelations($EQR, $UC, $DR, $SR, $sr->{"S"}, $sr->{"ns"}, $sr->{"b"}, $sr->{"R"}, $sr->{"nt"}, $sr->{"T"}, 1);
        if($cfg->{verbose} == 1) {
            foreach my $eqr (keys %{$EQR}) {
                print "geteffectiverelations eqr=$eqr $EQR->{$eqr}\n";
            }
        }
        # relation
        if($cfg->{verbose} == 1) {
            print "geteffectiverelations $sr->{b}, $sr->{R}\n";
        }
        # scope
        my $SCR = {};
        addscoperelation($SCR, $sr->{"T"}, 0);
        resolvescoperelations($SCR, $UC, $DR, $SR, $sr->{"S"}, $sr->{"ns"}, $sr->{"b"}, $sr->{"R"}, $sr->{"nt"}, $sr->{"T"}, 1);
        if($cfg->{verbose} == 1) {
            foreach my $scr (keys %{$SCR}) {
                print "geteffectiverelations scr=$scr $SCR->{$scr}\n";
            }
        }
        # effective
        foreach my $eqr (keys %{$EQR}) {
            foreach my $scr (keys %{$SCR}) {
                print "geteffectiverelations $eqr, $EQR->{$eqr}, $sr->{b}, $sr->{R}, $SCR->{$scr}, $scr\n" if($cfg->{verbose} == 1);
                addeffectiverelation($ER, $eqr, $EQR->{$eqr}, $sr->{"b"}, $sr->{"R"}, $SCR->{$scr}, $scr);
            }
        }
    }
    return $ER;
}

sub resolveequivrelations
{
    my ($EQR, $UC, $DR, $SR, $S, $ns, $b, $R, $nt, $T, $d) = @@_;

    print "resolveequivrelations(..., $S, $ns, $b, $R, $nt, $T, $d)\n" if($cfg->{verbose} == 1);
    if (($ns ne "oo") && ($ns < $d)) {
        print "resolveequivrelations reached or exceeded max nesting $ns > $d\n" if($cfg->{verbose} == 1);
        return;
    }
    my ($IE, $DUMMY) = getimmediateextensions($UC, $DR, $S, $R, $T);
    print "resolveequivrelations looking at @@{$IE} -> $S\n" if($cfg->{verbose} == 1);
    foreach my $ie (@@{$IE}) {
        my @@QR = querysetrelations($SR, "*", $ie, $S, ["S"]);
        foreach my $qr (@@QR) {
            printf "resolveequivrelations query for %s -> %s found %s receives implicit relation %s to %s\n", 
             rightstr(" ", $ie, 6), rightstr(" ", $S, 3), rightstr(" ", $qr->[0], 3), rightstr(" ", $R, 6), rightstr(" ", $T, 3) if($cfg->{verbose} == 1);
            addequivrelation($EQR, $qr->[0], $d);
            $d = $d + 1;
            print "resolveequivrelations running a recursion >>>$d resolveequivrelations(..., $qr->[0], $R, $T, $d)\n" if($cfg->{verbose} == 1);
            resolveequivrelations($EQR, $UC, $DR, $SR, $qr->[0], $ns, $b, $R, $nt, $T, $d);
            print "resolveequivrelations back from recursion <<<$d resolveequivrelations(..., $qr->[0], $R, $T, $d)\n" if($cfg->{verbose} == 1);
            $d = $d - 1;
        }
    }
}

sub resolvescoperelations
{
    my ($SCR, $UC, $DR, $SR, $S, $ns, $b, $R, $nt, $T, $d) = @@_;

    print "resolvescoperelations(..., $S, $ns, $b, $R, $nt, $T, $d)\n" if($cfg->{verbose} == 1);
    if (($nt ne "oo") && ($nt < $d)) {
        print "resolvescoperelations reached or exceeded max nesting $nt > $d\n" if($cfg->{verbose} == 1);
        return;
    }
    my ($DUMMY, $IS) = getimmediateextensions($UC, $DR, $S, $R, $T);
    print "resolvescoperelations looking at $T <- @@{$IS}\n" if($cfg->{verbose} == 1);
    foreach my $is (@@{$IS}) {
        my @@QR = querysetrelations($SR, $T, $is, "*", ["T"]);
        foreach my $qr (@@QR) {
            printf "resolvescoperelations query for %s <- %s found %s receives implicit relation %s to %s\n", 
             rightstr(" ", $is, 6), rightstr(" ", $T, 3), rightstr(" ", $qr->[0], 3), rightstr(" ", $R, 6), rightstr(" ", $T, 3) if($cfg->{verbose} == 1);
            addscoperelation($SCR, $qr->[0], $d);
            $d = $d + 1;
            print "resolvescoperelations running a recursion >>>$d resolvescoperelations(..., $qr->[0], $R, $T, $d)\n" if($cfg->{verbose} == 1);
            resolvescoperelations($SCR, $UC, $DR, $SR, $S, $ns, $b, $R, $nt, $qr->[0], $d);
            print "resolvescoperelations back from recursion <<<$d resolvescoperelations(..., $qr->[0], $R, $T, $d)\n" if($cfg->{verbose} == 1);
            $d = $d - 1;
        }
    }
}

sub addequivrelation
{
    my ($EQR, $S, $ns) = @@_;
    $EQR->{"$S"} = $ns;
}

sub addscoperelation
{
    my ($SCR, $T, $nt) = @@_;
    $SCR->{"$T"} = $nt;
}

sub addeffectiverelation
{
    my ($ER, $S, $ns, $b, $R, $nt, $T) = @@_;
    
    my $key = $T . "*" . $R . "*" . $S;
    my $er = $ER->{$key};
    if (not defined($er)) {
        $ER->{$key} = { "S" => $S,  "ns" => $ns, "b" => $b, "R" => $R, "nt" => $nt, "T" => $T };
    } else {
        print "addeffectiverelation $er->{ns} <=> $ns  &&  $er->{nt} <=> $nt\n" if($cfg->{verbose} == 1);
        if (($er->{"ns"} == $ns) && ($er->{"nt"} == $nt)) { print "addeffectiverelation #1!\n" if($cfg->{verbose} == 1);                                                                                          } #<ds,S,b,R,T,dt>, resolve b via R-specific conflict flag (prefer include or exlude) FIXME
        if (($er->{"ns"} == $ns) && ($er->{"nt"} <  $nt)) { print "addeffectiverelation #2!\n" if($cfg->{verbose} == 1);                                                                                          } #<ds,S,b,R,T,dt> (nop)
        if (($er->{"ns"} == $ns) && ($er->{"nt"} >  $nt)) { print "addeffectiverelation #3!\n" if($cfg->{verbose} == 1);                                     $er->{"b"} = $b; $er->{"T"} = $T; $er->{"nt"} = $nt; } #<ds,S,new-b,R,new-T,new-dt>
        if (($er->{"ns"} <  $ns) && ($er->{"nt"} == $nt)) { print "addeffectiverelation #4!\n" if($cfg->{verbose} == 1);                                                                                          } #<ds,S,b,R,T,dt> (nop)
        if (($er->{"ns"} <  $ns) && ($er->{"nt"} <  $nt)) { print "addeffectiverelation #5!\n" if($cfg->{verbose} == 1);                                                                                          } #<ds,S,b,R,T,dt> (nop)
        if (($er->{"ns"} <  $ns) && ($er->{"nt"} >  $nt)) { print "addeffectiverelation #6!\n" if($cfg->{verbose} == 1);                                     $er->{"b"} = $b; $er->{"T"} = $T; $er->{"nt"} = $nt; } #<ds,S,new-b,R,new-T,new-dt>
        if (($er->{"ns"} >  $ns) && ($er->{"nt"} == $nt)) { print "addeffectiverelation #7!\n" if($cfg->{verbose} == 1); $er->{"ns"} = $ns; $er->{"S"} = $S; $er->{"b"} = $b;                                     } #<new-ds,new-S,new-b,R,T,dt>
        if (($er->{"ns"} >  $ns) && ($er->{"nt"} <  $nt)) { print "addeffectiverelation #8!\n" if($cfg->{verbose} == 1); $er->{"ns"} = $ns; $er->{"S"} = $S; $er->{"b"} = $b;                                     } #<new-ds,new-S,new-b,R,T,dt>
        if (($er->{"ns"} >  $ns) && ($er->{"nt"} >  $nt)) { print "addeffectiverelation #9!\n" if($cfg->{verbose} == 1); $er->{"ns"} = $ns; $er->{"S"} = $S; $er->{"b"} = $b; $er->{"T"} = $T; $er->{"nt"} = $nt; } #<new-ds,new-S,new-b,R,new-T,new-dt>
    }
}
@


1.12
log
@flush; it sums up the relations but at least distance hehaves unexpected
@
text
@d222 2
a223 1
    { "S" => "u4", "ns" => "oo", "b" => "-", "R" => "read",   "nt" => "oo", "T" => "a2" },
d413 1
a413 1
                print "DEBUG: eqr=$eqr $EQR->{$eqr}\n";
d418 1
a418 1
            print "DEBUG: $sr->{b}, $sr->{R}\n";
d426 1
a426 1
                print "DEBUG: scr=$scr $SCR->{$scr}\n";
d432 2
a433 2
                print "DEBUG: $eqr, $EQR->{$eqr}, $sr->{b}, $sr->{R}, $scr, $SCR->{$scr}\n" if($cfg->{verbose} == 1);
                addeffectiverelation($ER, $eqr, $EQR->{$eqr}, $sr->{b}, $sr->{R}, $scr, $SCR->{$scr});
d513 10
a522 9
        if (($er->{"ns"} = $ns) && ($er->{"nt"} = $nt)) {                                                                                          print "DEBUG: #1!\n"; } #<ds,S,b,R,T,dt>, resolve b via R-specific conflict flag (prefer include or exlude) FIXME
        if (($er->{"ns"} = $ns) && ($er->{"nt"} > $nt)) {                                                                                          print "DEBUG: #2!\n"; } #<ds,S,b,R,T,dt> (nop)
        if (($er->{"ns"} = $ns) && ($er->{"nt"} < $nt)) {                                     $er->{"b"} = $b; $er->{"T"} = $T; $er->{"nt"} = $nt; print "DEBUG: #3!\n"; } #<ds,S,new-b,R,new-T,new-dt>
        if (($er->{"ns"} > $ns) && ($er->{"nt"} = $nt)) {                                                                                          print "DEBUG: #4!\n"; } #<ds,S,b,R,T,dt> (nop)
        if (($er->{"ns"} > $ns) && ($er->{"nt"} > $nt)) {                                                                                          print "DEBUG: #5!\n"; } #<ds,S,b,R,T,dt> (nop)
        if (($er->{"ns"} > $ns) && ($er->{"nt"} < $nt)) {                                     $er->{"b"} = $b; $er->{"T"} = $T; $er->{"nt"} = $nt; print "DEBUG: #6!\n"; } #<ds,S,new-b,R,new-T,new-dt>
        if (($er->{"ns"} < $ns) && ($er->{"nt"} = $nt)) { $er->{"ns"} = $ns; $er->{"S"} = $S; $er->{"b"} = $b;                                     print "DEBUG: #7!\n"; } #<new-ds,new-S,new-b,R,T,dt>
        if (($er->{"ns"} < $ns) && ($er->{"nt"} > $nt)) { $er->{"ns"} = $ns; $er->{"S"} = $S; $er->{"b"} = $b;                                     print "DEBUG: #8!\n"; } #<new-ds,new-S,new-b,R,T,dt>
        if (($er->{"ns"} < $ns) && ($er->{"nt"} < $nt)) { $er->{"ns"} = $ns; $er->{"S"} = $S; $er->{"b"} = $b; $er->{"T"} = $T; $er->{"nt"} = $nt; print "DEBUG: #9!\n"; } #<new-ds,new-S,new-b,R,new-T,new-dt>
@


1.11
log
@flush; it sums up the relations but at least distance hehaves unexpected
@
text
@d513 8
a520 8
        if (($er->{"ns"} = $ns) && ($er->{"nt"} < $nt)) {                                                                                          print "DEBUG: #2!\n"; } #<ds,S,b,R,T,dt> (nop)
        if (($er->{"ns"} = $ns) && ($er->{"nt"} > $nt)) {                                     $er->{"b"} = $b; $er->{"T"} = $T; $er->{"nt"} = $nt; print "DEBUG: #3!\n"; } #<ds,S,new-b,R,new-T,new-dt>
        if (($er->{"ns"} < $ns) && ($er->{"nt"} = $nt)) {                                                                                          print "DEBUG: #4!\n"; } #<ds,S,b,R,T,dt> (nop)
        if (($er->{"ns"} < $ns) && ($er->{"nt"} < $nt)) {                                                                                          print "DEBUG: #5!\n"; } #<ds,S,b,R,T,dt> (nop)
        if (($er->{"ns"} < $ns) && ($er->{"nt"} > $nt)) {                                     $er->{"b"} = $b; $er->{"T"} = $T; $er->{"nt"} = $nt; print "DEBUG: #6!\n"; } #<ds,S,new-b,R,new-T,new-dt>
        if (($er->{"ns"} > $ns) && ($er->{"nt"} = $nt)) { $er->{"ns"} = $ns; $er->{"S"} = $S; $er->{"b"} = $b;                                     print "DEBUG: #7!\n"; } #<new-ds,new-S,new-b,R,T,dt>
        if (($er->{"ns"} > $ns) && ($er->{"nt"} < $nt)) { $er->{"ns"} = $ns; $er->{"S"} = $S; $er->{"b"} = $b;                                     print "DEBUG: #8!\n"; } #<new-ds,new-S,new-b,R,T,dt>
        if (($er->{"ns"} > $ns) && ($er->{"nt"} > $nt)) { $er->{"ns"} = $ns; $er->{"S"} = $S; $er->{"b"} = $b; $er->{"T"} = $T; $er->{"nt"} = $nt; print "DEBUG: #9!\n"; } #<new-ds,new-S,new-b,R,new-T,new-dt>
@


1.10
log
@calculate equivalence and scope independent of each other; track distance
@
text
@d222 1
d377 3
a379 2
    foreach my $i (@@{$ER}) {
        dumpeffectiverelation($i->{S}, $i->{ns}, $i->{b}, $i->{R}, $i->{nt}, $i->{T});
d400 1
d402 1
a402 1
        if($cfg->{verbose} == 0) {
d406 1
d410 8
a417 2
        foreach my $eqr (keys %{$EQR}) {
            print "DEBUG: eqr=$eqr $EQR->{$eqr}\n";
d419 1
a419 1
        print "DEBUG: $sr->{b}, $sr->{R}\n";
d423 11
a433 2
        foreach my $scr (keys %{$SCR}) {
            print "DEBUG: scr=$scr $SCR->{$scr}\n";
a435 2
    my $ER = [];
    #addeffectiverelation($ER, $qr->[0], $d, $b, $R, 0, $T);
d506 16
a521 1
    push @@{$ER}, { "S" => $S,  "ns" => $ns, "b" => $b, "R" => $R, "nt" => $nt, "T" => $T };
@


1.9
log
@cosmetics
@
text
@d219 1
a219 1
    { "S" => "g1", "ns" =>   0 , "b" => "+", "R" => "read",   "nt" => "oo", "T" => "a1" },
d223 1
a223 1
    { "S" => "a2", "ns" => "oo", "b" => "+", "R" => "parent", "nt" => "oo", "T" => "a1" },
d230 1
a230 1
    { "S" => "u2", "ns" =>   0 , "b" => "+", "R" => "proxy",  "nt" => "oo", "T" => "u1" },
d272 1
a272 1
    #printf "querysetrelations(..., %s, %s, %s, ...)\n", rightstr(" ", $S, 3), rightstr(" ", $R, 6), rightstr(" ", $T, 3) if($cfg->{verbose} == 1);
d290 1
a290 1
                print "$i ";
d314 1
a314 1
sub getimmediateequiv
d318 1
a318 1
    #printf "getimmediateequiv(...) object relation %s %s %s ", rightstr(" ", $S, 3), rightstr(" ", $R, 6), rightstr(" ", $T, 3);
d323 1
d333 1
a333 1
                    $rsi->{$i} = 1 }
d335 4
d343 1
a343 1
    my @@O = ();
d345 7
a351 1
        push @@O, $i;
d355 1
a355 1
    return @@O;
a396 1
    my $ER = [];
d399 1
a399 1
        if($cfg->{verbose} == 1) {
d403 13
a415 2
        addeffectiverelation($ER, $sr->{"S"}, 0, $sr->{"b"}, $sr->{"R"}, 0, $sr->{"T"});
        resolveequivrelations($ER, $UC, $DR, $SR, $sr->{"ns"}, $sr->{"S"}, $sr->{"b"}, $sr->{"R"}, $sr->{"T"}, 0);
d417 2
d424 1
a424 1
    my ($ER, $UC, $DR, $SR, $ns, $S, $b, $R, $T, $d) = @@_;
d426 1
a426 1
    #print "resolveequivrelations(..., $S, $ns, $b, $R, $T, $d)\n";
d428 1
a428 1
        print "resolveequivrelations reached or exceeded max nesting $ns > $d\n";
d431 3
a433 3
    my @@IE = getimmediateequiv($UC, $DR, $S, $R, $T);
    #print "resolveequivrelations looking at @@IE of $S\n";
    foreach my $ie (@@IE) {
d436 3
a438 2
            printf "resolveequivrelations query for %s of %s found %s receives implicit relation %s to %s\n", rightstr(" ", $ie, 6), rightstr(" ", $S, 3), rightstr(" ", $qr->[0], 3), rightstr(" ", $R, 6), rightstr(" ", $T, 3);
            addeffectiverelation($ER, $qr->[0], $d, $b, $R, 0, $T);
d440 3
a442 3
            #print "resolveequivrelations running a recursion >>>$d resolveequivrelations(..., $qr->[0], $R, $T, $d)\n";
            resolveequivrelations($ER, $UC, $DR, $SR, $ns, $qr->[0], $b, $R, $T, $d);
            #print "resolveequivrelations back from recursion <<<$d resolveequivrelations(..., $qr->[0], $R, $T, $d)\n";
d446 38
@


1.8
log
@resolveequivrelations() recursively resolves all equivalences
@
text
@d371 1
a371 2
    my ($ds, $S, $b, $R, $T, $ts) = @@_;
    print " " . substr $ds . " "x80, 0,  5;
d373 1
d375 2
a376 1
    print " " . substr $R  . " "x80, 0, 15;
a377 1
    print " " . substr $ts . " "x80, 0,  5;
@


1.7
log
@implement querysetrelations(), a poor mans SQL-like "select from"
@
text
@d31 1
a31 1
#FIXME use strict;
d72 1
a72 1
    foreach $u (@@{$CU->{$c}}) {
d219 1
a219 1
    { "S" => "g1", "ns" => "oo", "b" => "+", "R" => "read",   "nt" => "oo", "T" => "a1" },
d230 1
a230 1
    { "S" => "u2", "ns" => "oo", "b" => "+", "R" => "proxy",  "nt" => "oo", "T" => "u1" },
d270 1
a270 1
    my @@O;
d272 1
a272 1
    printf "querysetrelations(..., %s, %s, %s, ...)\n", rightstr(" ", $S, 3), rightstr(" ", $R, 6), rightstr(" ", $T, 3) if($cfg->{verbose} == 1);
d295 2
d318 1
a318 1
    printf "getimmediateequiv (object relations %s %s %s) ", rightstr(" ", $S, 3), rightstr(" ", $R, 6), rightstr(" ", $T, 3);
d321 1
a321 1
    printf "become class relations %s %s %s:", rightstr(" ", $S, 7), rightstr(" ", $R, 6), rightstr(" ", $T, 7);
d323 1
a323 1
    foreach $dr (@@{$DR}) {
d338 7
a344 9
    foreach my $i (keys %{$rsi}) { print " $i"; } print "\n";
    return @@rsi;
}

sub queryforsetrelations
{
    my ($UC, $DR, $S, $R, $T) = @@_;

    printf "getdefinedrelations (object relations %s %s %s) ", rightstr(" ", $S, 3), rightstr(" ", $R, 6), rightstr(" ", $T, 3);
d350 1
a350 1
        $r = $f x $l . $s;
d363 1
a363 1
    dumpeffectiverelation("ds"  , "S"   , "b"   , "R"   , "T"   , "ts"  );
d366 1
a366 1
        dumpeffectiverelation($i->{ds}, $i->{S}, $i->{b}, $i->{R}, $i->{T}, $i->{ts});
d388 14
a401 8
    foreach $sr (@@{$SR}) {
        print "processing set relationship"                                                       if($cfg->{verbose} == 1);
        dumpsetrelation($sr->{"S"}, $sr->{"ns"}, $sr->{"b"}, $sr->{"R"}, $sr->{"nt"}, $sr->{"T"}) if($cfg->{verbose} == 1);
        getimmediateequiv($UC, $DR, $sr->{"S"}, $sr->{"R"}, $sr->{"T"});

        #my @@EQ = (); #<a,d>
        #<$RS_i,$ns>
        lookup_ns_and_rsi_in_dr($DR, $sr->{S}, $sr->{R}, $sr->{T})
d403 18
a421 5
    $ER = [
        { "ds" => 3, "S" => "foo",  "b" => "+", "R" => "loves", "T" => "bar",  "ts" => 2 },
        { "ds" => 0, "S" => "quux", "b" => "+", "R" => "needs", "T" => "none", "ts" => 1 }
    ];
    return $ER;
d424 1
a424 1
sub lookup_ns_and_rsi_in_dr
d426 2
a427 1
        my ($DR, $S, $R, $T) = @@_;
@


1.6
log
@describe operation and limitations of getimmediateequiv
@
text
@d257 40
d338 7
@


1.5
log
@getimmediateequiv now uses hash to remove duplicates and supports wildcard relations
@
text
@d257 15
@


1.4
log
@flush before getimmediateequiv moves from array to hash
@
text
@d154 1
a154 1
    "RS_i" => [ ],
d156 1
a156 1
    "R"    => [ "parent" ],
d267 10
a276 7
        foreach my $s   (@@{$dr->{"S"}}) {
        foreach my $r   (@@{$dr->{"R"}}) {
        foreach my $t   (@@{$dr->{"T"}}) {
        if ($s eq "*" && $r eq $R && $t eq "*") { foreach my $i (@@{$dr->{"RS_i"}}) { $rsi->$i } };
        if ($s eq "*" && $r eq $R && $t eq $T ) { foreach my $i (@@{$dr->{"RS_i"}}) { $rsi->$i } };
        if ($s eq $S  && $r eq $R && $t eq "*") { foreach my $i (@@{$dr->{"RS_i"}}) { $rsi->$i } };
        if ($s eq $S  && $r eq $R && $t eq $T ) { foreach my $i (@@{$dr->{"RS_i"}}) { $rsi->$i } };
d281 1
a281 1
    foreach my $i (key %{$rsi}) { print " $i"; } print "\n";
@


1.3
log
@flush before getimmediateequiv moves from array to hash
@
text
@d265 1
a265 1
    my @@rsi;
d270 4
a273 4
        if ($s eq "*" && $r eq $R && $t eq "*") { foreach my $i (@@{$dr->{"RS_i"}}) { push @@rsi, $i } };
        if ($s eq "*" && $r eq $R && $t eq $T ) { foreach my $i (@@{$dr->{"RS_i"}}) { push @@rsi, $i } };
        if ($s eq $S  && $r eq $R && $t eq "*") { foreach my $i (@@{$dr->{"RS_i"}}) { push @@rsi, $i } };
        if ($s eq $S  && $r eq $R && $t eq $T ) { foreach my $i (@@{$dr->{"RS_i"}}) { push @@rsi, $i } };
d278 1
a278 1
    foreach my $i (@@rsi) { print " $i"; } print "\n";
@


1.2
log
@cosmetics
@
text
@d60 26
a85 2
# defined relationships (pre-configured input)
# @@DR := { <RS_i,ns,S,R,T,nt,RT_i> } = { ... }
d90 2
a91 2
    # user and every object that is_proxy_of
    # has _read/write_access_to an
d94 1
a94 2
    "RS_i" => [ "is_proxy_of" ],
    "ns"   => 1,
d96 1
a96 1
    "R"    => [ "has_read_access_to", "has_write_access_to" ],
d98 1
a98 2
    "nt"   => "oo",
    "RT_i" => [ "as_parent" ]
d104 1
a104 2
    "RS_i" => [ "is_member_of" ],
    "ns"   => "oo",
d106 1
a106 1
    "R"    => [ "has_read_access_to", "has_write_access_to" ],
d108 1
a108 2
    "nt"   => "oo",
    "RT_i" => [ "as_parent" ]
d114 1
a114 2
    "RS_i" => [ "is_occupant_of" ],
    "ns"   => "oo",
d116 1
a116 1
    "R"    => [ "has_read_access_to", "has_write_access_to" ],
d118 11
a128 2
    "nt"   => "oo",
    "RT_i" => [ "as_parent" ]
d134 1
a134 2
    "RS_i" => [ ],
    "ns"   => 0,
d136 1
a136 1
    "R"    => [ "is_proxy_of" ],
a137 1
    "nt"   => 0,
a144 1
    "ns"   => 0,
d146 1
a146 1
    "R"    => [ "is_occupant_of" ],
a147 1
    "nt"   => 0,
a154 1
    "ns"   => 0,
d156 1
a156 1
    "R"    => [ "as_parent" ],
a157 1
    "nt"   => 0,
a164 1
    "ns"   => 0,
d166 1
a166 1
    "R"    => [ "is_member_of" ],
a167 1
    "nt"   => 0,
d174 1
a174 2
    "RS_i" => [ "is_proxy_of" ],
    "ns"   => 0,
d176 1
a176 1
    "R"    => [ "can_manage" ],
d178 1
a178 2
    "nt"   => 0,
    "RT_i" => [ "parent_is" ]
d186 2
a187 2
    dumpdefinedrelation("RS_i", "ns"  , "S"   , "R",    "T"   , "nt"  , "RT_i");
    dumpdefinedrelation("-"x80, "-"x80, "-"x80, "-"x80, "-"x80, "-"x80, "-"x80);
a188 2
        $ns   = $i->{"ns"  };
        $nt   = $i->{"nt"  };
d194 1
a194 1
            dumpdefinedrelation($rsi, $ns, $s, $r, $t, $nt, $rti);
d205 1
a205 1
    my ($RS_i, $ns, $S, $R, $T, $nt, $RT_i) = @@_;
a206 1
    print " " . substr $ns   . " "x80, 0,  2;
a209 1
    print " " . substr $nt   . " "x80, 0,  2;
a212 3
#foreach $i (@@{$DR}) {
#    print "$i->{R}->[0]\n";
#}
d214 2
a215 2
# set relations
# @@SR := { <S,b,R,T> } = { ... }
d219 3
a221 2
    { "S" => "group-1",   "b" => "+", "R" => "has_read_access_to",  "T" => "account-1" },
    { "S" => "user-1",    "b" => "+", "R" => "has_write_access_to", "T" => "account-2" },
d223 1
a223 1
    { "S" => "account-2", "b" => "+", "R" => "as_parent",           "T" => "account-1" },
d225 7
a231 7
    { "S" => "user-1",    "b" => "+", "R" => "is_member_of",        "T" => "group-1"   },
    { "S" => "group-2",   "b" => "+", "R" => "is_member_of",        "T" => "group-1"   },
    { "S" => "user-2",    "b" => "+", "R" => "is_member_of",        "T" => "group-2"   },
    { "S" => "user-4",    "b" => "+", "R" => "is_member_of",        "T" => "group-2"   },
    # proxies                                                                          
    { "S" => "user-2",    "b" => "+", "R" => "is_proxy_of",         "T" => "user-1"    },
    { "S" => "user-3",    "b" => "+", "R" => "is_proxy_of",         "T" => "user-2"    }
d238 2
a239 2
    dumpsetrelation("S"   , "b"   , "R"   , "T"   );
    dumpsetrelation("-"x80, "-"x80, "-"x80, "-"x80);
d241 1
a241 1
        dumpsetrelation($i->{S}, $i->{b}, $i->{R}, $i->{T});
d247 7
a253 5
    my ($S, $b, $R, $T) = @@_;
    print " " . substr $S . " "x80, 0, 15;
    print " " . substr $b . " "x80, 0,  1;
    print " " . substr $R . " "x80, 0, 15;
    print " " . substr $T . " "x80, 0, 15;
d257 33
d292 1
a292 1
my $ER = geteffectiverelations($DR, $SR);
d320 1
a320 1
    my ($DR, $SR) = @@_;
d324 3
a326 2
        print "processing set relationship"                     if($cfg->{verbose} == 1);
        dumpsetrelation($sr->{S}, $sr->{b}, $sr->{R}, $sr->{T}) if($cfg->{verbose} == 1);
@


1.1
log
@flush and break at "object class vs. instance" and "usefulness outside acl" problems
@
text
@d167 1
a167 1
    print "dumping defined relations\n";
d221 1
a221 1
#dumpsetrelations($SR);
d225 1
a225 1
    print "dumping set relations\n";
d250 1
a250 1
    print "dumping effective relations\n";
@