#!/usr/bin/perl
# -*- cperl -*-

use strict;
use warnings;
no warnings 'uninitialized';
use English;

use Storable qw(thaw);

use Data::Dumper;
use IO::Socket::UNIX;

use Getopt::Long;
use Pod::Usage;

use constant CVS_ID   => '$Id: lvs-kiss-control,v 1.7 2003/01/26 23:52:54 perbu Exp $';
use constant DEFAULT_TIMEOUT => 30;



our ($SOCKET, $HELP, $TIMEOUT, $VERBOSE);
our $RETURN_VALUE;

my %RESPONSE_HANDLERS = (
                         status    => \&handle_status,
                         qs        => \&handle_qs,
                         weights   => \&handle_weights,
                         config    => \&handle_config,

                         enable    => \&handle_generic,
                         disable   => \&handle_generic,
                         reload    => \&handle_generic,
                         shutdown  => \&handle_generic,
                         ping      => \&handle_generic,
                         debug     => \&handle_generic,
                         interval  => \&handle_generic,
                         rinterval => \&handle_generic,
                        );

my %STATUS = (
              0  => "",
              1  => "Error, gnkka\n",
              17 => "Ugg! \n",
             );

$SOCKET = "/var/run/lvs-kiss.sock";
$TIMEOUT = 30;


GetOptions ("socket=s"   => \$SOCKET,    # numeric
            "verbose"    => \$VERBOSE,
            "help"       => \$HELP,
            "timeout=i"  => \$TIMEOUT,

           ) 
  or   pod2usage(   -msg     => "$!    Type $0 --help for help",
                    -exitval => 1, 
                    -verbose => 0,
                    -output  => \*STDERR );

if ((scalar @ARGV == 0) or $HELP)  {
  
  pod2usage(   -msg     => '',
               -exitval => 0, 
               -verbose => 1,
               -output  => \*STDOUT );

}

$SIG{ALRM} = \&hara_kiri;
alarm($TIMEOUT) if ($TIMEOUT);


my ($cmd, @opts) = @ARGV;

if ( defined $RESPONSE_HANDLERS{$cmd} ) {
  $RETURN_VALUE = 
    &{ $RESPONSE_HANDLERS{$cmd} }( thaw( issue_command($cmd, @opts) ) ) ;
} else {
  pod2usage(   -msg     => 
               "Unknown command '$ARGV[0]'    Type $0 --help for help",
               -exitval => 1, 
               -verbose => 0,
               -output  => \*STDERR );
}

exit( $RETURN_VALUE );


sub hara_kiri {
  STDERR->print("Timeout\n");
  exit(3);
}


sub issue_command {

  my $socket = 
    new IO::Socket::UNIX( $SOCKET )
      or die("open socket($SOCKET): $!\n");
    
  $socket->print( join(' ', @_ , "\n" ) );

  my $r;

  {
    local $RS = undef;
    $r = <$socket>;
  }
  $socket->close();
  
  return($r);
}



sub print_indented {
  my ($level, @text) = @_;
  
  for (@text) {
    print(" " x $level, $_, "\n" );
  }

}


sub handle_status {
  my ($r, $hash) = @_;

  my %STATES = 
    %{ thaw( issue_command("states") ) }; # fetch textual representation.

  if ( @opts == 0) {

    for my $vip (keys %$r) {
      print_indented(2, $vip);
      for my $rip (keys %{ $r->{$vip} } ) {
        print_indented(4, 
                       sprintf("%-30s %8s",
                       $rip , $STATES{$r->{$vip}->{$rip} } ) );
      }
    }

  } elsif ( @opts == 1) {

      for my $rip (keys %$r ) {
        print_indented(2, 
                       sprintf("%-30s %8s",
                       $rip , $STATES{$r->{$rip} } ) );
      }

  } elsif ( @opts == 2) {
    print $STATES{ ${ $r } }, "\n";

  }


}


sub handle_qs {
  my ($r) = @_;


  if ( @opts == 0) {

    for my $vip (keys %$r) {
      print_indented(2, $vip);
      for my $rip (keys %{ $r->{$vip} } ) {
        my $s = 0;        
        print_indented(4, 
                       sprintf("%-30s %-40s  => %10.1f",
                               $rip , join(' ', map { $s += $_;sprintf('%8.1f', $_ ) } 
                                   @{ $r->{$vip}->{$rip} } ), $s ) );
      }
    }

  } elsif ( @opts == 1) {

      for my $rip (keys %$r ) {
        print_indented(2, 
                       sprintf("%-30s %-40s",
                       $rip , join(' ', map { sprintf('%10.2f', $_ ) } 
                                   @{ $r->{$rip} } ) ) );
      }

  } elsif ( @opts == 2) {
    print ${ $r } , "\n";

  }

}


