# -*- perl -*- 
#
# DO NOT MOVE THE FIRST LINE
# It identifies the rest of the file as PERL for EMACS autoformatting
# put perl options at the end of that line, e.g., -p
#
# ----------------------------------------------------------------------------
#				    X-BONE
#
#		 USC Information Sciences Institute (USC/ISI)
#		    Marina del Rey, California 90292, USA
#			   Copyright (c) 1998-2000
# ----------------------------------------------------------------------------
#
# Copyright (c) 1998-2000 by the University of Southern California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation in source and binary forms for non-commercial purposes and
# without fee is hereby granted, provided that the above copyright notice
# appear in all copies and that both the copyright notice and this permission
# notice appear in supporting documentation, and that any documentation,
# advertising materials, and other materials related to such distribution and
# use acknowledge that the software was developed by the University of
# Southern California, Information Sciences Institute.  The name of the
# University may not be used to endorse or promote products derived from this
# software without specific prior written permission.
#
# THE UNIVERSITY OF SOUTHERN CALIFORNIA MAKES NO REPRESENTATIONS ABOUT THE
# SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE.  THIS SOFTWARE IS PROVIDED "AS
# IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT
# LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
# PARTICULAR PURPOSE.
#
# Other copyrights might apply to parts of this software and are so noted when
# applicable.
#
# -------------------------------------------------------------------------
#
# Effort sponsored by the Defense Advanced Research Projects Agency (DARPA)
# and Air Force Research Laboratory, Air Force Materiel Command, USAF, under
# agreement number F30602-98-1-0200. The U.S. Government is authorized to 
# reproduce and distribute reprints for Governmental purposes not withstanding
# any copyright annotation therein.
# 
# The views and conclusions contained herein are those of the authors and
# should not be interpreted as necessarily representing the official policies
# or endorsements, either expressed or implied, of the Defense Advanced
# Research Projects Agency (DARPA), the Air Force Research Laboratory, or the
# U.S. Government.
# 
# -------------------------------------------------------------------------
#
#  $RCSfile: xb-pick,v $
#
# $Revision: 1.12 $
#   $Author: touch $
#     $Date: 2000/10/24 17:28:38 $
#    $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Joe Touch
#
############################################################
#
# Start PERL on any system where perl is in the path
# This is a modified version of the "start perl" script
# provided in the PERL man pages, which starts perl 
# on the remainder of the file regardless of whether it
# is run under sh, csh, or perl.
#
# This version is modified to dynamically locate the
# perl path, rather than requiring it be hard-coded.
#
# setenv PERLDB_OPTS "N f=26"
#
# Must be set before perl starts!
#
# N 	: Nonstop (noninteractive)
# f=26	: frame=26 = 16 + 8 + 2,
#		2 = entry and exit,
#		!4 = don't print args to functions
#		8= enabled overloaded stringify and tied FETCH
#		16= print return values from subroutines
#
############################################################
# the following line finds perl and runs it, in sh, csh, or perl:
#
# note - '-T' (TAINT) switch is not included, because 'which' often
# returns a version of perl that isn't secure. don't worry about it.
#
eval '(exit $?0)' && eval 'PERLDB_OPTS="N f=26";export PERLDB_OPTS;PERL=`which perl5`; exec $PERL -wS $0 ${1+"$@"}'
    & eval 'setenv PERLDB_OPTS "N f=26"; setenv PERL `which perl5`; exec $PERL -wS $0 $argv:q'
    if 0;

############################################################
# PERL CODE STARTS HERE
############################################################


