… | |
… | |
37 | use base "Exporter"; |
37 | use base "Exporter"; |
38 | |
38 | |
39 | AE::log 7 => "starting log catcher service."; |
39 | AE::log 7 => "starting log catcher service."; |
40 | |
40 | |
41 | our $LOGLEVEL; |
41 | our $LOGLEVEL; |
|
|
42 | our $MON; |
|
|
43 | our $PROPAGATE = 1; # set to one when messages ought to be send to remote nodes |
42 | our %lport; # local logging ports |
44 | our %lport; # local logging ports |
43 | |
45 | |
44 | # other nodes connect via this |
46 | # other nodes connect via this |
45 | sub connect { |
47 | sub connect { |
46 | my ($version, $rport, $loglevel) = @_; |
48 | my ($version, $rport, $loglevel) = @_; |
47 | |
49 | |
|
|
50 | # context to catch log messages |
48 | my $ctx = new AnyEvent::Log::Ctx |
51 | my $ctx = new AnyEvent::Log::Ctx |
49 | title => "AnyEvent::MP::LogCatcher", |
52 | title => "AnyEvent::MP::LogCatcher", |
50 | level => $loglevel, |
53 | level => $loglevel, |
51 | log_cb => sub { |
54 | log_cb => sub { |
52 | snd $rport, @{ $_[0] }; |
55 | snd $rport, @{ $_[0] } |
|
|
56 | if $PROPAGATE; |
53 | }, |
57 | }, |
54 | fmt_cb => sub { |
58 | fmt_cb => sub { |
55 | [$_[0], $_[1]->title, $_[2], $_[3]] |
59 | [$_[0], $_[1]->title, $_[2], $_[3]] |
56 | }, |
60 | }, |
57 | ; |
61 | ; |
58 | |
62 | |
59 | $AnyEvent::Log::COLLECT->attach ($ctx); |
63 | $AnyEvent::Log::COLLECT->attach ($ctx); |
60 | |
64 | |
61 | # monitor them, silently die |
65 | # monitor them, silently die if they die |
62 | mon $rport, sub { |
66 | mon $rport, sub { |
63 | $AnyEvent::Log::COLLECT->detach ($ctx); |
67 | $AnyEvent::Log::COLLECT->detach ($ctx); |
64 | }; |
68 | }; |
|
|
69 | |
|
|
70 | AE::log 8 => "starting to propagate log messages to $rport"; |
65 | } |
71 | } |
66 | |
72 | |
67 | sub mon_node { |
73 | sub mon_node { |
68 | my ($node, $is_up) = @_; |
74 | my ($node) = @_; |
69 | |
75 | |
70 | return unless $is_up; |
76 | # don't log messages from ourselves |
|
|
77 | return if $node eq $NODE; |
71 | |
78 | |
72 | my $lport = $lport{$node} = port { |
79 | $lport{$node} ||= do { |
|
|
80 | my $lport = port { |
73 | my ($time, $ctx, $level, $msg) = @_; |
81 | my ($time, $ctx, $level, $msg) = @_; |
74 | |
82 | |
75 | $level = 2 if $level < 2; # do not exit because others do so |
83 | $level = 2 if $level < 2; # do not exit just because others do so |
76 | |
84 | |
77 | my $diff = $time - AE::now; |
85 | my $diff = AE::now - $time; |
78 | $diff = $diff < 1e-4 ? "" : sprintf ", %gs", $diff; |
86 | $diff = (abs $diff) < 1e-3 ? "" : sprintf "%+.3fs", $diff; |
79 | AE::log $level, "[$node$diff] $msg"; |
|
|
80 | }; |
|
|
81 | |
87 | |
82 | # establish connection |
88 | local $PROPAGATE; # do not propagate to other nodes |
83 | AnyEvent::MP::Kernel::snd_to_func $node, "AnyEvent::MP::LogCatcher::connect", 0, $lport, $LOGLEVEL; |
89 | (AnyEvent::Log::ctx $ctx)->log ($level, "[$node$diff] $msg"); |
|
|
90 | }; |
84 | |
91 | |
|
|
92 | mon $lport, sub { |
|
|
93 | delete $lport{$node} |
|
|
94 | or return; |
|
|
95 | AE::log error => "@_" |
|
|
96 | if @_; |
|
|
97 | mon_node ($node); |
|
|
98 | }; |
|
|
99 | |
|
|
100 | # establish connection |
|
|
101 | AnyEvent::MP::Kernel::snd_to_func $node, "AnyEvent::MP::LogCatcher::connect", 0, $lport, $LOGLEVEL; |
|
|
102 | |
85 | mon $node, $lport; |
103 | mon $node, $lport; |
|
|
104 | |
|
|
105 | $lport |
|
|
106 | } |
86 | } |
107 | } |
87 | |
108 | |
88 | =item AnyEvent::MP::LogCatcher::catch [$level] |
109 | =item AnyEvent::MP::LogCatcher::catch [$level] |
89 | |
110 | |
90 | Starts catching all log messages from all nodes with level C<$level> or |
111 | Starts catching all log messages from all nodes with level C<$level> or |
… | |
… | |
92 | again. |
113 | again. |
93 | |
114 | |
94 | Example: start a node that catches all messages (you might have to specify |
115 | Example: start a node that catches all messages (you might have to specify |
95 | a suitable profile name). |
116 | a suitable profile name). |
96 | |
117 | |
97 | aemp run profilename services '[["AnyEvent::MP::LogCatcher::catch",9]]' |
118 | AE_VERBOSE=9 aemp run profilename services '[["AnyEvent::MP::LogCatcher::catch",9]]' |
98 | |
119 | |
99 | =cut |
120 | =cut |
100 | |
121 | |
101 | sub catch { |
122 | sub catch { |
102 | $LOGLEVEL = $_[0]; |
123 | $LOGLEVEL = $_[0]; |
103 | kil $_, "restart" for values %lport; |
124 | kil $_ for values %lport; |
104 | %lport = (); |
125 | %lport = (); |
105 | |
126 | |
106 | return unless defined $LOGLEVEL; |
127 | return unless defined $LOGLEVEL; |
107 | |
128 | |
108 | mon_node $_, 1 |
129 | $MON = db_mon "'l" => sub { |
109 | for up_nodes; |
130 | my ($family, $add, $chg, $del) = @_; |
110 | |
131 | |
111 | mon_nodes \&mon_node; |
132 | kil delete $lport{$_} |
|
|
133 | for @$del; |
|
|
134 | |
|
|
135 | mon_node $_ |
|
|
136 | for @$add; |
|
|
137 | }; |
|
|
138 | |
112 | () |
139 | () |
113 | } |
140 | } |
114 | |
141 | |
115 | =back |
142 | =back |
|
|
143 | |
|
|
144 | =head1 LOGGING |
|
|
145 | |
|
|
146 | AnyEvent::MP::LogCatcher logs messages from remote nodes. It logs them |
|
|
147 | into the original logging context and prepends the origin node name |
|
|
148 | and, if the time difference is larger than 1e-4 seconds, also the time |
|
|
149 | difference between local time and origin time. |
116 | |
150 | |
117 | =head1 SEE ALSO |
151 | =head1 SEE ALSO |
118 | |
152 | |
119 | L<AnyEvent::MP>. |
153 | L<AnyEvent::MP>. |
120 | |
154 | |