# -*-perl-*-

# $Id$

# Sushi Miscellaneous functions

# $Log$
# Revision 1.18  2010/12/15 18:28:11  koczan
# CSDB isn't used
#
# Revision 1.17  2010/03/16 21:00:32  koczan
# Not every command has to be logged.
#
# Revision 1.16  2009/06/02 03:28:03  koczan
# added a bit to tell when sybase connections were happening
#
# Revision 1.15  2006/02/08 19:13:36  thomas
# use DBD::Pg not needed
#
# Revision 1.14  2005/11/01 22:44:42  thomas
# DBI connect with user '' to use current krb5 ticket cache
#
# Revision 1.13  2005/10/03 19:46:26  thomas
# Always authenticate to postgres using the current default principal
#
# Revision 1.12  2005/02/10 15:59:43  thomas
# make sushi work on amd64_tao10
#
# Revision 1.11  2004/03/02 20:39:05  thomas
# work around borked postgres/krb5 version heck
#
# Revision 1.10  2004/02/24 15:49:21  thomas
# First build for postgres 7.4.1
#
# Revision 1.9  2004/02/24 15:02:03  thomas
# commit before 0.3.12 fork
#
# Revision 1.8  2003/06/12 21:57:34  thomas
# final save before 0.3.11 branch
#
# Revision 1.7  2003/06/09 14:45:11  thomas
# schema version of database
#
# Revision 1.6  2003/06/04 17:30:53  thomas
# *** empty log message ***
#
# Revision 1.5  2002/10/30 19:41:50  thomas
# - Use gmtime, not ctime when converting to db values
# - Add errors for HostAtom checkDump
#
# Revision 1.4  2002/08/14 17:13:07  thomas
# 0.2.9 release
#
# Revision 1.3  2002/07/23 16:02:28  thomas
# version 0.2.5
#
# Revision 1.2  2002/07/08 15:56:33  thomas
# 0.2.3 release
#
# Revision 1.1.1.1  2002/05/21 14:13:27  thomas
# sushi - backup to disk
#

package Sushi::Misc;

# Add the CSL site_modules to the environment.
BEGIN { push(@INC, '/afs/cs.wisc.edu/s/perl-5.24.0/common/lib/site_perl/5.24.0') }

use strict;
use Time::Local;
use Time::localtime;
use Date::Parse;
use DirHandle;
use FileHandle;
use POSIX qw(setsid strftime);
use Authen::Krb5;
use CSL::Pg;
use DBI;
use XML::Simple;
use Data::Dumper;
use CSL::DBs;
use IPC::Open3;

###############################################################################
# Return the group name for the passed time.

sub dailyGroup {
  my ($time) = shift;

  defined $time or $time = time;

  my $string = sprintf "%04d.%02d.%02d",
    localtime($time)->year+1900,
      localtime($time)->mon+1,
	localtime($time)->mday;
}

###############################################################################

sub runCmd {
  my @args = @_;

  my $res = 0;
  $main::log->log (3, "runCmd: " . join (' ', @args) . "\n");
  $main::donothing and return 0;

  $res = system (@args);
  $res = $res>>8;
  return $res;
}

###############################################################################
# Exec() a command.  Exit of failure.

sub execCmd {
  my @args = @_;

  $main::log->log (3, "execCmd: " . join (' ', @args) . "\n");
  Sushi::Misc::closeSuDB();
  $::log->resetDB;
  $main::donothing or exec(@args);
  $main::log->error ("execCmd: failed to exec " . join (' ', @args) . "\n");
  exit 1;
}

###############################################################################
# Open a connection to the sushi db.

sub openSuDB {

  defined ($::sudbh) and return 1;

  # my $luser;

  #if ($< > 0) {
  #  $luser = getpwuid($<);
  #  if (!defined ($luser)) {
  #    $::log->error ("DB open failed in Misc::initSuDB\n");
  #    return 1;
  #  }
  #} else {
  #  $luser = "sushi";
  #}

  # Get the current krb5 principal
  # if (!defined ($luser = krb5_get_default_principal ())) {
  #   $::log->error ("Failed to identify user for sushi database authentication.\n  This is a Bad Thing(tm).\n");
  #   return 0;
  # }

  my $retries = 5;

  while ($retries>0 && !defined ($::sudbh)) {
    $retries--;
    $::sudbh = DBI->connect ($CSL::DBs::sushi, '', '', { AutoCommit => 0 });

    if (!defined ($::sudbh)) {
      $::log->log (3, "Misc::openSuDB: Database connect failed.  $retries retries left.\n");
      sleep 5;
    }
  }

  if (!defined $::sudbh) {
    $::log->error ("Failed to open database.  This is a Bad Thing(tm).\n");
    return 0;
  }

  my $res = $::sudbh->do ("set search_path to sushi");
  $::sudbh->commit;

  # DBI->trace (1);
  $::log->log (4, "Misc::openSuDB: Opened db connection\n");
  $::log->log (4, "Setting search_path returned $res\n");
  return 1;
}

