#!/usr/bin/perl -w
# $Id: master.pl 27576 2012-12-18 17:36:43Z teetov $
# ------------------------------------------------------------------------------
#  Author: Alex Teetov
#  QA by:  Christopher C Gettings
#  Copyright: videoNEXT Network Solutions LLC
# ------------------------------------------------------------------------------
#  API call for node registration and handshake
#
#  Direct usage:
#       master action=handshake uni=<22longId>
#       master action=register  uni=<22longId>
#       master action=keepalive uni=<22longId>
#
#  Registry for nodes:
#       $APL/var/conf/master/nodes
#
#  The call return XML document
#  TBD: analyze script behavior in IPv6 env
#  TBD: dynamic RTSP_PORT (inititally constant value)
# ------------------------------------------------------------------------------

use strict;
use XML::Simple;
use JSON;
use Data::Dumper;
use File::Basename qw(dirname);
use NextCAM::Conf "GetDefaultCfg";
use Master::Conf;
use SKM::DB "DBLocal";

my $APL=$ENV{APL} || '/opt/sarch';
my $APL_USR=$ENV{APL_USR}||'apl';
my $RTSP_BASE=8554;
my $RTSP_STEP=5;

sub master {
# ------------------------------------------ arguments from command line or ssh
  my %args=map{(uc($1),$2) if /(\S+)=(.*)/} @ARGV;
  if(   defined $ENV{SSH_TTY}       ){ $args{call} ='localhost'}# local testing.
  elsif(defined $ENV{SSH_CONNECTION}){($args{call})=$ENV{SSH_CONNECTION}=~/^(\S+)/;  }# TBD: check
  else                               { $args{call} ='localhost'}
  if($args{call} eq 'localhost') {
        open(MASTER,"$APL/var/conf/master/s_master") || die "cannot read $APL/var/conf/master/s_master";
        $_=<MASTER>; chomp;
        close MASTER;
        $args{ip}=$_;                         # read IPv4 for master TDB: should work with localhost in future 
  }else {
         $args{ip}=$args{call};
  }
  my $result;
  if(not $args{UNI} ){ 
      $result={'STATUS','ERROR','MESSAGE','No UNI specified'};
  }elsif(not  $args{UNI}=~/^\w{22}$/) {
      $result={'STATUS','ERROR','MESSAGE','incorrect UNI specified'};
  }else{
    if   ($args{ACTION}=~/^REGISTER$/i ) { $result=register (\%args); }
    elsif($args{ACTION}=~/^HANDSHAKE$/i) { $result=handshake(\%args); }
    elsif($args{ACTION}=~/^KEEPALIVE$/i) { $result=keepalive(\%args); }
    else {
      $result={'STATUS','ERROR','MESSAGE','No action specified'};
    }
  }
  #print Dumper($result);
  print XMLout($result,rootname => 'RESULT');
}

# ---------------------------------------------------------- write uni-----
#                      return OBJID of the node if success but 0 if error
sub write_uni {
    my %args=@_; 
    my $uni_file="$APL/var/conf/master/nodes/$args{UNI}";
    my $registered=-f $uni_file;
    my $nodeOBJ=0;
    my $new_node=0;
    my $dbm;
    eval {
	# Write to file
	open( NODE,">$uni_file") or die "Can't write UNI to file: $!"; 
	print(NODE "$_=$args{$_}\n") foreach(sort keys %args);
	close NODE; 
	# Write to DB
	# Use 'Local' DB config because master ip can be still not in pg_hba.conf
	$dbm=DBLocal({PrintError=>0,RaiseError=>1,AutoCommit=>0});
	$dbm->{FetchHashKeyName} = 'NAME_uc';
	my $uni_arr=$dbm->selectall_arrayref("SELECT obj FROM _objs WHERE name=? AND otype='D' AND subtype='N'",
	    undef,$args{UNI});
	if( @$uni_arr==1 ) {
	    $nodeOBJ=$uni_arr->[0][0];
	    $dbm->do("UPDATE _objs SET location=?,deleted=0 WHERE name=? AND otype='D' AND subtype='N'",
		undef,$args{FQDN},$args{UNI});
	    #$dbm->do("DELETE FROM _obj_attr WHERE obj=?",undef,$nodeOBJ);
	}
	elsif( ! @$uni_arr ) {
	    $dbm->do("INSERT INTO _objs (otype,subtype,name,location,rtime) VALUES ('D','N',?,?,now() at time zone 'UTC')",
		undef,$args{UNI},$args{FQDN});
	    my $seq_id = $dbm->selectall_arrayref("SELECT currval_seq_obj()");
	    $nodeOBJ = $seq_id->[0][0];
	    $new_node = 1;
	}
	else {
	    die "NODE definition is ambiguous!!!";
	}
	# For new node take attribute list and default values from template
	if ($new_node) {
	    $args{NODENAME} = $args{FQDN};
	    my $def_cfg = GetDefaultCfg('node');
	    foreach my $a (keys %$def_cfg) {
	        next if defined $args{$a};
	        $args{$a} = $def_cfg->{$a};
	    }
	}
	$args{HOST}=$args{FQDN}; # substitution!
	foreach my $attr (keys %args) {
	    #next if not $attr=~/^(IP|HOST|RTSP_PORT)$/;
	    # First try update, if fails then insert
	    my $nrows=$dbm->do("UPDATE _obj_attr SET val=? WHERE obj=? AND attr=?",
		undef,$args{$attr},$nodeOBJ,$attr);
	    next if $nrows ne '0E0';
	    $dbm->do("INSERT INTO _obj_attr (obj,attr,val) VALUES (?,?,?)",
		undef,$nodeOBJ,$attr,$args{$attr});
	}
        $dbm->commit;
        system("$APL/conf/bin/rebuild_domain_access 1>/dev/null 2>&1");
    };
    if($@) {
	$nodeOBJ=0;                              # info about error
	unlink "$uni_file" unless $registered;
	eval { $dbm->rollback };
    }
    $dbm->disconnect if $dbm;
    return $nodeOBJ;
}

