postprocess/rebase/rebase.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 # 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
  43 use strict;
  44
  45 #### globals #####
  46
  47 my $myname         = '';
  48 my $options_string = ''; # order of options is important
  49 my %options_hash;
  50 my $rebase_files;
  51 my $misc_dir = $ENV{TEMP};
  52 my $lastaddress;
  53 my @old_files;
  54 my @new_files;
  55
  56 #### main #####
  57
  58 $myname = script_id();
  59 parse_options();
  60 my %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.
  63 get_files( \@old_files, \@new_files );
  64 # Rebase libraries already listed in coffbase to the addresses given there.
  65 rebase_again( \@old_files, \@new_files ) if ( @old_files );
  66 # Rebase additional files.
  67 rebase_initially( \@new_files, $lastaddress ) if ( @new_files );
  68
  69 exit 0;
  70
  71
  72 #### subroutines ####
  73
  74 sub 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
  87 sub 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
 136 sub 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
 170 sub 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
 190 sub 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
 256 sub 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
 284 sub 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