#! /usr/bin/perl -w
#
# 
# -------------------------------------------------------------------
#                                   X-BONE
#
#                          http://www.isi.edu/xbone
#                USC Information Sciences Institute (USC/ISI)
#                   Marina del Rey, California 90292, USA
#                          Copyright (c) 1998-2005
# 
# -------------------------------------------------------------------
#
# Copyright (c) 1998-2005 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 partly sponsored by the Defense Advanced Research Projects
# Agency (DARPA) and Air Force Research Laboratory, Air Force Materiel
# Command, USAF, under agreement numbers F30602-98-1-0200 (X-Bone) and
# F30602-01-2-0529 (DynaBone). 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.
#
# This work was partly supported by the NSF STI-XTEND (ANI-0230789)
# and NETFS (ANI-0129689) projects. Any opinions, findings, and
# conclusions or recommendations expressed in this material are those
# of the authors and do not necessarily reflect the views of the
# National Science Foundation.
#
# -------------------------------------------------------------------
#  $RCSfile: xb-xml-index.pl,v $
#
# $Revision: 1.14 $
#   $Author: pingali $
#     $Date: 2005/04/10 01:26:56 $
#    $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Lars Eggert

use strict;
use sigtrap;

my $arch;
BEGIN {
  use Config;
  my $osvers = $Config{osvers};
  $osvers =~ s/(\d+\.\d+).*/$1/;
  $arch = "$Config{archname}-$osvers";
};

# set library search path
BEGIN {
  use strict;
  use sigtrap;
  use FindBin;
  use Config; 
  delete $ENV{PATH};

  my $version = $Config{'version'}; 
  $arch = $Config{'archname'}; 
  #my $ldir = $FindBin::RealBin;
  my $ldir = "/usr/local/www/xbone/s-cgi-bin"; 
  foreach my $p ($ldir, 
		 "$ldir/../lib", 
                 "$ldir/../cpan",
                 "$ldir/../cpan/lib/perl5/$version",
                 "$ldir/../cpan/lib/perl5/$version/$arch",
                 "$ldir/../cpan/lib/perl5/site_perl/mach",
                 "$ldir/../cpan/lib/perl5/site_perl/mach/$arch",
                 "$ldir/../cpan/lib/perl5/site_perl/$version",
                 "$ldir/../cpan/lib/perl5/site_perl/$version/$arch",
                 "$ldir/../cpan/lib/perl5/site_perl/$version/mach",
                 "$ldir/../cpan/lib/perl5/site_perl/$version/mach/$arch",
                ) {
    if(-d $p) { unshift @INC, $p; }
  }

  # untaint the resulting include path so "use" works
  foreach my $i (@INC) { if($i =~ /(.*)/) { $i = $1;} }
};

use CGI qw(:standard :html3);
use CGI::Carp qw(fatalsToBrowser);
use XB_Params;
#use XB_Common;
use XB_XML_Interface; 

my $host = `uname -n`; 
chomp($host); 

XB_XML_Interface::init(); 

my %om = ( Release=> "$XB_Params::rel_ver, " .
	   $XB_Params::XBONE_VERSION_DATE,
	   Protocol => $XB_Params::ctl_ver);

my %user = XB_XML_Interface::user_info(); 

my $mail = "mailto:$XB_Params::CA_EMAIL"; 
$mail =~ s/>/\&gt\;/g; 
$mail =~ s/</\&lt\;/g; 


my $msg = "content-type: text/xml\n\n"; 
$msg .= "<?xml version=\"1.0\"?>\n";
$msg .= "<?xml-stylesheet type=\"text/xsl\" href=\"/xml/index-xsl.xml\"?>";

$msg .= "<overlay>\n"; 
$msg .= "<user>\n"; 
$msg .= "  <name>$user{User}</name>\n"; 
$msg .= "  <location>$user{Location}</location>\n"; 
$msg .= "  <org>$user{Organization}</org>\n"; 
$msg .= "</user>\n"; 

$msg .= "<config>\n"; 
$msg .= "  <protocol>$om{Protocol}</protocol>\n"; 
$msg .= "  <release>$om{Release}</release>\n"; 
$msg .= "</config>\n"; 

#$msg .= "  <select>\n";
#$msg .= "    <url>" . param("url") . "</url>\n";
#$msg .= "  </select>\n";

$msg .= "<ca>http://$XB_Params::XBONE_OVERLAY_MANAGER</ca>\n";
$msg .= "<host>$host</host>\n";
$msg .= "<mail>$mail</mail>\n"; 
$msg .= "</overlay>\n"; 

print $msg; 
1;