#!/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/share/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;
		s!/$!!; # remove trailing / character, if any.
		push(@list,$_);
	}

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

	return @list;	
}

sub FindLinkName { $_=shift;
	my $dirty=undef; # set to 1 if we encounter a symlink.
	my @list=split(m:/:, $_);
	
	my $a=undef;
	foreach $elt (@list) {
		if (-l "$a/$elt") {
			my $b=readlink("$a/$elt");
			# We don't want to dereference the symlink that
			# actually points to the wrapper itself.
			if ($b=~m:/usr/share/xaw-wrappers/wrapper: eq undef) {
				$dirty=1;
				if ($b=~m:^/: eq undef) { # relative symlink, add to current pwd.
					$a.="/$b";
				}
				else { # absolute symlink, replaces current pwd.
					$a=$b;
				}
			}
			else {
				return $elt;
			}
		}
		else { # normal directory or file, add to pwd.
			$a.="/$elt";
		}
	}	

	if ($dirty) {
		return FindLinkName($a);
	}
	else {
		die "xaw-wrapper: $0 doesn't resolve to me!";
	}
}

my $this=FindLinkName($0);
print "Wrapped program is: $XawWrapper::wrapped{$this}\n" if $ENV{XAW_WRAPPERS_DEBUG};	
print "Program is: $XawWrapper::program{$this}\n" if $ENV{XAW_WRAPPERS_DEBUG};
print "This is: $this\n" if $ENV{XAW_WRAPPERS_DEBUG};
if (-x $XawWrapper::wrapped{$this}) {
	my $libc_version=GetLibC($XawWrapper::wrapped{$this});
	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::incompat{$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.
	$real=$XawWrapper::wrapped{$this};
	exec $real $XawWrapper::program{$this}, @ARGV;
}
else {
	print STDERR "Error: $XawWrapper::wrapped{$this} 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$XawWrapper::program{$this} and install it.\n";
}
