#!/usr/bin/perl
# ----------------------------------------------------------------------------
# This software is Copyright (C) 2007, All Rights Reserved
# ----------------------------------------------------------------------------
# This program is protected by local and international copyright laws. Any
# use of this program is subject to the the terms of the license agreement
# included as part of this distribution archive. Any other uses are strictly
# prohibited without the written permission of the Vendor and all
# other rights are reserved.
# -----------------------------------------------------------------------------
# Warning : Modifying this program violates your license agreement!
# -----------------------------------------------------------------------------

package IT::SSIResolver;

use strict;
use Socket;

# user defined globals (set by Init call)
use vars qw(@REQUIRED_USER_DEFINED_GLOBALS);
my @REQUIRED_USER_DEFINED_GLOBALS = qw(SSI_PARSING
                                       SERVER_RESOLVED_SSI_HTTP_AUTH_REQUIRED
                                       SERVER_RESOLVED_SSI_HTTP_AUTH_USERNAME
                                       SERVER_RESOLVED_SSI_HTTP_AUTH_PASSWORD
                                       SERVER_RESOLVED_SSI_TEMPDIR_PATH
                                       SERVER_RESOLVED_SSI_TEMPDIR_URL
                                       SERVER_RESOLVED_SSI_TEMPFILE_EXT
                                       SERVER_RESOLVED_SSI_COOKIES_TO_SEND
                                       EMULATED_SSI_DOCUMENT_ROOT
                                       EMULATED_SSI_USING_VIRTPATHS
                                       EMULATED_SSI_VIRTPATHS_TO_FILEPATHS
                                       );

use vars qw($SSI_PARSING $SERVER_RESOLVED_SSI_HTTP_AUTH_REQUIRED $SERVER_RESOLVED_SSI_HTTP_AUTH_USERNAME $SERVER_RESOLVED_SSI_HTTP_AUTH_PASSWORD);
use vars qw($SERVER_RESOLVED_SSI_TEMPDIR_PATH $SERVER_RESOLVED_SSI_TEMPDIR_URL $SERVER_RESOLVED_SSI_TEMPFILE_EXT $SERVER_RESOLVED_SSI_COOKIES_TO_SEND);
use vars qw($EMULATED_SSI_DOCUMENT_ROOT $EMULATED_SSI_USING_VIRTPATHS $EMULATED_SSI_VIRTPATHS_TO_FILEPATHS);

# library globals
use vars qw($INIT_CALLED $CRLF $ERASE_TEMP_FILES $MAX_SSI_RECURSION_DEPTH_ALLOWED $HEADERS_NOT_TO_FORWARD);
use vars qw($SERVER_RESOLVED_SSI_ERROR_HEADER $EMULATED_SSI_ERROR_HEADER $EMULATED_SSI_FORBIDDEN_EXTENSIONS);
$INIT_CALLED                       = 0; # indicated whether init() has been called or not
$CRLF                              = "\015\012";
$ERASE_TEMP_FILES                  = 1;  # disable this to examine generated files for debugging server resolved ssi
$MAX_SSI_RECURSION_DEPTH_ALLOWED   = 3;  # note: this is only incremented by our cgis.  Meaning depth can be deeper if some of those files are static html files but never more than X CGIs (which call each other)
$HEADERS_NOT_TO_FORWARD            = []; # special feature to prevent forwarding of problematic headers from browser
$SERVER_RESOLVED_SSI_ERROR_HEADER  = "Server Resolved SSI Error :";
$EMULATED_SSI_ERROR_HEADER         = "Emulated SSI Error :";
$EMULATED_SSI_FORBIDDEN_EXTENSIONS = [qw(CGI LIB PL PM PHP)]; # we don't allow these because we don't want the user to accidently include the source of a script file.



# ----------------------------------------------------------------------------
# Function    : init
# Description : define filepaths and globals required by library
# Usage       : &init({
#                 'ARGUMENT' => "$value",
#               });
#
# Note: Don't call any functions that call &_die_unless_init_called()
#       from this function because then we'll get a confusing error about the init
#       function not being called instead of the actual error.
# ----------------------------------------------------------------------------

