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

     2 # All rights reserved.

     3 # This component and the accompanying materials are made available

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

     5 # which accompanies this distribution, and is available

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

     7 #

     8 # Initial Contributors:

     9 # Nokia Corporation - initial contribution.

    10 #

    11 # Contributors:

    12 #

    13 # Description:

    14 #

    15 

    16 package BuildClient;

    17 

    18 use FindBin;		# for FindBin::Bin

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

    20 

    21 use strict;

    22 use Carp;

    23 use Msg;

    24 use FreezeThaw qw(freeze thaw);

    25 use Cwd 'chdir';

    26 use Compress::Zlib;			# For compression library routines

    27 

    28 # Global Varibales

    29 my $gClientName;

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

    31 my ($gDebug) = 0;

    32 

    33 # Check if HiRes Timer is available

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

    35   $gHiResTimer = 1;

    36 } else {

    37   print "Cannot load HiResTimer Module\n";

    38 }

    39 

    40 

    41 # GetClientVersion

    42 #

    43 # Inputs

    44 #

    45 # Outputs

    46 # Client Version Number

    47 #

    48 # Description

    49 # This function returns the Client version number

    50 sub GetClientVersion

    51 {

    52   return "1.3";

    53 }

    54 

    55 # rcvd_msg_from_server

    56 #

    57 # Inputs

    58 # $iConn (Instance of the Msg Module)

    59 # $msg (the recieved message from the server)

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

    61 #

    62 # Outputs

    63 #

    64 # Description

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

    66 sub rcvd_msg_from_server {

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

    68 

    69     my ($iResults, $iChdir);

    70 

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

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

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

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

    75     {

    76       print "Server Disconnected\n";

    77       return 0;

    78     } elsif ($err ne "") {

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

    80       return 0;

    81     }

    82 

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

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

    85 

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

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

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

    89     if ($sub_name eq 'ChangeClientName')

    90     {

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

    92       $BuildClient::gClientName = $iID;

    93     }

    94 

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

    96     if ($sub_name eq 'Exit')

    97     {

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

    99       exit 0;

   100     }

   101 

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

   103     if ($sub_name eq 'SetEnv')

   104     {

   105       &SetEnv($iID, $iStage);

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

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

   108       $iConn->transmit_immediately($serialized_msg);

   109     } elsif ($sub_name eq 'Execute') {

   110       # Process the "Execute" command

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

   112       # Add the client side per command start timestamp

   113       &TimeStampStart(\$iResults);

   114 

   115       eval {

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

   117                              # a symbolic reference

   118           # Change the working directory, first replacing the environment variables

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

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

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

   122           $iChdir = chdir "$iCwd";

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

   124           if ($iChdir)

   125           {

   126             # Log the directory change

   127             print "Chdir $iCwd\n";

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

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

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

   131           } else {

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

   133           }

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

   135       &TimeStampEnd(\$iResults);

   136       };

   137 

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

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

   140           # Handle Generic errors

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

   142           

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

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

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

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

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

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

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

   150       }

   151       # Send the message back to the server

   152       $iConn->transmit_immediately($msg);

   153       

   154     } 

   155 }

   156 

   157 # normalize_line_breaks

   158 #

   159 # Inputs

   160 # $lines  Text string which may consist of many lines

   161 #

   162 # Outputs

   163 # $lines  Text string which may consist of many lines

   164 #

   165 # Description

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

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

   168 sub normalize_line_breaks

   169 {

   170     my $lines = '';

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

   172         {

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

   174         $lines .= "$line\n";

   175         }

   176     return $lines;    

   177 }

   178 

   179 # Execute

   180 #

   181 # Inputs

   182 # @args

   183 #

   184 # Outputs

   185 # @results

   186 #

   187 # Description

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

   189 # It combines STDERR into STDOUT

   190 sub Execute

   191 {

   192   my (@iCommandline) = @_;

   193 

   194   print "Executing '@iCommandline'\n";

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

   196   {

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

   198   } else {

   199     if ($BuildClient::gDebug ne "")

   200     {

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

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

   203     }

   204     my $iResults;

   205 

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

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

   208     while (<PIPE>)

   209     {

   210       if ($BuildClient::gDebug ne "")

   211       {

   212         print DEBUGLOG $_;

   213       } else {

   214         print $_;

   215       }

   216       $iResults .= $_;

   217     }

   218     close PIPE;

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

   220     return $iResults;

   221   }

   222 }

   223 

   224 # SetEnv

   225 #

   226 # Inputs

   227 # @args

   228 #

   229 # Outputs

   230 #

   231 # Description

   232 # This function sets the local Environment.

   233 sub SetEnv

   234 {

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

   236 

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

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

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

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

   241   $ENV{$iKey} = $iValue;

   242 }

   243 

   244 # Connect

   245 #

   246 # Inputs

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

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

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

   250 # $iDebug - Debug Option

   251 #

   252 # Outputs

   253 #

   254 # Description

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

   256 

   257 sub Connect

   258 {

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

   260 

   261   my ($iSuccessConnect);

   262 

   263   # Set the Client name

   264   $BuildClient::gClientName = $iClientName;

   265   # Set Global Debug flag/filename

   266   $BuildClient::gDebug = $iDebug;

   267 

   268   # In continual loop try and connect to the datasource

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

   270   {

   271     # Cycle through the datasource list

   272     my $iMachine = shift @$iDataSource;

   273     push @$iDataSource, $iMachine;

   274     print "Connecting to $iMachine\n";

   275 

   276     # Process the datasource into hostname and port number

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

   278 

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

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

   281 

   282     # Check the status of the connection attempt

   283     if ($iConn)

   284     {

   285       # Connection was succesful

   286       print "Connection successful to $iMachine\n";

   287       $iSuccessConnect++;

   288       # Send a "Ready" command to the Server

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

   290       print "Sending Ready\n";

   291       $iConn->transmit_immediately($serialized_msg);

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

   293       Msg->result_iteration(300);

   294       # Server disconnected, clean up by chdir to root

   295       chdir "\\";

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

   297       $BuildClient::gClientName = $iClientName;

   298     } else {

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

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

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

   302       sleep $iConnectWait;

   303     }

   304   }

   305 }

   306 

   307 # TimeStampStart

   308 #

   309 # Inputs

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

   311 #

   312 # Outputs

   313 #

   314 # Description

   315 # This places a timestamp in the logs

   316 sub TimeStampStart

   317 {

   318   my $ref = shift;

   319   

   320   # Add the client side per command start timestamp

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

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

   323   if ($gHiResTimer == 1)

   324   {

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

   326   } else {

   327     # Add the HiRes timer unavailable statement

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

   329   }

   330 }

   331 

   332 # TimeStampEnd

   333 #

   334 # Inputs

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

   336 #

   337 # Outputs

   338 #

   339 # Description

   340 # This places a timestamp in the logs

   341 sub TimeStampEnd

   342 {

   343   my $ref = shift;

   344  

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

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

   347    # Add the client side per command end timestamp

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

   349 }

   350 

   351 # Subroutine for compressing data stream.

   352 # Input: message to be compressed.

   353 # Output: compressed message, ready for sending.

   354 sub Compress($)

   355 {

   356     my $msg = shift; # Get the message.

   357     

   358     # Initialise deflation stream

   359     my $x;

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

   361     

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

   363     {

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

   365     }

   366     

   367     # Compress the message

   368     my ($output, $status);

   369     my ($output2, $status2);

   370     

   371     # First attempt to perform the deflation

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

   373     

   374     if($@) # Deflation has failed.

   375     {

   376 	    $x = deflateInit();

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

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

   379 	    

   380 	    return $output.$output2;

   381     }

   382     

   383     # Now attempt to complete the compression

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

   385     

   386     if($@) # Deflation has failed.

   387     {

   388 	    $x = deflateInit();

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

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

   391 	    

   392 	    return $output.$output2;

   393     }

   394     

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

   396     {

   397         $x = deflateInit();

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

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

   400 	    

   401 	    return $output.$output2;

   402     }

   403     

   404     # Attempt to complete the compressions

   405     if($status2 != Z_OK)

   406     {

   407         $x = deflateInit();

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

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

   410 	    return $output.$output2;

   411     }

   412     

   413     # Return the compressed output.

   414     return $output . $output2;

   415 }

   416 

   417 1;