#
# Copyright (c) 2002-2004 Eric Wallengren
# This file is part of the Continuous Automated Build and Integration
# Environment (CABIE)
#
# CABIE is distributed under the terms of the GNU General Public
# License version 2 or any later version.  See the file COPYING for copying
# permission or http://www.gnu.org.
#
# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED OR
# IMPLIED, without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  ANY USE IS AT YOUR OWN RISK.
#
# Permission to modify the code and to distribute modified code is granted,
# provided the above notices are retained, and a notice that the code was
# modified is included with the above copyright notice.
#

#
# This package is specifically for running the buildserver and source monitor
# under Windows using ActiveState as the deployment platform.
#

BEGIN{
    push @INC, ".";
    push @INC, "lib";
    push @INC, "../lib";
}

#
# Package declaration
#
package winsys;

use vars qw( $Log $Message $Name $Value );

#
# Use Carp for error handling
#
use Carp;

use Win32;
use Win32::OLE qw( in );
use Win32::OLE::Variant;
use Win32::Daemon;
use Win32::Process;
use Win32::Job;
use Win32::AdminMisc;
use Sys::Hostname;
use FileHandle;

my $hostname = hostname();
$hostname    =~ s/\.[a-zA-Z0-9\n]+//g;

require "$hostname.pm";

my $config = new $hostname;

#
# Uncomment if you're using MySQL
#
use DBI;
DBI->trace(0);

#
# Global section, please do not edit!!!
#
my %fields = (
    sport         => '8091',
    mport         => '8092',
    port          => '8091',
    makemonitor   => '0',
    makedaemon    => '0',
    bAmMonitor    => '0',
    bAmServer     => '0',
    nativein      => '0',
    nativeout     => '0',
    nativeerr     => '0',
    volume        => 'NA',
    jobname       => 'NA',
    jobno         => '0',
    threadlock    => '0',
    hostname      => 'NA',
);

#
# Read commandline args
#
sub validateargs {

    my $self = shift;

    my $hostname = shift;

    my %Opts = @_;

    my $key;
    my $bMissing = 0;
    my $sport;
    my $mport;
    my $BSR = $config->BSR;
    $BSR =~ s/\//\\/g;

    my @windowsargs  = qw (m s i r);

    if (!defined($Opts{x})) {

        #
        # This will be for a service installation...
        #
        foreach $arg (@windowsargs) {

            if (!defined($Opts{m}) || !defined($Opts{s}) ||
               ( !defined($Opts{i}) && !defined($Opts{r})) ) {
               if ($bMissing == 0) {
                   print "Incomplete options: ";
                   $bMissing = 1;
               }
               print " -$arg";
            }
        }

        if ($bMissing) {

            print "\n";
            exit -1;

        }

        #
        # Look for -s (server port)
        #
        if ($Opts{s} !~ /^$/ ) {
            if ($Opts{s} !~ /^[0-9]+$/ ) {
                print "Invalid port number!\n";
                exit 1;
            } else {
                $sport = $Opts{s};
            }
        }

        #
        # Look for -m (monitor port)
        #
        if ($Opts{m} !~ /^$/ ) {
            if ($Opts{m} !~ /^[0-9]+$/ ) {
                print "Invalid port number!\n";
                exit 1;
            } else {
                $mport = $Opts{m};
            }
        }
        #
        # Next 2 hashes are for the service install...
        #
        my %BuildServiceHash = (
            machine     =>  "$hostname",
            name        =>  'buildserver',
            display     =>  'CABIE build monitor service',
            path        =>  $^X,
            user        =>  '',
            pwd         =>  '',
            description => "Monitor output of builds on $hostname",
            parameters  => "-I$BSR\\lib $BSR\\buildserver.pl -x -s $sport",
        );

        my %MonitorServiceHash = (
            machine     =>  "$hostname",
            name        =>  'testserver',
            display     =>  'CABIE test monitor service',
            path        =>  $^X,
            user        =>  '',
            pwd         =>  '',
            description => "Monitor tests for $hostname",
            parameters  => "-I$BSR\\lib $BSR\\buildserver.pl -x -m $mport",
        );

        #
        # Can't install and remove services at the same time...
        #
        if ( defined($Opts{i}) && defined ($Opts{r}) ) {
            print "cannot install and remove an NT service!\n";
            exit 1;
        }

        #
        # Delete the services...
        #
        if (defined($Opts{r})) {
            if( Win32::Daemon::DeleteService( 'buildserver' )) {
                print "Successfully deleted.\n";
            } else {
                print "Failed to remove buildserver service: " . 
                    Win32::FormatMessage( Win32::Daemon::GetLastError() ) . 
                                          "\n";
            }

            if( Win32::Daemon::DeleteService( 'testserver' )) {
                print "Successfully deleted.\n";
            } else {
                print "Failed to remove test service: " . 
                    Win32::FormatMessage( Win32::Daemon::GetLastError() ) . 
                                          "\n";
            }
        }

        #
        # Install the services...
        #
        if (defined($Opts{i})) {
            if( Win32::Daemon::CreateService( \%BuildServiceHash )) {
                print "Successfully installed.\n";
            } else {
                print "Failed to install buildserver service: " . 
                    Win32::FormatMessage( Win32::Daemon::GetLastError() ) . 
                                          "\n";
            }

            if( Win32::Daemon::CreateService( \%MonitorServiceHash )) {
                print "Successfully installed.\n";
            } else {
                print "Failed to install test server service: " . 
                    Win32::FormatMessage( Win32::Daemon::GetLastError() ) . 
                                          "\n";
            }

        }

        exit 0;

    }


}