sub init {
  my $args = shift;
  if (!$args)                     { die("no arguments specified!"); }
  if (ref $args ne 'HASH')        { die("args must be passed by hash ref!"); }

  # error checking
  my($thisSubroutine) = (caller(0))[3];
  foreach (@REQUIRED_USER_DEFINED_GLOBALS) {
    unless (exists $args->{$_}) { &IT::Error::dieAsCaller("required $thisSubroutine argument '$_' not defined"); }
  }

  # set user defined globals
  $SSI_PARSING                            = $args->{'SSI_PARSING'};
  $SERVER_RESOLVED_SSI_HTTP_AUTH_REQUIRED = $args->{'SERVER_RESOLVED_SSI_HTTP_AUTH_REQUIRED'};
  $SERVER_RESOLVED_SSI_HTTP_AUTH_USERNAME = $args->{'SERVER_RESOLVED_SSI_HTTP_AUTH_USERNAME'};
  $SERVER_RESOLVED_SSI_HTTP_AUTH_PASSWORD = $args->{'SERVER_RESOLVED_SSI_HTTP_AUTH_PASSWORD'};
  $SERVER_RESOLVED_SSI_TEMPDIR_PATH       = $args->{'SERVER_RESOLVED_SSI_TEMPDIR_PATH'};
  $SERVER_RESOLVED_SSI_TEMPDIR_URL        = $args->{'SERVER_RESOLVED_SSI_TEMPDIR_URL'};
  $SERVER_RESOLVED_SSI_TEMPFILE_EXT       = $args->{'SERVER_RESOLVED_SSI_TEMPFILE_EXT'};
  $SERVER_RESOLVED_SSI_COOKIES_TO_SEND    = $args->{'SERVER_RESOLVED_SSI_COOKIES_TO_SEND'};
  $EMULATED_SSI_DOCUMENT_ROOT             = $args->{'EMULATED_SSI_DOCUMENT_ROOT'};
  $EMULATED_SSI_USING_VIRTPATHS           = $args->{'EMULATED_SSI_USING_VIRTPATHS'};
  $EMULATED_SSI_VIRTPATHS_TO_FILEPATHS    = $args->{'EMULATED_SSI_VIRTPATHS_TO_FILEPATHS'};

  # error checking
  unless ($SERVER_RESOLVED_SSI_TEMPDIR_URL)                   { die "SERVER_RESOLVED_SSI_TEMPDIR_URL has no value!\n"; }
  unless ($SERVER_RESOLVED_SSI_TEMPFILE_EXT)                  { die "SERVER_RESOLVED_SSI_TEMPFILE_EXT has no value!\n"; }
  unless (ref $SERVER_RESOLVED_SSI_COOKIES_TO_SEND eq 'HASH') { die "SERVER_RESOLVED_SSI_COOKIES_TO_SEND not a hashref!"; }
  if ($SSI_PARSING ne 'DISABLED' && $SSI_PARSING ne 'SERVER_RESOLVED' && $SSI_PARSING ne 'EMULATED') { die "Invalid value '$SSI_PARSING' for SSI_PARSING!"; }

  # add trailing slashes where needed
  foreach ($SERVER_RESOLVED_SSI_TEMPDIR_PATH, $SERVER_RESOLVED_SSI_TEMPDIR_URL, $EMULATED_SSI_DOCUMENT_ROOT) {
    if (!/[\\|\/]$/) { $_ .= "/"; }
  }

  # set sub globals
  $INIT_CALLED = 1;

}

# ----------------------------------------------------------------------------
# Function    : _die_unless_init_called()
# Description : Dies unless &init() has been called.  This is called
#               first by many public function to make sure the init function
#               for the module has been called.
# Usage       : &_die_unless_init_called();
# ----------------------------------------------------------------------------

