xref: /trunk/main/postprocess/rebase/rebase.pl (revision cdf0e10c) 
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