Import Lemonldap-NG Patroni backend changes

.github/workflows/ci.yml

@@ -14,7 +14,7 @@ jobs:
     steps:
       - uses: actions/checkout@v4
       - name: Install Perl dependencies
-        run: sudo apt install libmodule-build-perl libapache-session-perl libjson-perl libdbi-perl libdbd-sqlite3-perl libnet-ldap-perl libredis-perl libdbd-mysql-perl
+        run: sudo apt install libmodule-build-perl libapache-session-perl libjson-perl libdbi-perl libdbd-sqlite3-perl libnet-ldap-perl libredis-perl libdbd-mysql-perl liblwp-protocol-psgi-perl
       - name: Build and run tests
         run: |
           perl Build.PL

Build.PL

@@ -13,7 +13,11 @@ Module::Build->new(
         'DBD::Cassandra' => 0,
         'Redis::Fast'    => 0,
     },
-    test_requires      => { DBI => 0, 'DBD::SQLite' => 0, },
+    test_requires => {
+        DBI                   => 0,
+        'DBD::SQLite'         => 0,
+        'LWP::Protocol::PSGI' => 0,
+    },
     dist_version       => '1.3.18',
     autosplit          => [qw(lib/Apache/Session/Browseable/_common.pm)],
     configure_requires => { 'Module::Build' => 0, },

lib/Apache/Session/Browseable/Patroni.pm

@@ -48,30 +48,59 @@ Optionally, add indexes on some fields. Example for Lemonldap::NG:
 
 Use it with Perl:
 
-  use Apache::Session::Browseable::Postgres;
+  use Apache::Session::Browseable::Patroni;
 
   my $args = {
-       DataSource => 'dbi:Pg:sessions',
+       DataSource => 'dbi:Pg:dbname=sessions',
        UserName   => $db_user,
        Password   => $db_pass,
        Commit     => 1,
 
-       # List all Patroni API available (to avoid any haproxy and/or floating IP)
-       PatroniUrl => 'http://1.2.3.4:8008/cluster http://2.3.4.5:8008/cluster',
+       # List Patroni API endpoints (comma or space separated)
+       # Put preferred (local) endpoints first
+       PatroniUrl => 'http://1.2.3.4:8008/cluster, http://2.3.4.5:8008/cluster',
+
+       # Optional parameters with defaults:
+       # PatroniTimeout             => 3,   # API request timeout in seconds
+       # PatroniCacheTTL            => 60,  # Leader cache TTL in seconds
+       # PatroniCircuitBreakerDelay => 30,  # Delay before retrying failed API
   };
 
-  # Use it like L<Apache::Session::Browseable::Postgres>
+  # Use it like L<Apache::Session::Browseable::PgJSON>
 
 =head1 DESCRIPTION
 
 Apache::Session::Browseable provides some class methods to manipulate all
 sessions and add the capability to index some fields to make research faster.
 
-Apache::Session::Browseable::Patroni implements it for PosqtgreSQL databases
+Apache::Session::Browseable::Patroni implements it for PostgreSQL databases
 using "json" or "jsonb" type to be able to browse sessions and is able to dial
 directly with Patroni API to find the master node of PostgreSQL cluster in
 case of error.
 
+=head2 Resilience features
+
+=over 4
+
+=item * B<Circuit breaker>: Avoids hammering the Patroni API when it's failing.
+After a failure, the API won't be queried again for C<PatroniCircuitBreakerDelay>
+seconds (default: 30).
+
+=item * B<Leader caching>: The discovered leader is cached for
+C<PatroniCacheTTL> seconds (default: 60). This cache is used as fallback when
+the API is unavailable.
+
+=item * B<Split-brain detection>: Refuses to use a cluster that reports
+multiple leaders.
+
+=item * B<Leader health check>: Verifies that the leader is in "running" state
+before using it.
+
+=item * B<Multi-source support>: Each DataSource maintains its own independent
+cache, allowing multiple Patroni clusters to be used simultaneously.
+
+=back
+
 =head1 SEE ALSO
 
 L<http://lemonldap-ng.org>, L<Apache::Session::Postgres>

lib/Apache/Session/Browseable/Store/Patroni.pm

@@ -8,7 +8,12 @@ use Apache::Session::Store::Postgres;
 our @ISA     = qw(Apache::Session::Store::Postgres);
 our $VERSION = '1.3.17';
 
