#!/usr/bin/perl -w
#
# build-opt-env.pl
#    November 6, 1998 clh
#        used by Perl scripts in JGOFS OtherOptions server
#        to establish an operating environment
# NB: this file belongs in the directory configured as ScriptAlias /jg/
#     on this HTTPD server.  (typically htmlbin or optbin)
#
#	OPTHOME == top of tree
#	OPTRUNDIR == to be appended to OPTHOME to find this directory
#	MYADDR == how to refer to host running these scripts
#	DEFAULT_PORT == which port on this host to use
#	JGTEMP == top level temporary space
#	USETEMPDIR == temporary space to use as tree for current object
#	USETEMPADDR == URL for USETEMPDIR
# LOCAL_SERVER_ROOT == file spec of object's JGOFSroot.  Non-emptiness depends
#     on defn of config param LOCAL_SERVER_ROOTS
# *** 
#   and then, a set of commonly used strings referring to the object
# ***
# given a JGOFS object: http://usjgofs.whoi.edu/test(press>100)
#
#	OBJECT == a jgofs object string (no jg/serv/, no extension)
#  		//usjgofs.whoi.edu/test (or, for locally-accessed objects, /test)
#	OBJEXT == same as above, with extension (not used often)
#  		//usjgofs.whoi.edu/test.html0
#	URLOBJX == object spec as usable from a browser (jg/serv and ext.)
#  		//usjgofs.whoi.edu/jg/serv/test.html0
#	URLOBJ == object spec as above without the ext. (calling scripts)
#  		//usjgofs.whoi.edu/jg/serv/test
#	PROTOLEV == just the extension
#		html0
#	SUBSELS == subselections list used to pass to scripts/programs
#		press>100 ( or for string compare: press%20gt%20100)
#	DISPSS == un-trigram'ed subselections for displaying in browser
#		press>100 ( or for string compare: "press gt 100")
#
#
# Also, the extended URL is "put into the environment", as a whole and
# as its pieces.  The env var PATH_INFO_PREFIX (currently "PATH_INFO_")
# is put in front of all env vars in this section.  Given an extended
# URL of the form {dir=dirserver,info=infoserver/obj,new_field=whatever}, 
# we provide env vars
#	PREFIXdir == dirserver
#	PREFIXinfo == infoserver/obj
#	PREFIXnew_field == whatever
# if PATH_INFO is non-empty (a PATH_INFO w/o extended URL will result
# in defined, empty env vars).  For convenience, we also define
# PREFIXoption_string as the extended URL w/o the curly brackets. (Note:
# nothing in the path_info_routines architecture requires that "new"
# fields be part of the extended URL.  But that's how it is now (Aug 04).
# Code for PATH_INFO_PREFIX section just looks at all non-object/protocol/
# level stuff that comes out of parse_path_info)

#    1 Aug 16.  WJS
# LOCAL_SERVER_ROOT env var, via a reworking of LOCAL_SERVER_ROOTS logic
#    9 Apr 15.  WJS
# When doing a search of a list, it's not a good idea to unconditionally return
#   after processing the first element.  List in question this time was 
#   LOCAL_SERVER_ROOTS
#    7 Aug 15.  WJS
# Use REMOTE_ADDR for a temp directory name instead of REMOTE_HOST
#   Latter is only available conditionally and ip addr more useful for ID
#   purposes (dns name goes away more frequently than ip addr changes)
#   Motivation for change was neither.  OOserver run on dmoserv2 "got" REMOTE_HOST
#   for most boxes while production server on gb11 didn't, implying some difference
#   in Apache setup that we didn't want to have to track down

#   26 Mar 15.  WJS
# Set INCLUDE_ATTRIBUTES_SWITCH env var (for list)
#   22 Mar 15.  WJS
# Bug fix to 17 Jan work, which did not handle local object spec format as input
#   17 Jan 15.  WJS
# Make OBJECT point to a local object if LOCAL_SERVER_ROOTS says so