#
# Start the NT build/monitor services
#
sub startdaemons {

    my $self    = shift;
    my $dir     = shift;
    my $Mtmpdir = sprintf "%s", $config->BTMP;
    my $Mnull   = sprintf "%s", $config->NULL;

    my %Opts = @_;

    if (defined($Opts{x})) {

        #
        # If -d was specified on the command line, disconnect filehandles,
        # set appropriate fields and start the service.
        #
        $self->makedaemon('1');

        #
        # If we're the buildserver
        #
        if (defined($Opts{s})) {
            $self->port($Opts{s});
            $self->bAmServer('1');
            print $self->bAmServer."\n";
            close(STDIN);
            close(STDOUT);
            close(STDERR);
            open STDIN, "$Mnull" ||die "open $!";
            open STDOUT, ">$dir/proc/bsdaemon.log" || die "open $!";
            open STDERR, ">$dir/proc/bserror.log" || die "open $!";
            print "***$port starting server daemon***\n";
        }

        #
        # If we're the buildserver monitor
        #
        if (defined($Opts{m})) {
            $self->port($Opts{m});
            $self->bAmMonitor('1');
            $logext = "_connectlog";
            close(STDIN);
            close(STDOUT);
            close(STDERR);
            open STDIN, "$Mnull" ||die "open $!";
            open STDOUT, ">$dir/proc/msdaemon.log" || die "open $!";
            open STDERR, ">$dir/proc/mserror.log" || die "open $!";
            print "***$port starting monitor daemon***\n";
        }

        Win32::Daemon::StartService();

        open (PID, ">$Mtmpdir/.sourcemonitor.id");
        print PID "monitor: NT service monitorserver\n";
        close(PID);

        open (PID, ">$Mtmpdir/.buildserver.id");
        print PID "server: NT service buildserver\n";
        close(PID);

        #
        # Wait until the service manager is ready for us to continue...
        #
        while( SERVICE_START_PENDING != Win32::Daemon::State() ) {
            sleep( 1 );
        }

        #
        # Now let the service manager know that we are running...
        #
        Win32::Daemon::State( SERVICE_RUNNING );

        #
        # Win32::Daemon::State( 1 );
        #

        $self->nativein(fileno(STDIN));
        $self->nativeout(fileno(STDOUT));
        $self->nativeerr(fileno(STDERR));

    }

}

#
# Shutdown the service
#
sub shutdown {

    Win32::Daemon::State( SERVICE_STOPPED );
    Win32::Daemon::StopService();

}
    