-our %knownMappings;
+# Cache structure per DataSource:
+# {
+#   leader => { host => '...', port => '...', time => ... },
+#   lastFailure => timestamp,
+# }
+our %patroniCache;
 
 sub connection {
     my $self    = shift;
@@ -25,11 +30,21 @@ sub connection {
         return;
     }
 
-    # Use last known Patroni response if available
-    $session->{args}->{DataSource} =
-      $knownMappings{ $session->{args}->{DataSource} }
-      if $session->{args}->{DataSource}
-      and $knownMappings{ $session->{args}->{DataSource} };
+    # Store original DataSource as cache key
+    my $originalDataSource = $session->{args}->{DataSource};
+    $self->{_originalDataSource} = $originalDataSource;
+
+    # Use cached leader if available and not expired
+    my $cache    = $patroniCache{$originalDataSource}  || {};
+    my $cacheTTL = $session->{args}->{PatroniCacheTTL} || 60;
+
+    if (    $cache->{leader}
+        and $cache->{leader}->{time}
+        and ( time() - $cache->{leader}->{time} ) < $cacheTTL )
+    {
+        $session->{args}->{DataSource} =
+          _buildDataSource( $originalDataSource, $cache->{leader} );
+    }
 
     foreach ( 0 .. 1 ) {
         (
@@ -105,6 +120,21 @@ sub remove {
 sub checkMaster {
     my ( $self, $args ) = @_;
     delete $self->{failure};
+
+    my $originalDataSource =
+      $self->{_originalDataSource} || $args->{DataSource};
+    my $cache = $patroniCache{$originalDataSource} ||= {};
+
+    # Circuit breaker: avoid hammering Patroni API if it's failing
+    my $circuitBreakerDelay = $args->{PatroniCircuitBreakerDelay} || 30;
+    if ( $cache->{lastFailure}
+        and ( time() - $cache->{lastFailure} ) < $circuitBreakerDelay )
+    {
+        # Circuit breaker active, try cached leader as fallback
+        return $self->_useCachedLeader( $args, $originalDataSource,
+            "Circuit breaker active" );
+    }
+
     require JSON;
     require LWP::UserAgent;
     require IO::Socket::SSL;
@@ -114,7 +144,7 @@ sub checkMaster {
             verify_hostname => 0,
             SSL_verify_mode => &IO::Socket::SSL::SSL_VERIFY_NONE,
         },
-        timeout => 3,
+        timeout => $args->{PatroniTimeout} || 3,
     );
     my $res;
 
@@ -125,27 +155,110 @@ sub checkMaster {
         if ( $resp->is_success ) {
             my $c = eval { JSON::from_json( $resp->decoded_content ) };
             if ( $@ or !$c->{members} or ref( $c->{members} ) ne 'ARRAY' ) {
-                print STDERR "Bad response from $patroniUrl\n"
-                  . $resp->decoded_content;
+                print STDERR "Bad response from $patroniUrl: "
+                  . $resp->decoded_content . "\n";
                 next;
             }
-            my ($leader) = grep { $_->{role} eq 'leader' } @{ $c->{members} };
+
+            my @leaders = grep { $_->{role} eq 'leader' } @{ $c->{members} };
+
+            # Check for split-brain scenario
+            if ( @leaders > 1 ) {
+                my $leadersList =
+                  join( ', ', map { "$_->{host}:$_->{port}" } @leaders );
+                print STDERR
+                  "Multiple leaders detected (split-brain) from $patroniUrl"
+                  . " - Leaders: $leadersList\n";
+                next;
+            }
+
+            my ($leader) = @leaders;
             unless ($leader) {
-                print STDERR "No leader found from $patroniUrl\n"
-                  . $resp->decoded_content;
+                print STDERR "No leader found from $patroniUrl: "
+                  . $resp->decoded_content . "\n";
+                next;
+            }
+
+            # Validate leader has required fields
+            unless ( $leader->{host} && $leader->{port} ) {
+                print STDERR "Leader missing host or port from $patroniUrl: "
+                  . $resp->decoded_content . "\n";
+                next;
+            }
+
+            # Check leader health state
+            if ( $leader->{state} && $leader->{state} ne 'running' ) {
+                print STDERR
+                  "Leader not in running state (state=$leader->{state})"
+                  . " from $patroniUrl\n";
                 next;
             }
-            my $old = $args->{DataSource};
-            $args->{DataSource} =~ s/(?:port|host)=[^;]+;*//g;
-            $args->{DataSource} =~ s/;$//;
-            $args->{DataSource} .= ( $args->{DataSource} =~ /:$/ ? '' : ';' )
-              . "host=$leader->{host};port=$leader->{port}";
-            $knownMappings{$old} = $args->{DataSource};
+
+            # Cache the leader info
+            $cache->{leader} = {
+                host => $leader->{host},
+                port => $leader->{port},
+                time => time()
+            };
+
+            # Reset circuit breaker on success
+            delete $cache->{lastFailure};
+
+            $args->{DataSource} =
+              _buildDataSource( $originalDataSource, $leader );
             $res = 1;
             last;
         }
     }
+
+    # If API failed, record for circuit breaker and try cached leader
+    unless ($res) {
+        $cache->{lastFailure} = time();
+        $res = $self->_useCachedLeader( $args, $originalDataSource,
+            "Patroni API unavailable" );
+    }
+
     return $res;
 }
 
+# Use cached leader as fallback
+sub _useCachedLeader {
+    my ( $self, $args, $originalDataSource, $reason ) = @_;
+
+    my $cache    = $patroniCache{$originalDataSource} || {};
+    my $cacheTTL = $args->{PatroniCacheTTL}           || 60;
+
+    if (    $cache->{leader}
+        and $cache->{leader}->{time}
+        and ( time() - $cache->{leader}->{time} ) < $cacheTTL )
+    {
+        my $age = time() - $cache->{leader}->{time};
+        print STDERR "$reason, using cached leader (${age}s old)\n";
+        $args->{DataSource} =
+          _buildDataSource( $originalDataSource, $cache->{leader} );
+        return 1;
+    }
+    return 0;
+}
+
+# Build DataSource string with new host/port
+sub _buildDataSource {
+    my ( $originalDataSource, $leader ) = @_;
+
+    my $chain = $originalDataSource;
+
+    # Remove existing host/port parameters
+    $chain =~ s/;\s*host=[^;]+//gi;
+    $chain =~ s/;\s*port=[^;]+//gi;
+    $chain =~ s/\s+host=[^\s;]+//gi;
+    $chain =~ s/\s+port=[^\s;]+//gi;
+
+    # Clean up trailing semicolons
+    $chain =~ s/;+$//;
+
+    # Add new host and port
+    my $separator = ( $chain =~ /:$/ ) ? '' : ';';
+    return "${chain}${separator}host=$leader->{host};port=$leader->{port}";
+}
+
 1;