#   25 Jul 12.  WJS
#	Lost quotation marks around obj spec in call to fixurl.  Been
#	  that way since 2008 - wonder if it was even in the conversion
#	  of build-opt-env (has it right) to perl.
#    6 Jan 11.  WJS
#	Define variables if in error environment
#    Jul 21, 2009.  WJS
#	Trigram shell chars in SUBSELS
#    May 22, 2009.  WJS
#	Remove htmlunesc going from QS -> $subsels
#    December 27, 2008.  WJS
#	Replace backtick operators w/call to backtick function.  While at
#	  it, submit to perl's doc for its error treatment vs my ideas
#	  about what perl "had to do"
#    May 22, 2007.  WJS
#	Replace copy_file code w/escape to OS "cp" command.  Not as
#	  good (consider system independence) but file copying stuff 
#	  still not right (see comments near sysopen call)
#    March 28, 2007.  WJS
#	Bug fix:  the good news re the 29 Nov 06 mod - it got the permissions
#	correct.  The bad news: it failed to copy the file contents.
#    November 29, 2006.  WJS
#	Bug fix: copying setup directory did not also copy file permissions
#    March 16, 2005.  WJS
#	Bug fix: URLOBJ & URLOBJX defns were reversed
#	10 Dec 04 mod dropped protocol/level if level=0.  Some day I
#	  may learn that 0 is considered "False" by perl, along with
#	  "undefined" being considered "False"
#    December 10, 2004 wjs
#	Bug fix: don't add . to object spec if no protocol/level
#	Define a few more env vars to "" rather than leaving them undefined
#    December 2, 2004 wjs
#	USETEMPADDR
#    August 5, 2004 wjs
#	Replace template/make technique w/run-time invocation of
#	  opt-build-env.pl
#	Hardcode perl location to /usr/bin/perl; add -w
#	Add a "normal exit" value of 1
#	Reorder comments to most-recent-first
#	Some work w/ ENV{"PATH_INFO"}:
#	  1) check if it exists.  This routine can be used in an
#	     environment where we don't use/care about PATH_INFO
#	     parse_path_info not graceful in this situation, and
#	     resulted in this routine issuing a warning
#	  2) Check parse_path_info return and ALERT to STDERR if necessary
#	  3) Put pieces of extended URL into environment
#    December 7, 1999 clh
#	add another variable DISPOBJ, the display-style object,
#	complete with subselections if present
#    October 25, 1999 clh
#        attempt to provide a bit more error handling
#        list of environment variables established:
#    April 15, 1999 clh
#	 add env var USETEMPDIR
#        add make_common_object_env_vars
#    December 15, 1998 clh
#	 conditional use of REMOTE_HOST
#
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#

#   Get rid of args, since opt-build-env.pl will read them if present
#   $build_env_file_name is used in opt-build-env.pl
@ARGV = ();

#   To avoid duplicate defns because of duplicate inclusion of wjs*.pl, file names
#   in all references must match; eg, can't say ./wjs*.pl here and wjs*.pl there.
#   Feh.  Next step is to just do it myself via a WJS_INCLUDED var defined in wjs*.pl
$utils_file_name = "wjs_web_perl_utilities.pl";
require $utils_file_name;
$build_env_file_name = "../opt-build-env.pl";
require $build_env_file_name;
$trigram_file_name = "./trigram.pl";
require $trigram_file_name;

#   Control  list  behavior.  OOserver needs "new" behavior.  With
#   use of  list  from data server (for local access), we might get a
#   list  compiled "the old way" (highly likely since Bob didn't want
#   to change)
$ENV{"INCLUDE_ATTRIBUTES_SWITCH"} = "TRUE";

$cp_program = $ENV{"CPPROG"};
$cp_program || 
  die "Did not get file spec for cp program from $build_env_file_name";
(-e $cp_program) ||
  die "$cp_program (set up in $build_env_file_name) does not exist";
(-x $cp_program) ||
  die "$cp_program (set up in $build_env_file_name) not executable";

#  
$topdir = $ENV{"JGOFSDIR"};
$ENV{'OPTHOME'} = $topdir;

