############################################################################
#
#	File:     cgi.icn
#
#	Subject:  Procedures for writing CGI scripts
#
#	Authors:  Joe Van Meter, Clinton Jeffery, Federico Balbi,
#		  Kostas Oikonomou, and Wade Bowmer
#
#	Date:	  October 27, 2005
#       Revised:  May 2007
#
############################################################################
#
# This library makes programming cgi programs easier by automatically
# checking for title and body procedures.  There are other procedures
# that do some repetitive things for the programmer.
#
############################################################################

global cgi			# table of input fields
global cgi_hexen                # set in cgiReadParse()


#
# cgiEcho(file,args[]) - write a file to both HTML stdout and a regular
#  text file, if one is present
#
procedure cgiEcho(f, args[])
   push(args, f)
   if type(f) == "file" then {	# if we have a file
      write ! args		# write to it
      pop(args)			# and then discard it
      }
   put(args, "<br>")		# write HTML
   write ! args
end


#
# cgiInput(type, name, values) -
#
procedure cgiInput(ty,nam,va)
   every is := !va do {
      writes("[<input type=\"",ty,"\" name=\"",nam,"\" value=\"",is,"\"")
      if is===va[1] then
	 writes(" checked")
      write(">", is, "]")
      }
end

#
# cgiSelect(name, values)
# this program with the name and value makes a select box
#
procedure cgiSelect(nam, va)
   write("<select name=\"", nam, "\">")
   every is := !va do {
      writes("<option" )
      if is==va[1] then writes(" selected")
      write(">", is)
      }
   write("</select>")
end

#
# cgiXYCoord()
# This procedure is used with a ISMAP to figure out what the x and y coords
# and if they are between a certain boundry. It returns the value of the
# list that was entered.
#
record HMap(value,x1,y1,x2,y2)

procedure cgiXYCoord(hlst)
   title := hlst[1]
   getenv("QUERY_STRING") ? {
      x := tab(find(","))
      move(1)
      y := tab(0)
      }
   every q := 2 to *hlst do {
      if (hlst[q].x1 < x < hlst[q].x2) & (hlst[q].y1 < y < hlst[q].y2) then {
	 title := hlst[q].value
	 }
      }
   return title
end

procedure cgiMyURL()
   return "http://" || getenv("SERVER_NAME") || getenv("SCRIPT_NAME")
end

procedure cgiMethGet()
   if getenv("REQUEST_METHOD")==="GET" then return
   # else fail
end

#
# cgiReadParse()
# This procedure gets input from either QUERY_STRING or stdin puts the
# values with their variable names and returns a table with references
# from the variables to their values
#

procedure cgiReadParse()
   local html, it, line, r, k, data, c1, c2
   initial {
      cgi_hexen := &digits ++ 'ABCDEF'
      }
   html := [ ]
   it := ""
   cgi := table()
   line := ""

   ct := getenv("CONTENT_TYPE")
   cl := getenv("CONTENT_LENGTH")
   if match("multipart/form-data;", ct) then {
      ct ? {
	 tab(find("boundary=") + 9)
	 boundary := "--" || tab(0)
	 }
      content := reads(&input, cl)
      content ? {
	 while tab(find(boundary)) do {
	    tab(find("\n")+1)
	    while match("Content-") do {
	       line := tab(find("\n"))
	       move(1)
	       line ? {
		  s := tab(many(&letters++'-')) | stop("bogons")
		  case s of {
		  "Content-Disposition": {
		     move(2)
		     if ="form-data; " then {
			if ="name=" then {
			   move(1)
			   nam := tab(find("\""))
			   if tab(find("filename=")+9) then {
			      if match("\"") then {
				 move(1)
				 cgi["filename"] := tab(find("\""))
				 }
			      }
			   }
			}
		     }
		  "Content-Type": {
		     }
		  default: cgiEcho("eh? ", line)
		  }
	       }
	    }
	 #if it didn't match "Content-" its not header any more, skip a line
	 tab(find("\n")+1)
	 # then grab rest
	 value := tab(find(boundary)) | stop("incomplete value")
	 if value[-1] == "\n" then value[-1] := ""
	 if value[-1] == "\r" then value[-1] := ""
	 if \nam then cgi[\nam] := value
	 if match(boundary || "--") then {
	    break
	    }
	 else if match(boundary) then { # no terminating --
	    next
	    }
	 }
      }
   }
else {
   if cgiMethGet() then
      line := getenv("QUERY_STRING")
   else line := reads(&input, getenv("CONTENT_LENGTH"))
   line ? {
      while put(html, tab(find("&"))) do
	 tab(many('&'))
      put(html, tab(0))
      }
   every r := 1 to *html do
      html[r] := map(html[r], "+", " ")
   every !html ? {
      # does this really loop multiple times?  If so, what are we
      # throwing away?
      while k := tab(find("=")) do
	 tab(many('='))
      k := cgiFixHex(\k)
      data := cgiFixHex(tab(0))
      if member(cgi, k) then cgi[k] ||:= "," || data
      else cgi[k] := data
      }
   }
   return cgi
end


