1*9780544fSAndrew Rist#************************************************************** 2*9780544fSAndrew Rist# 3*9780544fSAndrew Rist# Licensed to the Apache Software Foundation (ASF) under one 4*9780544fSAndrew Rist# or more contributor license agreements. See the NOTICE file 5*9780544fSAndrew Rist# distributed with this work for additional information 6*9780544fSAndrew Rist# regarding copyright ownership. The ASF licenses this file 7*9780544fSAndrew Rist# to you under the Apache License, Version 2.0 (the 8*9780544fSAndrew Rist# "License"); you may not use this file except in compliance 9*9780544fSAndrew Rist# with the License. You may obtain a copy of the License at 10*9780544fSAndrew Rist# 11*9780544fSAndrew Rist# http://www.apache.org/licenses/LICENSE-2.0 12*9780544fSAndrew Rist# 13*9780544fSAndrew Rist# Unless required by applicable law or agreed to in writing, 14*9780544fSAndrew Rist# software distributed under the License is distributed on an 15*9780544fSAndrew Rist# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 16*9780544fSAndrew Rist# KIND, either express or implied. See the License for the 17*9780544fSAndrew Rist# specific language governing permissions and limitations 18*9780544fSAndrew Rist# under the License. 19*9780544fSAndrew Rist# 20*9780544fSAndrew Rist#************************************************************** 21*9780544fSAndrew Rist 22*9780544fSAndrew Rist 23cdf0e10cSrcweir 24cdf0e10cSrcweir#************************************************************************* 25cdf0e10cSrcweir# 26cdf0e10cSrcweir# createPDBRelocators - create for pdb relocator files 27cdf0e10cSrcweir# PDB relocator files are used to find debug infos 28cdf0e10cSrcweir# for analysis of creash reports 29cdf0e10cSrcweir# 30cdf0e10cSrcweir# usage: create_pdb_relocators($inpath, $milestoneext, $pre); 31cdf0e10cSrcweir# 32cdf0e10cSrcweir#************************************************************************* 33cdf0e10cSrcweir 34cdf0e10cSrcweirpackage CreatePDBRelocators; 35cdf0e10cSrcweir 36cdf0e10cSrcweiruse strict; 37cdf0e10cSrcweiruse File::Basename; 38cdf0e10cSrcweiruse SourceConfig; 39cdf0e10cSrcweir 40cdf0e10cSrcweirsub new 41cdf0e10cSrcweir{ 42cdf0e10cSrcweir my $Object = shift; 43cdf0e10cSrcweir my $solarversion = shift; 44cdf0e10cSrcweir my $workdir; 45cdf0e10cSrcweir my $relworkdir; 46cdf0e10cSrcweir my $self = {}; 47cdf0e10cSrcweir my @basedirs; 48cdf0e10cSrcweir my @repos; 49cdf0e10cSrcweir 50cdf0e10cSrcweir if (!defined ($solarversion)) { 51cdf0e10cSrcweir $solarversion = $ENV{SOLARVERSION}; 52cdf0e10cSrcweir } 53cdf0e10cSrcweir if ( !$solarversion ) { 54cdf0e10cSrcweir print STDERR "can't determine SOLARVERSION.\n"; 55cdf0e10cSrcweir exit (1); 56cdf0e10cSrcweir } 57cdf0e10cSrcweir 58cdf0e10cSrcweir $self->{SOLARVERSION} = $solarversion; 59cdf0e10cSrcweir 60cdf0e10cSrcweir $workdir = $ENV{WORKDIR}; 61cdf0e10cSrcweir if ( !$workdir ) { 62cdf0e10cSrcweir print STDERR "can't determine WORKDIR.\n"; 63cdf0e10cSrcweir exit (1); 64cdf0e10cSrcweir } 65cdf0e10cSrcweir 66cdf0e10cSrcweir if ( $workdir =~ /^$solarversion/ ) { 67cdf0e10cSrcweir $relworkdir = $workdir; 68cdf0e10cSrcweir $relworkdir =~ s/^$solarversion\///; 69cdf0e10cSrcweir } else { 70cdf0e10cSrcweir print STDERR "ERROR: workdir outside $solarversion unsupported\n"; 71cdf0e10cSrcweir exit (2); 72cdf0e10cSrcweir } 73cdf0e10cSrcweir my $SourceConfigObj = SourceConfig->new(); 74cdf0e10cSrcweir @repos = $SourceConfigObj->get_repositories(); 75cdf0e10cSrcweir if ( defined $ENV{UPDMINOREXT} ) { 76cdf0e10cSrcweir foreach my $onedir ( @repos ) { 77cdf0e10cSrcweir push( @basedirs, $onedir.$ENV{UPDMINOREXT} ); 78cdf0e10cSrcweir } 79cdf0e10cSrcweir } 80cdf0e10cSrcweir # basdirs is repositories (dmake) + workdir (gnu make) 81cdf0e10cSrcweir push(@basedirs, $relworkdir); 82cdf0e10cSrcweir if (!scalar @basedirs) { 83cdf0e10cSrcweir print STDERR "no basedir and no working directory found.\n"; 84cdf0e10cSrcweir exit (2); 85cdf0e10cSrcweir } 86cdf0e10cSrcweir $self->{BASEDIRS} = \@basedirs; 87cdf0e10cSrcweir bless($self, $Object); 88cdf0e10cSrcweir return $self; 89cdf0e10cSrcweir} 90cdf0e10cSrcweir 91cdf0e10cSrcweirsub create_pdb_relocators 92cdf0e10cSrcweir{ 93cdf0e10cSrcweir my $self = shift; 94cdf0e10cSrcweir my $inpath = shift; 95cdf0e10cSrcweir my $milestoneext = shift; 96cdf0e10cSrcweir my $pre = shift; 97cdf0e10cSrcweir 98cdf0e10cSrcweir my $solarversion = $self->{SOLARVERSION}; 99cdf0e10cSrcweir my $root_dir = "$solarversion/$inpath"; 100cdf0e10cSrcweir 101cdf0e10cSrcweir # sanitize path 102cdf0e10cSrcweir $root_dir =~ s/\\/\//g; 103cdf0e10cSrcweir my $o =~ s/\\/\//g; 104cdf0e10cSrcweir my $premilestoneext = $milestoneext; 105cdf0e10cSrcweir if ( $pre ne "" ) { 106cdf0e10cSrcweir $premilestoneext = ~ s/^\.//; 107cdf0e10cSrcweir $premilestoneext = ".pre$premilestoneext"; 108cdf0e10cSrcweir } 109cdf0e10cSrcweir my $pdb_dir = $root_dir . "/pdb$premilestoneext"; 110cdf0e10cSrcweir my $pdb_so_dir = $root_dir . "/pdb$premilestoneext/so"; 111cdf0e10cSrcweir 112cdf0e10cSrcweir # create pdb directories if necessary 113cdf0e10cSrcweir if ( ! -d $pdb_dir ) { 114cdf0e10cSrcweir if ( !mkdir($pdb_dir, 0775) ) { 115cdf0e10cSrcweir print STDERR "can't create directory '$pdb_dir'\n"; 116cdf0e10cSrcweir return undef; 117cdf0e10cSrcweir } 118cdf0e10cSrcweir } 119cdf0e10cSrcweir if ( ! -d $pdb_so_dir ) { 120cdf0e10cSrcweir if ( !mkdir($pdb_so_dir, 0775) ) { 121cdf0e10cSrcweir print STDERR "can't create directory '$pdb_so_dir'\n"; 122cdf0e10cSrcweir return undef; 123cdf0e10cSrcweir } 124cdf0e10cSrcweir } 125cdf0e10cSrcweir 126cdf0e10cSrcweir # collect files 127cdf0e10cSrcweir foreach my $basedir (@{$self->{BASEDIRS}}) { 128cdf0e10cSrcweir my @pdb_files; 129cdf0e10cSrcweir my $o = $self->{SOLARVERSION} . "/$basedir"; 130cdf0e10cSrcweir $basedir =~ s/(.*?)\.(.*)/$1/; 131cdf0e10cSrcweir $self->collect_files( $o, $inpath, \@pdb_files); 132cdf0e10cSrcweir 133cdf0e10cSrcweir foreach (@pdb_files) { 134cdf0e10cSrcweir my $relocator = basename($_) . ".location"; 135cdf0e10cSrcweir /$o\/(.*)/i; 136cdf0e10cSrcweir 137cdf0e10cSrcweir my $src_location = $1; 138cdf0e10cSrcweir 139cdf0e10cSrcweir my $location = ""; 140cdf0e10cSrcweir my $target = ""; 141cdf0e10cSrcweir if ( $src_location =~ /\/so\// ) 142cdf0e10cSrcweir { 143cdf0e10cSrcweir $location = "../../../$basedir$milestoneext/" . $src_location; 144cdf0e10cSrcweir $target = "$pdb_dir/so/$relocator"; 145cdf0e10cSrcweir } 146cdf0e10cSrcweir else 147cdf0e10cSrcweir { 148cdf0e10cSrcweir $location = "../../$basedir$milestoneext/" . $src_location; 149cdf0e10cSrcweir $target = "$pdb_dir/$relocator"; 150cdf0e10cSrcweir } 151cdf0e10cSrcweir 152cdf0e10cSrcweir if ( !open(RELOCATOR, ">$target") ) { 153cdf0e10cSrcweir print STDERR "can't write file '$target'\n"; 154cdf0e10cSrcweir return undef; 155cdf0e10cSrcweir } 156cdf0e10cSrcweir print RELOCATOR "$location\n"; 157cdf0e10cSrcweir close(RELOCATOR); 158cdf0e10cSrcweir } 159cdf0e10cSrcweir } 160cdf0e10cSrcweir return 1; 161cdf0e10cSrcweir} 162cdf0e10cSrcweir 163cdf0e10cSrcweirsub collect_files_from_all_basedirs 164cdf0e10cSrcweir{ 165cdf0e10cSrcweir my $self = shift; 166cdf0e10cSrcweir my ($platform, $filesref) = @_; 167cdf0e10cSrcweir my $basedir; 168cdf0e10cSrcweir my $ret; 169cdf0e10cSrcweir foreach $basedir (@{$self->{BASEDIRS}}) { 170cdf0e10cSrcweir my $srcdir = $self->{SOLARVERSION} . "/$basedir"; 171cdf0e10cSrcweir $ret |= $self->collect_files ($srcdir, $platform, $filesref); 172cdf0e10cSrcweir } 173cdf0e10cSrcweir return $ret; 174cdf0e10cSrcweir} 175cdf0e10cSrcweir 176cdf0e10cSrcweirsub collect_files 177cdf0e10cSrcweir{ 178cdf0e10cSrcweir my $self = shift; 179cdf0e10cSrcweir my ($srcdir, $platform, $filesref) = @_; 180cdf0e10cSrcweir my $template = "$srcdir/*/$platform"; 181cdf0e10cSrcweir my $template2 = "$srcdir/LinkTarget"; 182cdf0e10cSrcweir if ( $ENV{GUI} eq "WNT" ) { 183cdf0e10cSrcweir # collect all pdb files on o: 184cdf0e10cSrcweir # regular glob does not work with two wildcard on WNT 185cdf0e10cSrcweir my @bin = glob("$template/bin/*.pdb"); 186cdf0e10cSrcweir my @bin_so = glob("$template/bin/so/*.pdb"); 187cdf0e10cSrcweir my @workdir = glob("$template2/*/*.pdb"); 188cdf0e10cSrcweir # we are only interested in pdb files which are accompanied by 189cdf0e10cSrcweir # .exe or .dll which the same name 190cdf0e10cSrcweir foreach (@bin, @bin_so, @workdir) { 191cdf0e10cSrcweir my $dir = dirname($_); 192cdf0e10cSrcweir my $base = basename($_, ".pdb"); 193cdf0e10cSrcweir my $exe = "$dir/$base.exe"; 194cdf0e10cSrcweir my $dll = "$dir/$base.dll"; 195cdf0e10cSrcweir if ( -e $exe || -e $dll ) { 196cdf0e10cSrcweir push(@$filesref, $_); 197cdf0e10cSrcweir } 198cdf0e10cSrcweir } 199cdf0e10cSrcweir } 200cdf0e10cSrcweir else { 201cdf0e10cSrcweir # collect all shared libraries on o: 202cdf0e10cSrcweir my @lib = glob("$template/lib/*.so*"); 203cdf0e10cSrcweir my @workdir_lib = glob("$template2/Library/*.so*"); 204cdf0e10cSrcweir my @lib_so = glob("$template/lib/so/*.so*"); 205cdf0e10cSrcweir my @mac_lib = glob("$template/lib/*.dylib*"); 206cdf0e10cSrcweir my @mac_workdir_lib = glob("$template2/Library/*.dylib*"); 207cdf0e10cSrcweir my @mac_lib_so = glob("$template/lib/so/*.dylib*"); 208cdf0e10cSrcweir # collect all binary executables on o: 209cdf0e10cSrcweir my @bin = $self->find_binary_execs("$template/bin"); 210cdf0e10cSrcweir my @workdir_bin = $self->find_binary_execs("$template2/Executable"); 211cdf0e10cSrcweir my @bin_so = $self->find_binary_execs("$template/bin/so"); 212cdf0e10cSrcweir push(@$filesref, (@lib, @lib_so, @workdir_lib, @mac_lib, @mac_workdir_lib, @mac_lib_so, @bin, @workdir_bin, @bin_so)); 213cdf0e10cSrcweir } 214cdf0e10cSrcweir return 1; 215cdf0e10cSrcweir} 216cdf0e10cSrcweir 217cdf0e10cSrcweirsub find_binary_execs 218cdf0e10cSrcweir{ 219cdf0e10cSrcweir my $self = shift; 220cdf0e10cSrcweir my $path = shift; 221cdf0e10cSrcweir my @files = glob("$path/*"); 222cdf0e10cSrcweir my @execs = grep(-x $_, @files); 223cdf0e10cSrcweir my @elf_files = grep(`file $_` =~ /ELF/, @execs); 224cdf0e10cSrcweir my @MachO_files = grep(`file $_` =~ /Mach\-O/, @execs); 225cdf0e10cSrcweir return ( @elf_files, @MachO_files ); 226cdf0e10cSrcweir} 227cdf0e10cSrcweir 228cdf0e10cSrcweir1; # required 229cdf0e10cSrcweir 230