sub _die_unless_init_called {
  if ($INIT_CALLED) { return; }

  my($thisPackage) = (caller(0))[0];
  my($subroutine) = (caller(1))[3];
  &IT::Error::dieAsCaller("You must call &${thisPackage}::init() before calling $subroutine",2);

}

# ----------------------------------------------------------------------------
# Function    : resolveSSIs
# Description :
# Usage       : my $resolvedContent = &IT::SSIResolver::resolveSSIs($content);
# ----------------------------------------------------------------------------

sub resolveSSIs {
  &_die_unless_init_called();
  my $content = shift;
  my $resolvedContent;

  if    ($SSI_PARSING eq 'DISABLED')        { $resolvedContent = $content; }
  elsif ($SSI_PARSING eq 'SERVER_RESOLVED') { $resolvedContent = &_server_resolve_ssi_and_code($content); }
  elsif ($SSI_PARSING eq 'EMULATED')        { $resolvedContent = &_emulate_basic_ssi($content); }
  else                                      { die "Unknown SSI_PARSING value of $SSI_PARSING"; }

  return $resolvedContent;
}

# ----------------------------------------------------------------------------
# Name          : _server_resolve_ssi_and_code
# Description   : passes content through the web server, which resolves
#                 server markup such as SSIs and Server-Side Scripting.
# Usage         : my ($headers, $body) = &_server_resolve_ssi_and_code($content);
#                 print $headers . $body;
# ------------------------------------------------------------------------

sub _server_resolve_ssi_and_code {
  &_die_unless_init_called();
  my $content = shift;

  # IIS will return 404 on zero byte files
  if ($content eq '') { return("Content-type: text/html\n\n",''); }   #-- skip syntax check --#

  # check for SSI recursion
  $ENV{'HTTP_SSI_RECURSION_DEPTH'} =~ s/[^0-9]//;     # prevent someone sending -999999 to bypass error checking and create a practically infinite loop
  if ($ENV{'HTTP_SSI_RECURSION_DEPTH'} > $MAX_SSI_RECURSION_DEPTH_ALLOWED) {
    my $headers = "Content-type: text/html\n\n";  #-- skip syntax check --#
    my $body    = "[$SERVER_RESOLVED_SSI_ERROR_HEADER SSI recursion limit of $MAX_SSI_RECURSION_DEPTH_ALLOWED exceeded.  This page was not parsed for server-side markup.]\n\n" . $content;
    return($headers, $body);
  }

  # create temp file
  my $tempFileDir    = $SERVER_RESOLVED_SSI_TEMPDIR_PATH;
  my $tempFilePrefix = "temp_";
  my $tempFileSuffix = ".$SERVER_RESOLVED_SSI_TEMPFILE_EXT";
  &IT::FileLock::getLock('exclusive');
  my $tempFileName   = &IT::File::createUniqueFilename($tempFileDir, $tempFilePrefix, $tempFileSuffix);
  &IT::FileLock::releaseLock();
  my $tempFilePath   = "$tempFileDir/$tempFileName";
  &IT::File::writeFileFast($tempFilePath, $content) || die "Unable to create temp file '$tempFilePath'";

  # construct HTTP headers for the web request
  my $http_headers_to_send = &_construct_HTTP_headers_for_server_resolve_request();

  # add a header for Basic Authentication (if client's /publish/ directory is password protected)
  if ($SERVER_RESOLVED_SSI_HTTP_AUTH_REQUIRED) {
    my $auth_string = $SERVER_RESOLVED_SSI_HTTP_AUTH_USERNAME . ":" . $SERVER_RESOLVED_SSI_HTTP_AUTH_PASSWORD;
    $http_headers_to_send->{'Authorization'} = "Basic " . &_MIME64_encode($auth_string);
  }

  # do not allow content-encoding (such as gzip) in reponse, so it's possible to modify the HTML
  # Additionally, having a content-length header that is shorted than the content may cause the browser to truncate the content
  # An example of where you would modify the html might be removing links on a generated article preview page
  $http_headers_to_send->{'Accept-Encoding'} = '';
  $http_headers_to_send->{'Cache-Control'} .= ', ' if length $http_headers_to_send->{'Cache-Control'};
  $http_headers_to_send->{'Cache-Control'} .= 'no-transform';

  # make a web request for the temp file
  my $temp_file_url = "$SERVER_RESOLVED_SSI_TEMPDIR_URL$tempFileName";
  my ($responseCode, $response_headers, $response_body) = &_getPage($temp_file_url, $http_headers_to_send);

  # display an error message if responseCode isn't 200 ('ok');
  if ($responseCode ne '200') {
    $response_body  = "[$SERVER_RESOLVED_SSI_ERROR_HEADER Server returned a response code of '$responseCode' on the following request: \n";
    $response_body .= "$temp_file_url\n]\n";
  }

  # delete the temp file
  if ($ERASE_TEMP_FILES) {
    unlink("$SERVER_RESOLVED_SSI_TEMPDIR_PATH$tempFileName");
  }

  # return the server-parsed page
  if (wantarray) { return($response_headers, $response_body); }
  else           { return $response_body; }
}