###############################################################################

# Get the default principal out of the current krb5 ticket cache
sub krb5_get_default_principal {

  my ($luser, $cin, $cout);
  my $pid = open3 ($cin, $cout, undef, '/s/sushi-0.3.22/depend/bin/klist');
  close $cin;
  if (defined $cout) {
    while (<$cout>) {
      # Take only the first component of the principal, since
      # that's all that postgres uses
      if (/^Default principal:\s+(\w+)(\@|\/)/) {
	$luser = $1;
	last;
      }
    }
    close $cout;
  }
  # Don't accumulate zombies
  waitpid $pid,0 if defined $pid;

  $luser;
}


###############################################################################
# Close the sushi db connection

sub closeSuDB {
  defined ($::sudbh) or return 1;
  $::sudbh->disconnect;
  $::sudbh = undef;
  return 1;
}

###############################################################################
# Open a connection to the CSL db

sub openCSDB {
  $main::log->log (2, "Connecting to Sybase\n");
  my $csdbh = DBI->connect (
			    $CSL::DBs::sybase_proxy,
			    {'ChopBlanks' => 1}
			   );

  if (!defined ($csdbh)) {
    $main::log->error ("Database connect failed.  This is a Bad Thing(tm)\n.");
    return undef;
  }
  $main::log->log (4, "Misc::openCSDB: Opened db connection\n");
  return $csdbh;
}

###############################################################################
# Convert a clock time into a number of seconds
sub db2sec {
  my $it= shift;
  if ($it=~/(\d+):(\d+):(\d+)/) {
    return (((($1*60)+$2)*60)+$3);
  } elsif ($it=~/(\d+):(\d+)/) {
    return ((($1*60)+$2)*60);
  }
  return undef;
}

###############################################################################
# Format a date for postgres that includes the time zone, so that 
# postgres doesn't get confused about which 1am - 2am you are in
# on the one Sunday morning in the fall when there are two of them.

sub secs2utc {
  my $secs = shift;

  defined $secs or return undef;

  return gmtime ($secs) . " UTC";
}

###############################################################################

sub date2secs {
  my $date = shift;

  defined ($date) or return undef;

  if ($date =~ /^\d+$/) {
    # Already numbers only, it's good to go.
    return $date;
  }

  if ($date =~ /^(\d\d\d\d)(\d\d)(\d\d)\.(\d\d)(\d\d)(\d\d)$/) {
    # Sushi short format date
    my ($year,$mon,$mday,$hour,$min,$sec) = ($1,$2,$3,$4,$5,$6);
    $mon--;
    return timelocal($sec,$min,$hour,$mday,$mon,$year);
  }

  # Otherwise, try to parse it with the module
  my $secs = str2time($date);
  return $secs;

}

###############################################################################

sub initialize {
  my $libdir = shift;
  my ($cmds, $groups, $atoms, $medias, $table_defs);

  my ($de, $bt, $cmd);

  # Find the commands that I can execute
  my $dh = new DirHandle ("$libdir/Sushi/Command")
    || die "Can't read commands directory\n";
  while (defined ($de = $dh->read)) {
    $de =~ /^\.\.?$/ and next;
    $de =~ /\.pm$/ or next;
    $de =~ s/.pm//;
    eval "require Sushi::Command::$de";
    die $@ if $@;
    ($cmd = $de) =~ tr/[A-Z]/[a-z]/;
    $cmds->{$cmd} = $de;
    $::log->log (4, "Found Command $cmd\n");
  }
  undef $dh;

  # Find the Groups
  if (!($dh = new DirHandle ("$libdir/Sushi/Group"))) {
    $::log->error("Can't read group types directory\n");
    return 0;
  }
  while (defined ($de = $dh->read)) {
    $de =~ /^\.\.?$/ and next;
    $de =~ /\.pm$/ or next;
    $de =~ s/\.pm$//;
    eval "require Sushi::Group::$de";
    die $@ if $@;
    $::log->log (4,"Added Group::$de\n");
    push @$groups, $de;
  }

  # Find the Atoms
  if (!($dh = new DirHandle ("$libdir/Sushi/Atom"))) {
    $::log->error("Can't read atom types directory\n");
    return 0;
  }
  while (defined ($de = $dh->read)) {
    $de =~ /^\.\.?$/ and next;
    $de =~ /\.pm$/ or next;
    $de =~ s/\.pm$//;
    eval "require Sushi::Atom::$de";
    die $@ if $@;
    $::log->log (4,"Added Atom::$de\n");
    push @$atoms, $de;
  }

  # Find the off-line media types
  if (!($dh = new DirHandle ("$libdir/Sushi/OffLine"))) {
    $::log->error("Can't read off-line media types directory\n");
    return 0;
  }
  while (defined ($de = $dh->read)) {
    $de =~ /^\.\.?$/ and next;
    $de =~ /\.pm$/ or next;
    $de =~ s/\.pm$//;
    eval "require Sushi::OffLine::$de";
    die $@ if $@;
    $::log->log (4,"Added OffLine::$de\n");
    push @$medias, $de;
  }

  # Read the XML definition for GenDB
  # Much like the Modules, the tables.xml is stored up one directory and in
  # a different subdirectory.
  use File::Spec;
  use FindBin qw($Bin);
  $table_defs = XMLin (
		       File::Spec->catdir($Bin, '../etc/tables.xml'),
		       forcearray => ['list_opts', 'list_heading'],
		      );

  return ($cmds, $groups, $atoms, $medias, $table_defs);
}

