line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Patro; |
2
|
69
|
|
|
69
|
|
3304046
|
use strict; |
|
69
|
|
|
|
|
157
|
|
|
69
|
|
|
|
|
1766
|
|
3
|
69
|
|
|
69
|
|
338
|
use warnings; |
|
69
|
|
|
|
|
134
|
|
|
69
|
|
|
|
|
1695
|
|
4
|
69
|
|
|
69
|
|
16175
|
use Patro::Mony; |
|
69
|
|
|
|
|
147
|
|
|
69
|
|
|
|
|
1898
|
|
5
|
69
|
|
|
69
|
|
18065
|
use Patro::LeumJelly; |
|
69
|
|
|
|
|
267
|
|
|
69
|
|
|
|
|
2084
|
|
6
|
69
|
|
|
69
|
|
405
|
use Scalar::Util; |
|
69
|
|
|
|
|
108
|
|
|
69
|
|
|
|
|
2653
|
|
7
|
69
|
|
|
69
|
|
324
|
use Data::Dumper; |
|
69
|
|
|
|
|
108
|
|
|
69
|
|
|
|
|
2428
|
|
8
|
69
|
|
|
69
|
|
22954
|
use Socket (); |
|
69
|
|
|
|
|
186832
|
|
|
69
|
|
|
|
|
1955
|
|
9
|
69
|
|
|
69
|
|
419
|
use Carp; |
|
69
|
|
|
|
|
104
|
|
|
69
|
|
|
|
|
3256
|
|
10
|
69
|
|
|
69
|
|
363
|
use base 'Exporter'; |
|
69
|
|
|
|
|
122
|
|
|
69
|
|
|
|
|
5684
|
|
11
|
69
|
|
|
69
|
|
405
|
no overloading '%{}', '${}'; |
|
69
|
|
|
|
|
131
|
|
|
69
|
|
|
|
|
4674
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our @EXPORT = qw(patronize getProxies); |
14
|
|
|
|
|
|
|
our $VERSION = '0.15'; |
15
|
|
|
|
|
|
|
|
16
|
69
|
|
|
69
|
|
75964
|
BEGIN { *CORE::GLOBAL::ref = \&Patro::ref }; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub import { |
19
|
69
|
|
|
69
|
|
560
|
my ($class, @args) = @_; |
20
|
69
|
|
|
|
|
380
|
my @tags = grep /^:/, @args; |
21
|
69
|
|
|
|
|
218
|
@args = grep !/^:/, @args; |
22
|
69
|
|
|
|
|
118
|
$Patro::SECURE = 1; |
23
|
69
|
|
|
|
|
137
|
foreach my $tag (@tags) { |
24
|
86
|
100
|
|
|
|
1078
|
if ($tag eq ':test') { |
25
|
68
|
|
|
|
|
23882
|
require Patro::Archy; |
26
|
68
|
|
|
|
|
480
|
Patro::Archy->TEST_MODE; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# a poor man's Data::Dumper, but works for Patro::N objects. |
29
|
|
|
|
|
|
|
*xjoin = sub { |
30
|
15
|
|
|
15
|
|
38
|
join(",", map { my $r = $_; |
|
37
|
|
|
|
|
74
|
|
31
|
37
|
|
100
|
|
|
73
|
my $rt = Patro::reftype($_) || ""; |
32
|
|
|
|
|
|
|
$rt eq 'ARRAY' ? "[" . xjoin(@$r) . "]" : |
33
|
37
|
50
|
|
|
|
189
|
$rt eq 'HASH' ? do { |
|
|
100
|
|
|
|
|
|
34
|
0
|
|
|
|
|
0
|
"{".xjoin(map{"$_:'".$r->{$_}."'"}sort keys %$r)."}" |
|
0
|
|
|
|
|
0
|
|
35
|
|
|
|
|
|
|
} : $_ } @_) |
36
|
68
|
|
|
|
|
383
|
}; |
37
|
68
|
|
|
|
|
205
|
push @EXPORT, 'xjoin'; |
38
|
|
|
|
|
|
|
} |
39
|
86
|
100
|
|
|
|
336
|
if ($tag eq ':insecure') { |
40
|
9
|
|
|
|
|
24
|
$Patro::SECURE = 0; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
69
|
50
|
33
|
|
|
296
|
if (defined($ENV{PATRO_THREADS}) && |
45
|
|
|
|
|
|
|
!$ENV{PATRO_THREADS}) { |
46
|
0
|
|
|
|
|
0
|
$INC{'threads.pm'} = 1; |
47
|
|
|
|
|
|
|
} |
48
|
69
|
|
|
69
|
|
23444
|
eval "use threads;1"; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
69
|
|
|
|
|
4860
|
|
49
|
69
|
|
|
69
|
|
20543
|
eval "use threadsx::shared"; |
|
69
|
|
|
|
|
200
|
|
|
69
|
|
|
|
|
342
|
|
|
69
|
|
|
|
|
12076
|
|
50
|
69
|
|
|
|
|
234
|
$Patro::Archy::threads_avail = $threads::threads; |
51
|
69
|
50
|
|
|
|
224
|
if (!defined &threads::tid) { |
52
|
69
|
|
|
2
|
|
305
|
*threads::tid = sub { 0 }; |
|
2
|
|
|
|
|
199
|
|
53
|
|
|
|
|
|
|
} |
54
|
69
|
50
|
33
|
|
|
300
|
if ($ENV{PATRO_THREADS} && !$Patro::Archy::threads_avail) { |
55
|
0
|
|
|
|
|
0
|
warn "Threaded Patro server was requested but was not available\n"; |
56
|
|
|
|
|
|
|
} |
57
|
69
|
|
|
|
|
8340
|
Patro->export_to_level(1, 'Patro', @args, @EXPORT); |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# make Patro::nize a synonym for patronize |
61
|
0
|
|
|
0
|
0
|
0
|
sub nize { goto &patronize } |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub patronize { |
64
|
68
|
50
|
|
68
|
1
|
22892
|
croak 'usage: Patro::patronize(@refs)' if @_ == 0; |
65
|
68
|
|
|
|
|
421
|
require Patro::Archy; |
66
|
68
|
|
|
|
|
572
|
my $server = Patro::Archy->new({}, @_); |
67
|
21
|
|
|
|
|
350
|
return $server->{config}; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub ref (_) { |
71
|
4751
|
50
|
|
4751
|
1
|
383815
|
my $obj = @_ ? $_[0] : $_; |
72
|
4751
|
|
|
|
|
7320
|
my $ref = CORE::ref($obj); |
73
|
4751
|
100
|
|
|
|
9663
|
if (!Patro::LeumJelly::isProxyRef($ref)) { |
74
|
4723
|
|
|
|
|
13106
|
return $ref; |
75
|
|
|
|
|
|
|
} |
76
|
28
|
|
|
|
|
95
|
my $handle = Patro::LeumJelly::handle($obj); |
77
|
28
|
|
|
|
|
271
|
return $handle->{ref}; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub reftype { |
81
|
54
|
|
|
54
|
1
|
806
|
my $ref = CORE::ref($_[0]); |
82
|
54
|
100
|
|
|
|
125
|
if (!Patro::LeumJelly::isProxyRef($ref)) { |
83
|
33
|
|
|
|
|
161
|
return Scalar::Util::reftype($_[0]); |
84
|
|
|
|
|
|
|
} |
85
|
21
|
|
|
|
|
90
|
my $handle = Patro::LeumJelly::handle($_[0]); |
86
|
21
|
|
|
|
|
114
|
return $handle->{reftype}; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub _allrefs { |
90
|
0
|
|
|
0
|
|
0
|
return (CORE::ref($_[0]), Patro::ref($_[0]), |
91
|
|
|
|
|
|
|
Scalar::Util::reftype($_[0]), Patro::reftype($_[0])); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub client { |
95
|
14
|
50
|
|
14
|
1
|
571
|
if (!Patro::LeumJelly::isProxyRef(CORE::ref($_[0]))) { |
96
|
0
|
|
|
|
|
0
|
return; # not a remote proxy object |
97
|
|
|
|
|
|
|
} |
98
|
14
|
|
|
|
|
115
|
return Patro::LeumJelly::handle($_[0])->{client}; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub main::xdiag { |
102
|
0
|
|
|
0
|
|
0
|
my @lt = localtime; |
103
|
0
|
|
|
|
|
0
|
my $lt = sprintf "%02d:%02d:%02d", @lt[2,1,0]; |
104
|
0
|
|
|
|
|
0
|
my $pid = $$; |
105
|
0
|
0
|
|
|
|
0
|
$pid .= "-" . threads->tid if $threads::threads; |
106
|
0
|
0
|
|
|
|
0
|
my @msg = map { CORE::ref($_) |
|
0
|
0
|
|
|
|
0
|
|
107
|
|
|
|
|
|
|
? CORE::ref($_) =~ /^Patro::N/ |
108
|
|
|
|
|
|
|
? "<" . CORE::ref($_) . ">" |
109
|
|
|
|
|
|
|
: Data::Dumper::Dumper($_) : $_ } @_; |
110
|
0
|
0
|
|
|
|
0
|
if ($INC{'Test/More.pm'}) { |
111
|
0
|
|
|
|
|
0
|
Test::More::diag("xdiag $pid $lt: ",@msg); |
112
|
|
|
|
|
|
|
} else { |
113
|
0
|
|
|
|
|
0
|
print STDERR "xdiag $pid $lt: @msg\n"; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# Patro OO-interface |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub new { |
120
|
26
|
|
|
26
|
0
|
10159
|
my ($pkg,$config) = @_; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# want config to be a Patro::Config |
123
|
|
|
|
|
|
|
# but it could be a string or a filenae (from Patro::Config::to_string |
124
|
|
|
|
|
|
|
# or to_file) |
125
|
26
|
100
|
|
|
|
177
|
if (!CORE::ref($config)) { |
126
|
12
|
100
|
|
|
|
283
|
if (-f $config) { |
127
|
3
|
|
|
|
|
36
|
$config = Patro::Config->from_file($config); |
128
|
|
|
|
|
|
|
} else { |
129
|
9
|
|
|
|
|
87
|
$config = Patro::Config->from_string($config); |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
26
|
50
|
|
|
|
114
|
croak __PACKAGE__,": no host" unless $config->{host}; |
134
|
26
|
50
|
|
|
|
111
|
croak __PACKAGE__,": no port" unless $config->{port}; |
135
|
|
|
|
|
|
|
|
136
|
26
|
|
|
|
|
1646
|
my $iaddr = Socket::inet_aton($config->{host}); |
137
|
26
|
|
|
|
|
168
|
my $paddr = Socket::pack_sockaddr_in($config->{port}, $iaddr); |
138
|
|
|
|
|
|
|
|
139
|
26
|
50
|
|
|
|
1534
|
socket(my $socket, Socket::PF_INET(), Socket::SOCK_STREAM(), |
140
|
|
|
|
|
|
|
getprotobyname("tcp")) or croak __PACKAGE__,": socket $!"; |
141
|
26
|
50
|
|
|
|
3552
|
connect($socket,$paddr) |
142
|
|
|
|
|
|
|
or croak(__PACKAGE__, ": connect to $config->{host}:$config->{port}", |
143
|
|
|
|
|
|
|
" failed: $!"); |
144
|
|
|
|
|
|
|
|
145
|
26
|
|
|
|
|
601
|
my $self = bless { |
146
|
|
|
|
|
|
|
config => $config, |
147
|
|
|
|
|
|
|
socket => $socket, |
148
|
|
|
|
|
|
|
proxies => {}, |
149
|
|
|
|
|
|
|
objs => [], |
150
|
|
|
|
|
|
|
}, $pkg; |
151
|
|
|
|
|
|
|
|
152
|
26
|
|
|
|
|
169
|
$Patro::SERVER_VERSION = $config->{version}; |
153
|
|
|
|
|
|
|
|
154
|
26
|
|
|
|
|
181
|
my $fh0 = select $socket; |
155
|
26
|
|
|
|
|
126
|
$| = 1; |
156
|
26
|
|
|
|
|
149
|
select $fh0; |
157
|
|
|
|
|
|
|
|
158
|
26
|
|
|
|
|
61
|
foreach my $odata (@{$config->{store}}) { |
|
26
|
|
|
|
|
106
|
|
159
|
41
|
|
|
|
|
239
|
my $proxyref = Patro::LeumJelly::getproxy($odata,$self); |
160
|
41
|
|
|
|
|
142
|
$self->{proxies}{$odata->{id}} = $proxyref; |
161
|
41
|
|
|
|
|
74
|
push @{$self->{objs}}, $proxyref; |
|
41
|
|
|
|
|
143
|
|
162
|
|
|
|
|
|
|
} |
163
|
26
|
|
|
|
|
185
|
return $self; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub getProxies { |
167
|
26
|
|
|
26
|
1
|
85
|
my $patro = shift; |
168
|
26
|
100
|
|
|
|
135
|
if (CORE::ref($patro) ne 'Patro') { |
169
|
6
|
|
|
|
|
59
|
$patro = Patro->new($patro); |
170
|
|
|
|
|
|
|
} |
171
|
26
|
100
|
|
|
|
121
|
return wantarray ? @{$patro->{objs}} : $patro->{objs}[0]; |
|
18
|
|
|
|
|
85
|
|
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
######################################## |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
1; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head1 NAME |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
Patro - proxy access to remote objects |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head1 VERSION |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
0.15 |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head1 SYNOPSIS |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# on machine 1 (server) |
191
|
|
|
|
|
|
|
use Patro; |
192
|
|
|
|
|
|
|
my $obj = ... |
193
|
|
|
|
|
|
|
$config = patronize($obj); |
194
|
|
|
|
|
|
|
$config->to_file( 'config_file' ); |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
# on machines 2 through n (clients) |
198
|
|
|
|
|
|
|
use Patro; |
199
|
|
|
|
|
|
|
my ($proxy) = Patro->new( 'config_file' )->getProxies; |
200
|
|
|
|
|
|
|
... |
201
|
|
|
|
|
|
|
$proxy->{key} = $val; # updates $obj->{key} for obj on server |
202
|
|
|
|
|
|
|
$val = $proxy->method(@args); # calls $obj->method for obj on server |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head1 DESCRIPTION |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
C is a mechanism for making any Perl reference in one Perl program |
208
|
|
|
|
|
|
|
accessible is other processes, even processes running on different hosts. |
209
|
|
|
|
|
|
|
The "proxy" references have the same look and feel as the native references |
210
|
|
|
|
|
|
|
in the original process, and any manipulation of the proxy reference |
211
|
|
|
|
|
|
|
will have an effect on the original reference. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=head2 Some important features: |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=over 4 |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=item * Hash members and array elements |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
Accessing or updating hash values or array values on a remote reference |
220
|
|
|
|
|
|
|
is done with the same syntax as with the local reference: |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# host 1 |
223
|
|
|
|
|
|
|
use Patro; |
224
|
|
|
|
|
|
|
my $hash1 = { abc => 123, def => [ 456, { ghi => "jkl" }, "mno" ] }; |
225
|
|
|
|
|
|
|
my $config = patronize($hash1); |
226
|
|
|
|
|
|
|
... |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# host 2 |
229
|
|
|
|
|
|
|
use Patro; |
230
|
|
|
|
|
|
|
my $hash2 = Patro->new($config)->getProxies; |
231
|
|
|
|
|
|
|
print $hash2->{abc}; # "123" |
232
|
|
|
|
|
|
|
$hash2->{def}[2] = "pqr"; # updates $hash1 on host 1 |
233
|
|
|
|
|
|
|
print delete $hash2->{def}[1]{ghi}; # "jkl", updates $hash1 on host1 |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=item * Remote method calls |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
Method calls on the proxy object are propagated to the original object, |
238
|
|
|
|
|
|
|
affecting the remote object and returning the result of the call. |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
# host 1 |
241
|
|
|
|
|
|
|
use Patro; |
242
|
|
|
|
|
|
|
sub Foofie::new { bless \$_[1],'Foofie' } |
243
|
|
|
|
|
|
|
sub Foofie::blerp { my $self=shift; wantarray ? (5,6,7,$$self) : ++$$self } |
244
|
|
|
|
|
|
|
patronize(Foofie->new(17))->to_file('/config/file'); |
245
|
|
|
|
|
|
|
... |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
# host 2 |
248
|
|
|
|
|
|
|
use Patro; |
249
|
|
|
|
|
|
|
my $foo = Patro->new('/config/file')->getProxies; |
250
|
|
|
|
|
|
|
my @x = $foo->blerp; # (5,6,7,17) |
251
|
|
|
|
|
|
|
my $x = $foo->blerp; # 18 |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=item * Overloaded operators |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
Any overloaded operations on the original object are supported on the |
256
|
|
|
|
|
|
|
remote object. |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
# host 1 |
259
|
|
|
|
|
|
|
use Patro; |
260
|
|
|
|
|
|
|
my $obj = Barfie->new(2,5); |
261
|
|
|
|
|
|
|
$config = patronize($obj); |
262
|
|
|
|
|
|
|
$config->to_file( 'config' ); |
263
|
|
|
|
|
|
|
package Barfie; |
264
|
|
|
|
|
|
|
use overload '+=' => sub { $_ += $_[1] for @{$_[0]->{vals}};$_[0] }, |
265
|
|
|
|
|
|
|
fallback => 1; |
266
|
|
|
|
|
|
|
sub new { |
267
|
|
|
|
|
|
|
my $pkg = shift; |
268
|
|
|
|
|
|
|
bless { vals => [ @_ ] }, $pkg; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
sub prod { my $self = shift; my $z=1; $z*=$_ for @{$_[0]->{vals}}; $z } |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
# host 2 |
273
|
|
|
|
|
|
|
use Patro; |
274
|
|
|
|
|
|
|
my $proxy = getProxies('config'); |
275
|
|
|
|
|
|
|
print $proxy->prod; # calls Barfie::prod($obj) on host1, 2 * 5 => 10 |
276
|
|
|
|
|
|
|
$proxy += 4; # calls Barfie '+=' sub on host1 |
277
|
|
|
|
|
|
|
print $proxy->prod; # 6 * 9 => 54 |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=item * Code references |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
Patro supports sharing code references and data structures that contain |
282
|
|
|
|
|
|
|
code references (think dispatch tables). Proxies to these code references |
283
|
|
|
|
|
|
|
can invoke the code, which will then run on the server. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# host 1 |
286
|
|
|
|
|
|
|
use Patro; |
287
|
|
|
|
|
|
|
my $foo = sub { $_[0] + 42 }; |
288
|
|
|
|
|
|
|
my $d = { |
289
|
|
|
|
|
|
|
f1 => sub { $_[0] + $_[1] }, |
290
|
|
|
|
|
|
|
f2 => sub { $_[0] * $_[1] }, |
291
|
|
|
|
|
|
|
f3 => sub { int( $_[0] / ($_[1] || 1) ) }, |
292
|
|
|
|
|
|
|
g1 => sub { $_[0] += $_[1]; 18 }, |
293
|
|
|
|
|
|
|
}; |
294
|
|
|
|
|
|
|
patronize($foo,$d)->to_file('config'); |
295
|
|
|
|
|
|
|
... |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
# host 2 |
298
|
|
|
|
|
|
|
use Patro; |
299
|
|
|
|
|
|
|
my ($p_foo, $p_d) = getProxies('config'); |
300
|
|
|
|
|
|
|
print $p_foo->(17); # "59" (42+17) |
301
|
|
|
|
|
|
|
print $p_d->{f1}->(7,33); # "40" (7+33) |
302
|
|
|
|
|
|
|
print $p_d->{f3}->(33,7); # "4" int(33/7) |
303
|
|
|
|
|
|
|
($x,$y) = (5,6); |
304
|
|
|
|
|
|
|
$p_d->{g1}->($x,$y); |
305
|
|
|
|
|
|
|
print $x; # "11" ($x:6 += 5) |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
=item * filehandles |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
Filehandles can also be shared through the Patro framework. |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
# host 1 |
312
|
|
|
|
|
|
|
use Patro; |
313
|
|
|
|
|
|
|
open my $fh, '>', 'host1.log'; |
314
|
|
|
|
|
|
|
patronize($fh)->to_file('config'); |
315
|
|
|
|
|
|
|
... |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
# host 2 |
318
|
|
|
|
|
|
|
use Patro; |
319
|
|
|
|
|
|
|
my $ph = getProxies('config'); |
320
|
|
|
|
|
|
|
print $ph "A log message for the server\n"; |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
Calling C through a proxy filehandle presents some security concerns. |
323
|
|
|
|
|
|
|
A client could read or write any file on the server host visible to the |
324
|
|
|
|
|
|
|
server's user id. Or worse, a client could open a pipe through the handle |
325
|
|
|
|
|
|
|
to run an arbitrary command on the server. C and C operations |
326
|
|
|
|
|
|
|
on proxy filehandles will not be allowed unless the process running the |
327
|
|
|
|
|
|
|
Patro server imports C with the C<:insecure> tag. |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=back |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
=head1 FUNCTIONS |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=head2 patronize |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
CONFIG = patronize(@REFS) |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
Creates a server on the local machine that provides proxy access to |
339
|
|
|
|
|
|
|
the given list of references. It returns an object |
340
|
|
|
|
|
|
|
with information about how to connect to the server. |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
The returned object has C and C methods |
343
|
|
|
|
|
|
|
to store the configuration where it can be read by other processes. |
344
|
|
|
|
|
|
|
Either the object, its string representation, or the filename |
345
|
|
|
|
|
|
|
containing config information may be used as input to the |
346
|
|
|
|
|
|
|
L<"getProxies"> function to retrieve proxies to the shared |
347
|
|
|
|
|
|
|
references. |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=head2 getProxies |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
PROXIES = getProxies(CONFIG) |
352
|
|
|
|
|
|
|
PROXIES = getProxies(STRING) |
353
|
|
|
|
|
|
|
PROXIES = getProxies(FILENAME) |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
Connects to a server on another machine, specified in the C |
356
|
|
|
|
|
|
|
string, and returns proxies to the list of references that are served. |
357
|
|
|
|
|
|
|
In scalar context, returns a proxy to the first reference that is |
358
|
|
|
|
|
|
|
served. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
See the L<"PROXIES"> section below for what you can do with the output |
361
|
|
|
|
|
|
|
of this function. |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
=head2 ref |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
TYPE = Patro::ref(PROXY) |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
For the given proxy object, returns the ref type of the remote object |
368
|
|
|
|
|
|
|
being served. If the input is not a proxy, returns C. |
369
|
|
|
|
|
|
|
See also L<"reftype">. |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=head2 reftype |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
TYPE = Patro::reftype(PROXY) |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
Returns the simple reference type (e.g., C) of the remote |
376
|
|
|
|
|
|
|
object associated with the given proxy, as if we were calling |
377
|
|
|
|
|
|
|
C on the remote object. Returns C if |
378
|
|
|
|
|
|
|
the input is not a proxy object. |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
=head2 client |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
CLIENT = Patro::client(PROXY) |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
Returns the IPC client object used by the given proxy to communicate |
385
|
|
|
|
|
|
|
with the remote object server. The client object contains information |
386
|
|
|
|
|
|
|
about how to communicate with the server and other connection |
387
|
|
|
|
|
|
|
configuration. |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=head1 PROXIES |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
Proxy references, as returned by the L<"getProxies"> function above, |
393
|
|
|
|
|
|
|
or sometimes returned in other calls to the server, are designed |
394
|
|
|
|
|
|
|
to look and feel as much as possible as the real references on the |
395
|
|
|
|
|
|
|
remote server that they provide access to, so any operation or |
396
|
|
|
|
|
|
|
expression with the proxy on the local machine should evaluate |
397
|
|
|
|
|
|
|
to the same value(s) as the same operation or expression with the |
398
|
|
|
|
|
|
|
real object/reference on the remote server. |
399
|
|
|
|
|
|
|
When the server if using threads and is sharing the served |
400
|
|
|
|
|
|
|
objects between threads, an update to the |
401
|
|
|
|
|
|
|
proxy object will affect the remote object, and vice versa. |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
=head2 Example 1: network file synchronization |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
Network file systems are notoriously flaky when it comes to |
406
|
|
|
|
|
|
|
synchronizing files that are being written to by processes on |
407
|
|
|
|
|
|
|
many different hosts [citation needed]. C provides a |
408
|
|
|
|
|
|
|
workaround, in that every machine can hold to a proxy to an object |
409
|
|
|
|
|
|
|
that writes to a file, with the object running on a single machine. |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# master |
412
|
|
|
|
|
|
|
package SyncWriter; |
413
|
|
|
|
|
|
|
use Fcntl qw(:flock SEEK_END); |
414
|
|
|
|
|
|
|
sub new { |
415
|
|
|
|
|
|
|
my ($pkg,$filename) = @_; |
416
|
|
|
|
|
|
|
open my $fh, '>', $filename; |
417
|
|
|
|
|
|
|
bless { fh => $fh }, $pkg; |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
sub print { |
420
|
|
|
|
|
|
|
my $self = shift; |
421
|
|
|
|
|
|
|
flock $self->{fh}, LOCK_EX; |
422
|
|
|
|
|
|
|
seek $self->{fh}, 0, SEEK_END; |
423
|
|
|
|
|
|
|
print {$self->{fh}} @_; |
424
|
|
|
|
|
|
|
flock $self->{fh}, LOCK_UN; |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
sub printf { ... } |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
use Patro; |
429
|
|
|
|
|
|
|
my $writer = SyncWriter->new("file.log"); |
430
|
|
|
|
|
|
|
my $cfg = patronize($writer); |
431
|
|
|
|
|
|
|
open my $fh,'>','/network/accessible/file'; |
432
|
|
|
|
|
|
|
print $fh $cfg; |
433
|
|
|
|
|
|
|
close $fh; |
434
|
|
|
|
|
|
|
... |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
# slaves |
437
|
|
|
|
|
|
|
use Patro; |
438
|
|
|
|
|
|
|
open my $fh, '<', '/network/accessible/file'; |
439
|
|
|
|
|
|
|
my $cfg = <$fh>; |
440
|
|
|
|
|
|
|
close $fh; |
441
|
|
|
|
|
|
|
my $writer = Patro->new($cfg)->getProxies; |
442
|
|
|
|
|
|
|
... |
443
|
|
|
|
|
|
|
# $writer->print with a proxy $writer |
444
|
|
|
|
|
|
|
# invokes $writer->print on the host. Since all |
445
|
|
|
|
|
|
|
# the file operations are done on a single machine, |
446
|
|
|
|
|
|
|
# there are no network synchronization issues |
447
|
|
|
|
|
|
|
$writer->print("a log message\n"); |
448
|
|
|
|
|
|
|
... |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=head2 Example 2: Distributed queue |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
A program that distributes tasks to several threads or several |
453
|
|
|
|
|
|
|
child processes can be extended to distribute tasks to |
454
|
|
|
|
|
|
|
several machines. |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
# master |
457
|
|
|
|
|
|
|
use Patro; |
458
|
|
|
|
|
|
|
my $queue = [ 'job 1', 'job 2', ... ]; |
459
|
|
|
|
|
|
|
patronize($queue)->to_file('/network/accessible/file'); |
460
|
|
|
|
|
|
|
... |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# slaves |
463
|
|
|
|
|
|
|
use Patro; |
464
|
|
|
|
|
|
|
my $queue = Patro->new('/network/accessible/file')->getProxies; |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
while (my $task = shift @$queue) { |
467
|
|
|
|
|
|
|
... do task ... |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
(This example will not work without threads. For a more robust |
471
|
|
|
|
|
|
|
network-safe queue that will run with forks, see L) |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=head2 Example 3: Keep your code secret |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
If you distribute your Perl code for others to use, it is very |
476
|
|
|
|
|
|
|
difficult to keep others from being able to see (and potentially |
477
|
|
|
|
|
|
|
steal) your code. L are penetrable by |
478
|
|
|
|
|
|
|
any determined reverse engineer. Most other suggestions for keeping |
479
|
|
|
|
|
|
|
your code secret revolve around running your code on a server, |
480
|
|
|
|
|
|
|
and having your clients send input and receive output through a |
481
|
|
|
|
|
|
|
network service. |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
The C framework can make this service model easier to use. |
484
|
|
|
|
|
|
|
Design a small set of objects that can execute your code, provide |
485
|
|
|
|
|
|
|
your clients with a public API for those objects, and make proxies |
486
|
|
|
|
|
|
|
to your objects available through C. |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
# code to run on client machine |
489
|
|
|
|
|
|
|
use Patro; |
490
|
|
|
|
|
|
|
my $cfg = ... # provided by you |
491
|
|
|
|
|
|
|
my ($obj1,$obj2) = Patro->new($cfg)->getProxies; |
492
|
|
|
|
|
|
|
$result = $obj1->method($arg1,$arg2); |
493
|
|
|
|
|
|
|
... |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
In this model, the client can use the objects and methods of your code, |
496
|
|
|
|
|
|
|
and inspect the members of your objects through the proxies, but the |
497
|
|
|
|
|
|
|
client cannot see the source code. |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=head1 ENVIRONMENT |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
C pays attention to the following environment variables. |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
=head2 PATRO_THREADS |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
If the environment variable C is set, C will use |
507
|
|
|
|
|
|
|
it to determine whether to use a forked server or a threaded server |
508
|
|
|
|
|
|
|
to provide proxy access to objects. If this variable is not set, |
509
|
|
|
|
|
|
|
C will use threads if the L module can be loaded. |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
=head1 LIMITATIONS |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
The C<-X> file test operations on a proxy filehandle depend on |
515
|
|
|
|
|
|
|
the file test implementation in L, which is available |
516
|
|
|
|
|
|
|
only in Perl v5.12 or better. |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
When the server uses forks (because threads are unavailable or |
519
|
|
|
|
|
|
|
because L<"PATRO_THREADS"> was set to a false value), it is less |
520
|
|
|
|
|
|
|
practical to share variables between processes. |
521
|
|
|
|
|
|
|
When you manipulate a proxy reference, you are |
522
|
|
|
|
|
|
|
manipulating the copy of the reference running in a different process |
523
|
|
|
|
|
|
|
than the remote server. So you will not observe a change in the |
524
|
|
|
|
|
|
|
reference on the server (unless you use a class that does not save |
525
|
|
|
|
|
|
|
state in local memory, like L). |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
=head1 DOCUMENTATION AND SUPPORT |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
Up-to-date (blead version) sources for C are on github at |
531
|
|
|
|
|
|
|
L |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
perldoc Patro |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
You can also look for information at: |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
=over 4 |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
Report bugs and request missing features at |
544
|
|
|
|
|
|
|
L |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
L |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
=item * CPAN Ratings |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
L |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
=item * Search CPAN |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
L |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
=back |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
MIT License |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
Copyright (c) 2017, Marty O'Brien |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
Permission is hereby granted, free of charge, to any person obtaining a copy |
568
|
|
|
|
|
|
|
of this software and associated documentation files (the "Software"), to deal |
569
|
|
|
|
|
|
|
in the Software without restriction, including without limitation the rights |
570
|
|
|
|
|
|
|
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell |
571
|
|
|
|
|
|
|
copies of the Software, and to permit persons to whom the Software is |
572
|
|
|
|
|
|
|
furnished to do so, subject to the following conditions: |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
The above copyright notice and this permission notice shall be included in all |
575
|
|
|
|
|
|
|
copies or substantial portions of the Software. |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
578
|
|
|
|
|
|
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
579
|
|
|
|
|
|
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE |
580
|
|
|
|
|
|
|
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
581
|
|
|
|
|
|
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, |
582
|
|
|
|
|
|
|
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE |
583
|
|
|
|
|
|
|
SOFTWARE. |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
=cut |