# ------------------------------------------------------------------------
# Name          : _construct_HTTP_headers_for_server_resolve_request
# Description   : builds a hash of HTTP headers for proxy calls.  HTTP headers that
#                 this script received are forwarded, an ssi_recursion_depth counter
#                 is incremented, and information about the original request is forwarded.
# Usage         : my $http_headers_to_send = &_construct_HTTP_headers_for_server_resolve_request();
# ------------------------------------------------------------------------

sub _construct_HTTP_headers_for_server_resolve_request {

  my %headers;

  # pass existing HTTP headers, correcting for CGI translation errors (e.g. "User-Agent" -> "USER_AGENT")
  # (CGI creates ENV variables for HTTP headers: "[e]ach HTTP header field name is converted to upper case, has all occurrences of "-" replaced with "_", and has "HTTP_" prepended to form the metavariable name.)" - http://cgi-spec.golux.com/)
  my $ENV_key;
  foreach $ENV_key (keys %ENV) {
    $ENV_key =~ /^HTTP_/i || next;                                              # skip ENV vars which are not from HTTP headers
    my $header_value = $ENV{$ENV_key};

    # determine the correct header name from the ENV key name (a list of known headers: http://www.w3.org/Protocols/rfc2616/rfc2616-sec5.html (see 4.5, 5.3, and 7.1))
    # fix the header name by (1) stripping HTTP_, (2) replacing underscores with hyphens, and (3) capitalizing words
    my $header_name;
    $header_name = $ENV_key;
    $header_name =~ s/^HTTP_//;
    $header_name =~ s/_/-/g;                                                    # although underscores are allowed in header names according to the HTTP RFC (2616), they aren't used in any of the standard headers (http://www.w3.org/Protocols/rfc2616/rfc2616-sec5.html (see 4.5, 5.3, and 7.1))
    $header_name =~ s/(\w+)/ ucfirst lc $1 /eg;                                 # field names are case-insensitive according to RFC 2616, but we're doing this just to be safe (http://www.w3.org/Protocols/rfc2616/rfc2616-sec4.html#sec4.2)

    $headers{$header_name} = $header_value;
  }

  # remove certain headers for a variety of reasons (see pod - Forwarded Headers)
  # remove headers in such a way that capitalization doesn't matter
  # all headers not listed here are acceptable for forwarding
  my @headers_to_remove = (
    'Allow', 'Authorization', 'Cache-Control', 'Connection', 'Content-Encoding',
    'Content-Language', 'Content-Length', 'Content-Location', 'Content-MD5',
    'Content-Range', 'Content-Type', 'Expect', 'Expires', 'Host', 'If-Match',
    'If-Modified-Since', 'If-None-Match', 'If-Range', 'If-Unmodified-Since',
    'Last-Modified', 'Max-Forwards', 'TE', 'Trailer', 'Transfer-Encoding',
    'Upgrade', 'Via' );
  my %uc_headers_to_remove = map { uc($_) => 1 } @headers_to_remove;
  my $header_name;
  foreach $header_name (keys %headers) {
    if ($uc_headers_to_remove{uc $header_name}) { delete $headers{$header_name}; }
  }

  # rebuild cookie header, since we may have set cookies during this execution
  $headers{'Cookie'} = join('; ',
                       map { &IT::Common::urlEncode($_) . "=" . &IT::Common::urlEncode($SERVER_RESOLVED_SSI_COOKIES_TO_SEND->{$_}) }
                       keys %$SERVER_RESOLVED_SSI_COOKIES_TO_SEND);

  # increment our own SSI recursion depth counter
  $headers{'Ssi-Recursion-Depth'}++;

  ### determine information about our original client
  my $client_ip;

  # if this web request is local (coming from this server), we might be acting on behalf of someone
  # (note: this test assumes that when the server sends a request, it uses the same outgoing ip (in REMOTE_ADDR)
  #  as is made available in $ENV{'SERVER_ADDR'} or $ENV{'LOCAL_ADDR'}, and NOT 'localhost' or '127.0.0.1')
  if ($ENV{'REMOTE_ADDR'} eq ($ENV{'SERVER_ADDR'} || $ENV{'LOCAL_ADDR'})) {

    # use forwarded information about our client's client
    $client_ip   = $ENV{'HTTP_X_FORWARDED_FOR'} || $ENV{'HTTP_CLIENT_IP'} || $ENV{'REMOTE_ADDR'};

  }

  # otherwise, there aren't any proxies and we're dealing directly with the client
  else {
    $client_ip   = $ENV{'REMOTE_ADDR'};   # use information about our client
  }

  # forward this information about our original client (using header keys conventionally used by proxies)
  $headers{'X-Forwarded-For'} = $client_ip;
  $headers{'Client-Ip'}       = $client_ip;

  # die if we have multiple headers with the same (case-insentive) name
  my %header_count;
  foreach (keys %headers) {
    $header_count{uc $_}++;
    if ($header_count{uc $_} > 1) { die "multiple headers named: '$_'"; }
  }

  return \%headers;
}

