line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright 2018 - present MongoDB, Inc. |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Licensed under the Apache License, Version 2.0 (the "License"); |
4
|
|
|
|
|
|
|
# you may not use this file except in compliance with the License. |
5
|
|
|
|
|
|
|
# You may obtain a copy of the License at |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# http://www.apache.org/licenses/LICENSE-2.0 |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# Unless required by applicable law or agreed to in writing, software |
10
|
|
|
|
|
|
|
# distributed under the License is distributed on an "AS IS" BASIS, |
11
|
|
|
|
|
|
|
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
12
|
|
|
|
|
|
|
# See the License for the specific language governing permissions and |
13
|
|
|
|
|
|
|
# limitations under the License. |
14
|
|
|
|
|
|
|
|
15
|
60
|
|
|
60
|
|
35503
|
use strict; |
|
60
|
|
|
|
|
147
|
|
|
60
|
|
|
|
|
1886
|
|
16
|
60
|
|
|
60
|
|
315
|
use warnings; |
|
60
|
|
|
|
|
139
|
|
|
60
|
|
|
|
|
2386
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
package MongoDB::Role::_TopologyMonitoring; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# MongoDB role to add topology monitoring support |
21
|
|
|
|
|
|
|
|
22
|
60
|
|
|
60
|
|
304
|
use version; |
|
60
|
|
|
|
|
129
|
|
|
60
|
|
|
|
|
472
|
|
23
|
|
|
|
|
|
|
our $VERSION = 'v2.2.2'; |
24
|
|
|
|
|
|
|
|
25
|
60
|
|
|
60
|
|
4654
|
use Moo::Role; |
|
60
|
|
|
|
|
136
|
|
|
60
|
|
|
|
|
424
|
|
26
|
60
|
|
|
60
|
|
20476
|
use namespace::clean; |
|
60
|
|
|
|
|
134
|
|
|
60
|
|
|
|
|
448
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# These are used to cache data |
29
|
|
|
|
|
|
|
has old_topology_desc => ( is => 'rw' ); |
30
|
|
|
|
|
|
|
has old_server_desc => ( is => 'rw' ); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub publish_topology_opening { |
33
|
72
|
|
|
72
|
0
|
140
|
my $self = shift; |
34
|
|
|
|
|
|
|
|
35
|
72
|
|
|
|
|
354
|
my $event = { |
36
|
|
|
|
|
|
|
topologyId => "$self", |
37
|
|
|
|
|
|
|
type => "topology_opening_event" |
38
|
|
|
|
|
|
|
}; |
39
|
|
|
|
|
|
|
|
40
|
72
|
|
|
|
|
191
|
eval { $self->monitoring_callback->($event) }; |
|
72
|
|
|
|
|
254
|
|
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub publish_topology_closing { |
44
|
72
|
|
|
72
|
0
|
173
|
my $self = shift; |
45
|
|
|
|
|
|
|
|
46
|
72
|
|
|
|
|
385
|
my $event = { |
47
|
|
|
|
|
|
|
topologyId => "$self", |
48
|
|
|
|
|
|
|
type => "topology_closed_event" |
49
|
|
|
|
|
|
|
}; |
50
|
|
|
|
|
|
|
|
51
|
72
|
|
|
|
|
144
|
eval { $self->monitoring_callback->($event) }; |
|
72
|
|
|
|
|
273
|
|
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub publish_server_opening { |
55
|
153
|
|
|
153
|
0
|
332
|
my ( $self, $address ) = @_; |
56
|
|
|
|
|
|
|
|
57
|
153
|
|
|
|
|
682
|
my $event = { |
58
|
|
|
|
|
|
|
topologyId => "$self", |
59
|
|
|
|
|
|
|
address => $address, |
60
|
|
|
|
|
|
|
type => "server_opening_event" |
61
|
|
|
|
|
|
|
}; |
62
|
|
|
|
|
|
|
|
63
|
153
|
|
|
|
|
394
|
eval { $self->monitoring_callback->($event) }; |
|
153
|
|
|
|
|
436
|
|
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub publish_server_closing { |
67
|
39
|
|
|
39
|
0
|
94
|
my ( $self, $address ) = @_; |
68
|
|
|
|
|
|
|
|
69
|
39
|
|
|
|
|
182
|
my $event = { |
70
|
|
|
|
|
|
|
topologyId => "$self", |
71
|
|
|
|
|
|
|
address => $address, |
72
|
|
|
|
|
|
|
type => "server_closed_event" |
73
|
|
|
|
|
|
|
}; |
74
|
|
|
|
|
|
|
|
75
|
39
|
|
|
|
|
79
|
eval { $self->monitoring_callback->($event) }; |
|
39
|
|
|
|
|
131
|
|
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub publish_server_heartbeat_started { |
79
|
0
|
|
|
0
|
0
|
0
|
my ($self, $link) = @_; |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
0
|
my $event = { |
82
|
|
|
|
|
|
|
connectionId => $link->address, |
83
|
|
|
|
|
|
|
type => "server_heartbeat_started_event" |
84
|
|
|
|
|
|
|
}; |
85
|
|
|
|
|
|
|
|
86
|
0
|
|
|
|
|
0
|
eval { $self->monitoring_callback->($event) }; |
|
0
|
|
|
|
|
0
|
|
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub publish_server_heartbeat_succeeded { |
90
|
0
|
|
|
0
|
0
|
0
|
my ($self, $link, $rtt_sec_fail, $is_master) = @_; |
91
|
|
|
|
|
|
|
|
92
|
0
|
|
|
|
|
0
|
my $event = { |
93
|
|
|
|
|
|
|
duration => $rtt_sec_fail, |
94
|
|
|
|
|
|
|
reply => $is_master, |
95
|
|
|
|
|
|
|
connectionId => $link->address, |
96
|
|
|
|
|
|
|
type => "server_heartbeat_succeeded_event" |
97
|
|
|
|
|
|
|
}; |
98
|
|
|
|
|
|
|
|
99
|
0
|
|
|
|
|
0
|
eval { $self->monitoring_callback->($event) }; |
|
0
|
|
|
|
|
0
|
|
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub publish_server_heartbeat_failed { |
103
|
0
|
|
|
0
|
0
|
0
|
my ($self, $link, $rtt_sec_fail, $e) = @_; |
104
|
|
|
|
|
|
|
|
105
|
0
|
|
|
|
|
0
|
my $event = { |
106
|
|
|
|
|
|
|
duration => $rtt_sec_fail, |
107
|
|
|
|
|
|
|
failure => $e, |
108
|
|
|
|
|
|
|
connectionId => $link->address, |
109
|
|
|
|
|
|
|
type => "server_heartbeat_failed_event" |
110
|
|
|
|
|
|
|
}; |
111
|
|
|
|
|
|
|
|
112
|
0
|
|
|
|
|
0
|
eval { $self->monitoring_callback->($event) }; |
|
0
|
|
|
|
|
0
|
|
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub __create_server_description { |
116
|
940
|
|
|
940
|
|
1528
|
my ($self, $server) = @_; |
117
|
|
|
|
|
|
|
|
118
|
940
|
|
|
|
|
1193
|
my $server_desc; |
119
|
|
|
|
|
|
|
|
120
|
940
|
50
|
|
|
|
1997
|
if (defined $server->is_master) { |
121
|
|
|
|
|
|
|
$server_desc = { |
122
|
|
|
|
|
|
|
address => $server->address, |
123
|
|
|
|
|
|
|
error => $server->error, |
124
|
|
|
|
|
|
|
roundTripTime => $server->rtt_sec, |
125
|
|
|
|
|
|
|
lastWriteDate => $server->is_master->{lastWrite}->{lastWriteDate}, |
126
|
|
|
|
|
|
|
opTime => $server->is_master->{opTime}, |
127
|
|
|
|
|
|
|
type => $server->type || "Unknown", |
128
|
|
|
|
|
|
|
minWireVersion => $server->is_master->{min_wire_version}, |
129
|
|
|
|
|
|
|
maxWireVersion => $server->is_master->{max_wire_version}, |
130
|
|
|
|
|
|
|
me => $server->me, |
131
|
|
|
|
|
|
|
arbiters => $server->arbiters, |
132
|
|
|
|
|
|
|
hosts => $server->hosts, |
133
|
|
|
|
|
|
|
passives => $server->passives, |
134
|
|
|
|
|
|
|
(defined $server->is_master->{tags} ? |
135
|
|
|
|
|
|
|
(tags => $server->is_master->{tags}) : ()), |
136
|
|
|
|
|
|
|
($server->primary ne "" ? (primary => $server->primary) : ()), |
137
|
|
|
|
|
|
|
(defined $server->is_master->{setName} ? |
138
|
|
|
|
|
|
|
(setName => $server->is_master->{setName}) : ()), |
139
|
|
|
|
|
|
|
(defined $server->is_master->{setVersion} ? |
140
|
|
|
|
|
|
|
(setVersion => $server->is_master->{setVersion}) : ()), |
141
|
|
|
|
|
|
|
(defined $server->is_master->{electionId} ? |
142
|
|
|
|
|
|
|
(electionId => $server->is_master->{electionId}) : ()), |
143
|
|
|
|
|
|
|
(defined $server->is_master->{logicalSessionTimeoutMinutes} ? |
144
|
|
|
|
|
|
|
(logicalSessionTimeoutMinutes => |
145
|
940
|
50
|
50
|
|
|
17280
|
$server->is_master->{logicalSessionTimeoutMinutes}) : ()), |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
146
|
|
|
|
|
|
|
}; |
147
|
|
|
|
|
|
|
} else { |
148
|
0
|
0
|
0
|
|
|
0
|
$server_desc = { |
149
|
|
|
|
|
|
|
address => $server->address, |
150
|
|
|
|
|
|
|
error => $server->error, |
151
|
|
|
|
|
|
|
roundTripTime => $server->rtt_sec, |
152
|
|
|
|
|
|
|
type => $server->type || "Unknown", |
153
|
|
|
|
|
|
|
me => $server->me, |
154
|
|
|
|
|
|
|
arbiters => $server->arbiters, |
155
|
|
|
|
|
|
|
hosts => $server->hosts, |
156
|
|
|
|
|
|
|
passives => $server->passives, |
157
|
|
|
|
|
|
|
#TODO figure out what tags should be |
158
|
|
|
|
|
|
|
tags => undef, |
159
|
|
|
|
|
|
|
($server->primary ne "" ? (primary => $server->primary) : ()), |
160
|
|
|
|
|
|
|
}; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
940
|
|
|
|
|
67265
|
return $server_desc; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub __has_changed_servers { |
167
|
146
|
|
|
146
|
|
277
|
my ($self, $new_server ) = @_; |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
# Fields considered Server Description equality |
170
|
146
|
|
|
|
|
217
|
my $equal_servers = 1; |
171
|
146
|
|
|
|
|
935
|
my %equality_fields = ( |
172
|
|
|
|
|
|
|
address => 1, |
173
|
|
|
|
|
|
|
type => 1, |
174
|
|
|
|
|
|
|
minWireVersion => 1, |
175
|
|
|
|
|
|
|
minWireVersion => 1, |
176
|
|
|
|
|
|
|
me => 1, |
177
|
|
|
|
|
|
|
arbiters => 1, |
178
|
|
|
|
|
|
|
hosts => 1, |
179
|
|
|
|
|
|
|
passives => 1, |
180
|
|
|
|
|
|
|
tags => 1, |
181
|
|
|
|
|
|
|
primary => 1, |
182
|
|
|
|
|
|
|
setName => 1, |
183
|
|
|
|
|
|
|
setVersion => 1, |
184
|
|
|
|
|
|
|
electionId => 1, |
185
|
|
|
|
|
|
|
logicalSessionTimeoutMinutes => 1, |
186
|
|
|
|
|
|
|
); |
187
|
146
|
|
|
|
|
320
|
my $new_server_desc = $self->__create_server_description($new_server); |
188
|
|
|
|
|
|
|
|
189
|
146
|
|
|
|
|
264
|
my %oldhash = %{$self->old_server_desc}; |
|
146
|
|
|
|
|
1130
|
|
190
|
146
|
|
|
|
|
306
|
my %newhash = %{$new_server_desc}; |
|
146
|
|
|
|
|
880
|
|
191
|
|
|
|
|
|
|
|
192
|
146
|
|
|
|
|
534
|
foreach my $key (keys %newhash) { |
193
|
410
|
100
|
|
|
|
744
|
if (exists($equality_fields{$key})) { |
194
|
267
|
100
|
66
|
|
|
1109
|
if (!exists($oldhash{$key})) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
195
|
20
|
|
|
|
|
40
|
$equal_servers = 0; |
196
|
20
|
|
|
|
|
41
|
last; |
197
|
|
|
|
|
|
|
} elsif (!defined($newhash{$key}) && |
198
|
|
|
|
|
|
|
!defined($oldhash{$key})) { |
199
|
28
|
|
|
|
|
62
|
next; |
200
|
|
|
|
|
|
|
} elsif ($newhash{$key} ne $oldhash{$key}) { |
201
|
116
|
|
|
|
|
223
|
$equal_servers = 0; |
202
|
116
|
|
|
|
|
235
|
last; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
146
|
100
|
|
|
|
446
|
unless ( $equal_servers ) { |
208
|
136
|
|
|
|
|
713
|
my $event_server = { |
209
|
|
|
|
|
|
|
topologyId => "$self", |
210
|
|
|
|
|
|
|
address => $new_server->address, |
211
|
|
|
|
|
|
|
previousDescription => $self->old_server_desc, |
212
|
|
|
|
|
|
|
newDescription => $new_server_desc, |
213
|
|
|
|
|
|
|
type => "server_description_changed_event" |
214
|
|
|
|
|
|
|
}; |
215
|
|
|
|
|
|
|
|
216
|
136
|
|
|
|
|
232
|
eval { $self->monitoring_callback->($event_server) }; |
|
136
|
|
|
|
|
426
|
|
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
sub publish_old_topology_desc { |
221
|
218
|
|
|
218
|
0
|
500
|
my ( $self, $address, $new_server ) = @_; |
222
|
|
|
|
|
|
|
|
223
|
218
|
100
|
|
|
|
479
|
if ( $address ) { |
224
|
146
|
|
|
|
|
329
|
my $server = $self->servers->{$address}; |
225
|
146
|
|
|
|
|
377
|
my $old_server = $self->__create_server_description($server); |
226
|
146
|
|
|
|
|
593
|
$self->old_server_desc($old_server); |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
218
|
100
|
|
|
|
489
|
if ( $new_server ) { |
230
|
146
|
|
|
|
|
403
|
$self->__has_changed_servers($new_server); |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
218
|
|
|
|
|
21203
|
$self->old_topology_desc( $self->__create_topology_description ); |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub publish_new_topology_desc { |
237
|
218
|
|
|
218
|
0
|
386
|
my $self = shift; |
238
|
|
|
|
|
|
|
|
239
|
218
|
|
|
|
|
745
|
my $event_topology = { |
240
|
|
|
|
|
|
|
topologyId => "$self", |
241
|
|
|
|
|
|
|
previousDescription => $self->old_topology_desc, |
242
|
|
|
|
|
|
|
newDescription => $self->__create_topology_description, |
243
|
|
|
|
|
|
|
type => "topology_description_changed_event" |
244
|
|
|
|
|
|
|
}; |
245
|
|
|
|
|
|
|
|
246
|
218
|
|
|
|
|
3479
|
eval { $self->monitoring_callback->($event_topology) }; |
|
218
|
|
|
|
|
652
|
|
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub __create_topology_description { |
250
|
436
|
|
|
436
|
|
724
|
my ( $self ) = @_; |
251
|
|
|
|
|
|
|
|
252
|
436
|
|
|
|
|
1181
|
my @servers = map { $self->__create_server_description($_) } $self->all_servers; |
|
648
|
|
|
|
|
1391
|
|
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
return { |
255
|
436
|
100
|
|
|
|
7427
|
topologyType => $self->type, |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
256
|
|
|
|
|
|
|
( $self->replica_set_name ne "" |
257
|
|
|
|
|
|
|
? ( setName => $self->replica_set_name ) |
258
|
|
|
|
|
|
|
: () |
259
|
|
|
|
|
|
|
), |
260
|
|
|
|
|
|
|
( defined $self->max_set_version |
261
|
|
|
|
|
|
|
? ( maxSetVersion => $self->max_set_version ) |
262
|
|
|
|
|
|
|
: () |
263
|
|
|
|
|
|
|
), |
264
|
|
|
|
|
|
|
( defined $self->max_election_id |
265
|
|
|
|
|
|
|
? ( maxElectionId => $self->max_election_id ) |
266
|
|
|
|
|
|
|
: () |
267
|
|
|
|
|
|
|
), |
268
|
|
|
|
|
|
|
servers => \@servers, |
269
|
|
|
|
|
|
|
stale => $self->stale, |
270
|
|
|
|
|
|
|
( defined $self->is_compatible |
271
|
|
|
|
|
|
|
? ( compatible => $self->is_compatible ) |
272
|
|
|
|
|
|
|
: () |
273
|
|
|
|
|
|
|
), |
274
|
|
|
|
|
|
|
( defined $self->compatibility_error |
275
|
|
|
|
|
|
|
? ( compatibilityError => $self->compatibility_error ) |
276
|
|
|
|
|
|
|
: () |
277
|
|
|
|
|
|
|
), |
278
|
|
|
|
|
|
|
( defined $self->logical_session_timeout_minutes |
279
|
|
|
|
|
|
|
? ( logicalSessionTimeoutMinutes => $self->logical_session_timeout_minutes ) |
280
|
|
|
|
|
|
|
: () |
281
|
|
|
|
|
|
|
), |
282
|
|
|
|
|
|
|
}; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
1; |