#
# Return process array for NT
#
sub processtable {

    my $self = shift;
    my @psarray;

    push @psarray, "\n";

    my $Machine = "\\\\.";

    my $pid;
    my $name;
    my $path;

    #
    # WMI Win32_Process class
    #
    my $CLASS = 
        "winmgmts:{impersonationLevel=impersonate}$Machine\\Root\\cimv2";
    my $WMI = Win32::OLE->GetObject( $CLASS ) || die;

    #
    # Iterate through the list of running processess
    #
    foreach my $Proc ( sort {lc $a->{Name} cmp lc $b->{Name}} in
        ( $WMI->InstancesOf( "Win32_Process" ))) 
    {

        $path ="";
        $path = "$Proc->{ExecutablePath}" if( "" ne $Proc->{ExecutablePath});

        $pid = sprintf( "%5d %-22s %-22s\n", $Proc->{ProcessID}, 
            "\u$Proc->{Name}", $path );

        push @psarray, "$pid";
    }

    return @psarray;

}

#
# Get average MAX duration for the job
#
sub _get_average {

    my $self   = shift;
    my $server = shift;
    my $title  = shift;
    my $total  = 0;
    my $keep;

    my $sqlquery;
    my @sqlarray;

    my $line;

    $sqlquery = "select keeplevel from configuration where binary ".
                "title=\"$title\" and binary server=\"$server\"";

    @sqlarray = $self->run_sql_query($sqlquery, ";", 0);

    $keep = $sqlarray[0];

    $sqlquery = "select start,end from jobs where binary ".
                "title=\"$title\" and binary server=\"$server\" ".
                "and status!=\"2\" ".
                "order by job desc limit $keep";

    @sqlarray = $self->run_sql_query($sqlquery, ";", 0);

    $max = 0;
    $min = 0;
    $sum = 0;
    $rec = @sqlarray;

    foreach $line (@sqlarray) {

        ($start, $end) = split(/;/, $line);
        $elapsed = $end-$start;

        if (!$min) {
            $min = $elapsed;
        }

        if ($elapsed < $min) {
            $min = $elapsed;
        } 

        if ($elapsed > $max) {
            $max = $elapsed;
        } 

        $sum += $elapsed;

    }

    if ($rec > 0) {
        if ($rec == 1) {
            $max *= .1;
            return $max;
        } 
        if ($rec == 2) {
            $total  = $sum/2;
            $t      = $total * .1;
            $total += $t;
            return $total;
        }
        if ($rec > 2) {
            $rec   = $rec - 2;
            $sum  -= $max;
            $sum  -= $min;
            $total = $sum / $rec;
            $t     = $total * .1;
            $total += $t;
            return $total;
        }
    
    } else {
        return 0;
    }

}

sub _get_hosttime {

    my $self = shift;

    my $sqlquery = "select unix_timestamp()";

    my @sqlarray = $self->run_sql_query($sqlquery, ";");

    return $sqlarray[0];

}

sub run_sql_submit {

    my $self   = shift;
    my $table  = shift;
    my @values = @_;

    my $picture;
    my $count  = 0;

    my $sqlserver = $config->SQLSERVER;
    my $sqlid     = $config->SQLID;
    my $dbh;
    my $sth;

    my $ret = 1;

    $dbh = DBI->connect("dbi:mysql:database=builds;host=$sqlserver",
        "$sqlid", ''); 

    if (defined($dbh)) {

        while ($count < @values) {
            $picture .= "?, ";
            $count++;
        }

        $picture =~ s/, $//g;

        $sth = $dbh->prepare("INSERT INTO $table VALUES($picture)");

        $sth->execute(@values);

        $dbh->disconnect;

    } else {
        $ret = 0;
    }

    return $ret;

}

sub run_sql_remove {

    my $self       = shift;
    my $sqlquery   = shift;

    my $sqlserver  = $config->SQLSERVER;
    my $sqlid      = $config->SQLID;

    my $dbh;
    my $sth;

    my $ret        = 1;

    $dbh = DBI->connect("dbi:mysql:database=builds;host=$sqlserver",
        "$sqlid", '');

    if (defined($dbh)) {
        $sth = $dbh->prepare($sqlquery);

        $sth->execute();

        $dbh->disconnect;

    } else {
        $ret = 0;
    }

    return $ret;

}