###############################################################################
# Go into the background.
sub becomeOrphan {

  my $pid = fork();
  if ($pid>0) {
    # Parent
    setpgrp ($pid,$pid);
    exit (0);
  } elsif (defined $pid) {
    # Child
    return 1;
  }
  die"Misc::BecomeOrphan: fork failed!\n";
}

###############################################################################

sub becomeDaemon {

  my $pid = fork();
  if ($pid>0) {
    # Parent
    exit 0;
  } elsif (defined $pid) {
    # Child
    my $sess_id = setsid();
    STDIN->open ("/dev/null", "r");
    #STDOUT->open ("/dev/null", "w");
    #STDERR->open ("/dev/null", "w");
    STDOUT->open ("/tmp/sushi.stdout.$$", "w");
    STDERR->open ("/tmp/sushi.stderr.$$", "w");
  }
}

###############################################################################

sub newScheduledCheck {
  my $timestamp = $::sudbh->selectrow_array ("select timestamp from scheduled_check");
  return date2secs($timestamp);
}

###############################################################################
# Tell sushid to that there may be some new atoms scheduled.

sub newScheduledSet {

  my $rows = $::sudbh->do ("lock scheduled_check in exclusive mode");
  $rows = $::sudbh->do ("update scheduled_check set timestamp = ". $::sudbh->quote (ctime (time)));
  $::sudbh->commit;
}

###############################################################################
# Print the lines to the fd if defined, otherwise stdout.

sub printToFile {
  my ($opts, @stuff) = @_;

  if (defined $opts->{fd}) {
    my $fd = $opts->{fd};
    print $fd @stuff;
  } else {
    print @stuff;
  }
}

###############################################################################

sub shortTime {
  my $timestamp = shift;

  if (defined $timestamp) {
    return sprintf "%04d%02d%02d.%02d%02d%02d",
      localtime ($timestamp)->year+1900,
	localtime ($timestamp)->mon+1,
	  localtime ($timestamp)->mday,
	    localtime ($timestamp)->hour,
	      localtime ($timestamp)->min,
		localtime ($timestamp)->sec;
  } else {
    return undef;
  }
}

###############################################################################
# Return the following parameters

sub getIntervalParms {
  my ($now, $interval) = ( @_ );

  defined ($now) or $now = time;
  defined ($interval) or $interval = 14;

  my ($ttime, $tmon, $daysleft, $doepoch);
  my ($mday,$mon,$year) = (localtime($now)->mday,
			   localtime($now)->mon,
			   localtime($now)->year);

  # The start of the cycle
  my $stmday = int(($mday-1)/$interval)*$interval+1;
  my $starttime = timelocal (0,0,0,$stmday,$mon,$year);

  # If the end of the cycle is in next month, it's an inc only day
  my $endtime = $starttime + $interval*24*60*60 - 1;
  $tmon = localtime($endtime)->mon;
  if ($tmon != $mon) {
    $doepoch = 0;
    $daysleft = 1;
  } else {
    $doepoch = 1;
    $daysleft = $interval - ($mday - $stmday);
  }

  return ($starttime, $endtime, $doepoch, $daysleft);

}

###############################################################################
# Take a number ending with a [kK], [mM], [gG] and multiply as appropriate

sub sushiInt {
  my $number = shift;

  defined ($number) or return undef;

  if ($number =~ /(\d+)([kKmMgG])/) {
    my ($base, $factor) = ($1, $2);
    if ($factor eq 'k' || $factor eq 'K') {
      return $base*1024;
    } elsif ($factor eq 'm' || $factor eq 'M') {
      return $base*1024*1024;
    } elsif ($factor eq 'g' || $factor eq 'G') {
      return $base*1024*1024*1024;
    } else {
      print STDERR "Whoa, Jack!!\n";
    }
  }
  return $number;
}

###############################################################################

sub confirm {
  my $prompt = shift;

  my $response = "";
  my $first = 1;

  while ($response ne "yes" && $response ne "no") {
    if ($first) {
      print $prompt . "  Are you sure you want to do this (yes/no) ";
    } else {
      print "Please answer yes or no ";
    }
    $first = 0;
    $response = <STDIN>;
    chomp ($response);
    $response =~ tr/[A-Z]/[a-z]/;
  }
  return ($response eq "yes");
}

###############################################################################

1;
