| : |
| eval 'exec perl -S $0 ${1+"$@"}' |
| if 0; |
| #************************************************************** |
| # |
| # Licensed to the Apache Software Foundation (ASF) under one |
| # or more contributor license agreements. See the NOTICE file |
| # distributed with this work for additional information |
| # regarding copyright ownership. The ASF licenses this file |
| # to you under the Apache License, Version 2.0 (the |
| # "License"); you may not use this file except in compliance |
| # with the License. You may obtain a copy of the License at |
| # |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| # |
| # Unless required by applicable law or agreed to in writing, |
| # software distributed under the License is distributed on an |
| # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| # KIND, either express or implied. See the License for the |
| # specific language governing permissions and limitations |
| # under the 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 |
| #$ARGV_COPY{$_}++ foreach (@ARGV); |
| 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}}) { |
| # print "Active: $active_server:$active_port\n"; |
| 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 |
| # print "Inactive: $current_server:$current_port\n"; |
| 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 '';#die "connect: $!"; |
| 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: '; |
| if (defined $ENV{CWS_WORK_STAMP}) { |
| print $ENV{CWS_WORK_STAMP}; |
| } else { |
| 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};# = $job_hash{log}; |
| }; |
| 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;#($$job_hash{server_pid}.$$job_hash{setsolar_cmd}, $cmd_file); |
| 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; |
| }; |
