xref: /trunk/main/postprocess/checkdeliver/checkdeliver.pl (revision cdf0e10c4e3984b49a9502b011690b615761d4a3) 
1:
2eval 'exec perl -wS $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#
32# checkdeliver.pl - compare delivered files on solver with those on SRC_ROOT
33#
34
35use strict;
36use Getopt::Long;
37use File::stat;
38use IO::Handle;
39
40use lib ("$ENV{SOLARENV}/bin/modules");
41
42#### globals #####
43
44my $err              = 0;
45my $srcrootdir       = '';
46my $solverdir        = '';
47my $platform         = '';
48my $logfile          = '';
49my $milestoneext     = '';
50my $local_env        = 0;
51my @exceptionmodlist = (
52                        "postprocess",
53                        "instset.*native",
54                        "smoketest.*native",
55                        "testautomation",
56                        "testgraphical"
57                       ); # modules not yet delivered
58
59#### main #####
60
61print_logged("checkdeliver.pl - checking delivered binaries\n");
62
63get_globals();                                  # get global variables
64my $deliverlists_ref = get_deliver_lists();     # get deliver log files
65foreach my $listfile ( @$deliverlists_ref ) {
66    $err += check( $listfile );                 # check delivered files
67}
68print_logged("OK\n") if ( ! $err );
69exit $err;
70
71#### subroutines ####
72
73sub get_globals
74# set global variables using environment variables and command line options
75{
76    my $help;
77
78    # set global variables according to environnment
79    $platform      = $ENV{INPATH};
80    $srcrootdir    = $ENV{SOURCE_ROOT_DIR};
81    $solverdir     = $ENV{SOLARVERSION};
82    $milestoneext  = $ENV{UPDMINOREXT};
83
84    # override environment with command line options
85    GetOptions('help' => \$help,
86               'l=s'  => \$logfile,
87               'p=s'  => \$platform
88    ) or usage (1);
89
90    if ( $help ) {
91        usage(0);
92    }
93
94    #do some sanity checks
95    if ( ! ( $platform && $srcrootdir && $solverdir ) ) {
96        die "Error: please set environment\n";
97    }
98    if ( ! -d $solverdir ) {
99        die "Error: cannot find solver directory '$solverdir'\n";
100    }
101
102    # Check for local env., taken from solenv/bin/modules/installer/control.pm
103    # In this case the content of SOLARENV starts with the content of SOL_TMP
104    my $solarenv = "";
105    my $sol_tmp;
106    if ( $ENV{'SOLARENV'} ) {
107        $solarenv = $ENV{'SOLARENV'};
108    }
109    if ( $ENV{'SOL_TMP'} ) {
110        $sol_tmp = $ENV{'SOL_TMP'};
111    }
112    if ( defined $sol_tmp && ( $solarenv =~ /^\s*\Q$sol_tmp\E/ )) {
113        # Content of SOLARENV starts with the content of SOL_TMP: Local environment
114        $local_env = 1;
115    }
116}
117
118sub get_deliver_lists
119# find deliver log files on solver
120{
121    my @files;
122    my $pattern = "$solverdir/$platform/inc";
123    $pattern .= "$milestoneext" if ( $milestoneext );
124    $pattern .= "/*/deliver.log";
125
126    @files = glob( $pattern );
127    # do not check modules not yet built
128    foreach my $exceptionpattern ( @exceptionmodlist ) {
129        @files = grep ! /\/$exceptionpattern\//, @files;
130    }
131    if ( ! @files ) {
132        print_logged( "Error: cannot find deliver log files\n" );
133        exit 1;
134    }
135    return \@files;
136}
137
138sub check
139# reads deliver log file given as parameter and compares pairs of files listed there.
140{
141    my $listname = shift;
142    my $error = 0;
143    my %delivered;
144    my $module;
145    my $repository;
146    STDOUT->autoflush(1);
147    # which module are we checking?
148    if ( $listname =~ /\/([\w-]+?)\/deliver\.log$/o) {
149        $module = $1;
150    } else {
151        print_logged( "Error: cannot determine module name from \'$listname\'\n" );
152        return 1;
153    }
154
155    if ( -z $listname ) {
156        print_logged( "Warning: empty deliver log file \'$listname\'. Module '$module' not delivered correctly?\n\n" );
157        return 0;
158    }
159
160    # read deliver log file
161    if ( ! open( DELIVERLOG, "< $listname" ) ) {
162        print_logged( "Error: cannot open file \'$listname\'\n$!" );
163        exit 2;
164    }
165    while ( <DELIVERLOG> ) {
166        next if ( /^LINK / );
167        # What's this modules' repository?
168        if ( /COPY\s+(.+?)\/$module\/prj\/build.lst/ ) {
169#        if ( /COPY (\w[\w\s-]*?)\/$module\/prj\/build.lst/ ) {
170            $repository = $1;
171        }
172        # For now we concentrate on binaries, located in 'bin' or 'lib' and 'misc/build/<...>/[bin|lib]'.
173        next if ( (! /\/$module\/$platform\/[bl]i[nb]\//) && (! /\/$module\/$platform\/misc\/build\//));
174        next if (! /[bl]i[nb]/);
175        next if ( /\.html$/ );
176        chomp;
177        if ( /^\w+? (\S+) (\S+)\s*$/o ) {
178            my $origin = $1;
179            $delivered{$origin} = $2;
180        } else {
181            print_logged( "Warning: cannot parse \'$listname\' line\n\'$_\'\n" );
182        }
183    }
184    close( DELIVERLOG );
185
186    if ( ! $repository ) {
187        print_logged( "Error parsing \'$listname\': cannot determine repository. Module '$module' not delivered correctly?\n\n" );
188        $error ++;
189        return $error;
190    }
191
192    my $path = "$srcrootdir/$repository/$module";
193    # is module physically accessible?
194    # there are valid use cases where we build against a prebuild solver whithout having
195    # all modules at disk
196    my $canread = is_moduledirectory( $path );
197    if ( ! $canread ) {
198        # do not bother about non existing modules in local environment
199        # or on childworkspaces
200        if (( $local_env ) || ( $ENV{CWS_WORK_STAMP} )) {
201            return $error;
202        }
203        # in a master build it is considered an error to have deliver leftovers
204        # from non exising (removed) modules
205        print_logged( "Error: module '$module' not found.\n" );
206        $error++;
207        return $error;
208    }
209    if ( $canread == 2 ) {
210        # module is linked and not built, no need for checking
211        # should not happen any more nowadays ...
212        return $error;
213    }
214
215    # compare all delivered files with their origin
216    # no strict 'diff' allowed here, as deliver may alter files (hedabu, strip, ...)
217    foreach my $file ( sort keys %delivered ) {
218        my $ofile = "$srcrootdir/$file";
219        my $sfile = "$solverdir/$delivered{$file}";
220        if ( $milestoneext ) {
221            # deliver log files do not contain milestone extension on solver
222            $sfile =~ s/\/$platform\/(...)\//\/$platform\/$1$milestoneext\//;
223        }
224        my $orgfile_stats = stat($ofile);
225        next if ( -d _ );  # compare files, not directories
226        my $delivered_stats = lstat($sfile);
227        next if ( -d _ );  # compare files, not directories
228        if ( $^O !~ /^MSWin/ ) {
229            # windows does not know about links.
230            # Therefore lstat() is not a lstat, and the following check would break
231            next if ( -l _ );  # compare files, not links
232        }
233
234        if ( $orgfile_stats && $delivered_stats ) {
235            # Stripping (on unix like platforms) and signing (for windows)
236            # changes file size. Therefore we have to compare for file dates.
237            # File modification time also can change after deliver, f.e. by
238            # rebasing, but only increase. It must not happen that a file on
239            # solver is older than it's source.
240            if ( ( $orgfile_stats->mtime - $delivered_stats->mtime ) gt 1 ) {
241                print_logged( "Error: " );
242                print_logged( "delivered file is older than it's source '$ofile' '$sfile'\n" );
243                $error ++;
244            }
245        } elsif ( !$orgfile_stats && $delivered_stats ) {
246            # This is not an error if we have a solver and did not build the
247            # module!
248        } elsif ( !$orgfile_stats && !$delivered_stats ) {
249            # This is not necessarily an error.
250            # Instead, this seems to be an error of the deliver.log file.
251        } else {
252            print_logged( "Error: no such file '$ofile'\n" ) if ( ! $orgfile_stats );
253            print_logged( "Error: no such file '$sfile'\n" ) if ( ! $delivered_stats );
254            $error ++;
255        }
256    }
257    if ( $error ) {
258        print_logged( "$error errors found: Module '$module' not delivered correctly?\n\n" );
259    }
260    STDOUT->autoflush(0);
261    return $error;
262}
263
264sub is_moduledirectory
265# Test whether we find a module having a d.lst file at a given path.
266# Return value: 1: path is valid directory
267#               2: path.link is a valid link
268#               0: module not found
269{
270    my $dirname = shift;
271    if ( -e "$dirname/prj/d.lst" ) {
272        return 1;
273    } elsif ( -e "$dirname.link/prj/d.lst" ) {
274        return 2
275    } else {
276        return 0;
277    }
278}
279
280sub print_logged
281# Print routine.
282# If a log file name is specified with '-l' option, print_logged() prints to that file
283# as well as to STDOUT. If '-l' option is not set, print_logged() just writes to STDOUT
284{
285    my $message = shift;
286    print "$message";
287    if ( $logfile ) {
288        open ( LOGFILE, ">> $logfile" ) or die "Can't open logfile '$logfile'\n";
289        print LOGFILE "$message";
290        close ( LOGFILE) ;
291    }
292}
293
294
295sub usage
296# print usage message and exit
297{
298    my $retval = shift;
299    print STDERR "Usage: checkdeliver.pl [-h] [-p <platform>]\n";
300    print STDERR "Compares delivered files on solver with original ones in build tree\n";
301    print STDERR "Options:\n";
302    print STDERR "    -h              print this usage message\n";
303    print STDERR "    -p platform     specify platform\n";
304
305    exit $retval;
306}
307
308