… | |
… | |
46 | configure |
46 | configure |
47 | up_nodes mon_nodes node_is_up |
47 | up_nodes mon_nodes node_is_up |
48 | db_set db_del |
48 | db_set db_del |
49 | db_mon db_family db_keys db_values |
49 | db_mon db_family db_keys db_values |
50 | ); |
50 | ); |
51 | |
|
|
52 | =item $AnyEvent::MP::Kernel::WARN->($level, $msg) |
|
|
53 | |
|
|
54 | This value is called with an error or warning message, when e.g. a |
|
|
55 | connection could not be created, authorisation failed and so on. |
|
|
56 | |
|
|
57 | It I<must not> block or send messages -queue it and use an idle watcher if |
|
|
58 | you need to do any of these things. |
|
|
59 | |
|
|
60 | C<$level> should be C<0> for messages to be logged always, C<1> for |
|
|
61 | unexpected messages and errors, C<2> for warnings, C<7> for messages about |
|
|
62 | node connectivity and services, C<8> for debugging messages and C<9> for |
|
|
63 | tracing messages. |
|
|
64 | |
|
|
65 | The default simply logs the message to STDERR. |
|
|
66 | |
|
|
67 | =item @AnyEvent::MP::Kernel::WARN |
|
|
68 | |
|
|
69 | All code references in this array are called for every log message, from |
|
|
70 | the default C<$WARN> handler. This is an easy way to tie into the log |
|
|
71 | messages without disturbing others. |
|
|
72 | |
|
|
73 | =cut |
|
|
74 | |
|
|
75 | our $WARNLEVEL = exists $ENV{PERL_ANYEVENT_MP_WARNLEVEL} ? $ENV{PERL_ANYEVENT_MP_WARNLEVEL} : 5; |
|
|
76 | our @WARN; |
|
|
77 | our $WARN = sub { |
|
|
78 | &$_ for @WARN; |
|
|
79 | |
|
|
80 | return if $WARNLEVEL < $_[0]; |
|
|
81 | |
|
|
82 | my ($level, $msg) = @_; |
|
|
83 | |
|
|
84 | $msg =~ s/\n$//; |
|
|
85 | |
|
|
86 | printf STDERR "%s <%d> %s\n", |
|
|
87 | (POSIX::strftime "%Y-%m-%d %H:%M:%S", localtime time), |
|
|
88 | $level, |
|
|
89 | $msg; |
|
|
90 | }; |
|
|
91 | |
|
|
92 | =item $AnyEvent::MP::Kernel::WARNLEVEL [default 5 or $ENV{PERL_ANYEVENT_MP_WARNLEVEL}] |
|
|
93 | |
|
|
94 | The maximum level at which warning messages will be printed to STDERR by |
|
|
95 | the default warn handler. |
|
|
96 | |
|
|
97 | =cut |
|
|
98 | |
51 | |
99 | sub load_func($) { |
52 | sub load_func($) { |
100 | my $func = $_[0]; |
53 | my $func = $_[0]; |
101 | |
54 | |
102 | unless (defined &$func) { |
55 | unless (defined &$func) { |
… | |
… | |
372 | sub _inject_nodeevent($$;@) { |
325 | sub _inject_nodeevent($$;@) { |
373 | my ($node, $up, @reason) = @_; |
326 | my ($node, $up, @reason) = @_; |
374 | |
327 | |
375 | for my $cb (values %MON_NODES) { |
328 | for my $cb (values %MON_NODES) { |
376 | eval { $cb->($node->{id}, $up, @reason); 1 } |
329 | eval { $cb->($node->{id}, $up, @reason); 1 } |
377 | or $WARN->(1, $@); |
330 | or AE::log die => $@; |
378 | } |
331 | } |
379 | |
332 | |
380 | $WARN->(7, "$node->{id} is " . ($up ? "up" : "down") . " (@reason)"); |
333 | AE::log 7 => "$node->{id} is " . ($up ? "up" : "down") . " (@reason)"; |
381 | } |
334 | } |
382 | |
335 | |
383 | ############################################################################# |
336 | ############################################################################# |
384 | # self node code |
337 | # self node code |
385 | |
338 | |
… | |
… | |
390 | or return; # killing nonexistent ports is O.K. |
343 | or return; # killing nonexistent ports is O.K. |
391 | delete $PORT_DATA{$port}; |
344 | delete $PORT_DATA{$port}; |
392 | |
345 | |
393 | my $mon = delete $LMON{$port} |
346 | my $mon = delete $LMON{$port} |
394 | or !@_ |
347 | or !@_ |
395 | or $WARN->(2, "unmonitored local port $port died with reason: @_"); |
348 | or AE::log die => "unmonitored local port $port died with reason: @_"; |
396 | |
349 | |
397 | $_->(@_) for values %$mon; |
350 | $_->(@_) for values %$mon; |
398 | } |
351 | } |
399 | |
352 | |
400 | sub _monitor { |
353 | sub _monitor { |
… | |
… | |
470 | |
423 | |
471 | $NODE{""} = $NODE{$NODE} = new AnyEvent::MP::Node::Self $NODE; |
424 | $NODE{""} = $NODE{$NODE} = new AnyEvent::MP::Node::Self $NODE; |
472 | $PORT{""} = sub { |
425 | $PORT{""} = sub { |
473 | my $tag = shift; |
426 | my $tag = shift; |
474 | eval { &{ $NODE_REQ{$tag} ||= do { &_secure_check; load_func $tag } } }; |
427 | eval { &{ $NODE_REQ{$tag} ||= do { &_secure_check; load_func $tag } } }; |
475 | $WARN->(2, "error processing node message from $SRCNODE: $@") if $@; |
428 | AE::log die => "error processing node message from $SRCNODE: $@" if $@; |
476 | }; |
429 | }; |
477 | |
430 | |
478 | our $NPROTO = 1; |
431 | our $NPROTO = 1; |
479 | |
432 | |
480 | # tell everybody who connects our nproto |
433 | # tell everybody who connects our nproto |
… | |
… | |
495 | my ($seed) = @_; |
448 | my ($seed) = @_; |
496 | |
449 | |
497 | my ($host, $port) = AnyEvent::Socket::parse_hostport $seed |
450 | my ($host, $port) = AnyEvent::Socket::parse_hostport $seed |
498 | or Carp::croak "$seed: unparsable seed address"; |
451 | or Carp::croak "$seed: unparsable seed address"; |
499 | |
452 | |
500 | $AnyEvent::MP::Kernel::WARN->(9, "trying connect to seed node $seed."); |
453 | AE::log 9 => "trying connect to seed node $seed."; |
501 | |
454 | |
502 | $SEED_CONNECT{$seed} ||= AnyEvent::MP::Transport::mp_connect |
455 | $SEED_CONNECT{$seed} ||= AnyEvent::MP::Transport::mp_connect |
503 | $host, $port, |
456 | $host, $port, |
504 | on_greeted => sub { |
457 | on_greeted => sub { |
505 | # called after receiving remote greeting, learn remote node name |
458 | # called after receiving remote greeting, learn remote node name |
… | |
… | |
987 | my $seeds = $CONFIG->{seeds}; |
940 | my $seeds = $CONFIG->{seeds}; |
988 | my $binds = $CONFIG->{binds}; |
941 | my $binds = $CONFIG->{binds}; |
989 | |
942 | |
990 | $binds ||= ["*"]; |
943 | $binds ||= ["*"]; |
991 | |
944 | |
992 | $WARN->(8, "node $NODE starting up."); |
945 | AE::log 8 => "node $NODE starting up."; |
993 | |
946 | |
994 | $BINDS = []; |
947 | $BINDS = []; |
995 | %BINDS = (); |
948 | %BINDS = (); |
996 | |
949 | |
997 | for (map _resolve $_, @$binds) { |
950 | for (map _resolve $_, @$binds) { |
… | |
… | |
1013 | } |
966 | } |
1014 | } |
967 | } |
1015 | |
968 | |
1016 | db_set "'l" => $NODE => $BINDS; |
969 | db_set "'l" => $NODE => $BINDS; |
1017 | |
970 | |
1018 | $WARN->(8, "node listens on [@$BINDS]."); |
971 | AE::log 8 => "node listens on [@$BINDS]."; |
1019 | |
972 | |
1020 | # connect to all seednodes |
973 | # connect to all seednodes |
1021 | set_seeds map $_->recv, map _resolve $_, @$seeds; |
974 | set_seeds map $_->recv, map _resolve $_, @$seeds; |
1022 | |
975 | |
1023 | master_search; |
976 | master_search; |