Remove --server mode and supporting code from build.pl.
diff --git a/bootstrap.1 b/bootstrap.1
index 069b995..19a9d1e 100755
--- a/bootstrap.1
+++ b/bootstrap.1
@@ -11,7 +11,6 @@ fi
unalias mkout
unalias deliver
unalias build
unalias build_client
unalias zipdep
# executables are *.exe for WNT. This variable is necessary since Cygwin 1.5.x
@@ -71,7 +70,6 @@ fi
#make sure build.pl is executable
chmod +x "$SRC_ROOT/solenv/bin/build.pl"
chmod +x "$SRC_ROOT/solenv/bin/build_client.pl"
chmod +x "$SRC_ROOT/solenv/bin/zipdep.pl"
chmod +x "$SRC_ROOT/solenv/bin/gccinstlib.pl"
diff --git a/set_soenv.in b/set_soenv.in
index e12f64a..1227ef4 100755
--- a/set_soenv.in
+++ b/set_soenv.in
@@ -89,7 +89,7 @@ my ( $oldPATH, $SRC_ROOT, $SO_HOME, $JAVA_HOME, $JDK, $JAVAFLAGS, $OOO_SHELL,
# IId. Declaring the aliases.
#-------------------------------------------
#
my ( $dmake, $build, $build_client, $mkout, $deliver, $zipdep );
my ( $dmake, $build, $mkout, $deliver, $zipdep );
#
#-------------------------------------------------------------
@@ -1455,7 +1455,6 @@ else
$mkout = '"perl $SOLARENV/bin/mkout.pl"';
$deliver = '"perl $SOLARENV/bin/deliver.pl"';
$build = '"perl $SOLARENV/bin/build.pl"';
$build_client = '"perl $SOLARENV/bin/build_client.pl"';
$zipdep = '"perl $SOLARENV/bin/zipdep.pl"';
#
@@ -2107,7 +2106,6 @@ ToFile( "Don't set aliases when bootstrapping", $empty, "c" );
ToFile( "alias mkout", $mkout, "a" );
ToFile( "alias deliver", $deliver, "a" );
ToFile( "alias build", $build, "a" );
ToFile( "alias build_client",$build_client, "a" );
ToFile( "alias zipdep", $zipdep, "a" );
# on Solaris, MacOSX and FreeBSD, set GNUCOPY and GNUPATCH
diff --git a/solenv/bin/build.pl b/solenv/bin/build.pl
index 9c6bc3c..9c710fe 100755
--- a/solenv/bin/build.pl
+++ b/solenv/bin/build.pl
@@ -158,20 +158,12 @@
my $stop_build_on_error = 0; # for multiprocessing mode: do not build further module if there is an error
my $interactive = 0; # for interactive mode... (for testing purpose enabled by default)
my $parent_process = 1;
my $server_mode = 0;
my $setenv_string = ''; # string for configuration of the client environment
my $ports_string = ''; # string with possible ports for server
my @server_ports = ();
my $html_port = 0;
my $server_socket_obj = undef; # socket object for server
my $html_socket_obj = undef; # socket object for server
my %clients_jobs = ();
my %clients_times = ();
my $client_timeout = 0; # time for client to build (in sec)...
# The longest time period after that
# the server considered as an error/client crash
my %lost_client_jobs = (); # hash containing lost jobs
my %job_jobdir = (); # hash containing job-dir pairs
my $reschedule_queue = 0;
my %module_build_queue = ();
my %reversed_dependencies = ();
@@ -654,9 +646,6 @@ sub build_all {
build_multiprocessing();
return;
};
if ($server_mode) {
run_server();
};
while ($prj = pick_prj_to_build(\%global_deps_hash)) {
if (!defined $dead_parents{$prj}) {
if (scalar keys %broken_build) {
@@ -685,11 +674,7 @@ sub build_all {
my $info_hash = $html_info{$initial_module};
$$info_hash{DIRS} = check_deps_hash(\%local_deps_hash, $initial_module);
$module_by_hash{\%local_deps_hash} = $initial_module;
if ($server_mode) {
run_server();
} else {
build_dependent(\%local_deps_hash);
};
build_dependent(\%local_deps_hash);
};
};
@@ -1242,7 +1227,7 @@ sub find_indep_prj {
$all_dependent = 1;
handle_dead_children(0) if ($processes_to_run);
my $children = children_number();
return '' if (!$server_mode && $children && ($children >= $processes_to_run));
return '' if ($children && ($children >= $processes_to_run));
$dependencies = shift;
if (scalar keys %$dependencies) {
foreach my $job (keys %$dependencies) {
@@ -1361,14 +1346,12 @@ sub print_error {
sub usage {
print STDERR "\nbuild\n";
print STDERR "Syntax: build [--all|-a[:prj_name]]|[--from|-f prj_name1[:prj_name2] [prj_name3 [...]]]|[--since|-c prj_name] [--with_branches prj_name1[:prj_name2] [--skip prj_name1[:prj_name2] [prj_name3 [...]] [prj_name3 [...]|-b] [--deliver|-d [--dlv_switch deliver_switch]]] [-P processes|--server [--setenvstring \"string\"] [--client_timeout MIN] [--port port1[:port2:...:portN]]] [--show|-s] [--help|-h] [--file|-F] [--ignore|-i] [--version|-V] [--mode|-m OOo[,SO[,EXT]] [--html [--html_path html_file_path] [--dontgraboutput]] [--pre_job=pre_job_sring] [--job=job_string|-j] [--post_job=post_job_sring] [--stoponerror] [--exclude_branch_from prj_name1[:prj_name2] [prj_name3 [...]]] [--interactive] [--verbose]\n";
print STDERR "Syntax: build [--all|-a[:prj_name]]|[--from|-f prj_name1[:prj_name2] [prj_name3 [...]]]|[--since|-c prj_name] [--with_branches prj_name1[:prj_name2] [--skip prj_name1[:prj_name2] [prj_name3 [...]] [prj_name3 [...]|-b] [--deliver|-d [--dlv_switch deliver_switch]]] [-P processes] [--show|-s] [--help|-h] [--file|-F] [--ignore|-i] [--version|-V] [--mode|-m OOo[,SO[,EXT]] [--html [--html_path html_file_path] [--dontgraboutput]] [--pre_job=pre_job_sring] [--job=job_string|-j] [--post_job=post_job_sring] [--stoponerror] [--exclude_branch_from prj_name1[:prj_name2] [prj_name3 [...]]] [--interactive] [--verbose]\n";
print STDERR "Example1: build --from sfx2\n";
print STDERR " - build all projects dependent from sfx2, starting with sfx2, finishing with the current module\n";
print STDERR "Example2: build --all:sfx2\n";
print STDERR " - the same as --all, but skip all projects that have been already built when using \"--all\" switch before sfx2\n";
print STDERR "Example3: build --all --server\n";
print STDERR " - build all projects in server mode, use first available port from default range 7890-7894 (running clients required!!)\n";
print STDERR "Example4(for unixes):\n";
print STDERR "Example3(for unixes):\n";
print STDERR " build --all --pre_job=echo\\ Starting\\ job\\ in\\ \\\$PWD --job=some_script.sh --post_job=echo\\ Job\\ in\\ \\\$PWD\\ is\\ made\n";
print STDERR " - go through all projects, echo \"Starting job in \$PWD\" in each module, execute script some_script.sh, and finally echo \"Job in \$PWD is made\"\n";
print STDERR "\nSwitches:\n";
@@ -1384,11 +1367,6 @@ sub usage {
print STDERR " --file - generate command file file_name\n";
print STDERR " --deliver - only deliver, no build (usable for \'-all\' and \'-from\' keys)\n";
print STDERR " -P - start multiprocessing build, with number of processes passed\n";
print STDERR " --server - start build in server mode (clients required)\n";
print STDERR " --setenvstring - string for configuration of the client environment\n";
print STDERR " --port - set server port, default is 7890. You may pass several ports, the server will be started on the first available\n";
print STDERR " otherwise the server will be started on first available port from the default range 7890-7894\n";
print STDERR " --client_timeout - time frame after which the client/job is considered to be lost. Default is 120 min\n";
print STDERR " --dlv_switch - use deliver with the switch specified\n";
print STDERR " --help - print help info\n";
print STDERR " --ignore - force tool to ignore errors\n";
@@ -1453,10 +1431,6 @@ sub get_options {
$arg =~ /^--dontgraboutput$/ and $dont_grab_output = 1 and next;
$arg =~ /^--html_path$/ and $html_path = shift @ARGV and next;
$arg =~ /^-i$/ and $ignore = 1 and next;
$arg =~ /^--server$/ and $server_mode = 1 and next;
$arg =~ /^--client_timeout$/ and $client_timeout = (shift @ARGV)*60 and next;
$arg =~ /^--setenvstring$/ and $setenv_string = shift @ARGV and next;
$arg =~ /^--port$/ and $ports_string = shift @ARGV and next;
$arg =~ /^--version$/ and do_exit(0);
$arg =~ /^-V$/ and do_exit(0);
$arg =~ /^-m$/ and get_modes() and next;
@@ -1496,20 +1470,9 @@ sub get_options {
if (!$enable_multiprocessing) {
print_error("Cannot load Win32::Process module for multiprocessing build");
};
if ($server_mode) {
print_error("Switches -P and --server collision");
};
} elsif ($stop_build_on_error) {
print_error("Switch --stoponerror is only for multiprocessing builds");
};
if ($server_mode) {
$html++;
$client_timeout = 60 * 60 * 2 if (!$client_timeout);
} else {
print_error("--ports switch is for server mode only!!") if ($ports_string);
print_error("--setenvstring switch is for server mode only!!") if ($setenv_string);
print_error("--client_timeout switch is for server mode only!!") if ($client_timeout);
};
if ($only_platform) {
$only_common = 'common';
@@ -2785,7 +2748,6 @@ sub generate_html_file {
print HTML ' top.innerFrame.frames[1].document.write(" <td width=* align=center><strong style=color:blue>Job</strong></td>");' . "\n";
print HTML ' top.innerFrame.frames[1].document.write(" <td width=* align=center><strong style=color:blue>Start Time</strong></td>");' . "\n";
print HTML ' top.innerFrame.frames[1].document.write(" <td width=* align=center><strong style=color:blue>Finish Time</strong></td>");' . "\n";
print HTML ' top.innerFrame.frames[1].document.write(" <td width=* align=center><strong style=color:blue>Client</strong></td>");' . "\n" if ($server_mode);
print HTML ' top.innerFrame.frames[1].document.write(" </tr>");' . "\n";
print HTML ' var dir_info_strings = Message2.split("<br><br>");' . "\n";
print HTML ' for (i = 0; i < dir_info_strings.length; i++) {' . "\n";
@@ -2801,7 +2763,6 @@ sub generate_html_file {
print HTML ' };' . "\n";
print HTML ' top.innerFrame.frames[1].document.write(" <td align=center>" + dir_info_array[2] + "</td>");' . "\n";
print HTML ' top.innerFrame.frames[1].document.write(" <td align=center>" + dir_info_array[3] + "</td>");' . "\n";
print HTML ' top.innerFrame.frames[1].document.write(" <td align=center>" + dir_info_array[5] + "</td>");' . "\n" if ($server_mode);
print HTML ' top.innerFrame.frames[1].document.write(" </tr>");' . "\n";
print HTML ' };' . "\n";
print HTML ' top.innerFrame.frames[1].document.write("</table>");' . "\n";
@@ -2819,7 +2780,6 @@ sub generate_html_file {
print HTML ' };' . "\n";
print HTML ' DirectoryInfos[2].innerHTML = dir_info_array[2];' . "\n";
print HTML ' DirectoryInfos[3].innerHTML = dir_info_array[3];' . "\n";
print HTML ' DirectoryInfos[4].innerHTML = dir_info_array[5];' . "\n" if ($server_mode);
print HTML ' };' . "\n";
print HTML ' };' . "\n";
print HTML ' };' . "\n";
@@ -2969,7 +2929,6 @@ sub get_dirs_info_line {
$dirs_info_line .= $log_path_string;
};
$dirs_info_line .= '<br>';
$dirs_info_line .= $jobs_hash{$job}->{CLIENT} . '<br>' if ($server_mode);
return $dirs_info_line;
};
@@ -3097,249 +3056,10 @@ sub accept_html_connection {
return $new_socket_obj;
};
sub accept_connection {
my $new_socket_obj = undef;
do {
$new_socket_obj = $server_socket_obj->accept();
if (!$new_socket_obj) {
print "Timeout on incoming connection\n";
check_client_jobs();
};
} while (!$new_socket_obj);
return $new_socket_obj;
};
sub check_client_jobs {
foreach (keys %clients_times) {
if (time - $clients_times{$_} > $client_timeout) {
print "Client's $_ Job: \"$clients_jobs{$_}\" apparently got lost...\n";
print "Scheduling for rebuild...\n";
print "You might need to check the $_\n";
$lost_client_jobs{$clients_jobs{$_}}++;
delete $processes_hash{$_};
delete $clients_jobs{$_};
delete $clients_times{$_};
};
};
};
sub get_server_ports {
# use port 7890 as default
my $default_port = 7890;
if ($ports_string) {
@server_ports = split( /:/, $ports_string);
} else {
@server_ports = ($default_port .. $default_port + 4);
};
};
sub run_server {
my @build_queue = (); # array, containing queue of projects
# to build
my $error = 0;
if (scalar @server_ports) {
foreach (@server_ports) {
$error = start_server_on_port($_, \$server_socket_obj);
if ($error) {
print STDERR "port $_: $error\n";
} else {
last;
};
};
print_error('Unable to start server on port(s): ' . "@server_ports\n") if ($error);
} else {
print_error('No ports for server to start');
};
my $client_addr;
my $job_string_base = get_job_string_base();
my $new_socket_obj;
while ($new_socket_obj = accept_connection()) {
check_client_jobs();
# find out who connected
my $client_ipnum = $new_socket_obj->peerhost();
my $client_host = gethostbyaddr(inet_aton($client_ipnum), AF_INET);
# print who is connected
# send them a message, close connection
my $client_message = <$new_socket_obj>;
chomp $client_message;
my @client_data = split(/ /, $client_message);
my %client_hash = ();
foreach (@client_data) {
/(=)/;
$client_hash{$`} = $'; #'
}
my $pid = $client_hash{pid} . '@' . $client_host;
if (defined $client_hash{platform}) {
if ($client_hash{platform} ne $ENV{OUTPATH} || (defined $client_hash{osname} && ($^O ne $client_hash{osname}))) {
print $new_socket_obj "Wrong platform";
close($new_socket_obj);
next;
};
} else {
if ($client_hash{result} eq "0") {
} else {
print "Error $client_hash{result}\n";
if (store_error($pid, $client_hash{result})) {
print $new_socket_obj $job_string_base . $clients_jobs{$pid};
close($new_socket_obj);
$clients_times{$pid} = time;
next;
};
};
delete $clients_times{$pid};
clear_from_child($pid);
delete $clients_jobs{$pid};
$verbose_mode && print 'Running processes: ', children_number(), "\n";
# Actually, next 3 strings are only for even distribution
# of clients if there are more than one build server running
print $new_socket_obj 'No job';
close($new_socket_obj);
next;
};
my $job_string;
my @lost_jobs = keys %lost_client_jobs;
if (scalar @lost_jobs) {
$job_string = $lost_jobs[0];
delete $lost_client_jobs{$lost_jobs[0]};
} else {
$job_string = get_job_string(\@build_queue);
};
if ($job_string) {
my $job_dir = $job_jobdir{$job_string};
$processes_hash{$pid} = $job_dir;
$jobs_hash{$job_dir}->{CLIENT} = $pid;
print "$pid got $job_dir\n";
print $new_socket_obj $job_string_base . $job_string;
$clients_jobs{$pid} = $job_string;
$clients_times{$pid} = time;
my $children_running = children_number();
$verbose_mode && print 'Running processes: ', $children_running, "\n";
$maximal_processes = $children_running if ($children_running > $maximal_processes);
} else {
print $new_socket_obj 'No job';
};
close($new_socket_obj);
};
};
#
# Procedure returns the part of the job string that is similar for all clients
#
sub get_job_string_base {
if ($setenv_string) {
return "setenv_string=$setenv_string ";
};
my $job_string_base = "server_pid=$$ setsolar_cmd=$ENV{SETSOLAR_CMD} ";
$job_string_base .= "source_root=$ENV{SOURCE_ROOT} " if (defined $ENV{SOURCE_ROOT});
$job_string_base .= "updater=$ENV{UPDATER} " if (defined $ENV{UPDATER});
return $job_string_base;
};
sub get_job_string {
my $build_queue = shift;
my $job = $dmake;
my ($job_dir, $dependencies_hash);
if ($build_all_parents) {
fill_modules_queue($build_queue);
do {
($job_dir, $dependencies_hash) = pick_jobdir($build_queue);
return '' if (!$job_dir);
$jobs_hash{$job_dir}->{START_TIME} = time();
$jobs_hash{$job_dir}->{STATUS} = 'building';
if ($job_dir =~ /(\s)$pre_job/o) {
do_custom_job($job_dir, $dependencies_hash);
$job_dir = '';
};
} while (!$job_dir);
} else {
$dependencies_hash = \%local_deps_hash;
do {
$job_dir = pick_prj_to_build(\%local_deps_hash);
if (!$job_dir && !children_number()) {
cancel_build() if (scalar keys %broken_build);
mp_success_exit();
};
return '' if (!$job_dir);
$jobs_hash{$job_dir}->{START_TIME} = time();
$jobs_hash{$job_dir}->{STATUS} = 'building';
if ($job_dir =~ /(\s)$pre_job/o) {
do_custom_job($job_dir, $dependencies_hash);
$job_dir = '';
};
} while (!$job_dir);
};
$running_children{$dependencies_hash}++;
$folders_hashes{$job_dir} = $dependencies_hash;
my $log_file = $jobs_hash{$job_dir}->{LONG_LOG_PATH};
my $full_job_dir = $job_dir;
if ($job_dir =~ /(\s)/o) {
$job = $'; #'
print $echo . "determine if we need to deliver $job_dir\n";
if ($job eq $post_job) {
if( $is_gbuild{$job_dir} ) {
print "Skip deliver for gmake-built module $job_dir\n";
return'';
};
$job = $deliver_command
};
$full_job_dir = $module_paths{$`};
}
my $log_dir = File::Basename::dirname($log_file);
if (!-d $log_dir) {
chdir $full_job_dir;
getcwd();
system("$perl $mkout");
};
my $job_string = "job_dir=$full_job_dir job=$job log=$log_file";
$job_jobdir{$job_string} = $job_dir;
return $job_string;
};
sub pick_jobdir {
my $build_queue = shift;
my $i = 0;
foreach (@$build_queue) {
my $prj = $$build_queue[$i];
my $prj_deps_hash = $projects_deps_hash{$prj};
if (defined $modules_with_errors{$prj_deps_hash} && !$ignore) {
push (@broken_modules_names, $prj);
splice (@$build_queue, $i, 1);
next;
};
$running_children{$prj_deps_hash} = 0 if (!defined $running_children{$prj_deps_hash});
my $child_nick = pick_prj_to_build($prj_deps_hash);
if ($child_nick) {
return ($child_nick, $prj_deps_hash);
}
if ((!scalar keys %$prj_deps_hash) && !$running_children{$prj_deps_hash}) {
if (!defined $modules_with_errors{$prj_deps_hash} || $ignore)
{
remove_from_dependencies($prj, \%global_deps_hash);
$build_is_finished{$prj}++;
splice (@$build_queue, $i, 1);
next;
};
};
$i++;
};
};
sub fill_modules_queue {
my $build_queue = shift;
my $prj;
while ($prj = pick_prj_to_build(\%global_deps_hash)) {
push @$build_queue, $prj;
$projects_deps_hash{$prj} = {};
get_module_dep_hash($prj, $projects_deps_hash{$prj});
my $info_hash = $html_info{$prj};
$$info_hash{DIRS} = check_deps_hash($projects_deps_hash{$prj}, $prj);
$module_by_hash{$projects_deps_hash{$prj}} = $prj;
};
if (!$prj && !children_number() && (!scalar @$build_queue)) {
cancel_build() if (scalar keys %broken_build);
mp_success_exit();
};
@server_ports = ($default_port .. $default_port + 4);
};
sub is_gnumake_module {
diff --git a/solenv/bin/build_client.pl b/solenv/bin/build_client.pl
deleted file mode 100755
index 5119f60a..0000000
--- a/solenv/bin/build_client.pl
+++ /dev/null
@@ -1,436 +0,0 @@
:
eval 'exec perl -S $0 ${1+"$@"}'
if 0;
#*************************************************************************
#
# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
#
# Copyright 2000, 2010 Oracle and/or its affiliates.
#
# OpenOffice.org - a multi-platform office productivity suite
#
# This file is part of OpenOffice.org.
#
# OpenOffice.org is free software: you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License version 3
# only, as published by the Free Software Foundation.
#
# OpenOffice.org is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Lesser General Public License version 3 for more details
# (a copy is included in the LICENSE file that accompanied this code).
#
# You should have received a copy of the GNU Lesser General Public License
# version 3 along with OpenOffice.org. If not, see
# <http://www.openoffice.org/license.html>
# for a copy of the LGPLv3 License.
#
#*************************************************************************
#
# build_client - client for the build tool in server mode
#
use strict;
use Socket;
use Sys::Hostname;
use File::Temp qw(tmpnam);
use POSIX;
use Cwd qw (cwd);
$SIG{KILL} = \&handle_temp_files;
$SIG{INT} = \&handle_temp_files;
### main ###
my $enable_multiprocessing = 1;
my $server_list_file;
my $server_list_time_stamp = 0;
my %ENV_BACKUP;
$ENV_BACKUP{$_} = $ENV{$_} foreach (keys %ENV);
if ($^O eq 'MSWin32') {
eval { require Win32::Process; import Win32::Process; };
$enable_multiprocessing = 0 if ($@);
} else {
use Cwd 'chdir';
};
my $processes_to_run = 1;
my %hosts_ports = ();
my $default_port = 7890;
my @ARGV_COPY = @ARGV; # @ARGV BACKUP
print "arguments: @ARGV\n";
get_options();
my $proto = getprotobyname('tcp');
my $paddr;
my $host = hostname();
my $current_server = '';
my $got_job = 0;
my %job_temp_files = ();
my %environments = (); # hash containing all environments
my $env_alias;
my %platform_rejects = (); # hash containing paddr of server, that replied "Wrong platform"
my $child = 0;
if ($processes_to_run > 1) {
my $started_processes = 1;
if ($^O eq 'MSWin32') {
my $process_obj = undef;
my $child_args = "perl $0";
foreach (@ARGV_COPY) {
/^-P(\d+)$/ and next;
/^-P$/ and shift @ARGV_COPY and next;
$child_args .= " $_";
};
do {
my $rc = Win32::Process::Create($process_obj, $^X,
$child_args,
0, 0, #NORMAL_PRIORITY_CLASS,
".");
print_error("Cannot start child process") if (!$rc);
$started_processes++;
} while ($started_processes < $processes_to_run);
} else {
my $pid;
do {
if ($pid = fork) { # parent
$started_processes++;
print $started_processes . "\n";
} elsif (defined $pid) { # child
$child++;
};
} while (($started_processes < $processes_to_run) && !$child);
};
};
run_client();
### end of main procedure ###
#########################
# #
# Procedures #
# #
#########################
sub handle_temp_files {
print STDERR "Got signal - clearing up...\n";
foreach (keys %job_temp_files) {
if ($job_temp_files{$_}) {
rename($_, $job_temp_files{$_}) or system("mv", $_, $job_temp_files{$_});
print STDERR "Could not rename $_ to $job_temp_files{$_}\n" if (-e $_);
} else {
unlink $_ or system("rm -rf $_");
print STDERR "Could not remove $_\n" if (-e $_);
};
};
exit($?);
};
sub run_client {
# initialize host and port
if (!scalar keys %hosts_ports) {
$hosts_ports{localhost} = $default_port;
}
print "Started client with PID $$, hostname $host\n";
my $message = '';
my $current_port = '';
my %active_servers = ();
do {
$got_job = 0;
foreach $current_server (keys %hosts_ports) {
foreach $current_port (keys %{$hosts_ports{$current_server}}) {
#before each "inactive" server/port connect - connect to each "active" server/port
next if (defined ${$active_servers{$current_server}}{$current_port});
# "active" cycle
foreach my $active_server (keys %active_servers) {
foreach my $active_port (keys %{$active_servers{$active_server}}) {
my $iaddr = inet_aton($active_server);
$paddr = sockaddr_in($active_port, $iaddr);
do {
my $server_is_active = 0;
$message = request_job($message, $active_server, $active_port);
$server_is_active++ if ($message);
if (!$server_is_active) {
delete ${$active_servers{$active_server}}{$active_port};
# throw away obsolete environments
foreach (keys %environments) {
/^\d+@/;
if ($' eq "$active_server:$active_port") {
delete $environments{$_};
};
};
};
$message = '' if ($message eq 'No job');
} while ($message);
};
};
# "inactive" cycle
my $iaddr = inet_aton($current_server);
$paddr = sockaddr_in($current_port, $iaddr);
do {
$message = request_job($message, $current_server, $current_port);
if ($message) {
if (!defined $active_servers{$current_server}) {
my %ports;
$active_servers{$current_server} = \%ports;
};
${$active_servers{$current_server}}{$current_port}++;
};
$message = '' if ($message eq 'No job');
} while ($message);
};
};
sleep 5 if (!$got_job);
read_server_list();
} while(1);
};
sub usage {
my $error = shift;
print STDERR "\nbuild_client\n";
print STDERR "Syntax: build_client [-PN] host1[:port1:...:portN] [host2[:port1:...:portN] ... hostN[:port1:...:portN]]|\@server_list_file\n";
print STDERR " -P - start multiprocessing build, with number of processes passed\n";
print STDERR "Example1: build_client myserver1 myserver2:7891:7892\n";
print STDERR " the client will be asking for jobs on myserver1's default ports (7890-7894)\n";
print STDERR " and on myserver2's ports 7891 and 7892\n";
print STDERR "Example2: build_client -P2 myserver1:7990 myserver2\n";
print STDERR " start 2 clients which will be asking for jobs myserver1's port 7990\n";
print STDERR " and myserver2's default ports (7890-7894)\n";
exit ($error);
};
sub get_options {
my $arg;
usage(1) if (!scalar @ARGV);
while ($arg = shift @ARGV) {
usage(0) if /^--help$/;
usage(0) if /^-h$/;
$arg =~ /^-P(\d+)$/ and $processes_to_run = $1 and next;
$arg =~ /^-P$/ and $processes_to_run = shift @ARGV and next;
$arg =~ /^@(\S+)$/ and $server_list_file = $1 and next;
store_server($arg);
};
if (($processes_to_run > 1) && (!$enable_multiprocessing)) {
print_error("Cannot load Win32::Process module for multiple client start");
};
if ($server_list_file) {
print_error("$server_list_file is not a regular file!!") if (!-f $server_list_file);
read_server_list();
}
print_error("No server info") if (!scalar %hosts_ports);
};
sub store_server {
my $server_string = shift;
my @server_params = ();
@server_params = split (/:/, $server_string);
my $host = shift @server_params;
my @names = gethostbyname($host);
my $host_full_name = $names[0];
my %ports = ();
if (defined $hosts_ports{$host_full_name}) {
%ports = %{$hosts_ports{$host_full_name}};
};
# To do: implement keys in form server:port -> priority
if (defined $hosts_ports{$host_full_name}) {
if (!$server_list_time_stamp) {
print "The $host with ip address " . inet_ntoa(inet_aton($host)) . " is at least two times in the server list\n";
};
} else {
print "Added server $host as $host_full_name\n";
};
if (scalar @server_params) {
$ports{$_}++ foreach (@server_params);
} else {
$ports{$_}++ foreach ($default_port .. $default_port + 4);
};
$hosts_ports{$host_full_name} = \%ports;
};
sub read_server_list {
open(SERVER_LIST, "<$server_list_file") or return;
my $current_time_stamp = (stat($server_list_file))[9];
return if ($server_list_time_stamp >= $current_time_stamp);
my @server_array = ();
foreach my $file_string(<SERVER_LIST>) {
while ($file_string =~ /(\S+)/) {
$file_string = $';
store_server($1);
};
};
close SERVER_LIST;
$server_list_time_stamp = $current_time_stamp;
};
sub request_job {
my ($message, $current_server, $current_port) = @_;
$message = "platform=$ENV_BACKUP{OUTPATH} pid=$$ osname=$^O" if (!$message);
# create the socket, connect to the port
socket(SOCKET, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
connect(SOCKET, $paddr) or return '';
my $error_code = 1;
$message .= "\n";
syswrite SOCKET, $message, length $message;
while (my $line = <SOCKET>) {
chomp $line;
if ($line eq 'No job') {
close SOCKET or die "close: $!";
return $line;
};
if ($line eq "Wrong platform") {
if (!defined $platform_rejects{$paddr}) {
$platform_rejects{$paddr}++;
print STDERR $line . "\n";
}
close SOCKET or die "close: $!";
delete $hosts_ports{$current_server};
return '';
} elsif (defined $platform_rejects{$paddr}) {
delete $platform_rejects{$paddr};
};
$got_job++;
$error_code = do_job($line . " server=$current_server port=$current_port");
}
close SOCKET or die "close: $!";
return("result=$error_code pid=$$");
}
sub do_job {
my @job_parameters = split(/ /, shift);
my %job_hash = ();
my $last_param;
my $error_code;
print "Client $$@" . "$host\n";
foreach (@job_parameters) {
if (/(=)/) {
$job_hash{$`} = $';
$last_param = $`;
} else {
$job_hash{$last_param} .= " $_";
};
};
$env_alias = $job_hash{server_pid} . '@' . $job_hash{server} . ':' . $job_hash{port};
my $result = "1"; # default value
my $cmd_file = File::Temp::tmpnam($ENV_BACKUP{TMP});
my $tmp_log_file = File::Temp::tmpnam($ENV_BACKUP{TMP});
$job_temp_files{$tmp_log_file} = $job_hash{log};
my $setenv_string = '';
if (defined $job_hash{setenv_string}) {
# use configuration string from server
$setenv_string .= $job_hash{setenv_string};
print "Environment: $setenv_string\n";
my $directory = $job_hash{job_dir};
open (COMMAND_FILE, ">$cmd_file");
print COMMAND_FILE "$setenv_string\n";
if (!defined $job_hash{job_dir}) {
close COMMAND_FILE;
print "No job_dir, cmd file: $cmd_file\n";
foreach (keys %job_hash) {
print "key: $_ $job_hash{$_}\n";
};
exit (1);
};
print COMMAND_FILE "pushd $job_hash{job_dir} && ";
print COMMAND_FILE $job_hash{job} ." >& $tmp_log_file\n";
print COMMAND_FILE "exit \$?\n";
close COMMAND_FILE;
$job_temp_files{$cmd_file} = 0;
$job_temp_files{$tmp_log_file} = $job_hash{log};
$error_code = system($ENV{SHELL}, $cmd_file);
unlink $cmd_file or system("rm -rf $cmd_file");
delete $job_temp_files{$cmd_file};
} else {
# generate setsolar string
if (!defined $environments{$env_alias}) {
$error_code = get_setsolar_environment(\%job_hash);
return($error_code) if ($error_code);
};
my $solar_vars = $environments{$env_alias};
delete $ENV{$_} foreach (keys %ENV);
$ENV{$_} = $$solar_vars{$_} foreach (keys %$solar_vars);
print 'Workspace: ';
print $ENV{SOLARSRC};
print "\nplatform: $ENV{INPATH} $^O";
print "\ndir: $job_hash{job_dir}\n";
print "job: $job_hash{job}\n";
chdir $job_hash{job_dir};
getcwd();
my $job_string = $job_hash{job} . ' > ' . $tmp_log_file . ' 2>&1';
$error_code = system($job_string);
};
rename($tmp_log_file, $job_hash{log}) or system("mv", $tmp_log_file, $job_hash{log});
delete $job_temp_files{$tmp_log_file};
if ($error_code) {
print "Error code = $error_code\n\n";
} else {
print "Success!!\n\n";
};
return $error_code;
};
sub get_setsolar_environment {
my $job_hash = shift;
my $server_pid = $$job_hash{server_pid};
my $setsolar_string = $$job_hash{setsolar_cmd};
# Prepare the string for the client
$setsolar_string =~ s/\s-file\s\S+//g;
my $error_code = 0;
my $cmd_file = File::Temp::tmpnam($ENV_BACKUP{TMP});
my $tmp_log_file = File::Temp::tmpnam($ENV_BACKUP{TMP});
if (defined $$job_hash{updater}) {
$ENV{UPDATER} = $$job_hash{updater};
} else {
undef $ENV{UPDATER} if (defined $ENV{UPDATER});
};
if (defined $$job_hash{source_root}) {
$ENV{SOURCE_ROOT} = $$job_hash{source_root};
} else {
undef $ENV{SOURCE_ROOT} if (defined $ENV{SOURCE_ROOT});
};
$error_code = system("$setsolar_string -file $cmd_file");
store_env_hash($cmd_file);
return $error_code;
};
sub print_error {
my $message = shift;
print STDERR "\nERROR: $message\n";
exit(1);
};
sub store_env_hash {
my $ss_setenv_file = shift;
my %solar_vars = ();
my $cmd_file = File::Temp::tmpnam($ENV_BACKUP{TMP});
my $env_vars_file = File::Temp::tmpnam($ENV_BACKUP{TMP});
print "$cmd_file $env_vars_file\n";
#get all env variables in $env_vars_file
open (COMMAND_FILE, ">$cmd_file");
print COMMAND_FILE "source $ss_setenv_file\n";
print COMMAND_FILE "env > $env_vars_file\n";
close COMMAND_FILE;
system($ENV{SHELL}, $cmd_file);
print_error($?) if ($?);
unlink $cmd_file or system("rm -rf $cmd_file");
unlink $ss_setenv_file or system("rm -rf $ss_setenv_file");
open SOLARTABLE, "<$env_vars_file" or die "can´t open solarfile $env_vars_file";
while(<SOLARTABLE>) {
chomp;
s/\r\n//o;
/(=)/;
$solar_vars{$`} = $';
};
close SOLARTABLE;
unlink $env_vars_file or system("rm -rf $env_vars_file");
$environments{$env_alias} = \%solar_vars;
};