# ----------------------------------------------------------------------------
# Function    : _getPage
# Description : Retrieve a page from a webserver and return it
# Usage       : $html = &GetPage("www.host.com/index.html");
#               ($responseCode, $headers, $html) =
#                 &GetPage("http://www.host.com:8080/detail.html?test=1", {
#                   'Referer' => 'http://www.host.com:8080/index.html',
#                   }, "POST");
# Req Modules : use Socket;
# ----------------------------------------------------------------------------

sub _getPage {

  ### Parse out hostname, optional port, and file
  my ($url, $send_headers, $post) = @_;
  $url =~ s|\w+://||g;                                      # remove http://
  $url =~ s/ /%20/gs;   # url encode spaces
  my ($host, $port, $file) = $url =~ m|^(.*?)(?::(\d+))?([/?].*)?$|;
  $port ||= 80;
  $file ||= '/';

  ### Set some required headers for this request
  $send_headers->{'Host'}       = $host;
  $send_headers->{'Connection'} = 'close';

  # fully qualify host (i.e. add trailing dot)
  $host = &IT::Common::getCompleteDomainWithTrailingDotOrIP($host);

  ### Pretend to be IE 6 if we're not already masquerading as something else
  unless (grep /^User-Agent$/i, keys %{$send_headers}) {
    $send_headers->{'User-Agent'} = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SSIResolver)";
  }

  ### For post methods get query info
  my($query,$query_length,$method);
  if ($post) {
    if ($file =~ s/\?(.*)//) { $query = $1; }
    unless (grep /^Content-Type$/i, keys %{$send_headers})   { $send_headers->{'Content-Type'} = 'application/x-www-form-urlencoded'; }
    unless (grep /^Content-Length$/i, keys %{$send_headers}) { $send_headers->{'Content-Length'} = length $query; }
    $method = 'POST';
  }
  else {
    $method = 'GET';
  }

  # remove problematic headers
  my ($headerfield, @matches);
  foreach $headerfield (@$HEADERS_NOT_TO_FORWARD) {
    @matches = grep /^$headerfield$/i, keys %{$send_headers};
    for (@matches) { delete $send_headers->{$_}; }
  }

  ### Prepare request
  my $request;
  $request .= "$method $file HTTP/1.0$CRLF";          # set http request (just like a browser)
  foreach (keys %{$send_headers}) {
    $request .= "$_: $send_headers->{$_}$CRLF";    # send headers
  }
  $request .= $CRLF;                                        # we've finished sending our headers
  $request .= $query . $CRLF . $CRLF if $post;              # and send our post data if necessary

  ### Send request
  my $socket = &IT::File::createFilehandle();
  my $paddr = gethostbyname($host)                              || die "Unknown host '$host': $!";
  my $ip    = join '.', unpack "C*", $paddr;

  socket($socket,AF_INET,SOCK_STREAM,0)                         || die "No Socket: $!";
  connect($socket,pack "SnA4x8",AF_INET,$port,$paddr)     || die "Can't connect to '$host' ($ip) on port $port : $!";
  select((select($socket),$|++)[0]);                        # unbuffer socket
  print $socket $request;                                   # send request all-at-once (otherwise, headers can appear in different packets and won't be interpretted)

  ### Get response
  my $response;
  while (<$socket>) { $response .= $_; }                        # read socket data
  close($socket);

  ### convert line ends to \n
  $response =~ s/\r\n/\n/sg;

  ### Separate response code and headers from content, if there's no \n\n, everything ends up in $response_content
  my ($response_code_line, $response_headers, $response_content) = $response =~ /^(.*?(?:\n))(.*?(?:\n)(?:\n))?(.*)$/s;

  # get response code
  my $responseCode = '';
  if ($response_code_line =~ m|^HTTP/\d+\.\d+ (\d+)|) {
    $responseCode = $1;
  }

  if (wantarray) { return ($responseCode, $response_headers, $response_content); }        # return all info
  else           { return $response_content; }                                                  # return page content
}

