#!/usr/bin/perl -w
our
$AUTHDB_WORKDIR
=
$ENV
{AUTHDB_WORKDIR} || getcwd();
my
$file
= File::Spec->catfile(
$AUTHDB_WORKDIR
,
'testauth.db'
);
my
$file_out
= File::Spec->catfile(
$AUTHDB_WORKDIR
,
'testauth.json'
);
my
$authdb
= WWW::Suffit::AuthDB->with_roles(
'+CRUD'
)->new(
ds
=>
qq{sqlite://$file?RaiseError=0&PrintError=0&sqlite_unicode=1}
,
sourcefile
=>
"t/authdb-test.json"
,
initialized
=> 1,
);
unlink
$file
if
-e
$file
;
is(
$authdb
->
dump
,
'null'
,
"Data pool is `null`"
) or diag explain
$authdb
->
dump
;
if
(-e
$authdb
->sourcefile) {
$authdb
->load;
ok(!
$authdb
->error,
"Load test AuthDB source file"
) or diag
$authdb
->error;
ok(
ref
(
$authdb
->data) eq
'HASH'
,
"Loaded data is hash"
);
}
else
{
note
"Skipped loading test AuthDB source file: file not found"
;
}
$authdb
->save(File::Spec->catfile(getcwd(),
'testauth.json'
));
ok(!
$authdb
->error,
"Save test data to external file"
) or diag
$authdb
->error;
$authdb
->
connect
;
ok(!
$authdb
->error,
"Connect to database"
) or diag
$authdb
->error;
$authdb
->model->initialize;
ok(!
$authdb
->model->error,
"Initialize schema"
) or diag
$authdb
->model->error;
ok(
$authdb
->model->is_initialized,
"Schema is initialized"
);
unless
(
$authdb
->model->ping) {
fail
sprintf
(
qq{Can't connect to database "%s"}
,
$authdb
->model->dsn);
diag
$authdb
->model->error;
goto
DONE;
}
subtest
'Checksum'
=>
sub
{
my
$test
=
'The quick brown fox jumps over the lazy dog'
;
is
$authdb
->checksum(
$test
=>
'md5'
),
"9e107d9d372bb6826bd81d3542a419d6"
,
"MD5"
;
is
$authdb
->checksum(
$test
=>
'sha1'
),
"2fd4e1c67a2d28fced849ee1bb76e7391b93eb12"
,
"SHA1"
;
is
$authdb
->checksum(
$test
=>
'sha224'
),
"730e109bd7a8a32b1cb9d9a09aa2325d2430587ddbc0c38bad911525"
,
"SHA224"
;
is
$authdb
->checksum(
$test
=>
'sha256'
),
"d7a8fbb307d7809469ca9abcb0082e4f8d5651e46d3cdb762d02d0bf37c9e592"
,
"SHA256"
;
is
$authdb
->checksum(
$test
=>
'sha384'
),
"ca737f1014a48f4c0b6dd43cb177b0afd9e5169367544c494011e3317dbf9a509cb1e5dc1e85a941bbee3d7f2afbc9b1"
,
"SHA384"
;
is
$authdb
->checksum(
$test
=>
'sha512'
),
"07e547d9586f6a73f73fbac0435ed76951218fb7d0c8d788a309d785436bbb642e93a252a954f23912547d1e8a3b5ed6e1bfd7097821233fa0538f3db854fee6"
,
"SHA512"
;
};
subtest
'Meta CRUD'
=>
sub
{
my
$now
=
time
;
ok
$authdb
->meta(
"test.time"
=>
$now
),
"The test key was created"
or diag
$authdb
->error;
is
$authdb
->meta(
"test.time"
),
$now
,
"The test value was readed"
or diag
$authdb
->error;
ok
$authdb
->meta(
"test.time"
=>
undef
),
"The test key was deleted"
or diag
$authdb
->error;
is
$authdb
->meta(
"test.time"
),
undef
,
"The test value value is unset"
or diag
$authdb
->error;
};
subtest
'User CRUD'
=>
sub
{
ok(
$authdb
->user_set(
username
=>
"foo"
,
name
=>
"Foo"
,
email
=>
'foo@localhost'
,
password
=>
"test"
,
algorithm
=>
"MD5"
,
role
=>
"Test foo user"
,
flags
=> 0,
public_key
=>
""
,
private_key
=>
""
,
attributes
=>
qq/{"disabled": 0}/
,
comment
=>
"User for test only"
,
),
"Add new user"
) or diag
$authdb
->error;
ok(
$authdb
->user_pset(
username
=>
"foo"
,
name
=>
"Foo"
,
email
=>
'foo@localhost'
,
password
=>
"098f6bcd4621d373cade4e832627b4f6"
,
algorithm
=>
"MD5"
,
role
=>
"Test foo user"
,
flags
=> 0,
public_key
=>
""
,
private_key
=>
""
,
attributes
=>
qq/{"disabled": 0}/
,
comment
=>
"User for test only (edited)"
,
),
"Edit the user data directly"
) or diag
$authdb
->error;
ok(
$authdb
->user_passwd(
username
=>
"foo"
,
password
=>
"password"
,
),
"Change password"
) or diag
$authdb
->error;
ok(
$authdb
->user_setkeys(
username
=>
"foo"
,
public_key
=>
'public_key'
,
private_key
=>
'private_key'
,
),
"Set keys pair"
) or diag
$authdb
->error;
my
%data
=
$authdb
->user_get(
"foo"
);
ok(!
$authdb
->error,
"Get user data"
) or diag
$authdb
->error;
ok(
$authdb
->user_del(
"foo"
),
"Delete foo user"
) or diag
$authdb
->error;
};
subtest
'Group CRUD'
=>
sub
{
ok(
$authdb
->group_set(
groupname
=>
"wheel"
,
description
=>
"Admin group"
,
),
"Add new group"
) or diag
$authdb
->error;
my
%data
=
$authdb
->group_get(
"wheel"
);
ok(!
$authdb
->error,
"Get group data"
) or diag
$authdb
->error;
my
@members
=
$authdb
->group_members(
"wheel"
);
ok(!
$authdb
->error,
"Get members list"
) or diag
$authdb
->error;
ok(
$authdb
->group_del(
"wheel"
),
"Delete wheel group"
) or diag
$authdb
->error;
};
subtest
'Realm CRUD'
=>
sub
{
ok(
$authdb
->realm_set(
realmname
=>
"default"
,
realm
=>
"Strict Zone"
,
description
=>
"Default realm"
,
),
"Add new realm"
) or diag
$authdb
->error;
my
%data
=
$authdb
->realm_get(
"default"
);
ok(!
$authdb
->error,
"Get realm data"
) or diag
$authdb
->error;
ok(
$authdb
->realm_del(
"default"
),
"Delete default realm"
) or diag
$authdb
->error;
};
subtest
'Route CRUD'
=>
sub
{
ok(
$authdb
->route_set(
realmname
=>
"default"
,
routename
=>
"root"
,
method
=>
"GET"
,
path
=>
"/"
,
),
"Add new route"
) or diag
$authdb
->error;
my
%data
=
$authdb
->route_get(
"root"
);
ok(!
$authdb
->error,
"Get route data"
) or diag
$authdb
->error;
ok(
$authdb
->route_del(
"root"
),
"Delete root route"
) or diag
$authdb
->error;
};
subtest
'Token CRUD'
=>
sub
{
ok(
$authdb
->token_set(
type
=>
'api'
,
jti
=>
'none'
,
username
=>
'foo'
,
clientid
=>
'qwertyuiqwertyui'
,
iat
=>
time
,
exp
=>
time
+ 3600,
address
=>
'127.0.0.1'
,
),
"Add new token"
) or diag
$authdb
->error;
my
@tokens
=
$authdb
->token_get();
ok(!
$authdb
->error,
"Get tokens"
) or diag
$authdb
->error;
ok(
$authdb
->token_del(
"foo"
,
"none"
),
"Delete token"
) or diag
$authdb
->error;
};
ok
$authdb
->import_data,
"Import data from JSON file"
or diag
$authdb
->error;
ok
$authdb
->export_data(
$file_out
),
"Export data to JSON file"
or diag
$authdb
->error;
subtest
'User'
=>
sub
{
my
$alice
=
$authdb
->cached_user(
"alice"
,
'd1b919$c1'
);
ok
$alice
->is_valid,
"User is valid"
;
is
$alice
->username,
'alice'
,
"Username"
;
my
$unknown
=
$authdb
->user(
"unknown"
);
ok !
$unknown
->is_valid,
"Unknown user is invalid"
;
};
subtest
'Group'
=>
sub
{
my
$manager
=
$authdb
->cached_group(
"manager"
);
ok
$manager
->is_valid,
"Group is valid"
;
is
$manager
->groupname,
'manager'
,
"Groupname"
;
};
subtest
'Realm'
=>
sub
{
my
$default
=
$authdb
->cached_realm(
"Default"
);
ok
$default
->is_valid,
"Realm is valid"
;
is
$default
->realmname,
'Default'
,
"Realmname"
;
};
subtest
'Routes'
=>
sub
{
ok !
$authdb
->error,
"Get routes"
;
};
subtest
'Cached user'
=>
sub
{
my
$alice
=
$authdb
->cached_user(
"alice"
,
'd1b919$c1'
);
ok
$alice
->is_cached,
"User is cached"
;
};
DONE: done_testing;
$authdb
->model->disconnect;