# XBONE code to set libraries
BEGIN {
  use strict;
  use sigtrap;
  use FindBin;
  delete $ENV{PATH};

  # taint-safe backticks equivalent
  my $pid = open KID, "-|";
  unless(defined $pid) { die "open: $!"; }
  unless($pid) { 
    foreach my $uname ("/usr/bin/uname", "/bin/uname") {
      if(-x $uname) { exec $uname, "-msr" or die "exec: $!"; }
    }
    die "cannot find uname"; 
  }
  my ($osname, $osvers, $arch) = split ' ', lc <KID>;
  close KID or die "close: $!";
  $osvers =~ s/^(\d+\.\d+).*/$1/;

  if($osname eq "sunos") {
    # bang Solaris uname returns into shape for perl usage
    ($osname, $arch) = ("solaris", "sun4");
    $osvers =~ s/5\.(\d+)/2.$1/;
  } elsif($osname eq "linux") {
    # same for Linux
    if($arch eq "i686") { $arch =~ s/i\d(\d+)/i3$1/; }
  } elsif($osname eq "freebsd") {
    if($osvers =~ /cairn/) { $osvers = "2.2"; }
  }

  my $ostag = join "-", ($arch, $osname, $osvers);
  print "Configuring perl for $ostag...\n" if 0;

  my $sdir = "/home/xbone/perl";
  my $ldir = $FindBin::RealBin;
  foreach my $p ($ldir, "$ldir/../lib", "$ldir/../../lib", 
		 "$ldir/../../../lib", 
		 "$ldir/../rd", "$ldir/../../rd", 
		 "$ldir/../../../rd", 
		 "$sdir/$ostag", "$sdir/$ostag/$arch-$osname") {
    if(-d $p) { unshift @INC, $p; }
  }

  # untaint the resulting include path so "use" works
  foreach my $i (@INC) { if($i =~ /(.*)/) { $i = $1;} }
  
  printf STDERR "\n%s\n\n", join "\n", @INC if 0;
};

##############################################################################
# END OF XBONE PREFIX CODE - PUT YOUR PERL CODE BELOW                        #
##############################################################################

# ------------------------------------------------------------
#
# xb_pick:
#
# interactive program to select from a set of overlays
#	input:	      XB_overlays - a list received from 
#			the localhost on the X-Bone port
#			list of available overlay names,
#			fully qualified (ovl1.xbone.net),
#
# THE FOLLOWING ARGS ARE USED:
#        args:
#		(none)	presents an interactive menu, and allows
#			the user to select which overlay, or "none",
#			is active. If no item is selected, the current
#			overlay is output.
#
# 	See the embedded help below for info on options.
#
#	returns:
#		0	success
#		<0	error (of the component command that failed)	
#
# ------------------------------------------------------------
#
# how the resolver selects suffices:
#     if the environment var LOCALDOMAIN is defined
#	 search the suffices in LOCALDOMAIN in order
#	 if this fails, do not look elsewhere
#      elseif /etc/resolv.conf contains a "domain ..." line
#	 search the suffices in domain 
#	 there is alternately a "search" list of domains
#  	 	up to 6 items, 256 chars total
#	 if this fails, do not look elsewhere
#      elseif the environment var HOST is defined
#	 drop the first name element of the HOST string
#	 search the suffix, and all subset domains (keep dropping
#	 first item) - stop at the last 2 item name
#	 e.g.,		domain =~ /[~\.]+\.(.*)/;
#			domain = $1;
#         if this fails, do not look elsewhere
#      else
#	 lookup the name as-is only
#
#  other relevant environment variables for resolver:
#
#		RES_OPTIONS
#			options, namely:
#
#			RES_DEFNAMES = 1 (append suffixes to
#			single-component names)
#
#			RES_DNSRCH = 1 (go up the domain by parents)
#
#			RES_NOALIASES = 0 (don't turn off HOSTALIASES)
#
#			all are correct by default
#
#		LOCADOMAIN - overrides config file entries
#
#			   blank-sep tokens to override search list
#			   on a per-process basis
#
#		HOSTALIASES
#			name of file to search for single-domain entries
#			overrides /etc/hosts
#	
#
#	- does LOCADOMAIN preempt or replace the resolv.conf entry
#	       REPLACES IT!
#			hostname = tau-i.isi.edu
#			resolv.conf = isi.edu
#			LOCALDOMAIN = usc.edu
#			can't find rum
#
#	- does LOCALDOMAIN preempt or replace the hostname effect
#	       REPLACES IT!!
#
#			hostname = tau-i.isi.edu
#			LOCALDOMAIN = usc.edu
#			can't find tau
#
#	- what is the order if LOCALDOMAIN is not set?
#
#	       hostname = tau-i.isi.edu
#	       resolv.conf = usc.edu
#	       can't find rum
#
#	       if LOCALDOMAIN
#		  then
#			look there
#			quit
#	       elseif resolv.conf has domain
#		  then 
#			look there
#			quit
#	       else
#			look at hostname
#
# so to create:
#
#   LDN = ovl.xbone.net
#   RC = domain from resolv.conf or NULL
#   HN = hostname portion (in order)
#
# add:
#   LOCALDOMAIN_ORIG = LD
#   LOCALDOMAIN = LDN
#   LOCALDOMAIN .= LD
#   if LD != NULL
#      then return
#   LOCALDOMAIN .= RC
#   if RC != NULL
#      then return
#   LOCALDOMAIN .= HN
#	       
# subtract:
#   LOCALDOMAIN = LOCALDOMAIN_ORIG	       
#
# ** this won't recurse!