sub handle_weights {
  my ($r) = @_;


  if ( @opts == 0) {

    for my $vip (keys %$r) {
      print_indented(2, $vip);
      for my $rip (keys %{ $r->{$vip} } ) {
        print_indented(4, 
                       sprintf("%-30s %6.0f",
                       $rip , $r->{$vip}->{$rip} ) );
      }
    }

  } elsif ( @opts == 1) {

      for my $rip (keys %$r ) {
        print_indented(2, 
                       sprintf("%-30s %6.0f",
                       $rip , $r->{$rip} ) );
      }

    } elsif ( @opts == 2) {
      
      print(int ${ $r }, "\n" );

  } else {

    die("Syntax error\n");
  }

}

sub handle_config {
  my ($response) = @_;
  
  print ${ $response };

}


sub handle_generic {
  my ($response) = @_;

  STDERR->print( $STATUS{ ${ $response } } );
  print "OK\n"
    if ($VERBOSE && $response == 0);

  return( ${ $response }  );
  
}




__END__

=head1 NAME

lvs-kiss-control - Control the lvs-kiss daemon.

=head1 SYNOPSIS

lvs-kiss-control [--options] <command>

=head1 DESCRIPTION

Unless the lvs-kiss daemon is started with the --nosocket option the
daemon opens a socket on which there can be given commands. The lvs-kiss
daemon can reload its configuration, shutdown, temporary disable and
enable realservers, inspect status and such.


=head1 OPTIONS

=over 5

=item B<--socket <socket>>

Specify alternate socket - default is /var/run/lvs-kiss.sock.

=item B<--timeout> <timeout>

Specify timeout (in seconds). Default is 30 seconds.

=item B<--verbose> 

Be a bit verbose. 

=item B<--help>

Displays help.

=back

=head2 COMMANDS

=over 5

=item B<status>

Show status of all the virtualservers and the realservers. A
virtualserver can be given as an option and the only this virtualserver
will be shown. If a realserver is also given - only the status of this
perticular realserver is shown.

=item B<qs>

This command shows the internal load-queues of lvs-kiss. As with
B<status> a virtualserver or a virtualserver and a realserver might be
given also to get a bit less information.


=item B<weights>

Shows what weights the different servers are given. Might be narrowed
down as B<status>.

=item B<reload>

Issues a reload command to lvs-kiss in order to make lvs-kiss reload its
configuration. 

=item B<shutdown>

Issue a shutdown command. 

=item B<disable> <Virtualserver> <Realserver> 

Temporarily disables a realserver. 

=item B<enable>

Enables or re-enables a realserver. Internally, this is done by marking
the realserver as DEAD and the let lvs-kiss itself discover that the
server is alive again. So, if you are taking a server down for
maintainance you can disable it - disconnect the server and re-enable it
in lvs-kiss. The server won't be used until it is declared healty by
lvs-kiss itself.

=item B<ping>

Check if lvs-kiss is alive. Can be used by the init-script in order to
verify that lvs-kiss has started up.

=item B<debug> <value>

"debug 1" turns on debugging. This makes lvs-kiss syslog quite a lot of
information. "debug 0" turns it off again.

=item B<interval> <interval>

Instructs lvs-kiss to set the interval between checks to <interval>
seconds.

=item B<rinterval> <rebalancing interval>

Instructs lvs-kiss to set the default rebalancing/check ratio. The
default is to rebalance the realservers at every check - this also
implies checking of load - if these are heavy, but the alive/dead-checks
are not you might want to set rinterval to something higher the 1. Then
lvs-kiss will rebalance the realservers at every N check. Please see the
lvs-kiss manual page for more information.

=item B<config>

Shows the running configuration - be aware that this representation
might be somewhat different from what you are used to - and all comments
are stripped off.

=back

=head1 VERSION

This is lvs-kiss-control, a part of lvs-kiss 1.2

=head1 AUTHOR

Per Andreas Buer <perbu (at) linpro.no>

=head1 BUGS

Please report other bugs to the author.

=head1 COPYRIGHT

Copyright  2002 Per Andreas Buer / Linpro AS.

This is free software; see the source for copying conditions. There is
NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE.


=head1 SEE ALSO

lvs-kiss (8), lvs-kiss.conf (5), Config::General (3),
Config::General::Interpolate (3), ipsvadm (8),

=cut