sub run_sql_query {

    my $self       = shift;
    my $sqlquery   = shift;
    my $delimeter  = shift;
    my $direction  = shift;

    my $sqlserver  = $config->SQLSERVER;
    my $sqlid      = $config->SQLID;

    my $dbh;
    my $sth;
    my $line;
    my $record;

    my @ret;
    my @row;

    if ($sqlquery =~ /delete from/i) {
        return "cannot delete records from query function";
    }
    if ($sqlquery =~ /drop table/i) {
        return "cannot drop tables from query function";
    }

    $dbh = DBI->connect("dbi:mysql:database=builds;host=$sqlserver",
        "$sqlid", '');

    if ($sqlquery =~ /\"\"/ && defined($dbh)) {
       $dbh->disconnect;
       undef $dbh;
    }

    if (defined($dbh)) {
        $sth = $dbh->prepare($sqlquery);

        $sth->execute();

        #
        # If this is not an update statement
        #
        if ($sqlquery !~ /^update/ic ) {
            while ( @row = $sth->fetchrow_array ) {
                $record = "";
                foreach $line (@row) {
                    chomp $line;
                    $record .= "$line"."$delimeter";
                }
    
                $record =~ s/$delimeter$//g;
    
                if ($direction) {
                    unshift @ret, $record;
                } else {
                    push @ret, $record;
                }
    
            }
        }

        $dbh->disconnect;

        return @ret;

    } else {
        return undef;
    }

}

#
# Kill process by pid
#
sub kill {

    my $self  = shift;

    my $entry = shift;

    Win32::Process::KillProcess($entry, $exitcode);

}

#
# Fork a process and return pid to calling app
#
sub forkprocess {

    my $self  = shift;
    my $cmd   = shift;
    my $wait  = shift;
    my $sleep = shift;
    my @args  = @_;

    my $job;
    my $pid;

    $cmd .= " ";

    #
    # Strip apart arg array since args will all be on a 
    # single command line
    #
    foreach my $entry (@args) { $cmd .= "$entry "; }

    $cmd =~ s/ $//g;

    my $ProcessObj;

    #
    # We'll always use cmd.exe for the shell
    #
    $executable = $self->whereis("cmd.exe");

    if (!$wait) {

        sleep($sleep);
        #
        # Create the process object
        #
        Win32::Process::Create($ProcessObj, "$executable",
                               "cmd /c $cmd",
                               0,
                               CREATE_NEW_CONSOLE,
                               ".") || die ErrorReport();
    
        #
        # Get the pid
        #
        $pid = $ProcessObj->GetProcessID();

    } else {
        
        my $sqlquery;
        my @sqlarray;

        #
        # Grab info from config
        #
        my $title = $self->jobname;
        my $jobno = $self->jobno;
        my $host  = $self->hostname;

        my $status;

        #
        # Create then spawn the job
        #
        $job = Win32::Job->new;
        $pid = $job->spawn("$executable", "cmd /c $cmd");

        #
        # Push pid onto process tree table
        #
        push @sqlarray, "$host";
        push @sqlarray, "$title";
        push @sqlarray, "$jobno";
        push @sqlarray, "$cmd";
        push @sqlarray, "$pid";

        $self->run_sql_submit("proctree", @sqlarray);

        #
        # Wait untile the process has completed
        #
        $job->run(3600, 1);

        $status = $job->status();

        #
        # Remove all entries from proctree associated with this job
        #
        $sqlquery  = "delete from proctree where binary server=".
                     "\"$host\" and title=\"$title\" ".
                     "and pid=\"$pid\"";

        $self->run_sql_remove("$sqlquery");

        return $$status{$pid}{exitcode};

    }

    #
    # Return pid
    #
    return $pid;

}

