xref: /aoo41x/main/solenv/bin/build_client.pl (revision 7e90fac2)
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