# default simple rule - if LOCALDOMAIN is null,
# then just present the user with a set of strings and go from there

use strict;
use sigtrap;
use Sys::Hostname;
use Getopt::Long;
use XB_Overlay_List;
use XB_Node_DB;


use vars qw/ $opt_list $opt_search $opt_undo $opt_isolate $opt_debug $opt_help $opt_index $opt_pick $opt_all $opt_count $opt_numlist $opt_exec /;

sub print_usage($)
{
    my ($warn) = @_;
    if ($warn ne "") { $warn = "\n>>> $warn <<<\n";}
    print <<"ENDHELP";

Usage error: xb_pick.pl
    $warn
    Selects an overlay for a subsequent X-Window or application

      OPTIONS:
		(none)	presents an interactive menu, and allows
			the user to select which overlay, or "none",
			is active. If no item is selected, the current
			overlay is output.

  the following terminate immediately if present.

	-help, -?		print out some help
        -list, -current		list the current overlay
	-search, -dns		list the DNS searchlist, in order

	--NOT YET IMPLEMENTED--
	(-undo			undo the effect of xbone overlay names)

  the following try to find a local RD and return an immediate result:

	-listall, -all 		list all the overlays available
	-numlist		numbered list of all overlays     
	-listcount, -count	list the number of overlays available 

  the following is an option on all the rest, including no arg:
	    
	-exec string		send the string to the exec call,
	    			rather than starting another xterm

  the following override the interactive setting if present:

	-index #, -number #	pick this overlay index (careful!)
	-pick name, -overlay name, -ovl name	pick this overlay by name

	   these switches take the following optional switch:
	   this switch can also be used with NO arguments, to modify
	   the interactive setting result:

	    -isolate, -keep		keep the overlay completely isolated

ENDHELP
}

sub list_current()
{
    if (defined ($ENV{'LOCALDOMAIN'})) {
	my $searchlist = $ENV{'LOCALDOMAIN'};
	$searchlist =~ /(.+\.xbone\.net) /;
	print "Current overlay is $1\n";
    } else {
	print "There is no current overlay.\n";
    }
}

sub list_search()
{
    my $list = ""; 
    my $found = 0;
    my $reason = "";

    if (defined ($ENV{'LOCALDOMAIN'})) {
	$list = $ENV{'LOCALDOMAIN'};
	$reason = "Environment LOCALDOMAIN";
	$found++;
	printf STDERR "localdomain\n" if $opt_debug;
    } 

    if (!$found && (-s "/etc/resolv.conf")) {
	printf STDERR "resolv.conf\n" if $opt_debug;
	$reason = "/etc/resolv.conf"; 
	open(RES,"</etc/resolv.conf") or 
	    die "can't override an /etc/resolv.conf that cannot be read";
	my $line = "";
	while ($line = <RES>) {
	    # if it's a domain line, add all the partial suffices
	    if ($line =~ /^\s*domain\s+(\S+)\s*/) {
		$found++;
		my $dom = $1;
		while ($dom =~ /[^\.]+\.[^\.]/) {
		    $list .= " " . $dom;
		    $dom =~ s/^[^\.]+\.//;
		}
	    }
	    # if it's an explicit search list, use as-is
	    if ($line =~ /^\s*search\s+(\S+)\s*/) {
		$found++;
		$list = $1;
	    }
	}
    } 
    
    if (!$found) {
	printf STDERR "hostname\n" if $opt_debug;
	# it's based on the hostname
	$reason = "Based on hostname";
	my $dom = hostname;
	$dom =~ s/^[^\.]+\.//;
	while ($dom =~ /[^\.]+\.[^\.]/) {
	    $list .= " " . $dom;
	    $dom =~ s/^[^\.]+\.//;
	}
    }
    print "Search order: $list\nSearch determined by: $reason\n";
    return;
}