# Replaces any hex codes in the given string by their ascii character
# equivalents and returns the fixed string.
procedure cgiFixHex(s)
   while s ?:=
      ((tab(find("%")) ||
	(move(1) &
	 (c1 := tab(any(cgi_hexen))) & (c2 := tab(any(cgi_hexen))) &
	 cgiHexchar(c1,c2)
	 ) || tab(0)
	)
       )
   return s
end

#
# procedure cgiPrintVariables
# prints the variables with their value
#

procedure cgiPrintVariables(in)
   write("<br>")
   every X := key(in) do
      write("<b>",X,"</b> is <i>",in[X],"</i><p>")
end

procedure cgiError(in)
   if /in then
      write("Error: Script ", cgiMyURL(), " encountered fatal error")
   else {
      write("Content-type: text/html\n\n")
      write("<html><head><title>",in[1],"</title></head>\n")
      every i := 2 to *in do
	 write("<p>", in[i], "</p>")
      write("</body></html>\n")
      }
end

procedure cgiHexval(c)
   if any(&digits, c) then return integer(c)
   if any('ABCDEF', c) then return ord(c) - ord("A") + 10
   if any('abcdef', c) then return ord(c) - ord("a") + 10
end

procedure cgiHexchar(c1,c2)
   return char(cgiHexval(c1) * 16 + cgiHexval(c2))
end

#
# procedure cgiColorToHex
# if a basic color is entered into the procedure the hex values
# is returned
#

procedure cgiColorToHex(s)
static ColorTbl
initial {
   ColorTbl:=table(0)
   ColorTbl["black"] := "000000"
   ColorTbl["gray"]  := "666666"
   ColorTbl["white"] := "ffffff"
   ColorTbl["pink"]  := "ff0099"
   ColorTbl["violet"]:= "ffccff"
   ColorTbl["brown"] := "996633"
   ColorTbl["red"]   := "ff0000"
   ColorTbl["orange"]:= "ff9900"
   ColorTbl["yellow"]:= "ffff33"
   ColorTbl["green"] := "339933"
   ColorTbl["cyan"]  := "ff66cc"
   ColorTbl["blue"]  := "0000ff"
   ColorTbl["purple"]:= "990099"
   ColorTbl["magenta"]:="cc0066"
   }

   if rv := ColorValue(s) then {
      # unfinished; convert 16-bit decimal values into 8-bits/component hex
      }
   return ColorTbl[s]
end

#
# Procedure cgiPrePro
# This procedure goes through a file writes out
# either anything between ALL and the value that are passed into the
# procedure.
#

procedure cgiPrePro(filename,def)
   AllFlag := 0
   DefFlag := 0
   all := "<!-- ALL"
   look := "<!-- " || def
   intext := open(filename)
   while here:=read(intext) do {
      if match(all,here) then {
	 if AllFlag = 1 then
	    AllFlag := 0
	 else {
	    here := read(intext)
	    AllFlag := 1
	    }
	 }
      if match(look,here) then
	 if DefFlag = 1 then {
	    DefFlag := 0
	    }
	 else {
	    DefFlag := 1
	    here := read(intext)
	    }
      if AllFlag = 1 then writes(here)
      else if DefFlag = 1 then writes(here)
      }
end

#
# cgiRemoteUser(): returns the reported Web user.
#
procedure cgiRemoteUser()
   return getenv("REMOTE_USER")
end

#
# Procedure cgiRndImg
#
# if a list is passed into the procedure then an img is randomized
#

procedure cgiRndImg(GifList, AltText)
   writes("<img src=\"",?GifList,"\"", " alt=\"",AltText,"\"", ">")
end

procedure cgiOptwindow(opts, args[])
   if not getenv("DISPLAY") then {
      /opts["D"] := getenv("REMOTE_ADDR") || ":0"
      }
   return optwindow ! push(args, opts)
end

#
# procedure main
#
# This procedure wraps the application's cgimain() inside a standard HTML
# document, with customizable title, head, and body attributes procedures.
# It reads the input for the application, placing results in variable "cgi".
#

procedure main(args)
   local BB
   write("Content-type: text/html\n\n")

   if \cgicookies then
      every c := !cgicookies(args) do {
	 if type(c) == "table" then {
	    write("Set-cookie: ", c["name"], "=", c["value"])
	    every attr := ! [ "expires", "path", "domain" ] do
	       if \c[attr] then writes("; " || attr || c[attr])
	    if \c["secure"] then writes("; secure")
	    }
	 else
	    write("Set-cookie: ", c)
	 write()
	 }
   write()

   write("<html>")
   write("<head>")
   if \cgititle then {
      write("<title>")
      write(cgititle(args))
      write("</title>")
      }
   # This can write arbitrary stuff, e.g. JavaScript.
   if \cgihead then cgihead(args)
   write("</head>")
   writes("<body")
   if \cgiBBuilder then {
      BB := cgiBBuilder(args)
      writes(" background=\"",BB["background"],"\"")
      writes(" bgcolor=\"",BB["bgcolor"],"\"")
      writes(" text=\"",BB["text"],"\"")
      writes(" link=\"",BB["link"],"\"")
      writes(" vlink=\"",BB["vlink"],"\"")
      writes(" bgproperties=\"",BB["bgproperties"],"\"")
      }
   write(">")
   cgiReadParse()
   cgimain(args)
   write("</body>")
   write("</html>")
end