# cgiutil.icn: Icon utility functions to help in handling CGI scripts
#--
# Written by John W. Shipman (john@nmt.edu), New Mexico Tech Computer Center,
# Socorro, NM 87801.  This program is in the public domain.
#--


# - - -   S h o w _ E n v   - - -

procedure Show_Env ( name )
#--
# If the environmental variable with the given names exists, outputs
# "name=<value>" to the standard output, with <value> escaped by
# HTML conventions, and returns the value as a string (NOT escaped).
# Returns an empty string if the variable doesn't exist.
#--
  local value

  if  not ( value := getenv ( name ) )  then
    return "";

  write ( name, " = `", HTML_Escape ( value ), "'" );
  return value;  
end # --- Show_Env ---


# - - -   S h o w _ C o n t e n t   - - -

procedure Show_Content ( )
#--
# Interrogates the value of the CONTENT_LENGTH variable, then reads
# that many characters from standard input, breaks the input into
# name/value pairs, and then displays all the name/value pairs.
#--
  local pair        # Current name-value pair (a 2-element list)

  every pair := Generate_Content ( )  do
    write ( pair[1], ": `", HTML_Escape(pair[2]), "'" );
end # --- Show_Content ---


# - - -   G e n e r a t e _ C o n t e n t   - - -

procedure Generate_Content ( )
#--
# Interrogates the value of the CONTENT_LENGTH variable, then reads
# that many characters from standard input, breaks the input into
# name/value pairs, and then generates zero or more two-element
# lists of the form ["name", "value"].
#--
  local contentLength   # Value of the CONTENT_LENGTH envi. var.
  local content         # First contentLength characters of standard input
  local nextAmpersand   # Location of next '&'
  local chunk           # Characters up to the next ampersand

  contentLength  :=  ( integer ( \ getenv ( "CONTENT_LENGTH" ) ) ) | 0;

  content  :=  reads ( &input, contentLength );

  content ?
  { #-- Dissect content
    while  nextAmpersand := upto ( '&' )  do
    { #-- Nonfirst contents
      chunk  :=  tab ( nextAmpersand );
      suspend Break_Pair ( chunk );
      move ( 1 );
    } #-- Nonfirst contents
    suspend Break_Pair ( tab ( 0 ) );
  } #-- Dissect content
  fail;
end # --- Generate_Content ---


# - - -   B r e a k _ P a i r   - - -

procedure Break_Pair ( chunk )
#--
# `chunk' should be a string of the form "name=value", where the value
# is URL-encoded.  Returns a list of two strings.
#--
  local name, value

  chunk ?
  { name  :=  tab ( upto ( '=' ) );
    move ( 1 );
    value  :=  URL_Decode ( tab ( 0 ) );
    
  }
  return [ name, value ];
end # --- Break_Pair ---


# - - -   U R L _ D e c o d e   - - -

procedure URL_Decode ( s )
#--
# Returns the argument string with "URL encoding" decoded:
#   (1) Plus sign ("+") is mapped to space.
#   (2) Hex escapes of the form "%dd" are mapped to the corresponding
#       character.
#--
  local result      # Result to be returned
  local c           # Next character
  local dd          # Hex digits dd of escape sequence "%dd"
  local ddValue     # Numeric value of dd

  result  :=  "";   # If anything fails, return empty string

  map ( s, "+", " " ) ?
  { #-- Digest query string
    while  c  :=  move ( 1 )  do
    { #-- Loop while string not exhausted
      if  c == "%"  then           # Is this an escape?
      { #-- Translate a "%dd" escape
        ( dd := move ( 2 ) ) | fail;        # Fail if there aren't 2 chars
        ( ddValue := hex ( dd ) ) | fail;   # Fail if bad hex
        c  :=  char ( ddValue );            # Convert to character
      } #-- Translate a "%dd" escape
      result  ||:=  c;
    } #-- Loop while string not exhausted
  } #-- Digest query string
 
  return result;
end # --- URL_Decode ---


# - - -   H T M L _ E s c a p e   - - -

procedure HTML_Escape ( s )
#--
# Returns the argument string with substitutions made for HTML display
#--
  local result      # Returned result
  local c           # Next character

  result  :=  "";

  every  c := ! s  do
  { #-- Remap character c if necessary
    case c of
    { #-- Check for special HTML escapes
      "<":  c  :=  "&lt;"
      ">":  c  :=  "&gt;"
      "&":  c  :=  "&amp;"
      "\"": c  :=  "&quot;"
    } #-- Check for special HTML escapes
    result  ||:=  c;
  } #-- Remap character c if necessary
  return result;
end # --- HTML_Escape ---


# - - -   h e x    - - -   From the Icon Program Library

############################################################################
#
#   File:     hexcvt.icn
#
#   Subject:  Procedures for hexadecimal conversion
#
#   Author:   Robert J. Alexander
#
#   Date:     November 8, 1990
#
############################################################################
#
#  hex(s) -- Converts string of hex digits into an integer.
#
#
#  hexstring(i) -- Returns a string that is the hexadecimal
#  representation of the argument.
#
############################################################################

procedure hex(s)
   local a,c
   a := 0
   every c := !map(s) do
     a := ior(find(c,"0123456789abcdef") - 1,ishift(a,4)) | fail
   return a
end

procedure hexstring(i,n)
   local s
   i := integer(i) | fail
   if i = 0 then s := "0"
   else {
      s := ""
      while i ~= 0 do {
     s := "0123456789ABCDEF"[iand(i,15) + 1] || s
     i := ishift(i,-4)
     }
      }
   if \n > *s then s := right(s,n,"0")
   return s
end