# ----------------------------------------------------------------------------
# Function    : _MIME64_encode
# Description : MIME64 encoding Perl routines.  MIME64 is a common base64
#               encoding scheme documented in RFC1341, section 5.2.
# Usage       : $enc = &_MIME64_encode($text);
# Benchmark   : much much faster than original _MIME64_encode function and
#               MIME::Base64 Perl (not C) module
# ----------------------------------------------------------------------------

sub _MIME64_encode {
  my $str  = shift;                                     # string to encode
  my $wrap = shift;                                     # wrap flag
  my $eol  = shift || "\x0A";                           # eol char (for wrapping)

  length($str) || return "";

  # uuencode and convert to mime64
  my $enc = pack('u',$str);                             # uuencode string
  $enc =~ s/^.//;                                       # remove first char (length byte)
  $enc =~ s/\n.?//g;                                    # for each line, rm \n and first char
  $enc =~ tr|` -_|AA-Za-z0-9+/|;                        # convert to MIME64

  # fix padding
  my $pad  = (3 - length($str) % 3) % 3;                # length of padding on end of string
  my $padstr = '=' x $pad;                              # generate MIME64 padding
  $enc =~ s/.{$pad}$/$padstr/ if $pad;                  # replace uuencode padding (garbage chars)

  # wrap lines
  my $wrapPos = 76;                                     # wrap position
  $enc =~ s/(.{1,$wrapPos})/$1$eol/g if $wrap;          # wrap lines

  return $enc;

}

# ----------------------------------------------------------------------------
# Function    : _MIME64_decode
# Description : MIME64 encoding Perl routines.  MIME64 is a common base64
#               encoding scheme documented in RFC1341, section 5.2.
# Usage       : $enc = &_MIME64_encode($text);
# Benchmark   : much much faster than original _MIME64_decode function and
#               MIME::Base64 Perl (not C) module
# ----------------------------------------------------------------------------

sub _MIME64_decode {
  my $enc  = shift;                             # string to encode

  length($enc) || return "";

  $enc =~ tr|A-Za-z0-9+/=||cd;                  # remove non-base64 chars

  # error checking
  if (length($enc) % 4) { die("_MIME64_decode: Length of base64 data not a multiple of 4"); }

  # convert to uuencoding
  $enc =~ s/=.*$//s;                            # remove padding (and anything after it)
  $enc =~ tr|A-Za-z0-9+/| -_|;                  # convert to uuencoding

  # wrap lines (and add first "character count" byte to each line)
  $enc =~ s/(.{1,60})/                          # wrap lines
           chr(32 + length($1) * 3\/4).         # length bit (number of "encoded" chars)
           "$1\n"/egx;                          # followed by encoded content, nextline

  # decode uuencoded data
  my $str = unpack("u", $enc);                  # uudecode

  return $str;

}


# ----------------------------------------------------------------------------
# Function    : _emulate_basic_ssi
# Description :
# Usage       : my $resolvedContent = &_emulate_basic_ssi($content);
# ----------------------------------------------------------------------------

sub _emulate_basic_ssi {
  &_die_unless_init_called();
  my $content = shift;

  my $matchBasicSSI  = q{<!--\s*#\s*include\s+virtual\s*=\s*(["'])([^'"]+)\1\s*-->};

  for (1..5) {  # don't recurse more than 5 levels deep in nested ssis
    $content =~ s{$matchBasicSSI}{
      my $includeValue  = $2;
      my $replacementValue = &_getBasicSSIreplacementValue($includeValue);

      $replacementValue;
    }gie;
  }

  return $content;

}

# ----------------------------------------------------------------------------
# Function    : _getBasicSSIreplacementValue
# Description :
# Usage       : my $replacementValue = &_getBasicSSIreplacementValue($fileOrVirtual, $includeValue);
# ----------------------------------------------------------------------------

sub _getBasicSSIreplacementValue {
  my($includeValue) = @_;
  my $error         = '';
  $includeValue =~ s|\\|/|gsi;

  # figure out actual file path
  my $filepath;
  if ($EMULATED_SSI_USING_VIRTPATHS) {    # make virtual path replacements
    foreach my $virtpathPrefix (keys %$EMULATED_SSI_VIRTPATHS_TO_FILEPATHS) {
      if ($includeValue =~ m|^\Q$virtpathPrefix\E|) {
        $filepath = $includeValue;
        $filepath =~ s|^\Q$virtpathPrefix\E|$EMULATED_SSI_VIRTPATHS_TO_FILEPATHS->{$virtpathPrefix}|;
        last;
      };
    }
  }
  $filepath ||= "$EMULATED_SSI_DOCUMENT_ROOT$includeValue";

  ### error checking

  # check for relative paths
  if ($includeValue !~ m/^\//) {
    return "[$EMULATED_SSI_ERROR_HEADER '$includeValue' must start with '/']";
  }

  # check for forbidden file extensions
  foreach my $badExtension (@$EMULATED_SSI_FORBIDDEN_EXTENSIONS) {
    if ($filepath =~ /\.$badExtension$/i) {
      return "[$EMULATED_SSI_ERROR_HEADER '$badExtension' script files cannot be included with emulated SSI!]";
    }
  }

  # check for query strings and named anchors
  if ($includeValue =~ /[\?\#]/) { return "[$EMULATED_SSI_ERROR_HEADER file value can not contain ? or # chars!]"; }

  # check for non-existant files
  if (!-f $filepath) { return "[$EMULATED_SSI_ERROR_HEADER file '$filepath' doesn't exist!]"; }

  ### include file
  my $fileContents = '';
  my $fh = &IT::File::createFilehandle();
  if (open($fh, "<$filepath")) {
    $fileContents = join '', <$fh>;
    close($fh);
  }
  else { return "[$EMULATED_SSI_ERROR_HEADER Couldn't open '$filepath' : $!]"; }

  # return file contents
  return $fileContents;

}

# ----------------------------------------------------------------------------
# end of file
1;

