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