solenv/bin/build_client.pl

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