1: 2eval 'exec perl -S $0 ${1+"$@"}' 3 if 0; 4#************************************************************** 5# 6# Licensed to the Apache Software Foundation (ASF) under one 7# or more contributor license agreements. See the NOTICE file 8# distributed with this work for additional information 9# regarding copyright ownership. The ASF licenses this file 10# to you under the Apache License, Version 2.0 (the 11# "License"); you may not use this file except in compliance 12# with the License. You may obtain a copy of the License at 13# 14# http://www.apache.org/licenses/LICENSE-2.0 15# 16# Unless required by applicable law or agreed to in writing, 17# software distributed under the License is distributed on an 18# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 19# KIND, either express or implied. See the License for the 20# specific language governing permissions and limitations 21# under the License. 22# 23#************************************************************** 24 25 26# 27# build_client - client for the build tool in server mode 28# 29 30use strict; 31use Socket; 32use Sys::Hostname; 33use File::Temp qw(tmpnam); 34use POSIX; 35use Cwd qw (cwd); 36 37$SIG{KILL} = \&handle_temp_files; 38$SIG{INT} = \&handle_temp_files; 39 40### main ### 41my $enable_multiprocessing = 1; 42my $server_list_file; 43my $server_list_time_stamp = 0; 44my %ENV_BACKUP; 45$ENV_BACKUP{$_} = $ENV{$_} foreach (keys %ENV); 46 47if ($^O eq 'MSWin32') { 48 eval { require Win32::Process; import Win32::Process; }; 49 $enable_multiprocessing = 0 if ($@); 50} else { 51 use Cwd 'chdir'; 52}; 53my $processes_to_run = 1; 54 55my %hosts_ports = (); 56my $default_port = 7890; 57my @ARGV_COPY = @ARGV; # @ARGV BACKUP 58#$ARGV_COPY{$_}++ foreach (@ARGV); 59print "arguments: @ARGV\n"; 60get_options(); 61 62my $proto = getprotobyname('tcp'); 63my $paddr; 64my $host = hostname(); 65my $current_server = ''; 66my $got_job = 0; 67my %job_temp_files = (); 68my %environments = (); # hash containing all environments 69my $env_alias; 70my %platform_rejects = (); # hash containing paddr of server, that replied "Wrong platform" 71 72my $child = 0; 73if ($processes_to_run > 1) { 74 my $started_processes = 1; 75 if ($^O eq 'MSWin32') { 76 my $process_obj = undef; 77 my $child_args = "perl $0"; 78 foreach (@ARGV_COPY) { 79 /^-P(\d+)$/ and next; 80 /^-P$/ and shift @ARGV_COPY and next; 81 $child_args .= " $_"; 82 }; 83 do { 84 my $rc = Win32::Process::Create($process_obj, $^X, 85 $child_args, 86 0, 0, #NORMAL_PRIORITY_CLASS, 87 "."); 88 print_error("Cannot start child process") if (!$rc); 89 $started_processes++; 90 } while ($started_processes < $processes_to_run); 91 } else { 92 my $pid; 93 do { 94 if ($pid = fork) { # parent 95 $started_processes++; 96 print $started_processes . "\n"; 97 } elsif (defined $pid) { # child 98 $child++; 99 }; 100 } while (($started_processes < $processes_to_run) && !$child); 101 }; 102}; 103 104run_client(); 105### end of main procedure ### 106 107######################### 108# # 109# Procedures # 110# # 111######################### 112sub handle_temp_files { 113 print STDERR "Got signal - clearing up...\n"; 114 foreach (keys %job_temp_files) { 115 if ($job_temp_files{$_}) { 116 rename($_, $job_temp_files{$_}) or system("mv", $_, $job_temp_files{$_}); 117 print STDERR "Could not rename $_ to $job_temp_files{$_}\n" if (-e $_); 118 } else { 119 unlink $_ or system("rm -rf $_"); 120 print STDERR "Could not remove $_\n" if (-e $_); 121 }; 122 }; 123 exit($?); 124}; 125 126sub run_client { 127# initialize host and port 128 if (!scalar keys %hosts_ports) { 129 $hosts_ports{localhost} = $default_port; 130 } 131 132 print "Started client with PID $$, hostname $host\n"; 133 134 my $message = ''; 135 my $current_port = ''; 136 my %active_servers = (); 137 138 do { 139 $got_job = 0; 140 foreach $current_server (keys %hosts_ports) { 141 foreach $current_port (keys %{$hosts_ports{$current_server}}) { 142 143 #before each "inactive" server/port connect - connect to each "active" server/port 144 next if (defined ${$active_servers{$current_server}}{$current_port}); 145 # "active" cycle 146 foreach my $active_server (keys %active_servers) { 147 foreach my $active_port (keys %{$active_servers{$active_server}}) { 148# print "Active: $active_server:$active_port\n"; 149 my $iaddr = inet_aton($active_server); 150 $paddr = sockaddr_in($active_port, $iaddr); 151 do { 152 my $server_is_active = 0; 153 $message = request_job($message, $active_server, $active_port); 154 $server_is_active++ if ($message); 155 if (!$server_is_active) { 156 delete ${$active_servers{$active_server}}{$active_port}; 157 # throw away obsolete environments 158 foreach (keys %environments) { 159 /^\d+@/; 160 if ($' eq "$active_server:$active_port") { 161 delete $environments{$_}; 162 }; 163 }; 164 }; 165 $message = '' if ($message eq 'No job'); 166 } while ($message); 167 }; 168 }; 169 170 # "inactive" cycle 171# print "Inactive: $current_server:$current_port\n"; 172 my $iaddr = inet_aton($current_server); 173 $paddr = sockaddr_in($current_port, $iaddr); 174 do { 175 $message = request_job($message, $current_server, $current_port); 176 if ($message) { 177 if (!defined $active_servers{$current_server}) { 178 my %ports; 179 $active_servers{$current_server} = \%ports; 180 }; 181 ${$active_servers{$current_server}}{$current_port}++; 182 }; 183 $message = '' if ($message eq 'No job'); 184 } while ($message); 185 }; 186 }; 187 sleep 5 if (!$got_job); 188 read_server_list(); 189 } while(1); 190}; 191 192sub usage { 193 my $error = shift; 194 print STDERR "\nbuild_client\n"; 195 print STDERR "Syntax: build_client [-PN] host1[:port1:...:portN] [host2[:port1:...:portN] ... hostN[:port1:...:portN]]|\@server_list_file\n"; 196 print STDERR " -P - start multiprocessing build, with number of processes passed\n"; 197 print STDERR "Example1: build_client myserver1 myserver2:7891:7892\n"; 198 print STDERR " the client will be asking for jobs on myserver1's default ports (7890-7894)\n"; 199 print STDERR " and on myserver2's ports 7891 and 7892\n"; 200 print STDERR "Example2: build_client -P2 myserver1:7990 myserver2\n"; 201 print STDERR " start 2 clients which will be asking for jobs myserver1's port 7990\n"; 202 print STDERR " and myserver2's default ports (7890-7894)\n"; 203 exit ($error); 204}; 205 206sub get_options { 207 my $arg; 208 usage(1) if (!scalar @ARGV); 209 while ($arg = shift @ARGV) { 210 usage(0) if /^--help$/; 211 usage(0) if /^-h$/; 212 $arg =~ /^-P(\d+)$/ and $processes_to_run = $1 and next; 213 $arg =~ /^-P$/ and $processes_to_run = shift @ARGV and next; 214 $arg =~ /^@(\S+)$/ and $server_list_file = $1 and next; 215 store_server($arg); 216 }; 217 if (($processes_to_run > 1) && (!$enable_multiprocessing)) { 218 print_error("Cannot load Win32::Process module for multiple client start"); 219 }; 220 if ($server_list_file) { 221 print_error("$server_list_file is not a regular file!!") if (!-f $server_list_file); 222 read_server_list(); 223 } 224 print_error("No server info") if (!scalar %hosts_ports); 225}; 226 227sub store_server { 228 my $server_string = shift; 229 my @server_params = (); 230 @server_params = split (/:/, $server_string); 231 my $host = shift @server_params; 232 my @names = gethostbyname($host); 233 my $host_full_name = $names[0]; 234 my %ports = (); 235 if (defined $hosts_ports{$host_full_name}) { 236 %ports = %{$hosts_ports{$host_full_name}}; 237 }; 238 # To do: implement keys in form server:port -> priority 239 if (defined $hosts_ports{$host_full_name}) { 240 if (!$server_list_time_stamp) { 241 print "The $host with ip address " . inet_ntoa(inet_aton($host)) . " is at least two times in the server list\n"; 242 }; 243 } else { 244 print "Added server $host as $host_full_name\n"; 245 }; 246 if (scalar @server_params) { 247 $ports{$_}++ foreach (@server_params); 248 } else { 249 $ports{$_}++ foreach ($default_port .. $default_port + 4); 250 }; 251 $hosts_ports{$host_full_name} = \%ports; 252}; 253 254sub read_server_list { 255 open(SERVER_LIST, "<$server_list_file") or return; 256 my $current_time_stamp = (stat($server_list_file))[9]; 257 return if ($server_list_time_stamp >= $current_time_stamp); 258 my @server_array = (); 259 foreach my $file_string(<SERVER_LIST>) { 260 while ($file_string =~ /(\S+)/) { 261 $file_string = $'; 262 store_server($1); 263 }; 264 }; 265 close SERVER_LIST; 266 $server_list_time_stamp = $current_time_stamp; 267}; 268 269sub request_job { 270 my ($message, $current_server, $current_port) = @_; 271 $message = "platform=$ENV_BACKUP{OUTPATH} pid=$$ osname=$^O" if (!$message); 272 # create the socket, connect to the port 273 socket(SOCKET, PF_INET, SOCK_STREAM, $proto) or die "socket: $!"; 274 connect(SOCKET, $paddr) or return '';#die "connect: $!"; 275 my $error_code = 1; 276 $message .= "\n"; 277 syswrite SOCKET, $message, length $message; 278 while (my $line = <SOCKET>) { 279 chomp $line; 280 if ($line eq 'No job') { 281 close SOCKET or die "close: $!"; 282 return $line; 283 }; 284 if ($line eq "Wrong platform") { 285 if (!defined $platform_rejects{$paddr}) { 286 $platform_rejects{$paddr}++; 287 print STDERR $line . "\n"; 288 } 289 close SOCKET or die "close: $!"; 290 delete $hosts_ports{$current_server}; 291 return ''; 292 } elsif (defined $platform_rejects{$paddr}) { 293 delete $platform_rejects{$paddr}; 294 }; 295 $got_job++; 296 $error_code = do_job($line . " server=$current_server port=$current_port"); 297 } 298 close SOCKET or die "close: $!"; 299 return("result=$error_code pid=$$"); 300} 301 302sub do_job { 303 my @job_parameters = split(/ /, shift); 304 my %job_hash = (); 305 my $last_param; 306 my $error_code; 307 print "Client $$@" . "$host\n"; 308 foreach (@job_parameters) { 309 if (/(=)/) { 310 $job_hash{$`} = $'; 311 $last_param = $`; 312 } else { 313 $job_hash{$last_param} .= " $_"; 314 }; 315 }; 316 $env_alias = $job_hash{server_pid} . '@' . $job_hash{server} . ':' . $job_hash{port}; 317 my $result = "1"; # default value 318 my $cmd_file = File::Temp::tmpnam($ENV_BACKUP{TMP}); 319 my $tmp_log_file = File::Temp::tmpnam($ENV_BACKUP{TMP}); 320 $job_temp_files{$tmp_log_file} = $job_hash{log}; 321 my $setenv_string = ''; 322 if (defined $job_hash{setenv_string}) { 323 # use configuration string from server 324 $setenv_string .= $job_hash{setenv_string}; 325 print "Environment: $setenv_string\n"; 326 327 my $directory = $job_hash{job_dir}; 328 open (COMMAND_FILE, ">$cmd_file"); 329 print COMMAND_FILE "$setenv_string\n"; 330 if (!defined $job_hash{job_dir}) { 331 close COMMAND_FILE; 332 print "No job_dir, cmd file: $cmd_file\n"; 333 foreach (keys %job_hash) { 334 print "key: $_ $job_hash{$_}\n"; 335 }; 336 exit (1); 337 }; 338 339 print COMMAND_FILE "pushd $job_hash{job_dir} && "; 340 print COMMAND_FILE $job_hash{job} ." >& $tmp_log_file\n"; 341 print COMMAND_FILE "exit \$?\n"; 342 close COMMAND_FILE; 343 $job_temp_files{$cmd_file} = 0; 344 $job_temp_files{$tmp_log_file} = $job_hash{log}; 345 $error_code = system($ENV{SHELL}, $cmd_file); 346 unlink $cmd_file or system("rm -rf $cmd_file"); 347 delete $job_temp_files{$cmd_file}; 348 } else { 349 # generate setsolar string 350 if (!defined $environments{$env_alias}) { 351 $error_code = get_setsolar_environment(\%job_hash); 352 return($error_code) if ($error_code); 353 }; 354 my $solar_vars = $environments{$env_alias}; 355 356 delete $ENV{$_} foreach (keys %ENV); 357 $ENV{$_} = $$solar_vars{$_} foreach (keys %$solar_vars); 358 print 'Workspace: '; 359 if (defined $ENV{CWS_WORK_STAMP}) { 360 print $ENV{CWS_WORK_STAMP}; 361 } else { 362 print $ENV{SOLARSRC}; 363 }; 364 365 print "\nplatform: $ENV{INPATH} $^O"; 366 print "\ndir: $job_hash{job_dir}\n"; 367 print "job: $job_hash{job}\n"; 368 chdir $job_hash{job_dir}; 369 getcwd(); 370 my $job_string = $job_hash{job} . ' > ' . $tmp_log_file . ' 2>&1'; 371 $error_code = system($job_string); 372# rename($tmp_log_file, $job_hash{log}) or system("mv", $tmp_log_file, $job_hash{log}); 373# delete $job_temp_files{$tmp_log_file};# = $job_hash{log}; 374 }; 375 rename($tmp_log_file, $job_hash{log}) or system("mv", $tmp_log_file, $job_hash{log}); 376 delete $job_temp_files{$tmp_log_file}; 377 378 if ($error_code) { 379 print "Error code = $error_code\n\n"; 380 } else { 381 print "Success!!\n\n"; 382 }; 383 return $error_code; 384}; 385 386sub get_setsolar_environment { 387 my $job_hash = shift; 388 my $server_pid = $$job_hash{server_pid}; 389 my $setsolar_string = $$job_hash{setsolar_cmd}; 390 # Prepare the string for the client 391 $setsolar_string =~ s/\s-file\s\S+//g; 392 my $error_code = 0; 393 my $cmd_file = File::Temp::tmpnam($ENV_BACKUP{TMP}); 394 my $tmp_log_file = File::Temp::tmpnam($ENV_BACKUP{TMP}); 395 if (defined $$job_hash{updater}) { 396 $ENV{UPDATER} = $$job_hash{updater}; 397 } else { 398 undef $ENV{UPDATER} if (defined $ENV{UPDATER}); 399 }; 400 if (defined $$job_hash{source_root}) { 401 $ENV{SOURCE_ROOT} = $$job_hash{source_root}; 402 } else { 403 undef $ENV{SOURCE_ROOT} if (defined $ENV{SOURCE_ROOT}); 404 }; 405 $error_code = system("$setsolar_string -file $cmd_file"); 406 store_env_hash($cmd_file); 407 return $error_code; 408}; 409 410sub print_error { 411 my $message = shift; 412 print STDERR "\nERROR: $message\n"; 413 exit(1); 414}; 415sub store_env_hash { 416 my $ss_setenv_file = shift;#($$job_hash{server_pid}.$$job_hash{setsolar_cmd}, $cmd_file); 417 my %solar_vars = (); 418 my $cmd_file = File::Temp::tmpnam($ENV_BACKUP{TMP}); 419 my $env_vars_file = File::Temp::tmpnam($ENV_BACKUP{TMP}); 420 print "$cmd_file $env_vars_file\n"; 421 #get all env variables in $env_vars_file 422 open (COMMAND_FILE, ">$cmd_file"); 423 print COMMAND_FILE "source $ss_setenv_file\n"; 424 print COMMAND_FILE "env > $env_vars_file\n"; 425 close COMMAND_FILE; 426 system($ENV{SHELL}, $cmd_file); 427 print_error($?) if ($?); 428 unlink $cmd_file or system("rm -rf $cmd_file"); 429 unlink $ss_setenv_file or system("rm -rf $ss_setenv_file"); 430 431 open SOLARTABLE, "<$env_vars_file" or die "can�t open solarfile $env_vars_file"; 432 while(<SOLARTABLE>) { 433 chomp; 434 s/\r\n//o; 435 /(=)/; 436 $solar_vars{$`} = $'; 437 }; 438 close SOLARTABLE; 439 unlink $env_vars_file or system("rm -rf $env_vars_file"); 440 $environments{$env_alias} = \%solar_vars; 441}; 442