File: 40server-security.t

package info (click to toggle)
libtangence-perl 0.33-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 580 kB
  • sloc: perl: 6,076; makefile: 15
file content (87 lines) | stat: -rw-r--r-- 2,090 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
#!/usr/bin/perl

use v5.26;
use warnings;

use Future::AsyncAwait 0.47;

use Test2::V0;

use Tangence::Constants;
use Tangence::Registry;

use lib ".";
use t::TestObj;
use t::TestServerClient;

my $registry = Tangence::Registry->new(
   tanfile => "t/TestObj.tan",
);
my $obj = $registry->construct(
   "t::TestObj",
);
# generate a second object that exists but we don't tell the client about
my $obj2 = $registry->construct(
   "t::TestObj",
);

my ( $server, $client ) = make_serverclient( $registry );

my $proxy = $client->rootobj;

# gutwrench into the objectproxy to make a new one with a different ID
$proxy->id == $obj->id or die "ARGH failed to have correct object ID in proxy";

my $proxy2 = Tangence::ObjectProxy->new(
   client => $proxy->client,
   id     => $obj2->id,
   class  => $obj->class,
);

# $proxy2 should now not work for anything

# methods
{
   my $f = $proxy2->call_method( "method", 0, "" );

   like( $f->failure, qr/^Access not allowed to object with id 2/,
      'unseen objects inaccessible by method' );
}

# events
{
   my $f = $proxy2->subscribe_event( "event", on_fire => sub {} );

   like( $f->failure, qr/^Access not allowed to object with id 2/,
      'unseen objects inaccessible by event' );
}

# properties
{
   my $f = $proxy2->get_property( "scalar" );

   like( $f->failure, qr/^Access not allowed to object with id 2/,
      'unseen objects inaccessible by property get' );

   $f = $proxy2->set_property( "scalar", 123 );

   like( $f->failure, qr/^Access not allowed to object with id 2/,
      'unseen objects inaccessible by property set' );

   $f = $proxy2->watch_property( "scalar", on_set => sub {} );

   like( $f->failure, qr/^Access not allowed to object with id 2/,
      'unseen objects inaccessible by property watch' );
}

# as argument to otherwise-allowed object
{
   await $proxy->set_property( "objset", [ $proxy ] ); # is allowed

   my $f = $proxy->set_property( "objset", [ $proxy2 ] );

   like( $f->failure, qr/^Access not allowed to object with id 2/,
      'unseen objects not allowed by value' );
}

done_testing;