#   "optbin" originally hard-coded in make file that made this from a
#   template version of this.  Don't know why optbin not defined in
#   something like opt-build-env
$rundir = "optbin";
$ENV{'OPTRUNDIR'} = $rundir;
#
$ENV{'DEFAULT_PORT'} = $ENV{"PORT"};
$tempdir = $ENV{"TEMPDIR"};

#
# we need this directory to exist so that a subdir can be created
#
if (!-e $tempdir) {
  $success = mkdir($tempdir,493);
  if (not $success) {
    print STDERR "*** ALERT:  $tempdir could not be created ***\n";
    die "***    reason from mkdir:  $!\n";
  }
}
#
# Env var REMOTE_HOST might be set, but HTTP guarantees REMOTE_ADDR
# Used to use _HOST if available; decided (Aug 15) to unconditionally use _ADDR)
$ENV{'JGTEMP'} = $tempdir;
$remotehost = $ENV{'REMOTE_ADDR'};

#
# check that the temporary directory exists and that it has all setup
#    info/data in it that any of the menu items needs
#  mod November 2, 1998 - clh - move here so all items need not dup code
#
$realtempdir = "$tempdir"."/"."$remotehost";
if (!-e $realtempdir) {
#
# MODE arg for mkdir is in decimal, max (o777) is 511
#    we want to turn off group and other write bits (umask 022)
#    and, 022 is 18 decimal, so:  511 - 18 == 493
#
  $success = mkdir($realtempdir,493);
  if (not $success) {
    print STDERR "*** ALERT:  $realtempdir could not be created ***\n";
    die "***    reason from mkdir:  $!\n";
  }
}

$success = opendir(DIR,"$topdir/setup");
  if ($success) {
      @setup_files = readdir(DIR);
      closedir(DIR);
#
# if any of the setup files do not exist in tempdir, copy 'em
# Seems to me that we would want to do more than just test existence.  If
# we changed a setup file, presumably we'd want the new one copied in.
# However, "on the ground", the reason the copies of the setup file get
# changed is for debugging purposes, etc, and resetting them would be quite
# an annoyance.  Hence, letting the traditional behavior continue WJS Mar 07
#
      foreach $i (@setup_files) {
        $setupfile = "$realtempdir"."/"."$i";
        if (! -e $setupfile) {
          &copy_file("$topdir/setup/$i", $setupfile);
        }
      }
  } else {
      print STDERR "*** ALERT:  cannot access $topdir/setup directory ***\n";
      print STDERR "***    reason:  $!\n";
  }

$ENV{'USETEMPDIR'}  =  $realtempdir;
$ENV{'USETEMPADDR'}  =  $ENV{'TEMPADDR'} . "/$remotehost";
&make_common_object_env_vars;
#&print_to_stderr_env;
#&dump_environment_variables;
1;
#
#*********** subroutines
#

sub copy_file()
{
  my ($from,$to) = @_;
  my ($result,$exit_status,@status,$command);

#   If you wish to indulge in self-mortification, try to get a space
#   between the > and the &.  Purpose of that is to get cp's error info,
#   which goes to stderr, to go to stdout so we can get it here.
  $command = "$cp_program $from $to 2>&1";
  ($result,$exit_status,@status) = &backtick($command);
  ($exit_status == 0) ||
      die &format_backtick_return_status($command,$exit_status,@status,$result);
  return 1;
}

