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