File Coverage

blib/lib/Patro.pm
Criterion Covered Total %
statement 105 123 85.3
branch 29 48 60.4
condition 4 8 50.0
subroutine 22 25 88.0
pod 5 7 71.4
total 165 211 78.2


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