more on ha.pl

3 files changed, 122 insertions, 28 deletions

diff --git a/openbsd/frontends/Rexfile b/openbsd/frontends/Rexfile
index 8f95339..870c34b 100644
--- a/openbsd/frontends/Rexfile
+++ b/openbsd/frontends/Rexfile
@@ -7,7 +7,6 @@ group dnsslaves => 'twofish.buetow.org';
 
 user 'rex';
 sudo TRUE;
-sudo_password read_file "$ENV{'HOME'}/.ssh/rex_password";
 
 parallelism 5;
 
@@ -31,20 +30,28 @@ desc 'Setup inetd';
 task 'inetd', group => 'frontends',
   sub {
     file '/etc/inetd.conf',
-      source => "./etc/inetd.conf",
+      source => './etc/inetd.conf',
       on_change => sub {
         service 'inetd' => 'restart';
       };
+    service 'inetd', ensure => 'started';
   };
 
-desc 'Setup failover';
-task 'failover', group => 'frontends',
+desc 'Setup HA';
+task 'ha', group => 'frontends',
   sub {
     file '/usr/local/bin/ha.pl',
-      source => "./usr/local/bin/ha.pl",
+      source => './usr/local/bin/ha.pl',
       owner => 'root',
       group => 'wheel',
       mode => '755';
+
+    file '/var/run/ha.status',
+      content => '# Initial HA status file',
+      owner => 'www',
+      group => 'wheel',
+      mode => '644',
+      no_overwrite => TRUE;
   };
 
 1;
diff --git a/openbsd/frontends/etc/inetd.conf b/openbsd/frontends/etc/inetd.conf
index 5f88aa3..7176af4 100644
--- a/openbsd/frontends/etc/inetd.conf
+++ b/openbsd/frontends/etc/inetd.conf
@@ -1,2 +1,2 @@
 127.0.0.1:11965 stream tcp nowait www /usr/local/bin/vger vger -v
-*:4242 stream tcp nowait www /usr/local/bin/ha.pl ha.pl --inetd
+*:4242 stream tcp nowait www /bin/cat cat /var/run/ha.status
diff --git a/openbsd/frontends/usr/local/bin/ha.pl b/openbsd/frontends/usr/local/bin/ha.pl
index d227a86..6214871 100644
--- a/openbsd/frontends/usr/local/bin/ha.pl
+++ b/openbsd/frontends/usr/local/bin/ha.pl
@@ -3,41 +3,128 @@
 use strict;
 use warnings;
 
+use HTTP::Tiny;
+use IO::Socket::INET;
 use Sys::Hostname;
-use Getopt::Long;
+use JSON::PP;
+use File::Copy;
+use Data::Dumper;
 
-use constant STATUS_FILE => '/var/run/failover.status';
-use constant PARTNERS => qw(blowfish.buetow.org twofish.buetow.org);
+use constant STATUS_FILE => '/var/run/ha.status';
+use constant TMP_STATUS_FILE => '/tmp/ha.status';
+use constant PARTICIPANTS => qw(blowfish.buetow.org twofish.buetow.org);
+use constant HA_STATUS_PORT => 4242;
+use constant MAX_STATUS_AGE => 60;
 
-sub slurp {
-  my $file_path = shift;
-  open my $fd, $file_path or die $!;
-  my $data = <$fd>;
+sub update_ha_status {
+  my @status = @_;
+  my $json = JSON::PP->new->ascii;
+
+  open my $fd, '>', TMP_STATUS_FILE or die $!;
+  print $fd $json->encode($_), "\n" for @status;
   close $fd;
-  return $data;
+
+  copy TMP_STATUS_FILE, STATUS_FILE or die $!;
+  unlink TMP_STATUS_FILE;
+}
+
+sub fetch_remote_ha_status {
+  my $peer = shift;
+  my $socket = new IO::Socket::INET (
+      PeerHost => $peer,
+      PeerPort => HA_STATUS_PORT,
+      Proto => 'tcp',
+  );
+  return undef unless $socket;
+
+  my $response = '';
+  $socket->recv($response, 4096);
+  $socket->close();
+  return split /\n/, $response;
 }
 
-sub score {
-  for (PARTNERS) {
-    next if $_ eq hostname; # Ignore self
-    print "Trying $_\n";
+sub check_http_status {
+  my $peer = shift;
+  my $response = HTTP::Tiny->new( max_redirect => 0)->get('http://' . $peer);
+  my $valid_response = $response->{'status'} >= 200 && $response->{'status'} < 400;
+
+  return {
+    endpoint => 'http://' . $peer,
+    peer => $peer,
+    checked_from => hostname,
+    status => $valid_response ? 'OK' : 'ERROR',
+    message => $valid_response ? 'All fine' : 'Got unexpeced response',
+    epoch => time,
   }
 }
 
-sub inetd_response {
-  my $hostname = hostname;
-  print "OK: All is fine on $hostname itself!\n";
-  print slurp STATUS_FILE if -f STATUS_FILE;
+sub check_gemini_status {
+  my $peer = shift;
+  my $socket = new IO::Socket::INET (
+    PeerHost => $peer,
+    PeerPort => 1965,
+    Proto => 'tcp',
+  );
+
+  my $status = {
+    endpoint => 'gemini://' . $peer,
+    peer => $peer,
+    checked_from => hostname,
+    status => $socket ? 'OK' : 'ERROR',
+    message => $socket ? 'All fine' : $!,
+    epoch => time,
+  };
+
+  $socket->close() if $socket;
+  return $status;
+}
+
+sub check_status {
+  my $peer = shift;
+  my @service_status;
+
+  push @service_status, check_http_status $peer;
+  push @service_status, check_gemini_status $peer;
+
+  update_ha_status @service_status;
+  return @service_status;
+}
+
+sub scores {
+  my %scores;
+  for my $status (@_) {
+    next if time - $status->{epoch} > MAX_STATUS_AGE;
+    if ($status->{status} eq 'OK') {
+      $scores{$status->{peer}}++;
+    } else {
+      $scores{$status->{peer}} |= 0;
+    }
+  }
+
+  return
+    map { [$_, $scores{$_}] }
+    sort { $scores{$b} <=> $scores{$a} }
+    keys %scores;
 }
 
 sub main {
-  my ($inetd, $score) = (0, 0);
-  GetOptions('inetd' => \$inetd,
-             'score' => \$score)
-    or die "Error in command line arguments!\n";
+  my $json = JSON::PP->new->ascii;
+  my $hostname = hostname;
+  my @all;
+
+  for my $partner (grep { $_ ne $hostname } PARTICIPANTS) {
+    for (check_status $partner) {
+      print $json->encode($_), "\n";
+      push @all, $_;
+    }
+    for (fetch_remote_ha_status $partner) {
+      next if not defined or /^\s*#/;
+      print "$_\n";
+      push @all, $json->decode($_);
+    }
+  }
 
-  score if $score;
-  inetd_response if $inetd;
+  print Dumper scores @all;
 }
 
 main;