1#************************************************************** 2# 3# Licensed to the Apache Software Foundation (ASF) under one 4# or more contributor license agreements. See the NOTICE file 5# distributed with this work for additional information 6# regarding copyright ownership. The ASF licenses this file 7# to you under the Apache License, Version 2.0 (the 8# "License"); you may not use this file except in compliance 9# with the License. You may obtain a copy of the License at 10# 11# http://www.apache.org/licenses/LICENSE-2.0 12# 13# Unless required by applicable law or agreed to in writing, 14# software distributed under the License is distributed on an 15# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 16# KIND, either express or implied. See the License for the 17# specific language governing permissions and limitations 18# under the License. 19# 20#************************************************************** 21 22 23 24package installer::upx; 25 26use installer::converter; 27use installer::existence; 28use installer::globals; 29use installer::logger; 30use installer::pathanalyzer; 31use installer::scriptitems; 32use installer::systemactions; 33 34##################################################################### 35# Checking whether a file has to be stripped 36##################################################################### 37 38sub is_upx_candidate 39{ 40 my ( $filename, $onefile ) = @_; 41 42 my $useupx = 0; 43 44 if (( $filename =~ /\.so\s*$/ ) || 45 ( $filename =~ /\.dll\s*$/ ) || 46 ( $filename =~ /\.exe\s*$/ ) || 47 ( $filename =~ /\.bin\s*$/ )) 48 { 49 my $styles = ""; 50 if ( $onefile->{'Styles'} ) { $styles = $onefile->{'Styles'}; } 51 if ( ! ( $styles =~ /\bDONT_UPX\b/ )) { $useupx = 1; } 52 } 53 54 return $useupx; 55} 56 57##################################################################### 58# Checking whether a file has to be stripped 59##################################################################### 60 61sub do_upx 62{ 63 my ( $filename ) = @_; 64 65 my $compression = "9"; 66 my $systemcall = $installer::globals::upxfile . " -" . $compression . " " . $filename; 67 68 my $returnvalue = system($systemcall); 69 70 my $infoline = "Systemcall: $systemcall\n"; 71 $installer::logger::Lang->print($infoline); 72 73 if ($returnvalue) 74 { 75 $infoline = "WARNING: Could not successfully upx $filename! Using original file.\n"; 76 $installer::logger::Lang->print($infoline); 77 } 78 else 79 { 80 $infoline = "SUCCESS: upx $filename!\n"; 81 $installer::logger::Lang->print($infoline); 82 } 83 84 return $returnvalue; 85} 86 87##################################################################### 88# Using upx to decrease file size 89##################################################################### 90 91sub upx_on_libraries 92{ 93 my ( $filelist, $languagestringref) = @_; 94 95 installer::logger::include_header_into_logfile("UPX'ing files:"); 96 my $infoline = ""; 97 98 if ( ! $installer::globals::upx_in_path ) 99 { 100 $installer::logger::Lang->print("\n"); 101 $installer::logger::Lang->print("\n"); 102 $installer::logger::Lang->print("Warning: This is an UPX product, but upx was not found in PATH!\n"); 103 $installer::logger::Lang->print("\n"); 104 } 105 else 106 { 107 $infoline = "Using upx: $installer::globals::upxfile\n"; 108 $installer::logger::Lang->print($infoline); 109 110 my $upxdirbase = installer::systemactions::create_directories("upx", $languagestringref); 111 112 if (! installer::existence::exists_in_array($upxdirbase, \@installer::globals::removedirs)) 113 { 114 push(@installer::globals::removedirs, $upxdirbase); 115 } 116 117 for ( my $i = 0; $i <= $#{$filelist}; $i++ ) 118 { 119 my $sourcefilename = ${$filelist}[$i]->{'sourcepath'}; 120 121 if ( is_upx_candidate($sourcefilename, ${$filelist}[$i]) ) 122 { 123 my $shortfilename = $sourcefilename; 124 installer::pathanalyzer::make_absolute_filename_to_relative_filename(\$shortfilename); 125 126 $installer::logger::Lang->print("\n"); 127 $installer::logger::Lang->printf("Upx: %s", $shortfilename); 128 129 # copy file into directory for stripped libraries 130 my $onelanguage = ${$filelist}[$i]->{'specificlanguage'}; 131 132 # files without language into directory "00" 133 if ($onelanguage eq "") { $onelanguage = "00"; } 134 135 my $upxdir = $upxdirbase . $installer::globals::separator . $onelanguage; 136 installer::systemactions::create_directory($upxdir); # creating language specific subdirectories 137 138 my $destfilename = $upxdir . $installer::globals::separator . $shortfilename; 139 installer::systemactions::copy_one_file($sourcefilename, $destfilename); 140 141 # change sourcepath in files collector 142 ${$filelist}[$i]->{'sourcepath'} = $destfilename; 143 144 # do upx on file 145 my $return = do_upx($destfilename); 146 147 # Using original file, if upx was not successful (no reason for error) 148 if ( $return ) { ${$filelist}[$i]->{'sourcepath'} = $sourcefilename; } 149 } 150 } 151 } 152} 153 1541; 155