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