#! /bin/perl

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
# Copyright (C) 2023 Raphaël Gertz <mageia@rapsys.eu>

# Best practice
use strict;
use warnings;

# Fix use of acl
use filetest qw(access);

# Load dependancies
use File::Slurp qw(read_file);
use IO::Socket qw(AF_UNIX SOCK_STREAM);
use JSON::PP qw();
use Text::Table;
use Tie::IxHash;
use Monkey::Patch qw(patch_package);

# Debug
#use Data::Dumper;

# Load POSIX
use POSIX qw(EXIT_SUCCESS EXIT_FAILURE);

# Monkey-patch JSON::PP::object() subroutine to use Tie::IxHash.
#XXX: see https://stackoverflow.com/questions/51366750/perl-decode-and-encode-json-preserving-order
my $jsonhandler = patch_package 'JSON::PP' => 'object' => sub {
	my $orig = shift;
	my %obj;
	tie %obj, 'Tie::IxHash' or die "tie(\%obj, 'Tie::IxHash') failed!\n";
	$orig->(\%obj)
};

# Init json
my $json = JSON::PP->new->utf8->pretty->indent;

# Init index
tie(my %index, 'Tie::IxHash',
	'pxname'		=> { align_title => 'center', align => 'left' },
	'svname'		=> { align_title => 'center', align => 'left' },
	'scur'			=> { align_title => 'center', align => 'right' },
	'smax'			=> { align_title => 'center', align => 'right' },
	'slim'			=> { align_title => 'center', align => 'right' },
	'stot'			=> { align_title => 'center', align => 'right' },
	'bin'			=> { align_title => 'center', align => 'right' },
	'bout'			=> { align_title => 'center', align => 'right' },
	'status'		=> { align_title => 'center', align => 'center' },
	'rate'			=> { align_title => 'center', align => 'right' },
	'rate_max'		=> { align_title => 'center', align => 'right' },
	'check_status'	=> { align_title => 'center', align => 'center' },
	'check_code'	=> { align_title => 'center', align => 'center' },
	'cli_abrt'		=> { align_title => 'center', align => 'center' },
	'lastsess'		=> { align_title => 'center', align => 'center' }
);

# Init index
my $index = '/etc/haproxy/status.json';

# Init socket
my $socket = '/run/haproxy/haproxy.sock';

# Init dump
my $dump = 0;

# Strip and enable dump, index and socket
for (my $i = 0; $i <= $#ARGV; $i++) {
	# Match dump
	if ($ARGV[$i] eq '-d' || $ARGV[$i] eq '--dump') {
		$dump = 1;
		splice(@ARGV, $i, 1);
		$i--;
	# Match index
	} elsif (($ARGV[$i] eq '-i' || $ARGV[$i] eq '--index') && defined($ARGV[$i+1]) && -f $ARGV[$i+1]) {
		$index = $ARGV[$i+1];
		splice(@ARGV, $i, 2);
		$i--;
	# Match index
	} elsif ($ARGV[$i] =~ /^-(?:i|-index)=(.*)$/ && -f $1) {
		$index = $1;
		splice(@ARGV, $i, 1);
		$i--;
	# Match socket
	} elsif (($ARGV[$i] eq '-s' || $ARGV[$i] eq '--socket') && defined($ARGV[$i+1]) && -S $ARGV[$i+1]) {
		$socket = $ARGV[$i+1];
		splice(@ARGV, $i, 2);
		$i--;
	# Match socket
	} elsif ($ARGV[$i] =~ /^-(?:s|-socket)=(.*)$/ && -S $1) {
		$socket = $1;
		splice(@ARGV, $i, 1);
		$i--;
	}
}

# With extra arguments
if ($#ARGV ne -1) {
	print 'Usage: '.$0.' [-d] [-s|--socket /run/haproxy/haproxy.sock] [-i|--index /etc/haproxy/index.json]'."\n";
	exit EXIT_FAILURE;
}

# Load status index
if (-f $index) {
	# Local content
	my $content;
	#XXX: use eval to workaround a fatal in from_json
	if (! defined eval {
		# Read it
		($content = read_file($index)) &&
		# Read and decode it
		(%index = %{$json->decode($content)})
	}) {
	   die "Read status index '$index' failed: $!\n";
	}
}

# With dump
if ($dump) {
	# Dump index
	print $json->encode(\%index);
	# Exit with success
	exit EXIT_SUCCESS;
}

# Open socket
my $sock = IO::Socket->new(
	Domain => IO::Socket::AF_UNIX,
	Type => SOCK_STREAM,
	Peer => $socket,
	Blocking => 1
) or die "Socket creation failed: $!\n";

# Send show stat no-maint
#TODO: set the command as configurable ?
print $sock "show stat no-maint\n" or die "Socket write failed: $!";

# Get data
my @data = map { chomp; if (scalar $_) { my @local = split(','); \@local; } else { (); } } <$sock>;

# Get headers
my @headers = @{shift(@data)};

# Fix first header
$headers[0] =~ s/^# //;

# Init reverse map
tie(my %reverse, 'Tie::IxHash', map { if (defined($index{$headers[$_]})) { { $headers[$_] => $_ }; } else { (); } } keys @headers);

# Init keys
my @keys = values %reverse;

# Extract data by index
@data = map { my @local = @{$_}[@keys]; \@local; } @data;

# Extract headers by index
@headers = map { { title => $_, align => $index{$_}{align}, align_title => $index{$_}{align_title} }; } @headers[@keys];

# Set table
my $table = Text::Table->new(@headers);

# Load data
$table->load(@data);

# Print table
print $table;

# Exit with success
exit EXIT_SUCCESS;
