BEGIN { use_ok(
'SVN::Access'
) };
unlink
(
'svn_access_test.conf'
,
'whitespace_at_end_test.conf'
,
'line_cont.conf'
,
'syntax-err.conf'
,
'expn.conf'
,
'undef.conf'
);
my
$acl
= SVN::Access->new(
acl_file
=>
'svn_access_test.conf'
);
$acl
->add_group(
'@folks'
,
'bob'
,
'ed'
,
'frank'
);
is(
scalar
(
$acl
->group(
'folks'
)->members), 3,
"Added new group to the object."
);
$acl
->add_resource(
'/'
,
'@folks'
,
'rw'
);
is(
$acl
->resource(
'/'
)->authorized->{
'@folks'
},
'rw'
,
"Make sure we added these folks to the '/' resource."
);
$acl
->write_acl;
$acl
->add_resource(
'/test'
);
is(
ref
(
$acl
->resource(
'/test'
)),
'SVN::Access::Resource'
,
"Do empty resources show up in the array?"
);
$acl
->write_acl;
$acl
= SVN::Access->new(
acl_file
=>
'svn_access_test.conf'
);
is(
ref
(
$acl
->resource(
'/test'
)),
'SVN::Access::Resource'
,
"Do empty resources show up in the array after re-parsing the file?"
);
$acl
->add_resource(
'repo:/something with spaces'
,
mike
=>
'rw'
);
$acl
->add_resource(
'/kagetest'
,
joey
=>
'rw'
,
billy
=>
'r'
,
sam
=>
'r'
,
);
$acl
->resource(
'/kagetest'
)->authorize(
judy
=>
'rw'
,
phil
=>
'r'
,
frank
=>
''
,
wanda
=>
'r'
);
$acl
->resource(
'/kagetest'
)->authorize(
sammy
=>
'r'
, 2);
$acl
->add_alias(
'mikey'
,
'uid=mgregorowicz,ou=people,dc=mg2,dc=org'
);
is(
$acl
->alias(
'mikey'
),
'uid=mgregorowicz,ou=people,dc=mg2,dc=org'
,
"Making sure we can add an alias."
);
$acl
->remove_alias(
'mikey'
);
is(
$acl
->alias(
'mikey'
),
undef
,
"Delete alias check."
);
$acl
->add_alias(
'mikey'
,
'uid=mgregorowicz,ou=people,dc=mg2,dc=org'
);
$acl
->write_acl;
my
$whitespace_at_end_test
=
<<EOF;
[aliases]
mikey = uid=mgregorowicz,ou=people,dc=mg2,dc=org
[groups]
folks = bob, ed, frank
[/]
\@folks = rw
[/test]
[repo:/something with spaces]
mike = rw
[/kagetest]
joey = rw
billy = r
sammy = r
sam = r
judy = rw
phil = r
frank =
wanda = r
EOF
chomp
(
$whitespace_at_end_test
);
$whitespace_at_end_test
.=
" "
;
open
(WSTEST,
'>'
,
'whitespace_at_end_test.conf'
);
print
WSTEST
$whitespace_at_end_test
;
close
(WSTEST);
my
$wstestacl
= SVN::Access->new(
acl_file
=>
'whitespace_at_end_test.conf'
);
is(
scalar
(
$wstestacl
->group(
'folks'
)->members), 3,
"Sanity checking our whitespace test."
);
is(
$wstestacl
->resource(
'/kagetest'
)->authorized->{wanda},
'r'
,
"Making sure there's no trailing whitespace after wanda's 'r' access."
);
unlink
(
'whitespace_at_end_test.conf'
);
my
$test_contents
=
<<EOF;
[aliases]
mikey = uid=mgregorowicz,ou=people,dc=mg2,dc=org
[groups]
folks = bob, ed, frank
[/]
\@folks = rw
[/test]
[repo:/something with spaces]
mike = rw
[/kagetest]
joey = rw
billy = r
sammy = r
sam = r
judy = rw
phil = r
frank =
wanda = r
EOF
my
$actual_contents
;
open
(TEST_ACL,
'<'
,
'svn_access_test.conf'
);
{
local
$/;
$actual_contents
= <TEST_ACL>;
}
is(
$actual_contents
,
$test_contents
,
"Making sure our output remains in-order."
);
$acl
= SVN::Access->new(
acl_file
=>
'svn_access_test.conf'
);
is(
scalar
(
$acl
->group(
'folks'
)->members), 3,
"Checking our group after the write-out."
);
$acl
->remove_group(
'folks'
);
is(
defined
(
$acl
->groups),
''
,
"Making sure groups is undefined when we delete the last one"
);
is(
$acl
->aliases->{mikey},
'uid=mgregorowicz,ou=people,dc=mg2,dc=org'
,
"Does my alias still exist after round trip?"
);
$acl
->add_resource(
name
=>
'/awesomeness'
,
authorized
=> {
mike
=>
'rw'
,
}
);
is(
$acl
->resource(
'/awesomeness'
)->authorized->{mike},
'rw'
,
'was hash param understood?'
);
$acl
->remove_resource(
'/awesomeness'
);
my
$resource
= SVN::Access::Resource->new(
name
=>
'/awesomeness'
,
authorized
=> {
mike
=>
'rw'
,
},
);
push
(@{
$acl
->{acl}->{resources}},
$resource
);
is(
$acl
->resource(
'/awesomeness'
)->authorized->{mike},
'rw'
,
'sideloaded resource instantiated with hashref authorized'
);
$acl
->add_resource(
'/new'
,
'@doesntexist'
,
'rw'
);
eval
{
$acl
->write_acl;
};
ok(
defined
($@),
'We encountered a fatal error when trying to write an erroneous ACL.'
);
$acl
->remove_resource(
'/new'
);
$acl
->add_resource(
'my-repo:/test/path'
,
'mikey_g'
,
'rw'
);
is(
$acl
->resource(
'my-repo:/test/path'
)->authorized->{mikey_g},
'rw'
,
'Can we call up perms on the new path?'
);
$acl
->remove_resource(
'/'
);
$acl
->add_resource(
'my-repo2:/this/that/the other/thing'
);
$acl
->write_acl;
$acl
= SVN::Access->new(
acl_file
=>
'svn_access_test.conf'
);
$acl
->remove_resource(
'/test'
);
$acl
->remove_resource(
'my-repo:/test/path'
);
$acl
->remove_resource(
'/kagetest'
);
$acl
->remove_resource(
'my-repo2:/this/that/the other/thing'
);
$acl
->remove_resource(
'repo:/something with spaces'
);
$acl
->remove_resource(
'/awesomeness'
);
$acl
->remove_alias(
'mikey'
);
is(
defined
(
$acl
->resources),
''
,
"Making sure resources is undefined when we delete the last one"
);
$acl
->write_acl;
is((
stat
(
'svn_access_test.conf'
))[7], 0,
"Making sure our SVN ACL file is zero bytes, and unlinking."
);
system
(
"cat svn_access_test.conf"
);
unlink
(
'svn_access_test.conf'
);
open
(LTEST,
'>'
,
'line_cont.conf'
);
print
LTEST
<<'CHUMBA';
[groups]
folks = bob,
ed,
frank
missing=not
# the line above contains some whitespace
foo=bar # not allowed, baz
@tempt = incorrect
# see libsvn_subr/config_file.c:svn_config__parse_file()
[/]
@folks = rw
CHUMBA
close
(LTEST);
$acl
= SVN::Access->new(
acl_file
=>
'line_cont.conf'
);
ok(
defined
(
$acl
),
"Make sure we can parse file with line continuations"
);
my
@m
=
$acl
->group(
'folks'
)->members;
is(
$#m
, 2,
"Make sure group has three members, via continuations"
);
is(
$m
[2],
"frank"
,
"Make sure frank is at the end of the list"
);
@m
=
$acl
->group(
'foo'
)->members;
is(
$#m
, 0,
"Make sure group has 1 members due to trailing comment"
);
is(
$m
[0],
"bar"
,
"make sure trailing comment was stripped"
);
@m
=
$acl
->group(
'tempt'
)->members;
is(
$#m
, 0,
"Make sure group with @ is renamed and has one member"
);
is(
$m
[0],
"incorrect"
,
"Make sure that group has correct member"
);
$acl
= SVN::Access->new(
acl_file
=>
'line_cont.conf'
,
pedantic
=> 1);
@m
=
$acl
->group(
'@tempt'
)->members;
is(
$#m
, 0,
"Make sure group with @ has the name preserved (as svn allows)"
);
is(
$m
[0],
"incorrect"
,
"Make sure group with @ has proper membership"
);
@m
=
$acl
->group(
'foo'
)->members;
is(
$#m
, 1,
"Make sure group has 2 members"
);
is(
$m
[0],
"bar # not allowed"
,
"make sure comment is appended as svn does"
);
is(
$m
[1],
"baz"
,
"make sure next entry is right"
);
is(
ref
$acl
->group(
'missing'
),
"SVN::Access::Group"
,
"Group before bogus line continuation should be present"
);
unlink
(
'line_cont.conf'
);
open
(STEST,
'>'
,
'syntax-err.conf'
);
print
STEST
<<'CHUMBA';
[groups]
broken_line = one,
two
[]
ugh = foo
[/]
broken_line = w
foo = r@foobar = rw
CHUMBA
close
(STEST);
my
@errs
;
$SIG
{__WARN__} =
sub
{
push
@errs
,
@_
; };
$acl
=
eval
{ SVN::Access->new(
acl_file
=>
'syntax-err.conf'
); };
ok(
defined
(
$acl
),
"Make sure we can parse file with syntax errors"
);
is(
$#errs
, 2,
"Make sure we got the right number of errors"
);
ok(
$errs
[0] =~ /^Unrecognized line two\s*/,
"Make sure we detected the broken line syntax error"
);
ok(
$errs
[1] =~ /^Unrecognized line \[\]/,
"Make sure we catch the bogus section divider"
);
ok(
$errs
[2] =~ /^Invalid character in authz rule/,
"Make sure we catch the syntax error in rw spec"
);
unlink
(
'syntax-err.conf'
);
open
(STEST,
'>'
,
'expn.conf'
);
print
STEST
<<'CHUMBA';
[groups]
alicorn = &twilight
earth = applejack
unicorn = rarity
pony = @alicorn, @earth, @unicorn
[aliases]
twilight = twilight_sparkle
[/]
pony = rw
CHUMBA
close
(STEST);
$acl
=
eval
{ SVN::Access->new(
acl_file
=>
'expn.conf'
); };
ok(
defined
(
$acl
),
"Make sure we can parse complex file"
);
@g
=
$acl
->group(
"pony"
)->members();
is(
$g
[0],
'@alicorn'
,
"Make sure group returns groups unexpanded"
);
@g
=
$acl
->resolve(
'@pony'
);
is(
$g
[0],
'twilight_sparkle'
,
'Make sure resolve expands groups and aliases'
);
unlink
(
'expn.conf'
);
open
(STEST,
'>'
,
'undef.conf'
);
print
STEST
<<'CHUMBA';
[aliases]
right = correct
backwards = &forwards
forwards = backwards
[groups]
broken = one, two, three, &none, @nada, &right
outoforder = @working
working = yes
[/]
@zip = rw
&zilch = rw
@broken = rw
&right = rw
CHUMBA
close
(STEST);
@errs
= ();
$acl
=
eval
{ SVN::Access->new(
acl_file
=>
'undef.conf'
); };
ok(
defined
(
$acl
),
"Make sure we can parse a file with errors"
);
is(
$#errs
, -1,
"the parser doesn't catch the errors"
);
@errs
=
split
(/\n/,
$acl
->verify_acl);
is(
$#errs
, 3,
"Make sure we got the right number of verify errors"
);
ok(
$errs
[0] =~ /
'none'
, which is undefined/,
"Make sure we catch the undefined alias in group defn"
);
ok(
$errs
[1] =~ /
'nada'
, which is undefined/,
"Make sure we catch the undefined group in group defn"
);
ok(
$errs
[2] =~ /
'\@zip'
, which is undefined/,
"Make sure we catch the undefined group in resource"
);
ok(
$errs
[3] =~ /
'\&zilch'
, which is undefined/,
"Make sure we catch the undefined alias in resource"
);
unlink
(
'undef.conf'
);
open
(STEST,
'>'
,
'loop.conf'
);
print
STEST
<<'CHUMBA';
[aliases]
[groups]
one = two, three, @four
four = five, six, @one
direct = @direct, foo
[/]
@one = r
@four = rw
CHUMBA
close
(STEST);
@errs
= ();
$acl
=
eval
{ SVN::Access->new(
acl_file
=>
'loop.conf'
); };
ok(
defined
(
$acl
),
"Make sure we can parse a file with loops"
);
is(
$#errs
, -1,
"the parser doesn't catch the errors"
);
@errs
=
split
(/\n/,
$acl
->verify_acl);
is(
$#errs
, 2,
"Make sure we got the right number of verify errors"
);
@errs
= ();
my
@g
=
$acl
->resolve(
'@one'
);
is(
$#errs
, 0,
"One error from loop in group one"
);
ok(
$errs
[0] =~ /^Error: group loop detected \
@one
/,
"sanity checking error string content"
);
@errs
= ();
@g
=
$acl
->resolve(
'@four'
);
is(
$#errs
, 0,
"One error from loop in group four"
);
ok(
$errs
[0] =~ /^Error: group loop detected \
@four
/,
"sanity checking error string content"
);
@errs
= ();
@g
=
$acl
->resolve(
'@direct'
);
is(
$#errs
, 0,
"One error from loop in group direct"
);
ok(
$errs
[0] =~ /^Error: group loop detected \
@direct
/,
"sanity checking error string content"
);
unlink
(
'loop.conf'
);
exit
0;