#------------------------------------------ find_replacement_node
# Check if node already exists in DB with another UNI
# This can happen when backup was restored after system reinstall with 'Clean' option
sub find_replacement_node {
    my $ip=shift;
    my $dbl;
    my ($obj,$uni,$port);
    eval {
        # Use 'Local' DB config because master ip can be still not in pg_hba.conf
    	$dbl=DBLocal({PrintError=>0,RaiseError=>1,AutoCommit=>0});
    	my $ra=$dbl->selectrow_arrayref(
    	    "SELECT o.obj,o.name,a1.val FROM _objs o INNER JOIN _obj_attr a ON o.obj=a.obj 
    	    INNER JOIN _obj_attr a1 ON o.obj=a1.obj
    	    WHERE a.attr='IP' and a.val=? and o.deleted=0 and o.rtime IS null AND a1.attr='RTSP_PORT'",
    	    undef,$ip
    	);
    	($obj,$uni,$port) = @$ra if @$ra;
    };
    eval { $dbl->disconnect } if $dbl;
    return ($obj,$uni,$port);
}

# ---------------------------------------------------------- choosertsp-----
# function a little complicated since initially multiple nodes have the same port
sub chooseport {
    my $uni=shift;
    my $nlist=NodeList;
    my %registred_ports;         # all rtsp ports registerd in system
    $registred_ports{$nlist->{$_}->{RTSP_PORT}}++ foreach (keys %$nlist);
    if(exists $nlist->{$uni}) {  # node is present, try to keep the same port
      my $port=$nlist->{$uni}->{RTSP_PORT};
      return $port if $registred_ports{$port}==1;
    }
    for(my $port=$RTSP_BASE;$port<$RTSP_BASE+1000;$port+=$RTSP_STEP) {
      return $port if not exists $registred_ports{$port};
    }
    # we actually should never reach this point ..
    return 0; # this value should be never return
}
# ---------------------------------------------------------- whosthere -----
sub whosthere {   
     my $args=shift;
     my $rsp;
     if($args->{call} eq 'localhost') { 
        $rsp=`$APL/vpatch/bin/vctl info`;
        return 'ERROR:local-callback-fails' if $?;
     }else {
        $rsp=`ssh $args->{ip} '$APL/vpatch/bin/vctl info'`;
        return 'ERROR:ssh-callback-fails' if $?;
     }
     my %conf=map{/(^\w+)=(.+)/} grep {/^\w+=.+/} split(/\n/,$rsp);
     # Query node history
     my @hist;
     my @token;
     my $hist='';
     if($args->{call} eq 'localhost') { 
        @hist=`$APL/vpatch/bin/vctl history`;
        return 'ERROR:local-callback-fails' if $?;
     }else {
        @hist=`ssh $args->{ip} '$APL/vpatch/bin/vctl history'`;
        return 'ERROR:ssh-callback-fails' if $?;
     }
     foreach(@hist) {
        push (@token, {'ACTION',$1,'DATE',$2}) if /^(\S+)\s+(.*)$/
     }
     $hist=encode_json(\@token) if @token;
     return wantarray?($conf{verid},$conf{stype},$conf{maturity},$conf{host},$conf{uri},$conf{install_result},$hist):$conf{verid};
}
# ---------------------------------------------------------- register -----
sub register {     
    my $args=shift;
    my $uni=$args->{UNI};
    if(-f "$APL/var/conf/master/nodes/$uni") {# node already in system
      return {STATUS=>'ERROR',MESSAGE=>"UNI=$uni already registered"};
    }
    if(! -f "$APL/var/conf/master/s_master") {
      return {STATUS=>'ERROR',MESSAGE=>'Server is not a master. Node cannot be registered'};
    }
    my ($verid,$stype,$maturity,$host,$uri,$install_result,$hist)=whosthere($args);
    return {STATUS=>'ERROR',MESSAGE=>"Unknown node revision $verid"} if $verid=~/^ERROR/;
    return {STATUS=>'ERROR',MESSAGE=>"Not a VIRGIN slave"} if $stype ne 'master' and $maturity ne 'VIRGIN';
    my $port=chooseport($uni);
    my %nodeconf=(UNI=>$uni,FQDN=>$host,VERID=>$verid,IP=>$args->{ip},RTSP_PORT=>$port,HOST=>$host,URI=>$uri,INSTALL_RESULT=>$install_result,HISTORY=>$hist);
    my $objid=write_uni(%nodeconf);
    return {STATUS=>'ERROR',MESSAGE=>'Cannot write UNI'} if ! $objid; # Error from write_uni
    return {STATUS=>'OK',MESSAGE=>'REGISTRED',OBJID=>$objid,%nodeconf};
}
# ---------------------------------------------------------- handshake-----
sub handshake {    
    my $args=shift;
    my $uni=$args->{UNI};
    if(! -f "$APL/var/conf/master/nodes/$uni") {# node is not known
      return {STATUS=>'FAIL',MESSAGE=>'NOTREGISTRED'};
    }
    my ($verid,$stype,$maturity,$host,$uri,$install_result,$hist)=whosthere($args);
    return {STATUS=>'ERROR',MESSAGE=>"Unknown node revision $verid"} if $verid=~/^ERROR/;
    my ($old_obj,$old_uni,$old_port)=find_replacement_node($args->{ip});
    my $port;
    if ($old_obj) { # Found replacement node. Use its parameters
        $port=$old_port;
        $uni=$old_uni;
    }
    else {
        $port=chooseport($uni);
    }
    #my $objid=write_uni(UNI=>$uni,FQDN=>$host,VERID=>$verid,IP=>$args->{ip},RTSP_PORT=>$port,HOST=>$host,URI=>$uri,INSTALL_RESULT=>$install_result,HISTORY=>$hist);
    my %nodeconf=(UNI=>$uni,FQDN=>$host,VERID=>$verid,IP=>$args->{ip},RTSP_PORT=>$port,HOST=>$host,INSTALL_RESULT=>$install_result,HISTORY=>$hist);
    my $objid=write_uni(%nodeconf);
    return {STATUS=>'ERROR',MESSAGE=>'Cannot write UNI'} if !$objid; # Error from write_uni
    return {STATUS=>'OK',MESSAGE=>'UNI CHANGED',RTSP_PORT=>$port,OBJID=>$objid,SET_UNI=>$old_uni} if $old_obj;
    return {STATUS=>'OK',MESSAGE=>'CONFIRMED',OBJID=>$objid,%nodeconf};
}
# ---------------------------------------------------------- keepalive-----
sub keepalive {    
    my $args=shift;
    my $uni=$args->{UNI};
    my $cfile="$APL/var/conf/master/nodes/$uni";
    if(! -f $cfile) {# node is not known
      return {STATUS=>'FAIL',MESSAGE=>'NOTREGISTRED'};
    }
    if(!utime(time,time,$cfile)) { #change access&mod times. $cfile must belong to apache 
      # DE995 after backup restore $cfile belong to apl not apache
      # work around: create new file. remove the old
      `cp $cfile $cfile.new && rm $cfile && mv $cfile.new $cfile`;
       return {STATUS=>'ERROR',MESSAGE=>'CANNOT UPDATE TIME'} if $?;
    }
    return {STATUS=>'OK',MESSAGE=>"$cfile"};
}
# MAIN -------------------------------------------------------------------------             
master;
# END_OF_FILE
