# Copyright (c) 2003-2009 Nokia Corporation and/or its subsidiary(-ies).

# All rights reserved.

# This component and the accompanying materials are made available

# under the terms of "Eclipse Public License v1.0"

# which accompanies this distribution, and is available

# at the URL "http://www.eclipse.org/legal/epl-v10.html".

#

# Initial Contributors:

# Nokia Corporation - initial contribution.

#

# Contributors:

#

# Description:

#

package BuildClient;

use FindBin;		# for FindBin::Bin

use lib "$FindBin::Bin/lib/freezethaw"; # For FreezeThaw

use strict;

use Carp;

use Msg;

use FreezeThaw qw(freeze thaw);

use Cwd 'chdir';

use Compress::Zlib;			# For compression library routines

# Global Varibales

my $gClientName;

my ($gHiResTimer) = 0; #Flag - true (1) if HiRes Timer module available

my ($gDebug) = 0;

# Check if HiRes Timer is available

if (eval "require Time::HiRes;") {

  $gHiResTimer = 1;

} else {

  print "Cannot load HiResTimer Module\n";

}

# GetClientVersion

#

# Inputs

#

# Outputs

# Client Version Number

#

# Description

# This function returns the Client version number

sub GetClientVersion

{

  return "1.3";

}

# rcvd_msg_from_server

#

# Inputs

# $iConn (Instance of the Msg Module)

# $msg (the recieved message from the server)

# $err (any error message from the Msg Module)

#

# Outputs

#

# Description

# This function processes the incoming message from the Build Server and acts upon them

sub rcvd_msg_from_server {

    my ($iConn, $msg, $err) = @_;

    my ($iResults, $iChdir);

    # if the message is empty or a "Bad file descriptor" error happens

    # This usually means the the Build Server has closed the socket connection.

    # The client is returned to trying to connect to a build server

    if (($msg eq "") || ($err eq "Bad file descriptor"))

    {

      print "Server Disconnected\n";

      return 0;

    } elsif ($err ne "") {

      print "Error is communication occured:$err\n";

      return 0;

    }

    # Thaw the message, this decodes the text string sent from the server back into perl variables

    my ($sub_name, $iID, $iStage, $iComp, $iCwd, $iCommandline) = thaw ($msg);

    # The server has determined that this client is using a non-unique client name.

    # The server has added a random number on to the client name to try and make it unique.

    # The server send this new name back to the client, so the two are in sync.

    if ($sub_name eq 'ChangeClientName')

    {

      print "ClientName changed to: $iID by the server\n";

      $BuildClient::gClientName = $iID;

    }

    # The server sent and exit message to this client, so exit.

    if ($sub_name eq 'Exit')

    {

      print "Server request the client to exit\n";

      exit 0;

    }

    # If the command sent by the server is "SetEnv", call the SetEnv Function and respond to server when complete

    if ($sub_name eq 'SetEnv')

    {

      &SetEnv($iID, $iStage);

      # Prepare and send the "SetEnv Ready" message to the server with the client name

      my $serialized_msg = freeze ("SetEnv Ready", $BuildClient::gClientName);

      $iConn->transmit_immediately($serialized_msg);

    } elsif ($sub_name eq 'Execute') {

      # Process the "Execute" command

      print "Executing ID ". ($iID+1) ." Stage $iStage\n"; 

      # Add the client side per command start timestamp

      &TimeStampStart(\$iResults);

      eval {

          no strict 'refs';  # Because we call the subroutine using

                             # a symbolic reference

          # Change the working directory, first replacing the environment variables

          $iCwd =~ s/%(\w+)%/$ENV{$1}/g;

          $iCommandline =~ s/%(\w+)%/$ENV{$1}/g;

          # If the changing of the working directory fails it will remain in the current directory

          $iChdir = chdir "$iCwd";

          # Don't execute the command if the changing of the working directory failed.

          if ($iChdir)

          {

            # Log the directory change

            print "Chdir $iCwd\n";

            $iResults .= "Chdir $iCwd\n";

            # Execute the "Execute" function, passing it the commandline to execute and collect the results

            $iResults .= normalize_line_breaks(&{$sub_name} ($iCommandline));

          } else {

            $iResults .= "ERROR: Cannot change directory to $iCwd for $iComp\n";

          }

      # Add the client side per command end HiRes timestamp if available

      &TimeStampEnd(\$iResults);

      };

      # Send an appropriate message back to the server, depending on error situation

      if ($@ && $iChdir) {      # Directory changed OK, but an error occurred subsequently

          # Handle Generic errors

          $msg = bless \$@, "RPC::Error\n";

          # Freeze the perl variables into a text string to send to the server

          $msg = freeze('Results', $BuildClient::gClientName, $iID, $iStage, $iComp, $iCwd, $iCommandline, Compress($msg));

      } else {                  # Directory change failed OR no error at all.

          # $iResults will contain the error string if changing working directories failed

          #     otherwise it will contain the output of the execution of the commandline

          # Freeze the perl variables into a text string to send to the server

          $msg = freeze('Results', $BuildClient::gClientName, $iID, $iStage, $iComp, $iCwd, $iCommandline, Compress($iResults));

      }

      # Send the message back to the server

      $iConn->transmit_immediately($msg);

    } 

}

