xref: /aoo4110/main/postprocess/rebase/rebase.pl (revision b1cdbd2c) 
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
186sub rebase_again
187# rebase using given coffbase file
188{
189    my $oldfiles_ref = shift;
190    my $newfiles_ref = shift;
191    my @grownfiles;
192    my $solarbin ="$ENV{SOLARVERSION}/$ENV{INPATH}/bin$ENV{UPDMINOREXT}";
193    my $command = "rebase " . $options_string;
194    if ( $ENV{WRAPCMD} ) {
195        $command = $ENV{WRAPCMD} . " " . $command;
196    }
197    $command =~ s/-C /-i /;
198    $command =~ s/-d//;
199    $command =~ s/-b $options_hash{'b'}//;
200    my $fname = $misc_dir . "rebase_again.txt";
201    open ( FILES, "> $fname") or die "Error: cannot open file $fname";
202    my $filesstring = join " ", @$oldfiles_ref;
203    print FILES "$filesstring\n";
204    close FILES;
205    $command .= "\@$fname";
206    # Cygwin's perl needs escaped \ in system() and open( COMMAND ... )
207    if ( "$^O" eq "cygwin" ) { $command =~ s/\\/\\\\/g; }
208    print "\n$command\n";
209    open( COMMAND, "$command 2>&1 |") or die "Error: Can't execute $command\n";
210    if ( $? ) {
211        die "Error: rebase failed: $?!\n";
212    }
213    while( <COMMAND> ) {
214        print;
215        # evaluate error messages
216        if ( /REBASE: ([^\s]+).*Grew too large/ ) {
217            my $toobig_name = $1;
218            if ( -e "$solarbin/so/$toobig_name" ) {
219                push @grownfiles, "$solarbin/so/$toobig_name";
220                print "name was : $toobig_name\n";
221                print "push $solarbin/so/$toobig_name\n";
222            } else {
223                push @grownfiles, "$solarbin/$toobig_name";
224            }
225        }
226    }
227    close( COMMAND );
228    if ( @grownfiles ) {
229        # Some files are larger than expected and therefore could not be rebased.
230        # Remove respective entries from coffbase and schedule rebase in 'rebase_initially'.
231        push @$newfiles_ref, @grownfiles;
232        my $coffbase = $options_hash{'C'};
233        my $coffbase_new = $options_hash{'C'} . ".new";
234        open( COFFBASENEW, "> $coffbase_new") or die "Error: cannot open $coffbase_new";
235        open( COFFBASE, $coffbase) or die "Error: cannot open $coffbase";
236        my @entry;
237        while ( my $line = <COFFBASE> ) {
238            @entry = split /\s+/ , $line ;
239            if ( $entry[3] ) {
240                print STDERR "Warning: coffbase file structure invalid?\n";
241            }
242            grep /^$entry[0]$/, @grownfiles or print COFFBASENEW $line;
243        }
244        close( COFFBASE );
245        close( COFFBASENEW );
246        rename $coffbase, $coffbase . ".old" or warn "Error: cannot rename $coffbase";
247        rename $coffbase_new, $coffbase or warn "Error: cannot rename $coffbase_new";
248    }
249}
250
251
252sub rebase_initially
253{
254    my ($files_ref, $start_address) = @_;
255    my $command = "rebase ";
256    if ( $ENV{WRAPCMD} ) {
257        $command = $ENV{WRAPCMD} . " " . $command;
258    }
259    $command .= $options_string;
260    if ( $start_address ) {
261        $command =~ s/-b $options_hash{'b'}/ -b $start_address/;
262    }
263    my $fname = $misc_dir . "rebase_new.txt";
264    open ( FILES, "> $fname") or die "Error: cannot open file $fname";
265    my $filesstring = join " ", @$files_ref;
266    print FILES "$filesstring\n";
267    close FILES;
268    $command .= "\@$fname";
269    # Cygwin's perl needs escaped \ in system() and open( COMMAND ... )
270    if ( "$^O" eq "cygwin" ) { $command =~ s/\\/\\\\/g; }
271    print "\n$command\n";
272    my $error = system("$command");
273    if ($error) {
274        $error /= 256;
275        die "Error: rebase failed with exit code $error!\n";
276    }
277}
278
279
280sub usage
281{
282    print "Usage:\t $myname <-C filename> <-b address> [-d] [-e <Size>] [-l <filename>] [-v] [-m dir] [-R <roordir>] [-N <filename>] <file[list]> \n";
283    # Options similar to rebase binary. Additional options: -m misc-directory
284    print "Options:\n";
285    print "\t -C coffbase_filename    Write the list of base adresses to file coffbase_filename. ";
286    print                            "Mandatory.\n";
287    print "\t -b address              Initial base address. Mandatory.\n";
288    print "\t -e SizeAdjustment       Extra size to allow for image growth.\n";
289    print "\t -d                      Top down rebase.\n";
290    print "\t -l filename             Write logfile filename.\n";
291    print "\t -m directory            Directory to write work files.\n";
292    print "\t -R directory            Root directory.\n";
293    print "\t -N filename             Specify list of files not to be rebased.\n";
294    print "\t -v                      Verbose.\n";
295    return;
296}
297
298
299