procedure main(arg)

     cwd := getenv("PWD")

     dbfilename := getenv("PATH_TRANSLATED") | ( "/home/httpd/html" || get(arg) | "/index.qf" )
     arg := cgiParse(getenv("QUERY_STRING"))
     # startingpage := \get(arg) | ""

     # debug_write("... file to start with ", dbfilename, " and page ", startingpage)
     dir := ""
     dbfilename ? { while dir ||:= tab(find("/")) || "/"  do tab(many('/'))
                    dbfilename := tab(0)
                  }
     # debug_write("... switching to ", dir)
     chdir(dir)

     tokens := table()
     descr := table()
     loaddbfile(dbfilename, tokens, descr)

     # tokens["0"] := [ startingpage ]
     i := 1
     every item := !arg do
     {     tokens[string(i)] := [ item[2] ]
           # debug_write("... storing ", i, " as '", item, "'")
           i +:= 1
           if \item[1] then tokens["GET|" || item[1]] := [ item[2] ]
     }

     expand("Content-Type: $-Content Type.\n\n", tokens, writes) 
     expand("$-.", tokens, writes) 

     chdir(cwd)

end


procedure expand(token, db, action, action_parm)
       
# token is a string to expand. 
# db is a lookup table.

      /action_parm := []

      token ? { while d := find("$") do
                {     action ! ( action_parm ||| [ (tab(d)) ] )
                      move(1)

                      # Check for a plain $$.
                      if ="$" then
                      {  action ! ( action_parm ||| [ "$" ] )
                         next
                      }

                      # Okay, it must be a token reference.
                      item := tab(find(".")) & move(1)
                      # debug_write("... ", item)

                      # Fish the token name out.
                      precmd := item[1]
                      if any('-<!', precmd) then item := item[2:0]
                                            else precmd := ""
                      postcmd := item[-1]
                      if any('+?-', postcmd) then item := item[1:-1]
                                             else postcmd := ""

                      # Get the token's content. Non-existent tokens do not cause any sort of error.
                      content := \db[item] | [ "" ]
                      if postcmd == "?" then content := ?(content)
                                        else content := content[1]

                      # Check for the RPN special escape.
                      if match("%=", content) then
                      {  content ? { move(2)
                                     eqn := tab(find("\n") | 0)
                                     move(1)
                                     content := tab(0) | ""
                                   }
                         if not( content := decodeeqn(eqn, content, db) ) then 
                            next
                      }
                      
                      # Off we go...
                      case precmd of
                      {    ""  : action ! ( action_parm ||| [ content ] )
                           "-" : expand(content, db, action)
                                 # Gotta fix this. It's quite inelegant.
                           "<" : { # debug_write("... reading file '", content, "'")
                                   inlinefile := open(content, "r") &
                                   ( while action ! (action_parm ||| [ read(inlinefile) || "\n" ]) ) & 
                                   close(inlinefile)
                                 }
                         # "!" : # not needed because it doesn't do anything. :-)
                      }
                      case postcmd of
                      {    "+" : if *\db[item] > 1 then 
                                    put(db[item], get(db[item])) # Take first, put it on the end.
                           "-" : if *\db[item] > 1 then
                                    push(db[item], pull(db[item])) # Take last, put it at the start
                      }
                }
                action ! ( action_parm ||| [ (tab(0)) ] )
              }

end


procedure loaddbfile(filename, db, db_desc)

      local file, line, token

      # debug_write("*** loaddbfile called with ", filename)

      file := open(filename, "r") | fail

      while line := read(file) do
      {     
            # Discard blank lines and comments (# ... ).
            if *line == 0 | line[1] == "#" then next

            # Token declaration.
            if line[1] == "|" then
            {  line ? { move(1)
                        token := tab(upto('|')) & move(1)
                        db_desc[token] := tab(upto('|')) & move(1)
                        /db[token] := [ ]
                        put(db[token], tab(0))
                      }
               next
            }

            # Process directives.
            if line[1] == "-" then
            {  line ? { if ="-include " then
                           loaddbfile(tab(0), db, db_desc)
                        if ="-cd " then
                           chdir(tab(0))
                      }
               token := &null
               next
            }

            # Fish out escapes.
            if line[1] == "\\" then
               line := line[2:0]

            # Add it on.
            oldline := db[\token][-1]
            if oldline[-1] == "\\" then
               db[token][-1] := oldline[1:-1] || line
            else
               db[token][-1] ||:= "\n" || line
      }

      close(file)
      return *db