# normalize_line_breaks

#

# Inputs

# $lines  Text string which may consist of many lines

#

# Outputs

# $lines  Text string which may consist of many lines

#

# Description

# This subroutine converts any Unix, Macintosh or other line breaks into the DOS/Windows CRLF sequence

# Text in each line remains unchanged. Empty lines are discarded.

sub normalize_line_breaks

{

    my $lines = '';

    foreach my $line (split /\r|\n/, shift)

        {

        unless ($line) { next; }    # Discard empty line

        $lines .= "$line\n";

        }

    return $lines;    

}

# Execute

#

# Inputs

# @args

#

# Outputs

# @results

#

# Description

# This Executes the command in the args, must return and array

# It combines STDERR into STDOUT

sub Execute

{

  my (@iCommandline) = @_;

  print "Executing '@iCommandline'\n";

  if (! defined($BuildClient::gDebug))

  {

    return my $ireturn= `@iCommandline 2>&1`;   # $ireturn is not used but ensures that a scalar is returned.

  } else {

    if ($BuildClient::gDebug ne "")

    {

      # Open log file for append, if cannot revert to STDOUT

      open DEBUGLOG, ">>$BuildClient::gDebug" || $BuildClient::gDebug== "";

    }

    my $iResults;

    print DEBUGLOG "Executing '@iCommandline'\n" if ($BuildClient::gDebug ne "");

    open PIPE, "@iCommandline 2>&1 |";

    while (<PIPE>)

    {

      if ($BuildClient::gDebug ne "")

      {

        print DEBUGLOG $_;

      } else {

        print $_;

      }

      $iResults .= $_;

    }

    close PIPE;

    close DEBUGLOG if ($BuildClient::gDebug ne "");

    return $iResults;

  }

}

# SetEnv

#

# Inputs

# @args

#

# Outputs

#

# Description

# This function sets the local Environment.

sub SetEnv

{

  my ($iKey, $iValue) = @_;

  # Replace an environment Variable referenced using %Variable% with the contents of the Environment Variable

  # This allows the use of one Environment Variable in another as long as it is already set

  $iValue =~ s/%(\w+)%/$ENV{$1}/g;

  print "Setting Environment Variable $iKey to $iValue\n";

  $ENV{$iKey} = $iValue;

}

# Connect

#

# Inputs

# $iDataSource - Reference to array of Hostname:Port of BuildServers to connect to)

# $iConnectWait (How often it polls for a build server)

# $iClientName (Client name used to help identify the machine, Must be unique)

# $iDebug - Debug Option

#

# Outputs

#

# Description

# This function connects to the BuildServer and reads commands to run

sub Connect

