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