end

procedure decodeeqn(eqn, content, db)

          local in, stack
          
          in := eqn || " "
          stack := [ content ]

          # debug_write("... decoding '", in, "'")
          
          in ? while tab(many(' ')) do
               {  
                     # Token insertion.
                     if tab(match("$")) then
                     {  item := tab(find(".")) | fail
                        move(1)

                        # debug_write("... expanding '", item, "'")

                        # $% is actually an environment variable and $* is an array-count reference.
                        case item[1] of
                        {    "%" : ( item := getenv(item[2:0]) ) | next
                             "*" : item := ( *\(db[item[2:0]]) | 0 )
                             default: item := ( (\db[item])[1] ) | ""
                        }
                        # debug_write("... pushing '", item, "'")
                        push(stack, item)
                        next
                     }

                     # Quoted string.
                     if tab(match("\"")) then
                     {  ( item := tab(find("\"")) &
                          push(stack, item) & 
                          move(1)
                        ) | fail 
                        next
                     }

                     # Anything else.
                     item := tab(find(" ") | 0)
                     # debug_write( "... operator '", item, "'")

                     case item of
                     {    "=" | "~=" | "<" | ">" | "<=" | ">=" | "+" | "-" | "*" | "/" | "%" :
                                { one := pop(stack) + 0
                                  two := pop(stack) + 0
                                  if not( push(stack, proc(item,2)(two, one)) ) then 
                                     fail
                                }
                          "==" | "~==" | "||" :
                                { one := string(pop(stack))
                                  two := string(pop(stack))
                                  if not( push(stack, proc(item,2)(two, one)) ) then 
                                     fail
                                }
                          "repl":
                                { one := pop(stack) + 0
                                  two := string(pop(stack))
                                  if not( push(stack, repl(two, one)) ) then 
                                     fail
                                }
                          "size" : push(stack, *pop(stack))
                          "-ve" : push(stack, -(pop(stack) + 0) )
                          "store" : { item := pop(stack)
                                      # debug_write("... storing '", stack[1], "' into '", item, "'")
                                      target := db[item] 
                                      pop(\target) | fail
                                      db[item] := [ pop(stack) ] ||| target
                                    }
                          "expand" : { item := pop(stack)
                                       str := ""
                                       list1 := [ str ]
                                       expand(item, db, str_append, [ list1 ]) # This looks odd, but it works.
                                       push(list1[1])
                                     }
                          "drop" : pop(stack)
                          "dup"  : push(stack, stack[1])
                          "over" : push(stack, stack[2])
                          "swap" : ( one := pop(stack) & two := pop(stack) &
                                     push(stack, two, one)
                                     ) | fail 
                          "" : next
                          default : push(stack, item)
                     }
                }

          # debug_write("... eqn returns '", stack[1], "'")
          return stack[1]

end


procedure str_append(strlist, addstr)

     strlist[1] ||:= addstr

end


procedure debug_write(out[])

     push(out, &errout)
     write ! out

end



#
# cgiParse()
# 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 cgiParse(arg)
static hexen
initial { hexen := &digits ++ 'ABCDEFabcdef' }

   html := [ ]
   cgi := [ ]
   
   arg ? {  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 ? {  k := &null
                    while k := tab(find("=")) do tab(many('='))
                    data := tab(0)

                    while data ?:= ( tab(find("%")) || ( move(1) &
                                                         ( c1 := tab(any(hexen)) ) & 
                                                         ( c2 := tab(any(hexen)) ) &
                                                         cgiHexchar(c1,c2)
                                                       ) || tab(0)
                                   )

                    put( cgi, [ k , data ] )
                    # put( cgi, ( (\k || "=") | "" ) || data )
                  }
   return cgi
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