{

  my ($iDataSource, $iConnectWait, $iClientName, $iExitAfter, $iDebug) = @_;

  my ($iSuccessConnect);

  # Set the Client name

  $BuildClient::gClientName = $iClientName;

  # Set Global Debug flag/filename

  $BuildClient::gDebug = $iDebug;

  # In continual loop try and connect to the datasource

  while (($iExitAfter == -1) || ($iSuccessConnect < $iExitAfter))

  {

    # Cycle through the datasource list

    my $iMachine = shift @$iDataSource;

    push @$iDataSource, $iMachine;

    print "Connecting to $iMachine\n";

    # Process the datasource into hostname and port number

    my ($iHostname,$iPort) = $iMachine =~ /^(\S+):(\d+)/;

    # Create an instance of the message Module to handle the TCP/IP connection

    my $iConn = Msg->associate($iPort, $iHostname, \&rcvd_msg_from_server);

    # Check the status of the connection attempt

    if ($iConn)

    {

      # Connection was succesful

      print "Connection successful to $iMachine\n";

      $iSuccessConnect++;

      # Send a "Ready" command to the Server

      my $serialized_msg = freeze ("Ready", $BuildClient::gClientName, &GetClientVersion);

      print "Sending Ready\n";

      $iConn->transmit_immediately($serialized_msg);

      # Start the message processing loop with inital timeout of 300 seconds

      Msg->result_iteration(300);

      # Server disconnected, clean up by chdir to root

      chdir "\\";

      # Set the client name back to the name specified on the commandline just in case it has had it's name changed.

      $BuildClient::gClientName = $iClientName;

    } else {

      # Connection Failed, wait specified time before continuing and trying another connection attempt

      print "Could not connect to $iHostname:$iPort\n";

      print "Trying another connection attempt in $iConnectWait seconds\n";

      sleep $iConnectWait;

    }

  }

}

# TimeStampStart

#

# Inputs

# $iData - Reference to variable to put the start time stamp

#

# Outputs

#

# Description

# This places a timestamp in the logs

sub TimeStampStart

{

  my $ref = shift;

  # Add the client side per command start timestamp

  $$ref = "++ Started at ".localtime()."\n";

  # Add the client side per command start HiRes timestamp if available

  if ($gHiResTimer == 1)

  {

    $$ref .= "+++ HiRes Start ".Time::HiRes::time()."\n";

  } else {

    # Add the HiRes timer unavailable statement

    $$ref .= "+++ HiRes Time Unavailable\n";

  }

}

# TimeStampEnd

#

# Inputs

# $iData - Reference to variable to put the end time stamp

#

# Outputs

#

# Description

# This places a timestamp in the logs

sub TimeStampEnd

{

  my $ref = shift;

  # Add the client side per command end HiRes timestamp if available

  $$ref .= "+++ HiRes End ".Time::HiRes::time()."\n" if ($gHiResTimer == 1);

   # Add the client side per command end timestamp

  $$ref .= "++ Finished at ".localtime()."\n";

}

# Subroutine for compressing data stream.

# Input: message to be compressed.

# Output: compressed message, ready for sending.

sub Compress($)

{

    my $msg = shift; # Get the message.

    # Initialise deflation stream

    my $x;

    eval {$x = deflateInit() or die "Error: Cannot create a deflation stream\n";};

    if($@) # Deflation stream creationg has failed.

    {

	    return Compress("Error: creation of deflation stream failed: $@\n");

    }

    # Compress the message

    my ($output, $status);

    my ($output2, $status2);

    # First attempt to perform the deflation

    eval { ($output, $status) = $x -> deflate($msg); };

    if($@) # Deflation has failed.

    {

	    $x = deflateInit();

	    ($output, $status) = $x -> deflate("ERROR: Compression failed: $@\n");

	    ($output2, $status2) = $x -> flush();

	    return $output.$output2;

    }

    # Now attempt to complete the compression

    eval { ($output2, $status2) = $x -> flush(); };

    if($@) # Deflation has failed.

    {

	    $x = deflateInit();

	    ($output, $status) = $x -> deflate("ERROR: Compression failed: $@\n");

	    ($output2, $status2) = $x -> flush();

	    return $output.$output2;

    }

    if($status != Z_OK) # Deflation has failed.

    {

        $x = deflateInit();

	    ($output, $status) = $x -> deflate("ERROR: Compression failed: $@\n");

	    ($output2, $status2) = $x -> flush();

	    return $output.$output2;

    }

    # Attempt to complete the compressions

    if($status2 != Z_OK)

    {

        $x = deflateInit();

	    ($output, $status) = $x -> deflate("ERROR: Compression failed: $@\n");

	    ($output2, $status2) = $x -> flush();

	    return $output.$output2;

    }

    # Return the compressed output.

    return $output . $output2;

}

1;