sub make_common_object_env_vars
{
#   Next line a copy of one in *perl_utilities.pl.  Some day figure out
#   how to do .h files in perl.  Worse, not all of these chars relevant
#   as far as this app goes (in fact, \ and " might do it,
#   although the "original" problem had to do with ; - see below)
#     Well, not QUITE a copy.  Orig string had parens in it.  I suspect
#   we COULD get away w/trigramming parens - between our code and "browser
#   interpretation", most of what I saw "onscreen" was parens even when
#   the trigramming was done.  Nonetheless, the trigrams were in the log,
#   making it confusing there ...
  my ($shell_chars) = ' "`;{}|\\\'';	#  Add more when needed...
#   Next character must match trigram character in "the rest of the
#   system"; most probably core.h.  Of course, the user could compile
#   a different character into the c programs, leaving this program to twist
#   in the wind...
  my ($trigram_char) = '%';

  if ($ENV{"PATH_INFO"}) {
    $command = "$topdir/bin/parse_path_info -nonewline";
    ($path_info_string,$exit_status,@status) = &backtick($command);
    if (($path_info_string eq "") || ($exit_status != 0)) {
      $extra_info = ($path_info_string) ? 
		$path_info_string : "Empty return from parse_path_info";
      print STDERR " *** ALERT: parse_path_info problem\n";
      print STDERR " *** PATH_INFO: " . $ENV{"PATH_INFO"} . "\n";
      print STDERR 
	&format_backtick_return_status
				($command,$exit_status,@status,$extra_info);
#	Not sure we shouldn't abort, but historically we didn't.  This
#	mod to avoid "undefined variable" perl errors which, being undated,
#	are hard to ID
      $object = $protocol = "XXX-ERROR-XXX";
      $level = 9999999;
    } else {
#      -1 takes care of "odd number of elements in hash assignment"
#      (which occurs when there is no value for the last field parse_path_info
#      puts out
      %path_info=split(/[,=]/,$path_info_string,-1);
      $object= (defined $path_info{"object"}) ? $path_info{"object"} : "";
      $protocol= (defined $path_info{"protocol"}) ? $path_info{"protocol"} : "";
      $level= (defined $path_info{"level"}) ? $path_info{"level"} : "";
    }
  } else {
    $object = $protocol = $level = "";
  }
#
# Put all other PATH_INFO fields into environment.  At the moment (Aug 04),
# these are the "extended URL" fields (stuff in curly brackets).
# Also, for convenience (otheropt, a prime consumer of this info, is a
# c shell script, and I want to do as little programming in csh as I can),
# put out a comma separated list of key=value pairs
  $path_info_prefix = "PATH_INFO_";
  $ENV{"PATH_INFO_PREFIX"} = $path_info_prefix;
  if ($ENV{"PATH_INFO"}) {
    $tmp = "";
    while ( ($key,$value) = each %path_info ) {
      ($key =~ /^(object|level|protocol)$/) && next;
      $ENV{$path_info_prefix.$key} = $value;
      $tmp .= "$key=$value,";
    }
    chop $tmp;
    $ENV{$path_info_prefix . "OPTION_STRING"} = $tmp;
  }
#
# deal with the object, protocol, and level
#

  $ENV{'PROTOLEV'} = $protolev = 
  		($protocol && defined($level)) ? "$protocol$level" : "";
#       LOCAL_SERVER_ROOTS is an env var from build-env.pl.  Its contents consist of host
#   names and their local JGOFS server roots.  $object is a remote object spec.  If its host name is
#   mapped into a local server root, put the local object spec into the environment instead of the remote one.
#   There is much potential confusion between the "host name field in an object spec", dns names of data servers,
#   and httpd configuration virtual server names (and, I suppose, NON-virtual server names).  No words of
#   wisdom here, just the caveat
#       The idea is to execute the local data server's methods on the local object spec instead of the
#   OOserver's methods on the remote object spec.  This idea evades any http protection on the data server.
#               I suspect that the next paragraph is made obsolete by the dual_server approach.  Too lazy
#               at the moment (Jul 16) to get into revising the paragraph, though.
#       As of Jan 15, there ARE no OOserver methods - they have been soft-linked to a particular local data server.
#   Accordingly, only 1 virtual data server can use a particular OOserver.  The better way to do this is to have
#   each piece of OOserver decide at run time which method to run.  Note that with the Jan 15 implementation,
#   any links displayed by the "OOserver methods" will in fact point to the data server.  This may be an issue
#   in those OOserver pieces that really SHOULD use local methods.  The persistent object stuff is the most
#   obvious candidate for trouble; maybe the time splitter and time converters, too ... hmm, maybe this is NOT
#   a problem since the data server is in fact compiled with this specific OOserver in it.  Guess we'll see!
  ($local_object_spec,$local_root) = &return_local_object_info($object,"LOCAL_SERVER_ROOTS");
#   We assume that the presence of local information, which from a config standpoint means the presence of LOCAL_SERVER_ROOTS,
#   means we should use the local info.  No particular reason for this - might be better to have separate config params, but
#   not doing it now
  $ENV{'OBJECT'} = ($local_object_spec) ? $local_object_spec : $object;
  $ENV{'LOCAL_SERVER_ROOT'} = ($local_object_spec) ? $local_root : "";
#   The following object-related URLs seem to be OK to be left as remote object specs.  They are most used
#   to pass to other pieces of the OOserver.  When those pieces actually get around to doing something,
#   presumably they will use the OBJECT env var.  Operative word in sentence 1 could well be "seem", however
  $ENV{'OBJEXT'} = $ENV{'DISPOBJ'} = $object;
  $protolev && ($ENV{'OBJEXT'} .= ".$protolev");
  $ENV{'URLOBJX'} = $ENV{'URLOBJ'} = "";
  if ($object ne "") {
    $command = "$topdir/bin/fixurl " . '"' . $object . '"';
    ($urlobj,$exit_status,@status) = &backtick($command);
    ($exit_status == 0) ||
      die &format_backtick_return_status($command,$exit_status,@status,$urlobj);
    chomp($urlobj);
    $ENV{'URLOBJX'} = $ENV{'URLOBJ'} = $urlobj;
    $protolev && ($ENV{'URLOBJX'} .= ".$protolev");
  }
#
# deal with the sub-selections, if any
#
  $ENV{'SUBSELS'} = $ENV{'DISPSS'}= "";
  if ($ENV{'QUERY_STRING'}) {
    if ($ENV{'QUERY_STRING'} ne "") {
      $subsels = "$ENV{'QUERY_STRING'}";
      $ENV{'SUBSELS_QS'} = $subsels_qs = "$subsels";

#	Test below should be unneeded - QS would not contain htmlesc'ed things
### Check QS for htmlescaped operator - if found, unescape for subsels
###      ex: press&lt;200 --->  press<200
###
###      if ($subsels_qs =~ /[&;]/) {
###        $command = "$topdir/bin/htmlunesc \"$subsels_qs\"";
###        ($subsels,$exit_status,@status) = &backtick($command);
###        ($exit_status == 0) ||
###		die &format_backtick_return_status
###				($command,$exit_status,@status,$subsels);
###      } else {
###	   $subsels = "$subsels_qs";
###      }

#	Another small novella ...
#	  Trigramming of subsels has been "in here" (and in build-opt-env)
#	since at least 1999.  It was done w/trigram_util, and only blanks
#	were trigrammed.  It's not clear why this was done, since trigram-
#	ming was added when outer added string operators, and outer
#	has trigrammed since the beginning.  I think that perhaps this
#	was for selopt, which apparently did NOT trigram when it added
#	string ops (selopt.pl apparently DOES).
#	  Anyway, the matter was revisited in 2009, motivated by shell-
#	sensitive characters (such as semi-colons) in the data portion
#	of selections.  Note that this is an ENTIRELY different matter
#	than trigramming the blanks around string ops.  THAT is protection
#	because of http issues, and the trigramming technique was chosen
#	because other webbish stuff did trigramming for, apparently, the
#	same reason.  THIS is because the general technique of slapping
#	quotation marks around strings to protect their contents from
#	shell translation does not necessarily work.  Notably, an
#	embedded quotation mark or a trailing backslash will defeat
#	quotation marks.  Having said that, the trouble has arisen with
#	semicolons, for which I think quoting should work.
#	  Note that this code is in "the wrong place" and is the wrong
#	kind.  Shell character protection should occur immediately before 
#	we go to the shell, and the shell should immediately remove 
#	the protection, leaving the string as close as possible to 
#	"what it's supposed to be" for as long as possible.  The timing
#	issue would have the protection code "at" the shell invokation, at
#	the same place that the quotation marks (presumably! that would
#	explain the semi-colon stuff!) are added.  Allowing the shell to
#	undo the protection means that we would use backslashes, etc to
#	do the protection, not trigramming.  Nonetheless, we are going to
#	take a shot here, since what's going on "out there"  occurs in
#	lots of places.
#	  So - the theory here is that, although we are trigramming the
#	whole selection string, the intent is to trigram the stuff AFTER
#	the selection operator, and leave it that way until outer gets it.
#	outer will untrigram.  The operant principle is that ONLY outer
#	will fiddle with the stuff after the operator.
#	  Details:
#	    1) using trigram_util is no good, since IT is invoked
#	by the shell.  We'd have to protect the unprotected string
#	before we sent it to trigram_util, defeating the purpose.
#	    2) we must NOT trigram the trigram character because
#	the selection string may contain and already trigrammed character
#	delimiting the operator.  There is only 1 untrigramming done, so
#	we cannot trigram more than once.  THIS MEANS THAT IF THE TRIGRAM
#	CHARACTER IS IN THE DATA, THERE IS THE POTENTIAL FOR TROUBLE, and
#	we will not find out until "later", if at all.  With the new function
#	we COULD find out earlier if we want - the function call below 
#	will return a WARN status in such a case.  We are ignoring 
#	since the trouble has always been there (although if the datum 
#	happened to contain a legit trigram, say, "humidity90%20Mpswindpeed", 
#	the data will just end up altered)
#	    3) Not really clear which characters to trigram.  We've
#	stolen the string used by another shell character protection scheme,
#	but who knows if that was any good?  Certainly it's curious that
#	<, > and & are not in the string
#	    4) We are depending on the trigram character being "safe".  Note
#	that the default character, %, is not necessarily perl-safe, for
#	example (I think it is the modulo operator).
#	    5) Since most if not all of the OO code slaps quotation marks
#	around the selection string anyway, it's not really clear how to
#	test things.  Note all the quotation marks at the beginning of
#	this if block, for example - clearly there is no confidence in
#	what we're doing.  Isn't it great when you know the language is
#	which you're coding?
      ($status,$trigrammed_subsels) = 
		&trigram($subsels,$shell_chars,$trigram_char);
      ($status eq "NG") &&  die ("trigram error: $trigrammed_subsels\n");
      ($status eq "OK") || ($status eq "WARN") || 
	die ("Internal error: trigram func returned unknown status: $status\n");
      $ENV{'SUBSELS'} = $trigrammed_subsels;
#
# Check QS for operator that should be htmlescaped for displaying
#      ex: press<200 --->  press&lt;200
#
      if ($subsels =~ /[<>]/) {
        $command = "$topdir/bin/htmlesc \"$subsels\"";
	($dispss,$exit_status,@status) = &backtick($command);
	($exit_status == 0) ||
		  die &format_backtick_return_status
				($command,$exit_status,@status,$dispss);
      } else {
         $dispss = "$subsels_qs";
      }
      $command = "$topdir/bin/trigram_util -un \"$dispss\"";
      ($disp_style,$exit_status,@status) = &backtick($command);
      ($exit_status == 0) ||
		  die &format_backtick_return_status
				($command,$exit_status,@status,$disp_style);
      $ENV{'DISPSS'} = "$disp_style";
      $ENV{'DISPOBJ'} = "$object($disp_style)";
    } 
  }
}