sub set_overlay($@)
{
    my ($thisovl, @overlays) = @_;
    my $omax = $#overlays + 1;

    if (($thisovl < 0) || ($thisovl > $omax)) {
	print ">>>> ERROR: overlay number must be in the range 0..$omax\n";
	exit 2;
    }

# 1 - check whether LOCALDOMAIN was non-null
#	if it was, just put new name in front

    if (defined($ENV{"LOCALDOMAIN"})) {
	my $orig_localdom = $ENV{"LOCALDOMAIN"};
	$ENV{"LOCALDOMAIN"} = $overlays[$thisovl-1][0];
	if (! $opt_isolate) {
	    $ENV{"LOCALDOMAIN"} .= " " . $orig_localdom;
	}
	printf STDERR "CASE 1 - LOCALDOMAIN non-null\n" if $opt_debug;
	printf STDERR "list = $ENV{'LOCALDOMAIN'}\n" if $opt_debug;
	return;
    }

# 2 - check whether /etc/resolv.conf was non-null
#	if it was, then put new name in LOCALDOMAIN before prefixes there
#	we assume that resolv.conf won't have SEARCH and DOMAIN both
#	is that a valid assumption?

    if (-s "/etc/resolv.conf") {
	open(RES,"</etc/resolv.conf") or 
	    die "can't override an /etc/resolv.conf that cannot be read";
	while (my $line = <RES>) {
	    # if it's a domain line, add all the partial suffices
	    if ($line =~ /^\s*domain\s+(\S+)\s*/) {
		my $dom = $1;
		$ENV{"LOCALDOMAIN"} = $overlays[$thisovl-1][0];
		while ((! $opt_isolate) && ($dom =~ /[^\.]+\.[^\.]/)) {
		    $ENV{"LOCALDOMAIN"} .= " " . $dom;
		    $dom =~ s/^[^\.]+\.//;
		}
		printf STDERR "CASE 2\n" if $opt_debug;
		printf STDERR "list = $ENV{'LOCALDOMAIN'}\n" if $opt_debug;
		return;
	    }
	    # if it's an explicit search list, use as-is
	    if ($line =~ /^\s*search\s+(\S+)\s*/) {
		my $explicit_list = $1;
		$ENV{"LOCALDOMAIN"} = $overlays[$thisovl-1][0];
		if (! $opt_isolate) {
		    $ENV{"LOCALDOMAIN"} .= " " . $1;
		}
		printf STDERR "CASE 2 - /etc/resolv.conf has seach info\n" 
		    if $opt_debug;
		printf STDERR "list = $ENV{'LOCALDOMAIN'}\n" if $opt_debug;
		return;
	    }
	}
    }

# 3 - it's based on parsing the hostname
#	

    my $dom = hostname;
    $dom =~ s/^[^\.]+\.//;
    $ENV{"LOCALDOMAIN"} = $overlays[$thisovl-1][0];
    while ((! $opt_isolate) && ($dom =~ /[^\.]+\.[^\.]/)) {
	$ENV{"LOCALDOMAIN"} .= " " . $dom;
	$dom =~ s/^[^\.]+\.//;
    }
    printf STDERR "CASE 3 - based on parsing the hostname\n" if $opt_debug;
    printf STDERR "list = $ENV{'LOCALDOMAIN'}\n" if $opt_debug;
    return;
}

# still to be implemented:
#	-undo			undo the effect of xbone overlay names 
#	(this is hard to do - can I just omit the head of the list?)

