… | |
… | |
34 | |
34 | |
35 | use base "Exporter"; |
35 | use base "Exporter"; |
36 | |
36 | |
37 | our $VERSION = '0.7'; |
37 | our $VERSION = '0.7'; |
38 | our @EXPORT = qw( |
38 | our @EXPORT = qw( |
39 | %NODE %PORT %PORT_DATA $UNIQ $RUNIQ $ID add_node load_func snd_to_func |
39 | %NODE %PORT %PORT_DATA $UNIQ $RUNIQ $ID |
|
|
40 | connect_node add_node load_func snd_to_func |
40 | |
41 | |
41 | NODE $NODE node_of snd kil |
42 | NODE $NODE node_of snd kil |
42 | resolve_node initialise_node |
43 | resolve_node initialise_node |
|
|
44 | known_nodes up_nodes mon_nodes node_is_known node_is_up |
43 | ); |
45 | ); |
44 | |
46 | |
45 | our $DEFAULT_PORT = "4040"; |
47 | our $DEFAULT_PORT = "4040"; |
46 | |
48 | |
47 | our $CONNECT_INTERVAL = 2; # new connect every 2s, at least |
49 | our $CONNECT_INTERVAL = 2; # new connect every 2s, at least |
… | |
… | |
198 | |
200 | |
199 | AnyEvent::Socket::parse_address $host |
201 | AnyEvent::Socket::parse_address $host |
200 | or Carp::croak "$noderef: not a resolved node reference ('$_' contains unresolved address)"; |
202 | or Carp::croak "$noderef: not a resolved node reference ('$_' contains unresolved address)"; |
201 | } |
203 | } |
202 | |
204 | |
203 | # TODO: for indirect sends, use a different class |
|
|
204 | $node = new AnyEvent::MP::Node::Direct $noderef; |
205 | $node = new AnyEvent::MP::Node::Direct $noderef; |
205 | } |
206 | } |
206 | |
207 | |
207 | $NODE{$_} = $node |
208 | $NODE{$_} = $node |
208 | for $noderef, split /,/, $noderef; |
209 | for $noderef, split /,/, $noderef; |
209 | |
210 | |
210 | $node |
211 | $node |
|
|
212 | } |
|
|
213 | |
|
|
214 | sub connect_node { |
|
|
215 | &add_node->connect; |
211 | } |
216 | } |
212 | |
217 | |
213 | sub snd(@) { |
218 | sub snd(@) { |
214 | my ($noderef, $portid) = split /#/, shift, 2; |
219 | my ($noderef, $portid) = split /#/, shift, 2; |
215 | |
220 | |
… | |
… | |
339 | $node->{trial}{accept} = $tp; |
344 | $node->{trial}{accept} = $tp; |
340 | }, |
345 | }, |
341 | ; |
346 | ; |
342 | } |
347 | } |
343 | |
348 | |
344 | (add_node $_)->connect for @others; |
349 | connect_node $_ for @others; |
345 | |
350 | |
346 | if ($SLAVE) { |
351 | if ($SLAVE) { |
347 | my $timeout = AE::timer $MONITOR_TIMEOUT, 0, sub { $SLAVE->() }; |
352 | my $timeout = AE::timer $MONITOR_TIMEOUT, 0, sub { $SLAVE->() }; |
348 | $MASTER = $SLAVE->recv; |
353 | my $master = $SLAVE->recv; |
349 | defined $MASTER |
354 | $master |
350 | or Carp::croak "AnyEvent::MP: unable to enter slave mode, unable to connect to a seednode.\n"; |
355 | or Carp::croak "AnyEvent::MP: unable to enter slave mode, unable to connect to a seednode.\n"; |
|
|
356 | |
|
|
357 | $MASTER = $master->{noderef}; |
|
|
358 | $master->{autoconnect} = 1; |
351 | |
359 | |
352 | (my $via = $MASTER) =~ s/,/!/g; |
360 | (my $via = $MASTER) =~ s/,/!/g; |
353 | |
361 | |
354 | $NODE .= "\@$via"; |
362 | $NODE .= "\@$via"; |
355 | $NODE{$NODE} = $NODE{""}; |
363 | $NODE{$NODE} = $NODE{""}; |
… | |
… | |
358 | for values %NODE; |
366 | for values %NODE; |
359 | |
367 | |
360 | $SLAVE = 1; |
368 | $SLAVE = 1; |
361 | } |
369 | } |
362 | |
370 | |
363 | (load_func $_)->() |
|
|
364 | for @{ $profile->{services} }; |
371 | for (@{ $profile->{services} }) { |
|
|
372 | if (s/::$//) { |
|
|
373 | eval "require $_"; |
|
|
374 | die $@ if $@; |
|
|
375 | } else { |
|
|
376 | (load_func $_)->(); |
|
|
377 | } |
|
|
378 | } |
365 | } |
379 | } |
366 | |
380 | |
367 | ############################################################################# |
381 | ############################################################################# |
368 | # node monitoring and info |
382 | # node monitoring and info |
369 | |
383 | |
… | |
… | |
373 | @node{values %NODE} = values %NODE; |
387 | @node{values %NODE} = values %NODE; |
374 | |
388 | |
375 | values %node; |
389 | values %node; |
376 | } |
390 | } |
377 | |
391 | |
|
|
392 | =item node_is_known $noderef |
|
|
393 | |
|
|
394 | Returns true iff the given node is currently known to the system. |
|
|
395 | |
|
|
396 | =cut |
|
|
397 | |
|
|
398 | sub node_is_known($) { |
|
|
399 | exists $NODE{$_[0]} |
|
|
400 | } |
|
|
401 | |
|
|
402 | =item node_is_up $noderef |
|
|
403 | |
|
|
404 | Returns true if the given node is "up", that is, the kernel thinks it has |
|
|
405 | a working connection to it. |
|
|
406 | |
|
|
407 | If the node is known but not currently connected, returns C<0>. If the |
|
|
408 | node is not known, returns C<undef>. |
|
|
409 | |
|
|
410 | =cut |
|
|
411 | |
|
|
412 | sub node_is_up($) { |
|
|
413 | ($NODE{$_[0]} or return)->{transport} |
|
|
414 | ? 1 : 0 |
|
|
415 | } |
|
|
416 | |
378 | =item known_nodes |
417 | =item known_nodes |
379 | |
418 | |
380 | Returns the noderefs of all nodes connected to this node. |
419 | Returns the noderefs of all nodes connected to this node. |
381 | |
420 | |
382 | =cut |
421 | =cut |
… | |
… | |
402 | is established) or down (connection is lost). |
441 | is established) or down (connection is lost). |
403 | |
442 | |
404 | Node up messages can only be followed by node down messages for the same |
443 | Node up messages can only be followed by node down messages for the same |
405 | node, and vice versa. |
444 | node, and vice versa. |
406 | |
445 | |
407 | The fucntino returns an optional guard which can be used to de-register |
446 | The function returns an optional guard which can be used to de-register |
408 | the monitoring callback again. |
447 | the monitoring callback again. |
409 | |
448 | |
410 | =cut |
449 | =cut |
411 | |
450 | |
412 | our %MON_NODES; |
451 | our %MON_NODES; |