#!/usr/bin/perl

use strict;
use warnings;
use open qw(:std :encoding(UTF-8));

use Storable qw(dclone);
use List::Util qw(any none first);
use Getopt::Long qw(:config posix_default no_ignorecase auto_help auto_version);
use Pod::Usage;
use YAML::XS qw();
use Kwalify;

our $VERSION = 'UNRELEASED';

my $network_file = '/etc/ngcp-config/network.yml';

GetOptions(
    'n|network-file=s' => \$network_file,
) or pod2usage(1);

my $yaml = YAML::XS::LoadFile($network_file)
    or die "cannot parse file $network_file";

sub dup_check
{
    my ($dupe, $text) = @_;
    my $errors = 0;

    foreach my $id (sort keys %{$dupe}) {
        next if scalar @{$dupe->{$id}} <= 1;

        warn "  - $text $id (@{$dupe->{$id}})\n";
        $errors++;
    }

    return $errors;
}

# Only run these checks, if we have any of instances defined.
if (exists $yaml->{instances}) {
    my $errors = 0;

    my %dupe_instance_name;
    my %dupe_conn;

    my @instance_names = map { $_->{name} } @{$yaml->{instances}};
    my @host_names = sort keys %{$yaml->{hosts}};

    my $i = 0;

    # Cycle through all existing instances definitions to find mistakes in
    # connections.
    foreach my $instance (@{$yaml->{instances}}) {
        my $instance_host = $instance->{host};
        my $j = 0;

        # Just in case, catch name duplicates used for general instances names.
        push @{$dupe_instance_name{$instance->{name}}}, "instance number: $i";

        # Iterate through the list of connections.
        foreach my $conn (@{$instance->{connections}}) {
            # Catch connections names duplicates of each given instance.
            my $conn_id = '#' . $i . ' : ' . $instance->{name} . ': ' . $conn->{name};
            push @{$dupe_conn{$conn_id}}, "con #$j: $conn->{name} ;";

            # Iterate through the list of connection links.
            foreach my $conn_link (@{$conn->{links}}) {
                my $conn_link_name = $conn_link->{name};
                my $remote;

                # Check that each connection of type instance/host indeed
                # exists.
                if ($conn_link->{type} eq 'instance') {
                    if (none { $_ eq $conn_link_name } @instance_names) {
                        warn "  - [instances/$instance->{name}/$conn->{name}/$conn_link_name] Missing required instance for connection link\n";
                        $errors ++;
                    }
                    $remote = first { $_->{name} eq $conn_link_name } @{$yaml->{instances}};
                } elsif ($conn_link->{type} eq 'host') {
                    if (none { $_ eq $conn_link_name } @host_names) {
                        warn "  - [instances/$instance->{name}/$conn->{name}/$conn_link_name] Missing required host for connection link\n";
                        $errors ++;
                    }
                    $remote = $yaml->{hosts}->{$conn_link_name};
                }

                # Iterate through the list of link interfaces.
                foreach my $link_iface (@{$conn_link->{interfaces}}) {
                    my $link_iface_name = $link_iface->{name};
                    my $link_iface_type = $link_iface->{type};

                    # Requested link must indeed have requested interface,
                    # otherwise not possible to interconnect.
                    if ($conn_link->{type} eq 'instance' ?
                       none { $_->{name} eq $link_iface_name } @{$remote->{interfaces}} :
                       none { $_ eq $link_iface_name } @{$remote->{interfaces}})
                    {
                        warn "  - [instances/$instance->{name}/$conn->{name}/$conn_link_name/$link_iface_name] Missing required link interface\n";
                        $errors ++;
                    }

                    # Check type interface
                    my $iface;
                    if ($conn_link->{type} eq 'instance') {
                        $iface = first { $_->{name} eq $link_iface_name } @{$remote->{interfaces}};
                    } else {
                        $iface = $remote->{$link_iface_name};
                    }
                    if (none { $_ eq $link_iface_type } @{$iface->{type}}) {
                        warn "  - [instances/$instance->{name}/$conn->{name}/$conn_link_name/$link_iface_name] Missing type $link_iface_type on link interface\n";
                        $errors ++;
                    }
                }
            }

            $j++;
        }

        # Just in case, check also that a host, on which we must run this
        # instance, exists.
        if (none { $_ eq $instance_host } @host_names) {
            warn "  - [instances/$instance->{name}] Missing required host $instance_host\n";
            $errors ++;
        }

        $i++;
    }

    # Check duplicates and raise an error if found.
    $errors += dup_check(\%dupe_instance_name, '[/instances/<name>] Duplicate instance name with an existing instance');
    $errors += dup_check(\%dupe_conn, '[/instances/<name>] Duplicate connetion name');

    exit 1 if $errors;
}

1;

# vim: ts=4 sw=4 et

__END__

=encoding utf-8

=head1 NAME

ngcp-instances-validator - dynamically validates the instances connections, if instances are defined.

=head1 SYNOPSIS

B<ngcp-instances-validator> [I<option>...]

=head1 DESCRIPTION

B<This program> iterates through currently existing instances
defined in the network.yml with an intention of checking their
connections to other instances/hosts.

=head1 OPTIONS

=over 8

=item B<-n>, B<--network-file> I<yaml-file>

The B<network.yml> file to validate.

=item B<--help>

Print a help message.

=back

=head1 EXIT STATUS

=over 8

=item B<0>

The connections are getting validated correctly.

=item B<1>

The connections are getting validated incorrectly.

=back

=head1 AUTHOR

Donat Zenichev <dzenichev@sipwise.com>

=head1 LICENSE

Copyright © 2022 Sipwise GmbH, Austria

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/>.
