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