postprocess/checkdeliver/checkdeliver.pl

   1 :
   2 eval '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
  35 use strict;
  36 use Getopt::Long;
  37 use File::stat;
  38 use IO::Handle;
  39
  40 use lib ("$ENV{SOLARENV}/bin/modules");
  41
  42 #### globals #####
  43
  44 my $err              = 0;
  45 my $srcrootdir       = '';
  46 my $solverdir        = '';
  47 my $platform         = '';
  48 my $logfile          = '';
  49 my $milestoneext     = '';
  50 my $local_env        = 0;
  51 my @exceptionmodlist = (
  52                         "postprocess",
  53                         "instset.*native",
  54                         "smoketest.*native",
  55                         "testautomation",
  56                         "testgraphical"
  57                        ); # modules not yet delivered
  58
  59 #### main #####
  60
  61 print_logged("checkdeliver.pl - checking delivered binaries\n");
  62
  63 get_globals();                                  # get global variables
  64 my $deliverlists_ref = get_deliver_lists();     # get deliver log files
  65 foreach my $listfile ( @$deliverlists_ref ) {
  66     $err += check( $listfile );                 # check delivered files
  67 }
  68 print_logged("OK\n") if ( ! $err );
  69 exit $err;
  70
  71 #### subroutines ####
  72
  73 sub 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
 118 sub 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
 138 sub 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
 264 sub 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
 280 sub 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
 295 sub 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