sub return_local_object_info
#   Most of the work is parsing env var LOCAL_SERVER_ROOTS
#   Input args are object under consideration and the name of the local server roots env var
#   Returns 2 values: local object spec and local server root.  If these cannot be determined, returns
#     empty strings.
#   Dies on any error conditions
{
  my ($object,$local_server_root_env_var_name,$dummy) = @_;
#   Next 2 must match vals in build-env.pl
  my ($env_var_pairs_separator) = ',';
  my ($env_var_within_pair_separator) = '|';
  my ($qm_pairs_sep) = quotemeta($env_var_pairs_separator);
  my ($qm_within_pair_sep) = quotemeta($env_var_within_pair_separator);
  my ($local_server_root_env_val);
#   Note: $local root not needed for build-opt-env.pl purposes, but is checked here anyway
#   Now it has build-opt-env.pl purposes!
  my ($data_server_spec,$local_root);
  my ($host_and_port_from_object,$local_object_spec);

  ((defined $local_server_root_env_var_name) && ( ! (defined $dummy))) ||
      die ("Internal error: return_local_object_info called w/wrong # args");

  ($local_server_root_env_val = $ENV{$local_server_root_env_var_name}) || return "","";

  foreach (split /$qm_pairs_sep/,$local_server_root_env_val) {
    $_ || die ("Empty field in env var $local_server_root_env_var_name.  env var val: -->$local_server_root_env_val<--");
    ($data_server_spec,$local_root,$dummy) = split/$qm_within_pair_sep/;
    (defined $dummy) && 
        die("More than 2 fields where pair expected in env var $local_server_root_env_var_name.  env var val: -->$local_server_root_env_val<--");
    ($data_server_spec && $local_root) ||
        die ("Missing/empty/0 field in env var $local_server_root_env_var_name.  env var val: -->$local_server_root_env_val<--");
    $data_server_spec = &whitespace_strip($data_server_spec);
    $local_root = &whitespace_strip($local_root);
    ($data_server_spec && $local_root) ||
        die ("all-whitespace or 0 field in env var $local_server_root_env_var_name.  env var val: -->$local_server_root_env_val<--");
#     Remove optional prefixes
    (  ($dummy) = ($data_server_spec =~ qq|^//(.*)|)  )    &&    ($data_server_spec = $dummy);
    (  ($dummy) = ($local_root =~ qq|^/(.*)|)  )    &&    ($local_root = $dummy);
    ($data_server_spec && $local_root) ||
        die ("all-slash or 0 field in env var $local_server_root_env_var_name.  env var val: -->$local_server_root_env_val<--");
    ($data_server_spec =~ qq|^/|) && 
        die ("data server name in env var $local_server_root_env_var_name starts w/illegal # of slashes.  env var val: -->$local_server_root_env_val<--");
    ($local_root =~ qq|^/|) && 
        die ("local root in env var $local_server_root_env_var_name starts w/illegal # of slashes.  env var val: -->$local_server_root_env_val<--");
#     Return local root as absolute file spec
    $local_root = '/' . $local_root;
#     Relying on format of $object since it presumably "comes from us" via parse_path_info
#     Can rely, but if it's a local object, there might not BE leading slashes!
    ($object =~ qq|^//|) || return $object,$local_root;
    ($host_and_port_from_object,$local_object_spec) = ($object =~ qq|^//(.+?)(/.+)|);
    ($host_and_port_from_object eq $data_server_spec) && (return $local_object_spec,$local_root);
  }
  return "",$local_root;
}


sub print_to_stderr_env{

print STDERR "environment established at present\n";
while (($key,$value) = each %ENV) {
  print STDERR "$key=$value\n";
}

#	copy_file code pre-May 2007
#sub copy_file()
#{
# use Fcntl;
#
# $to = pop(@_);
# $from = pop(@_);
#
# open(FROM,"$from") || die "Cannot open $from: $!\n";
# (undef,undef,$permissions,undef) = stat $from;
##   Note: although doc says "calls open(2)", the return status seems to
##   be the normal 0=bad rather than the open return of -1=bad.  Empirical
##   test (+observation that in perl, does not have to return file descrip)
##  Could not get sysopen to both create and write; hence double open 
##  (Turns out that I ANDed in O_WRONLY() instead of ORing.  Might be
##  worth another try... when the error checking on the copy loop is
##  added, for example)
##    Should really mask owner write permission into $permissions...
##    More notes: when the directory in $to did not allow O_CREAT(),
##  program apparently did not return here after failure. ?? (May 07)
# sysopen (    TO,  $to,  (O_CREAT() | O_WRONLY()),  $permissions    )  
#					|| die "Cannot create $to: $!\n";
# while (<FROM>) {
#   print TO;
# }
# 
# close(FROM);
# close(TO);
#}

}