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