#
# Handle CVS updates to stdout since windows 
# isn't a posix OS (no pipes, fork or other 
# normal expected behaviors)
#
sub cvs_update {

    my $self   = shift;

    my $port   = shift;
    my $client = shift;
    my $action = shift;

    my @modules = split(/ /, $client);

    my $entry;
    my @children;
    my @contents;

    my $count = 0;

    my $logtype;

    my $location = $self->whereis("cvs.exe");

    my $job = Win32::Job->new;

    if (!defined($location)) {
        print "unable to find cvs executable";
        return undef;
    }

    if ($action) {
        $logtype = "out";
    } else {
        $logtype = "stdout";
    }

    $location =~ s/\//\\\\/g;

    foreach $entry (@modules) {

        if (!$action) {
            $job->spawn("$location", "cvs -n -d$port up -d $entry", {
                stdin  => 'NUL',
                stdout => "$entry.$logtype.log", 
                stderr => "$entry.$logtype.err",
            });
        } else {
            $job->spawn("$location", "cvs -d$port up -d -P $entry", {
                stdin  => 'NUL',
                stdout => "$entry.$logtype.log", 
                stderr => "$entry.$logtype.err",
            });
        }
 
    }

    $job->run(3600, 1);

    foreach $entry (@modules) {
        if ( -f "$entry.$logtype.log" ) {
            open (TMPLOG, "<$entry.$logtype.log") 
                  || die "cannot open $entry.stdout.log";
            while (<TMPLOG>) {
                push @contents, "$_";
            }
            close (TMPLOG);
            unlink("$entry.$logtype.log");
        }
        if (-f "$entry.$logtype.err" ) {
            unlink ("$entry.$logtype.err") || die "unlink: $?";
        }
    }

    return @contents;

}

#
# Background copy for win32 (for promoting builds)
#
sub wincopyfiles {

    my $self = shift;

    my $from = shift;
    my $to   = shift;
    my $xcopy;

    $from    =~ s/\\/\\/g;
    $from    =~ s/\//\\/g;
    $to      =~ s/\\/\\/g;
    $to      =~ s/\//\\/g;

    my $ProcessObj;

    $xcopy = $self->whereis("xcopy.exe");
    $xcopy    =~ s/\//\\\\/g;

    Win32::Process::Create($ProcessObj, "$xcopy",
                           "xcopy $from $to /i/s/y",
                           0,
                           CREATE_NEW_CONSOLE,
                           ".") || die ErrorReport();
}

#
# Windows again...
#
sub cvs_wait {

    my $self  = shift;
    my @pids  = shift;

    my $one;
    my $mee;

}

#
# Find any file located in %PATH
#
sub whereis {

    my $self     = shift;
    my $filename = shift;

    my $bfound   = 0;
    my $envvar   = $ENV{PATH};
    my $entry;

    my @patharray = split(/;/, $envvar);

    foreach $entry (@patharray) {

        $entry =~ s/\\/\//g;

        if (-f "$entry/$filename") {
            return "$entry/$filename";
        }
    }

    return undef;

}

#
# Return free space
#
sub diskspace {

    my $self = shift;

    my $Drive = $config->JOBDIR;

    my ($left, $right) = split(":", $Drive);

    $self->volume($left);

    my @Geometry = Win32::AdminMisc::GetDriveGeometry("$left:\\");

    my $Free = $Geometry[0] * $Geometry[1] * $Geometry[2];

    return $Free;

}

#
# System HW/SW information
#
sub sysinfo {

    my $self = shift;
    my $info;
    my @OS_TYPE = qw(
        Windows_3x Windows_95 Windows_98 Windows_NT Windows_CE 
    );

    my $Class = "Win32_OperatingSystem";

    (my $Machine = shift @ARGV || "." ) =~ s/^[\\\/]+//;

    my $WMIServices = Win32::OLE->GetObject( 
        "winmgmts:{impersonationLevel=impersonate,(security)}//$Machine" ) 
        || die;

    foreach my $OS ( in( $WMIServices->InstancesOf( $Class ) ) ) {
  
        $info  = "$OS->{Caption} ".
                 "$OS->{Version} ".
                 "$OS->{CSDVersion}";

    }

    return $info;

}

#
# For producing win32 error strings.
#
sub ErrorReport{
    print Win32::FormatMessage( Win32::GetLastError() );
}

#
# Do not edit anything below this line...
#
# Object constructor...
#
sub new {

    my $that = shift;
    my $class = ref($that) || $that;
    my $self = {
        %fields,
    };
    bless $self, $class;
    return $self;
}

#
# Autoload definitions in this package...
#
sub AUTOLOAD {

    my $self = shift;
    my $type = ref($self) || croak "$self is not an object";
    my $name = $AUTOLOAD;
    $name =~ s/.*://;
    unless (exists $self->{$name}) {
        croak "Can't access `$name` field in an object of class $type";
    }
    if (@_) {
        return $self->{$name} = shift;
    } else {
        return $self->{$name};
    }
}

1;