1cdf0e10cSrcweir: 2cdf0e10cSrcweireval 'exec perl -wS $0 ${1+"$@"}' 3cdf0e10cSrcweir if 0; 4*7e90fac2SAndrew Rist#************************************************************** 5*7e90fac2SAndrew Rist# 6*7e90fac2SAndrew Rist# Licensed to the Apache Software Foundation (ASF) under one 7*7e90fac2SAndrew Rist# or more contributor license agreements. See the NOTICE file 8*7e90fac2SAndrew Rist# distributed with this work for additional information 9*7e90fac2SAndrew Rist# regarding copyright ownership. The ASF licenses this file 10*7e90fac2SAndrew Rist# to you under the Apache License, Version 2.0 (the 11*7e90fac2SAndrew Rist# "License"); you may not use this file except in compliance 12*7e90fac2SAndrew Rist# with the License. You may obtain a copy of the License at 13*7e90fac2SAndrew Rist# 14*7e90fac2SAndrew Rist# http://www.apache.org/licenses/LICENSE-2.0 15*7e90fac2SAndrew Rist# 16*7e90fac2SAndrew Rist# Unless required by applicable law or agreed to in writing, 17*7e90fac2SAndrew Rist# software distributed under the License is distributed on an 18*7e90fac2SAndrew Rist# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 19*7e90fac2SAndrew Rist# KIND, either express or implied. See the License for the 20*7e90fac2SAndrew Rist# specific language governing permissions and limitations 21*7e90fac2SAndrew Rist# under the License. 22*7e90fac2SAndrew Rist# 23*7e90fac2SAndrew Rist#************************************************************** 24*7e90fac2SAndrew Rist 25*7e90fac2SAndrew Rist 26cdf0e10cSrcweir 27cdf0e10cSrcweir# 28cdf0e10cSrcweir# rebase.pl - rebase windows dlls 29cdf0e10cSrcweir# 30cdf0e10cSrcweir# This perl script is to rebase all windows dlls. In principle this could 31cdf0e10cSrcweir# be done with one simple command line like f.e. 32cdf0e10cSrcweir# rebase -b 0x68000000 -d -R foo_dir -N bar.txt $(SOLARBINDIR)$/*.dll 33cdf0e10cSrcweir# That would work fine for creating complete office install sets, but it 34cdf0e10cSrcweir# could fail as soon as we are going to ship single dlls for a product 35cdf0e10cSrcweir# patch. Therefore, this wrapper perl script is used. It reads a given base 36cdf0e10cSrcweir# address file and rebases all files mentioned to the same address as 37cdf0e10cSrcweir# previously. New dlls get appended to the list. 38cdf0e10cSrcweir 39cdf0e10cSrcweiruse strict; 40cdf0e10cSrcweir 41cdf0e10cSrcweir#### globals ##### 42cdf0e10cSrcweir 43cdf0e10cSrcweirmy $myname = ''; 44cdf0e10cSrcweirmy $options_string = ''; # order of options is important 45cdf0e10cSrcweirmy %options_hash; 46cdf0e10cSrcweirmy $rebase_files; 47cdf0e10cSrcweirmy $misc_dir = $ENV{TEMP}; 48cdf0e10cSrcweirmy $lastaddress; 49cdf0e10cSrcweirmy @old_files; 50cdf0e10cSrcweirmy @new_files; 51cdf0e10cSrcweir 52cdf0e10cSrcweir#### main ##### 53cdf0e10cSrcweir 54cdf0e10cSrcweir$myname = script_id(); 55cdf0e10cSrcweirparse_options(); 56cdf0e10cSrcweirmy %lastrun = read_coffbase( \$lastaddress ); 57cdf0e10cSrcweir# Get files specified on command line. Differ between those already 58cdf0e10cSrcweir# listed in coffbase (%options_hash{'C'}) and additional ones. 59cdf0e10cSrcweirget_files( \@old_files, \@new_files ); 60cdf0e10cSrcweir# Rebase libraries already listed in coffbase to the addresses given there. 61cdf0e10cSrcweirrebase_again( \@old_files, \@new_files ) if ( @old_files ); 62cdf0e10cSrcweir# Rebase additional files. 63cdf0e10cSrcweirrebase_initially( \@new_files, $lastaddress ) if ( @new_files ); 64cdf0e10cSrcweir 65cdf0e10cSrcweirexit 0; 66cdf0e10cSrcweir 67cdf0e10cSrcweir 68cdf0e10cSrcweir#### subroutines #### 69cdf0e10cSrcweir 70cdf0e10cSrcweirsub script_id 71cdf0e10cSrcweir{ 72cdf0e10cSrcweir ( my $script_name = $0 ) =~ s/^.*[\\\/]([\w\.]+)$/$1/; 73cdf0e10cSrcweir 74cdf0e10cSrcweir my $script_rev; 75cdf0e10cSrcweir my $id_str = ' $Revision$ '; 76cdf0e10cSrcweir $id_str =~ /Revision:\s+(\S+)\s+\$/ 77cdf0e10cSrcweir ? ($script_rev = $1) : ($script_rev = "-"); 78cdf0e10cSrcweir# print "\n$script_name -- version: $script_rev\n"; 79cdf0e10cSrcweir return $script_name; 80cdf0e10cSrcweir} 81cdf0e10cSrcweir 82cdf0e10cSrcweir 83cdf0e10cSrcweirsub parse_options 84cdf0e10cSrcweir{ 85cdf0e10cSrcweir use Getopt::Std; 86cdf0e10cSrcweir if ( !getopts('C:b:de:l:m:R:N:v', \%options_hash) || ($#ARGV < 0) ) { 87cdf0e10cSrcweir print STDERR "Error: invalid command line.\n\n"; 88cdf0e10cSrcweir usage (); 89cdf0e10cSrcweir exit 1; 90cdf0e10cSrcweir } 91cdf0e10cSrcweir # create options string (we cannot rely on a hash because for some options the 92cdf0e10cSrcweir # order is important. -R option has to be specified before -N!) 93cdf0e10cSrcweir foreach my $var ( 'C', 'b', 'e', 'l', 'R', 'N' ) { 94cdf0e10cSrcweir if ($options_hash{$var} ) { 95cdf0e10cSrcweir $options_string .= "-$var $options_hash{$var} "; 96cdf0e10cSrcweir } 97cdf0e10cSrcweir } 98cdf0e10cSrcweir $options_string .= "-d " if $options_hash{"d"}; 99cdf0e10cSrcweir $options_string .= "-v " if $options_hash{"v"}; 100cdf0e10cSrcweir # some basic tests 101cdf0e10cSrcweir if ( ! $options_hash{'C'}) { 102cdf0e10cSrcweir print STDERR "Error: no coffbase specified\n\n"; 103cdf0e10cSrcweir usage (); 104cdf0e10cSrcweir exit 2; 105cdf0e10cSrcweir } 106cdf0e10cSrcweir if ( ! $options_hash{'b'}) { 107cdf0e10cSrcweir print STDERR "Error: no initial base address specified\n\n"; 108cdf0e10cSrcweir usage (); 109cdf0e10cSrcweir exit 2; 110cdf0e10cSrcweir } 111cdf0e10cSrcweir if ($options_hash{"m"}) { 112cdf0e10cSrcweir $misc_dir = $options_hash{"m"}; 113cdf0e10cSrcweir } 114cdf0e10cSrcweir if ( ! -d $misc_dir ) { 115cdf0e10cSrcweir print STDERR "Error: no directory to write work files. Please specify with -m\n"; 116cdf0e10cSrcweir usage (); 117cdf0e10cSrcweir exit 3; 118cdf0e10cSrcweir } 119cdf0e10cSrcweir if ( $misc_dir !~ /[\/\\]$/ ) { 120cdf0e10cSrcweir # append finishing path separator: 121cdf0e10cSrcweir if ( $misc_dir =~ /([\/\\])/ ) { 122cdf0e10cSrcweir $misc_dir .= $1; 123cdf0e10cSrcweir } 124cdf0e10cSrcweir } 125cdf0e10cSrcweir $rebase_files = join " ", @ARGV; 126cdf0e10cSrcweir # Cygwin's perl in a W32-4nt configuration wants / instead of \ . 127cdf0e10cSrcweir $rebase_files =~ s/\\/\//g; 128cdf0e10cSrcweir return; 129cdf0e10cSrcweir} 130cdf0e10cSrcweir 131cdf0e10cSrcweir 132cdf0e10cSrcweirsub read_coffbase 133cdf0e10cSrcweir{ 134cdf0e10cSrcweir my ($addref) = shift; 135cdf0e10cSrcweir my %baseaddresses; 136cdf0e10cSrcweir my @entry; 137cdf0e10cSrcweir if ( $options_hash{'C'} ) { 138cdf0e10cSrcweir my $filename = $options_hash{'C'}; 139cdf0e10cSrcweir if ( -e $filename ) { 140cdf0e10cSrcweir print "Repeated run, $filename present\n"; 141cdf0e10cSrcweir open( COFFBASE, $filename) or die "Error: cannot open $filename"; 142cdf0e10cSrcweir while ( my $line = <COFFBASE> ) { 143cdf0e10cSrcweir # each row consists of three entries, separated by white space: 144cdf0e10cSrcweir # dll-name base-address size 145cdf0e10cSrcweir @entry = split /\s+/ , $line ; 146cdf0e10cSrcweir if ( $entry[3] || ( ! $entry[2] ) ) { 147cdf0e10cSrcweir print STDERR "Warning: coffbase file structure invalid?\n"; 148cdf0e10cSrcweir } 149cdf0e10cSrcweir $baseaddresses{$entry[0]} = $entry[1]; 150cdf0e10cSrcweir if ( $entry[3] ) { 151cdf0e10cSrcweir print STDERR "Warning: coffbase file structure invalid?\n"; 152cdf0e10cSrcweir } 153cdf0e10cSrcweir } 154cdf0e10cSrcweir close( COFFBASE ); 155cdf0e10cSrcweir $$addref = $entry[1]; 156cdf0e10cSrcweir } else { 157cdf0e10cSrcweir print "Initial run, $filename not yet present\n"; 158cdf0e10cSrcweir } 159cdf0e10cSrcweir } else { 160cdf0e10cSrcweir die "Error: no coffbase specified."; 161cdf0e10cSrcweir } 162cdf0e10cSrcweir return %baseaddresses; 163cdf0e10cSrcweir} 164cdf0e10cSrcweir 165cdf0e10cSrcweir 166cdf0e10cSrcweirsub get_files 167cdf0e10cSrcweir{ 168cdf0e10cSrcweir use File::Basename; 169cdf0e10cSrcweir my ( $oldfiles_ref, $newfiles_ref ) = @_; 170cdf0e10cSrcweir my @target = split / /, $rebase_files; 171cdf0e10cSrcweir foreach my $pattern ( @target ) { 172cdf0e10cSrcweir foreach my $i ( glob( $pattern ) ) { 173cdf0e10cSrcweir my $lib = File::Basename::basename $i; 174cdf0e10cSrcweir $lib =~ s/\+/\\\+/g; 175cdf0e10cSrcweir if ( grep /^$lib$/i, (keys %lastrun) ) { 176cdf0e10cSrcweir push @$oldfiles_ref, $i; 177cdf0e10cSrcweir } else { 178cdf0e10cSrcweir push @$newfiles_ref, $i; 179cdf0e10cSrcweir } 180cdf0e10cSrcweir } 181cdf0e10cSrcweir } 182cdf0e10cSrcweir return; 183cdf0e10cSrcweir} 184cdf0e10cSrcweir 185cdf0e10cSrcweir 186cdf0e10cSrcweirsub rebase_again 187cdf0e10cSrcweir# rebase using given coffbase file 188cdf0e10cSrcweir{ 189cdf0e10cSrcweir my $oldfiles_ref = shift; 190cdf0e10cSrcweir my $newfiles_ref = shift; 191cdf0e10cSrcweir my @grownfiles; 192cdf0e10cSrcweir my $solarbin ="$ENV{SOLARVERSION}/$ENV{INPATH}/bin$ENV{UPDMINOREXT}"; 193cdf0e10cSrcweir my $command = "rebase " . $options_string; 194cdf0e10cSrcweir if ( $ENV{WRAPCMD} ) { 195cdf0e10cSrcweir $command = $ENV{WRAPCMD} . " " . $command; 196cdf0e10cSrcweir } 197cdf0e10cSrcweir $command =~ s/-C /-i /; 198cdf0e10cSrcweir $command =~ s/-d//; 199cdf0e10cSrcweir $command =~ s/-b $options_hash{'b'}//; 200cdf0e10cSrcweir my $fname = $misc_dir . "rebase_again.txt"; 201cdf0e10cSrcweir open ( FILES, "> $fname") or die "Error: cannot open file $fname"; 202cdf0e10cSrcweir my $filesstring = join " ", @$oldfiles_ref; 203cdf0e10cSrcweir print FILES "$filesstring\n"; 204cdf0e10cSrcweir close FILES; 205cdf0e10cSrcweir $command .= "\@$fname"; 206cdf0e10cSrcweir # Cygwin's perl needs escaped \ in system() and open( COMMAND ... ) 207cdf0e10cSrcweir if ( "$^O" eq "cygwin" ) { $command =~ s/\\/\\\\/g; } 208cdf0e10cSrcweir print "\n$command\n"; 209cdf0e10cSrcweir open( COMMAND, "$command 2>&1 |") or die "Error: Can't execute $command\n"; 210cdf0e10cSrcweir if ( $? ) { 211cdf0e10cSrcweir die "Error: rebase failed: $?!\n"; 212cdf0e10cSrcweir } 213cdf0e10cSrcweir while( <COMMAND> ) { 214cdf0e10cSrcweir print; 215cdf0e10cSrcweir # evaluate error messages 216cdf0e10cSrcweir if ( /REBASE: ([^\s]+).*Grew too large/ ) { 217cdf0e10cSrcweir my $toobig_name = $1; 218cdf0e10cSrcweir if ( -e "$solarbin/so/$toobig_name" ) { 219cdf0e10cSrcweir push @grownfiles, "$solarbin/so/$toobig_name"; 220cdf0e10cSrcweir print "name was : $toobig_name\n"; 221cdf0e10cSrcweir print "push $solarbin/so/$toobig_name\n"; 222cdf0e10cSrcweir } else { 223cdf0e10cSrcweir push @grownfiles, "$solarbin/$toobig_name"; 224cdf0e10cSrcweir } 225cdf0e10cSrcweir } 226cdf0e10cSrcweir } 227cdf0e10cSrcweir close( COMMAND ); 228cdf0e10cSrcweir if ( @grownfiles ) { 229cdf0e10cSrcweir # Some files are larger than expected and therefore could not be rebased. 230cdf0e10cSrcweir # Remove respective entries from coffbase and schedule rebase in 'rebase_initially'. 231cdf0e10cSrcweir push @$newfiles_ref, @grownfiles; 232cdf0e10cSrcweir my $coffbase = $options_hash{'C'}; 233cdf0e10cSrcweir my $coffbase_new = $options_hash{'C'} . ".new"; 234cdf0e10cSrcweir open( COFFBASENEW, "> $coffbase_new") or die "Error: cannot open $coffbase_new"; 235cdf0e10cSrcweir open( COFFBASE, $coffbase) or die "Error: cannot open $coffbase"; 236cdf0e10cSrcweir my @entry; 237cdf0e10cSrcweir while ( my $line = <COFFBASE> ) { 238cdf0e10cSrcweir @entry = split /\s+/ , $line ; 239cdf0e10cSrcweir if ( $entry[3] ) { 240cdf0e10cSrcweir print STDERR "Warning: coffbase file structure invalid?\n"; 241cdf0e10cSrcweir } 242cdf0e10cSrcweir grep /^$entry[0]$/, @grownfiles or print COFFBASENEW $line; 243cdf0e10cSrcweir } 244cdf0e10cSrcweir close( COFFBASE ); 245cdf0e10cSrcweir close( COFFBASENEW ); 246cdf0e10cSrcweir rename $coffbase, $coffbase . ".old" or warn "Error: cannot rename $coffbase"; 247cdf0e10cSrcweir rename $coffbase_new, $coffbase or warn "Error: cannot rename $coffbase_new"; 248cdf0e10cSrcweir } 249cdf0e10cSrcweir} 250cdf0e10cSrcweir 251cdf0e10cSrcweir 252cdf0e10cSrcweirsub rebase_initially 253cdf0e10cSrcweir{ 254cdf0e10cSrcweir my ($files_ref, $start_address) = @_; 255cdf0e10cSrcweir my $command = "rebase "; 256cdf0e10cSrcweir if ( $ENV{WRAPCMD} ) { 257cdf0e10cSrcweir $command = $ENV{WRAPCMD} . " " . $command; 258cdf0e10cSrcweir } 259cdf0e10cSrcweir $command .= $options_string; 260cdf0e10cSrcweir if ( $start_address ) { 261cdf0e10cSrcweir $command =~ s/-b $options_hash{'b'}/ -b $start_address/; 262cdf0e10cSrcweir } 263cdf0e10cSrcweir my $fname = $misc_dir . "rebase_new.txt"; 264cdf0e10cSrcweir open ( FILES, "> $fname") or die "Error: cannot open file $fname"; 265cdf0e10cSrcweir my $filesstring = join " ", @$files_ref; 266cdf0e10cSrcweir print FILES "$filesstring\n"; 267cdf0e10cSrcweir close FILES; 268cdf0e10cSrcweir $command .= "\@$fname"; 269cdf0e10cSrcweir # Cygwin's perl needs escaped \ in system() and open( COMMAND ... ) 270cdf0e10cSrcweir if ( "$^O" eq "cygwin" ) { $command =~ s/\\/\\\\/g; } 271cdf0e10cSrcweir print "\n$command\n"; 272cdf0e10cSrcweir my $error = system("$command"); 273cdf0e10cSrcweir if ($error) { 274cdf0e10cSrcweir $error /= 256; 275cdf0e10cSrcweir die "Error: rebase failed with exit code $error!\n"; 276cdf0e10cSrcweir } 277cdf0e10cSrcweir} 278cdf0e10cSrcweir 279cdf0e10cSrcweir 280cdf0e10cSrcweirsub usage 281cdf0e10cSrcweir{ 282cdf0e10cSrcweir print "Usage:\t $myname <-C filename> <-b address> [-d] [-e <Size>] [-l <filename>] [-v] [-m dir] [-R <roordir>] [-N <filename>] <file[list]> \n"; 283cdf0e10cSrcweir # Options similar to rebase binary. Additional options: -m misc-directory 284cdf0e10cSrcweir print "Options:\n"; 285cdf0e10cSrcweir print "\t -C coffbase_filename Write the list of base adresses to file coffbase_filename. "; 286cdf0e10cSrcweir print "Mandatory.\n"; 287cdf0e10cSrcweir print "\t -b address Initial base address. Mandatory.\n"; 288cdf0e10cSrcweir print "\t -e SizeAdjustment Extra size to allow for image growth.\n"; 289cdf0e10cSrcweir print "\t -d Top down rebase.\n"; 290cdf0e10cSrcweir print "\t -l filename Write logfile filename.\n"; 291cdf0e10cSrcweir print "\t -m directory Directory to write work files.\n"; 292cdf0e10cSrcweir print "\t -R directory Root directory.\n"; 293cdf0e10cSrcweir print "\t -N filename Specify list of files not to be rebased.\n"; 294cdf0e10cSrcweir print "\t -v Verbose.\n"; 295cdf0e10cSrcweir return; 296cdf0e10cSrcweir} 297cdf0e10cSrcweir 298cdf0e10cSrcweir 299