File: wrapper.pl

package info (click to toggle)
xaw-wrappers 0.23
  • links: PTS
  • area: main
  • in suites: slink
  • size: 72 kB
  • ctags: 14
  • sloc: perl: 237; makefile: 35; sh: 31
file content (88 lines) | stat: -rwxr-xr-x 2,769 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
#!/usr/bin/perl
#
# This is a wrapper program that decides what xaw replacements
# may be used with the program, then sets LD_LIBRARY_PATH 
# appropriatly, and runs the program.

# Loading this package causes all config files to be read.
BEGIN { unshift @INC, "/usr/lib/xaw-wrappers/" }
use XawWrapper;

# This looks at a binary and returns the version of libc it uses (5 or 6, 
# so far). Currently, we use ldd.
sub GetLibC { my $binary=shift;
	my $ret;
	open (LDD,"ldd $binary|");
	while (<LDD>) {
		if (/libc.so.(\d+)/ ne undef) {
			$ret=$1;
		}
	}
	close LDD;

	if ($ret) {
		return $ret;
	}
	else {
		# We couldn't figure out what version of libc5 it used. Default to libc6.
		print STDERR "xaw-wrappers: unable to determine libc version of $binary.\n";
		return 6;
	}
}

# This returns a list of the paths ld looks in for libraries, gathered from
# /etc/ld.so.conf and LD_LIBRARY_PATH
# The order of the directory names in the list is the same order that will
# be used by ld.so.
sub GetLdList {
	my @list;

	foreach (split(/:/,$ENV{LD_LIBRARY_PATH})) {
		chomp;
		chomp $_,"/"; # remove trailing / character, if any.
		push(@list,$_);
	}

	open (LDCONF,"</etc/ld.so.conf") || die "open /etc/ld.so.conf: $!\n";
	while (<LDCONF>) {
		chomp;
		chomp $_,"/"; # remove trailing / character, if any.
		push(@list,$_);
	}
	close LDCONF;

	return @list;	
}

my $this=XawWrapper::GetAbsolutePath(
	XawWrapper::DeSymlinkPath(XawWrapper::GetAbsolutePath($0)));
if (-x "$this.real") {
	my $libc_version=GetLibC("$this.real");
	print "libc version: $libc_version\n" if $ENV{XAW_WRAPPERS_DEBUG};
	# Get list of dirs on ld.so's search path.
	# Resolve library incompatabilites by deleting them from the list, 
	# set LD_LIBRARY_PATH to the other directories that are ok to use.
	foreach $dir (GetLdList()) {
		# Notice the hack to exclude libc6 programs from using libc5-compat 
		# libraries.
		# Also notice the hack of excluding all linuxaout libraries.
		if (! $XawWrapper::files{$this}{$dir} && $dir=~m/linuxaout/ eq undef &&
			  ! ($libc_version eq 6 && $dir=~m/libc5-compat/ ne undef)) {
			$ld_library_path.="$dir:";
		}
	}
	$ld_library_path=~s/:$//; # get rid of extra : character.
	print "LD_LIBRARY_PATH: $ld_library_path\n" if $ENV{XAW_WRAPPERS_DEBUG};
	$ENV{LD_LIBRARY_PATH}=$ld_library_path;

	# Lie to the program about its name, so for example, xconsole.real
	# thinks it's named xconsole.
	$thisreal="$this.real"; # works around a bug in perl.
	exec $thisreal $this, @ARGV;
}
else {
	print STDERR "Error: $this.real does not exist.\n";
	print STDERR "\tI'm just a humble wrapper script, and the program you want to run\n";
	print STDERR "\tis not available. To use the program, find the package that contains\n";
	print STDERR "\t$this and install it.\n";
}