#
# Get the options, print help, etc.:
#
# -debug - undocumented option to show which case is happening
#
#
my $result = GetOptions ("list|current",
			 "all|listall",
			 "numlist",
			 "count|listcount",
			 "search|dns",
			 "undo",
			 "isolate|keep",
			 "debug",
			 "help|?",
			 "index|number=i",
			 "exec=s",
			 "pick|overlay|ovl=s");

#
# check that the options are appropriate
#	fortunately, GetOptions checks the format of all args

#
# answer the help if asked; ignore other options
#
if ($opt_help) {
    print_usage("");
    exit 0;
}

if (defined($opt_index) && defined($opt_pick)) {
  print_usage("only one argument switch allowed");
  exit 1;
}

if (defined($opt_isolate) && !(defined($opt_index) || defined($opt_pick))) {
  print_usage("isolate/keep only with index/# or pick/overlay/ovl");
  exit 1;
}

#
# process all the options you can before proceeding
#	help, search, current
#

# search
if ($opt_search) {
    list_search();
    exit 0;
}

# list current
if ($opt_list) {
    list_current();
    exit 0;
}

# undo overlays
if ($opt_undo) {
  die "UNDO is not yet implemented";
}

# get the list of overlays from the local Resource Daemon
#############################################
# Start of new code to use XB_overlaylst()
#############################################

my ($callok, @rest, @overlays);

# grab enough state to know who we're talking to, notably
# the place where the rd is. this moved from 127.0.0.1,
# because there may be more than one rd...
%XB_Defs::DAEMON_STATE = ();
XB_read_config_file ($XB_Defs::DAEMON_CONF_FILE, \%XB_Defs::DAEMON_STATE);


($callok, @rest) = XB_overlaylst($XB_Defs::DAEMON_STATE{IPaddr});

if (!$callok) {
    print "ERROR: @rest.\n";
    exit 1;
}

@overlays = @rest;

if (!@overlays)
{
    print STDERR "No overlays currently available.\n";
    exit 1;
}

# 
# process all the deterministic options here
# 	all, count, index, pick
#

# all/numlist - works 12/6/99
if (($opt_all) || ($opt_numlist)) {
  for (my $i=0, my $j=1 ; $i<=$#overlays; $i++, $j++) {
    print "$j\t" if ($opt_numlist);
    print "$overlays[$i][0]\n";
  }
  exit 0;
}

# count - works 12/6/99
if ($opt_count) {
    print $#overlays+1;
    print "\n";
    exit 0;
}

# index 
if (defined($opt_index)) {
    print "picked index $opt_index\n";
    set_overlay($opt_index, @overlays);
    goto DONE;
}

# pick
if (defined($opt_pick)) {
    my $i;
    for ($i=1; $i<$#overlays+2; $i++) {
	if ($overlays[$i-1][0] =~ $opt_pick) {
	    print "   $i\t$overlays[$i-1][0]\n";
	    set_overlay($i, @overlays);
	    last;
	}
    }
    goto DONE;
}

# get the user to pick
print "   0\techo current overlay and exit\n";
for (my $i=1; $i<$#overlays+2; $i++) {
    print "   $i\t$overlays[$i-1][0]\n";
}
print "Enter desired overlay by number [hit return to quit]: ";
my $thisovl = <>;

# this is a nasty hack  - needs to be replaced with a real "make a number" func

if ($thisovl eq "\n") { $thisovl = 0 };
$thisovl += 0;

# just echo and quit if nothing interesting is asked for
if ($thisovl == 0) {
    list_current();
    exit 0;
}

# otherwise set the index like we were called with the number:
set_overlay($thisovl,@overlays);

# at this point, we'd like to export LOCALDOMAIN back to the calling shell
# since that doesn't work (the local environment of this shell is deleted
# when it completes), the only recourse is to startup a new xterm with
# the new environment! The nice thing is we don't have to undo anything -
# just kill the window when we're done.

DONE: 

my $exec_string = "/usr/X11R6/bin/xterm";
my $line;

if (defined($opt_exec)) {
    $exec_string = $opt_exec;
}

$line = `which $exec_string` or die "exec string $exec_string not found in $ENV{'PATH'}";
exec "$line";
