PERL-937 Gossip cluster time during SDAM

lib/MongoDB/MongoClient.pm

@@ -1105,28 +1105,6 @@ sub _build__read_concern {
     );
 }
 
-has _cluster_time => (
-    is => 'rwp',
-    isa => Maybe[Document],
-    init_arg => undef,
-    default => undef,
-);
-
-sub _update_cluster_time {
-    my ( $self, $cluster_time ) = @_;
-
-    # Only update the cluster time if it is more recent than the current entry
-    if ( ! defined $self->_cluster_time ) {
-        $self->_set__cluster_time( $cluster_time );
-    } else {
-        if ( $cluster_time->{'clusterTime'}
-           > $self->_cluster_time->{'clusterTime'} ) {
-            $self->_set__cluster_time( $cluster_time );
-        }
-    }
-    return;
-}
-
 #--------------------------------------------------------------------------#
 # private attributes
 #--------------------------------------------------------------------------#
@@ -1169,7 +1147,11 @@ has _topology => (
     isa      => InstanceOf ['MongoDB::_Topology'],
     init_arg => undef,
     builder  => '_build__topology',
-    handles  => { topology_type => 'type' },
+    handles  => {
+        topology_type => 'type',
+        _cluster_time => 'cluster_time',
+        _update_cluster_time => 'update_cluster_time',
+    },
     clearer  => '_clear__topology',
 );
 

lib/MongoDB/_Topology.pm

@@ -281,6 +281,26 @@ has rtt_ewma_sec => (
     isa => HashRef[Num],
 );
 
+has cluster_time => (
+    is => 'rwp',
+    isa => Maybe[Document],
+    init_arg => undef,
+    default => undef,
+);
+
+sub update_cluster_time {
+    my ( $self, $cluster_time ) = @_;
+
+    # Only update the cluster time if it is more recent than the current entry
+    if ( !defined $self->cluster_time ) {
+        $self->_set_cluster_time($cluster_time);
+    }
+    elsif ( $cluster_time->{'clusterTime'} > $self->cluster_time->{'clusterTime'} ) {
+        $self->_set_cluster_time($cluster_time);
+    }
+    return;
+}
+
 #--------------------------------------------------------------------------#
 # builders
 #--------------------------------------------------------------------------#
@@ -1004,7 +1024,7 @@ sub _selection_timeout {
 my $PRIMARY = MongoDB::ReadPreference->new;
 
 sub _generate_ismaster_request {
-    my ( $self, $should_perform_handshake ) = @_;
+    my ( $self, $link, $should_perform_handshake ) = @_;
     my @opts;
     if ($should_perform_handshake) {
         push @opts, client => $self->handshake_document;
@@ -1016,6 +1036,10 @@ sub _generate_ismaster_request {
     if (@{ $self->compressors }) {
         push @opts, compression => $self->compressors;
     }
+    if ( $link->supports_clusterTime && defined $self->cluster_time ) {
+        push @opts, '$clusterTime' => $self->cluster_time;
+    }
+
     return [ ismaster => 1, @opts ];
 }
 
@@ -1026,7 +1050,7 @@ sub _update_topology_from_link {
     my $is_master = eval {
         my $op = MongoDB::Op::_Command->_new(
             db_name             => 'admin',
-            query               => $self->_generate_ismaster_request( $opts{with_handshake} ),
+            query               => $self->_generate_ismaster_request( $link, $opts{with_handshake} ),
             query_flags         => {},
             bson_codec          => $self->bson_codec,
             read_preference     => $PRIMARY,
@@ -1060,6 +1084,10 @@ sub _update_topology_from_link {
 
     return unless $is_master;
 
+    if ( my $cluster_time = $is_master->{'$clusterTime'} ) {
+        $self->update_cluster_time($cluster_time);
+    }
+
     my $end_time = time;
     my $rtt_sec = $end_time - $start_time;
 

t/sessions-driver.t

@@ -19,6 +19,7 @@ use Test::Fatal;
 use Test::Deep qw/!blessed/;
 
 use utf8;
+use List::Util 'max';
 use Tie::IxHash;
 
 use MongoDB;
@@ -83,6 +84,40 @@ subtest 'LIFO Pool' => sub {
 
 subtest 'clusterTime in commands' => sub {
 
+    clear_events();
+
+    subtest 'SDAM' => sub {
+        my $local_client = get_high_heartbeat_client();
+
+        $local_client->topology_status( refresh => 1 );
+
+        my $command = $events[0]->{command};
+        ok exists $command->{'ismaster'}, 'ismaster in sent command';
+
+        # first ismaster to unknown hosts won't have it
+        ok !exists $command->{'$clusterTime'}, 'clusterTime in sent command';
+
+        # find max time among replies
+        my $max_cluster_time = max(
+            map  { $_->{reply}{'$clusterTime'}{clusterTime} }
+            grep { $_->{type} eq 'command_succeeded' } @events
+        );
+
+        $local_client->topology_status( refresh => 1 );
+
+        my $command2 = $events[-2]->{command};
+
+        # second ismaster to known hosts will
+        ok exists $command2->{'ismaster'}, 'ismater in sent command'
+          or diag explain $command2;
+
+        my $got = $command2->{'$clusterTime'}->{clusterTime};
+        ok( $got == $max_cluster_time, "clusterTime matches" )
+          or diag "GOT:\n", explain $got, "\nEXPECTED:\n", explain $max_cluster_time;
+    };
+
+    clear_events();
+
     subtest 'ping' => sub {
         my $local_client = get_high_heartbeat_client();
 
@@ -203,9 +238,6 @@ sub get_high_heartbeat_client {
         monitoring_callback => \&event_cb,
     );
 
-    # Make sure we have clusterTime already populated
-    $local_client->send_admin_command(Tie::IxHash->new('ismaster' => 1));
-
     return $local_client;
 }