#line 121 "/home/ubuntu/felix/src/packages/flx_web.fdoc"
  if PLAT_POSIX do
  PosixSignal::ignore_signal(PosixSignal::SIGPIPE);
  done
  
  
  
  class Css4Html {
  flx_head := """
  <style type="text/css">
  body {margin:3%; font-family: sans-serif; }
  h1 {color:black; font-size:120%; border-bottom: 2px solid #ddd; padding: 0 0 3px 0;}
  h2 {color:#202020; font-size:105%;}
  h3 {font-size:100%;}
  h4 {font-size:95%;}
  h5 {font-size:95%;}
  span.fstring {color:darkblue; font-style:italic; }
  span.comment {font-family:arial; color:blue; font-style:italic; }
  span.doccomment {font-family:arial; color:green; font-style:italic; }
  span.big_keyword {color:#FF1010; }
  span.small_keyword {color:#802040; }
  span.qualifier {color:#A02020; }
  span.library {color:#A02000; }
  span.ctor {color:#406020; }
  span.hack {color:#66DD00; }
  span.preproc {color:#005500; }
  span.embedded_c{background-color:#DDDDDD; }
  span.fpc_fieldname {color:#DD0000; }
  span.lineno {color:#101010; background-color:#E0E0E0; font-size:80%; font-family:"courier",monospace; font-style:normal; }
  pre { border: 1px solid #ccc; color: black; box-shadow:3px 3px 2px rgba(0,0,0,0.1); padding:2px; }
  pre.flxbg {background-color:#C2FDC2; box-shadow:3px 3px 2px rgba(0,0,0,0.1) }
  pre.uncheckedflxbg {background-color:#eee; box-shadow:3px 3px 2px rgba(0,0,0,0.1); }
  pre.cppbg {background-color:#C2FDC2; }
  pre.prefmtbg {background-color:#F1F1F1; }
  pre.expected {background-color:hsla(74,94%,88%,1); }
  pre.input {background-color:hsla(20,94%,88%,1); }
  pre.inclusion {
      font-family: Arial;
      font-weight: normal;
      font-size: 0.9em;
      color: #555;
      border: none;
      box-shadow: none;
      text-align: right;
      margin: -7px 11px -12px 0;
      padding: 0;
      background-color:#fafafa;
  }
  code.inclusion {background-color:#D070D0; color:black; }
  .obsolete { background-color:#FFEFEF; font-size: small; color:black; }
  .future { background-color:#FF8080; font-size: small; color:black; }
  .implementation_detail { background-color:#E0E0E0; font-size: small; color:black;  }
  .bug { background-color:#FFE0E0; font-size: small; color:black; }
  .fixed{ background-color:#FFE0E0; font-size: small; color:black; }
  .done { background-color:#FFE0E0; font-size: small; color:black; }
  .caveat { background-color:hsla(0,100%,91%,1); color:black; padding: 0.6em; }
  </style>
  """;
  }
  
  open Socket;
  open IOStream;
  
  open TerminalIByteStream[fd_t];
  open TerminalIOByteStream[socket_t];
  
  // this is a hack to make close work on a listener
  // RF got this right the first time:
  // in the abstract a listener is NOT a socket
  // In fact, it is a socket server, with accept() a way to
  // read new sockets off it ..
  open TerminalIByteStream[socket_t];
  
  include "web/http_response";
  open HTTPResponse;
  include "web/mime_type";
  
  include "plugins/plugin_common";
  include "plugins/fdoc-interface";
  include "plugins/edit-interface";
  include "plugins/toc_menu-interface";
  
  proc dbg(x:string) { fprint (cstderr,x); };
  fun / (x:string, y:string) => Filename::join (x,y);
  
  requires header '#include <stdlib.h>';
  fun strtod: string -> double = "strtod($1.data(),0)";
  fun atoi: string -> int = "atoi($1.data())";
  
  // command line argument processing
  
  // -------------------------------------------------------------------------
  // Setup the fixed defaults.
  var arg = "";
  var argno = 1;
  var SHARE = #Config::std_config.FLX_SHARE_DIR;
  var TARGET = #Config::std_config.FLX_TARGET_DIR;
  var INSTALL_ROOT = SHARE.[to -6]; // cut off the /share suffix
  
  var DELAY = 0.1;
  var PORT=1234;
  
  var FLX_PATH=Empty[string];
  var FDOC_PATH=Empty[string];
  
  var C_PATH=list(
    "/usr/local/include",
    "/usr/include"
  );
  
  var FLX_PKGCONFIG_PATH=Empty[string];
  
  var FLX_WEBSERVER_PLUGIN_PATH = Empty[string];
  var PLUGIN_MAP = Empty[string^3];
  
  // -------------------------------------------------------------------------
  // Set the hard coded default config.
  // This sucks totally, its just a hack based on my
  // local requirements. And even that screws up by
  // confusing multiple gcc installs and clang installs.
  
  var default_config = list (
    "C_PATH += /usr/include/c++/4.2.1",
    "C_PATH += /usr/include/c++/4.2.1/x86_64-apple-darwin10",
  
    "C_PATH += /usr/include/c++/4.6",
    "C_PATH += /usr/include/c++/4.6.3",
    "C_PATH += /usr/lib/gcc/x86_64-linux-gnu/4.6.3/include",
     ""
  );
  
  // -------------------------------------------------------------------------
  // Now find the users HOME directory.
  // Try to get the config string from there.
  var HOME: string = Env::getenv "HOME";
  println$ "Home=" + HOME;
  var FLX_HOME : string= Filename::join (HOME, ".felix");
  println$ "FlxHome=" + FLX_HOME;
  var FLX_CONFIG : string= Filename::join (FLX_HOME,"webserver.config");
  println$ "Flxconfig=" + FLX_CONFIG;
  var config_data = load(FLX_CONFIG);
  println$ "loaded webserver config data = " + config_data;
  var config_lines = split(config_data, "\n");
  
  
  // -------------------------------------------------------------------------
  // If we couldn't get the webserver config string
  // from the HOME directory, use the fixed default.
  if len config_data == 0.size do
    println "Using default config";
    config_lines = default_config;
  done
  
  // -------------------------------------------------------------------------
  // Parse the config string.
  config_lines = map (strip of (string)) config_lines;
  var pathext = RE2("(.*)\\+=(.*)");
  var varset = RE2("(.*)=(.*)");
  
  var result = varray[StringPiece] (4.size,StringPiece(""));
  for line in config_lines do
    var match_result = Match(pathext, StringPiece(line),0,ANCHOR_BOTH, result.stl_begin,3);
    if match_result do
      var lhs = result.1.str.strip;
      var rhs = result.2.str.strip;
      match lhs with
      | "C_PATH" => C_PATH += rhs;
      | "FLX_PATH" => FLX_PATH += rhs;
      | "FLX_PKGCONFIG_PATH" => FLX_PKGCONFIG_PATH += rhs;
      | "FLX_WEBSERVER_PLUGIN_PATH" => FLX_WEBSERVER_PLUGIN_PATH += rhs;
      | "FDOC_PATH" => FDOC_PATH += rhs;
      | _ => println$ "Unknown variable '" + lhs +"'";
      endmatch;
    else
    match_result = Match(varset, StringPiece(line),0,ANCHOR_BOTH, result.stl_begin,3);
    if match_result do
      lhs = result.1.str.strip;
      rhs = result.2.str.strip;
      match lhs with
      | "PORT" => PORT = atoi rhs;
      | "INSTALL_ROOT" => INSTALL_ROOT = rhs;
      | _ => println$ "Unknown variable '" + lhs +"'";
      endmatch;
    done done
  done
  
  // -------------------------------------------------------------------------
  // Process command line options.
  // These can reset the INSTALL_ROOT
  // or augment the C_PATH.
  while argno<System::argc do
    arg = System::argv argno;
    println$ "ARG=" + arg;
    if prefix(arg,"--root=") do
      INSTALL_ROOT=arg.[7 to];
      SHARE = INSTALL_ROOT/"share";
      TARGET = INSTALL_ROOT/"host";
  
    elif prefix(arg,"--close-delay=") do
      DELAY=strtod arg.[14 to];
    elif prefix(arg,"--port=") do
      PORT=atoi arg.[7 to];
    elif prefix(arg,"--cpath=") do
      C_PATH+=arg.[8 to];
    elif prefix(arg,"--plugin-path=") do
      FLX_WEBSERVER_PLUGIN_PATH+=arg.[14 to];
    done
    ++argno;
  done
  
  // -------------------------------------------------------------------------
  // Now, use the INSTALL_ROOT to augment
  // the search paths.
  C_PATH+= TARGET+"/lib/rtl";
  C_PATH+= INSTALL_ROOT+"/share/lib/rtl";
  FLX_PATH+=INSTALL_ROOT+"/share/lib";
  FLX_PATH+= TARGET+"/lib";
  FDOC_PATH+=INSTALL_ROOT;
  FLX_PKGCONFIG_PATH+= TARGET+"/config";
  FLX_WEBSERVER_PLUGIN_PATH+= TARGET+"/lib";
  
  // -------------------------------------------------------------------------
  // Print the configuation.
  println$ "INSTALL_ROOT="+INSTALL_ROOT;
  println$ "FLX_PATH="+str FLX_PATH;
  println$ "C_PATH="+str C_PATH;
  println$ "FLX_PKGCONFIG_PATH="+str FLX_PKGCONFIG_PATH;
  println$ "FLX_WEBSERVER_PLUGIN_PATH="+str FLX_WEBSERVER_PLUGIN_PATH;
  println$ "FDOC_PATH="+str FDOC_PATH;
  println$ "DELAY="+str DELAY;
  println$ "PORT="+str PORT;
  
  
  // -------------------------------------------------------------------------
  // Build consolidated configuration string
  // for plugins.
  
  val newline="\n";
  
  var config = "INSTALL_ROOT = " + INSTALL_ROOT + newline;
  for d in FLX_PATH do
    config += "FLX_PATH += " + d + newline;
  done
  
  for d in C_PATH do
    config += "C_PATH += " + d + newline;
  done
  
  for d in FDOC_PATH do
    config += "FDOC_PATH += " + d + newline;
  done
  
  for d in FLX_PKGCONFIG_PATH do
    config += "FLX_PKGCONFIG_PATH += " + d + newline;
  done
  
  for d in FLX_WEBSERVER_PLUGIN_PATH do
    config += "FLX_WEBSERVER_PLUGIN_PATH += " + d + newline;
  done
  
  print$ "CONSOLIDATED CONFIG:\n" + config;
  
  // -------------------------------------------------------------------------
  // Now load the plugins.
  
  var  xlat_felix = Dynlink::load-plugin-func2 [bool * string, string, string] (
      dll-name="flx2html", setup-str=config, entry-point="flx2html"
    );
  
  var  xlat_fdoc = Dynlink::load-plugin-func2 [fdoc_t, string, string] (
      dll-name="fdoc2html", setup-str=config, entry-point="fdoc2html"
    );
  
  var  xlat_fpc = Dynlink::load-plugin-func2 [bool * string, string, string] (
      dll-name="fpc2html", setup-str=config, entry-point="fpc2html"
    );
  
  var  xlat_py = Dynlink::load-plugin-func2 [bool * string, string, string] (
      dll-name="py2html", setup-str=config, entry-point="py2html"
    );
  
  var  xlat_ocaml = Dynlink::load-plugin-func2 [bool * string, string, string] (
      dll-name="ocaml2html", setup-str=config, entry-point="ocaml2html"
    );
  
  var  xlat_cpp = Dynlink::load-plugin-func2 [bool * string, string, string] (
      dll-name="cpp2html", setup-str=config, entry-point="cpp2html"
    );
  
  var editor_maker = Dynlink::load-plugin-func1 [edit-interface_t, 1] (
    dll-name="fdoc_edit", setup-str=config, entry-point="fdoc_edit"
    );
  
  var  toc_menu = Dynlink::load-plugin-func1 [toc_menu_interface, list[int * string * string]] (
      dll-name="toc_menu", setup-str="loaded-from-fdoc_frame", entry-point="toc_menu"
    );
  
  
  // MOVE THIS ELSEWHERE!
  
  fun getline_to_url (get:string) =>
    if not startswith get "GET " then
      ""
    else
      match find (get, ' ', 4uz) with
      | #None => ""
      | Some pos => get.[4 to pos]
      endmatch
    endif
  ;
  
  fun postline_to_url (get:string) =>
    if not startswith get "POST " then
      ""
    else
      match find (get, ' ', 5uz) with
      | #None => ""
      | Some pos => get.[5 to pos]
      endmatch
    endif
  ;
  
  
  // strip off the leading http:// then split on the next /
  fun split_url (inurl:string) = {
    val url =
      if startswith inurl "http://" then
        inurl.[to 7]
      else
        inurl
      endif
    ;
  
    return
      match find (url, '/') with
      | #None => None[string*string]
      | Some pos => Some$ url.[0 to pos], url.[pos + 1 to]
      endmatch
    ;
  }
  
  // parse balance of HTTP GET request (after gthe GET keyword)
  fun parse_get_line (get:string) =>
    split_url$ getline_to_url get
  ;
  
  // parse balance of HTTP GET request (after gthe GET keyword)
  fun parse_post_line (get:string) =>
    split_url$ postline_to_url get
  ;
  
  variant request_type = reqGET | reqPOST | reqHEAD | reqERROR;
  
  fun parse_request_type (r:string) =>
    if startswith r "GET" then reqGET
    elif startswith r "HEAD" then reqHEAD
    elif startswith r "POST" then reqPOST
    else reqERROR
    endif
  ;
  
  // fixup text by replacing < > and & characters
  fun txt2html (x:string) =
  {
    var out2 = "";
    for var i in 0 upto x.len.int - 1 do
      var ch = x.[i];
      if ch == char "<" do out2+="&lt;";
      elif ch == char ">" do out2+="&gt;";
      elif ch == char "&" do out2+="&amp;";
      else out2+=ch;
      done
    done
  
    return out2;
  }
  
  // put into <head> of document
  // http://www.mathjax.org/docs/1.1/start.html#mathjax-cdn
  mathjax := '''
  <script type="text/x-mathjax-config">
    MathJax.Hub.Config({
      tex2jax: {
          skipTags: ["script","noscript","style","textarea"]
      }
    });
  </script>
  <script type="text/javascript"
    src="http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML">
  </script>
  ''';
  
  
  // functions to make responses
  fun make_image_from_suffix (suffix:string, contents:string, headers:headers_t) =>
    make_image(MIMEType::mime_type_from_extension suffix,contents, headers)
  ;
  
  proc serve_not_found (k:socket_t, fname:string, get:bool) {
     var eof_flag = false;
     val data = make_not_found(fname);
     write_string(k,data,&eof_flag);
  }
  
  proc serve_not_implemented (k:socket_t, fname:string) {
     var eof_flag = false;
     val data = make_not_implemented(fname);
     write_string(k,data,&eof_flag);
  }
  
  
  proc serve_forbidden (k:socket_t, fname:string, get:bool) {
     var eof_flag = false;
     val data = make_forbidden(fname);
     write_string(k,data,&eof_flag);
  }
  
  fun find_defs (lines:string) : darray[int * int * string] =
  {
  
    var fregex = ".*\\.(flx|fdoc)";
    open Regdef;
    regdef anychar = perl (".");
  
    regdef letter = charset "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
    regdef digit = charset "0123456789";
    regdef id1 = letter | "_";
    regdef id2 = id1 | digit | "-" | "'";
    regdef id = id1 id2*;
  
    regdef tex = "\\" letter*;
    regdef symbol1 = "+-*/%^";
    regdef symbol = symbol1 | symbol1 symbol1 | symbol1 symbol1 symbol1;
    regdef name = id | symbol;
    regdef spaces = " "*;
    regdef vlist =  "[" spaces id (spaces "," spaces id)* spaces "]";
  
    regdef adjective = "pure" | "inline" | "noinline" | "pod" | "open" | "virtual";
    regdef binder = "fun" | "proc" | "gen" | "class" | "union" | "struct" | "type" | "typedef" | "ctor" (spaces vlist)?;
  
    regdef indent2 = "  ";
  
    regdef classbind= group ("class" | "open class");
    regdef otherbind= indent2 ? group (adjective* spaces binder);
  
    // Group 1 = class
    // Group 2 = other
    // group 3 = identifier
    regdef decl = (classbind | otherbind) spaces group (name) anychar*;
  
    var emptystring = "";
    var emptystringpiece = StringPiece emptystring;
  
    var lregex = decl . render;
    var lgrep = RE2 lregex;
    var n = NumberOfCapturingGroups(lgrep)+1;
    var v = varray[StringPiece] (n.size,emptystringpiece);
  
    var extract = RE2 " *([^={]*) *(=|{|;).*";
    var n2 = NumberOfCapturingGroups(extract)+1;
    var v2 = varray[StringPiece] (n2.size,emptystringpiece);
  
    var scomment = RE2 " *//[$](.*)";
    var vcomment = varray[StringPiece] (2.size, emptystringpiece);
    var count = 0;
    var comments = Empty[string];
  
    var h = darray[int * int * string] ();
    var lno = 1;
    for line in split (lines,char "\n") do
      ++count;
      var spl = StringPiece line;
  
      match lgrep line with
      | Some v =>
        var sym = v.3;
        var dfn = "";
        var m2 = Match (extract, spl, 0, ANCHOR_BOTH, v2.stl_begin, n2);
        if m2 do
          dfn = v2 . 1 . string . strip;
        else
          dfn = line . strip;
        done
        //println$ "DEFN: " + dfn;
        var level = if line.[0] == " " then 2 else 1 endif;
        push_back (h, (level, lno, dfn));
  
      | #None => ;
      endmatch; //d grexp
      ++lno;
    done // line
    return h;
  }
  
  var frame_style= """
  <style>
  .container {
    position: fixed;
    top:0px;
    left:0px;
    height : 100%;
    width: 100%;
    background-color: grey;
    margin: 0px;
    padding: 0px;
    border-width: 0px;
    color: #404040;
  }
  .maincontent {
    padding:4px;
    padding-left:8px;
    line-height:1.3em;
    color:#404040; background-color:#fafafa;
  }
  .maincontent h1 { margin-left:-8px; position: relative; font-family: georgia, serif; font-size: 1.8em; font-weight: normal; }
  .maincontent h2 { margin-left:-8px; position: relative; margin-bottom:-5px; }
  .maincontent h3 { margin-left:-8px; position: relative; margin-bottom:-5px; }
  .maincontent h4 { margin-left:-8px; position: relative; margin-bottom:-5px; }
  .maincontent code { color:#902030; }
  .toppanel {
    position:absolute; left:0px; top:0px; height:20px; right:0px;
    background-color: #e0e0e0;
  }
  .bottompanel {
    position:absolute; left:0px; top:22px; bottom:0px; right:0px;
    background-color: #fafafa;
    font-size:14px;
  }
  .leftpanel {
    position:absolute; left:0px; top:0px; bottom:0px; width: 150px;
    background-color: #eaeaea; overflow: auto;
  }
  .rightpanel {
    position:absolute; right: 0px; left:160px; top:0px; bottom: 0px;
    background-color: #fafafa; overflow: auto;
  }
  .divider {
    position:absolute; left: 150px; top:0px; bottom:0px;
    background-color: black; width:2px;
    box-shadow: 0 0 8px #000;
  }
  
  #panemover {
      position:absolute;
      left: 150px;
      width : 10px;
      top: 0px;
      bottom: 0px;
      opacity: 0.3;
      cursor:col-resize;
  }
  
  div.m {
      margin: 0px;
      padding:0px;
      border-width:2px;
      border-color: green;
  }
  
  div.m1 {
      background-color: #86E870;
      border-style:outset;
      border-color:#ccc;
      border-width:2px 0;
      font-size:90%;
      padding: 1px 0 2px 10px;
  }
  
  div.m2 {
      background-color: #70C070;
      padding-left:15px;
      padding-top:2px;
      border-style:outset;
      border-color:green;
      border-width:0 0 1px 0;
      font-size:80%;
  }
  
  div.m1:hover, div.m2:hover {
      background-color: white;
  }
  
  #leftmargintoc a {
      text-decoration: none;
      color: #404040;
  }
  </style>
  """;
  
  var frame_js = """
      <script async="true">
        function dragStart(e, left, right){
          document.getElementById("panemover").style.width="70%";
          document.getElementById("panemover").style.left="50px";
          mousedown = true;
          x = e.clientX
          dragOffsetLeft =
            document.getElementById(left).getBoundingClientRect().right -
            document.getElementById(left).getBoundingClientRect().left -
            x
          ;
          dragOffsetDivider= document.getElementById("divider").getBoundingClientRect().left - x;
          dragOffsetRight = document.getElementById(right).getBoundingClientRect().left - x;
        }
        function dragRelease(){
          document.getElementById('panemover').style.width = '6px';
          document.getElementById('panemover').style.left = document.getElementById('divider').offsetLeft + 'px';
          mousedown = false;
        }
        function drag(e, left, right){
          if(!mousedown){return}
          x = e.clientX
          tmpLeft = dragOffsetLeft + x
          tmpDivider= dragOffsetDivider + x
          tmpRight = dragOffsetRight + x
          document.getElementById(left).style.width= tmpLeft + 'px';
          document.getElementById("divider").style.left= tmpDivider + 'px';
          document.getElementById(right).style.left = tmpRight + 'px';
        };
      </script>
  """;
  
  typedef code_data_t = int * int * string;
  typedef menu_data_t = int * string * string;
  
  noinline fun wrap_html (h:darray[code_data_t], out:string) :string = {
    var h3 =  fold_right
      (fun (level:int, lno:int, text:string) (lst:list[menu_data_t]) =>
        (level, text, "#line" + lno.str) + lst
      )
      h Empty[menu_data_t]
    ;
      var menu = toc_menu (h3);
  
      var o = "";
      reserve(&o,10000+out.len.int);
  
      o+=frame_style;
      o+=#(menu.get_style);
      o+=frame_js;
      o+=#(menu.get_js);
  
      // MAIN CONTENT
      var topcontent =
        '    <!--Main Content top navbar-->\n'  +
        '    <!--Main Content top navbar End-->\n'
      ;
  
      var leftcontent = #(menu.make_menu);
  
      var rightcontent =
        '<!--Main Content Body-->\n' +
        out +
        '<!--Main Content Body End-->\n'
      ;
  
      var html = """
      <div class="container">
        <div class="toppanel">
  """ + topcontent + """
        </div> <!-- toppanel end -->
        <div class="bottompanel">
  
          <span id="divider" class="divider"></span>
  
          <span id="left" class="leftpanel" >
            <div class="menucontent">
  """ + leftcontent + """
            </div> <!-- leftpanel contents end -->
          </span> <!-- leftpanel end -->
  
  
          <span id="right" class="rightpanel">
            <div class="maincontent">
  """ + rightcontent + """
            </div> <!-- rightpanel contents end -->
            <hr>
          </span> <!-- rightpanel end -->
  
          <span id="panemover" style="cursor:col-resize;"
           onmousedown="dragStart(event, 'left', 'right'); return false;"
           onmousemove="drag(event, 'left', 'right');"
           onmouseout="dragRelease();"
           onmouseup="dragRelease();"
          >
          </span> <!-- panemover end -->
        </div> <!-- bottom panel end -->
      </div> <!-- container end -->
  """;
      o+= html;
      return o;
  }
  
  
  proc serve_felix (k:socket_t, fname:string, get:bool) {
    var eof_flag = false;
  
    match get_file(fname,INSTALL_ROOT,FLX_PATH) with
    | Some path =>
      val text = load path;
      println$ "Loaded felix file " + fname+", len="+str (text.len.int);
      var h =find_defs (text);
      val dirname = Filename::dirname path;
      def val needs_mathjax, val html = xlat_felix(text,dirname);
      var wrapped_html = wrap_html (h,"<pre>"+html+"</pre>");
      val data = make_html$
        "<html><head>"+Css4Html::flx_head+
         if needs_mathjax then mathjax else "" endif +
        "</head><body>"+ wrapped_html +
        "</body></html>\n\r",
        list[string*string](("Cache-control","max-age=86400"))
      ;
      write_string(k,data,&eof_flag);
    | #None =>
        serve_not_found (k,fname,get);
    endmatch;
  }
  
  proc serve_fpc (k:socket_t, fname:string, get:bool) {
    var eof_flag = false;
  
    match get_file (fname, INSTALL_ROOT,FLX_PKGCONFIG_PATH) with
    | Some path =>
      val text=load path;
      println$ "Loaded fpc file " + fname+", len="+str (text.len.int);
      val dirname = Filename::dirname path;
      val data = make_html$
        "<html><head>"+Css4Html::flx_head+"</head><body><pre>"+
        (xlat_fpc (text, dirname)).1
        +"</pre></body></html>\n\r",
        list[string*string]("Cache-control","max-age=86400")
      ;
      write_string(k,data,&eof_flag);
    | #None =>
        serve_not_found (k,fname,get);
    endmatch;
  
  }
  
  proc serve_py (k:socket_t, fname:string, get:bool) {
    var eof_flag = false;
    match get_file(fname,INSTALL_ROOT,FLX_PATH) with
    | Some path =>
      var flx = load path;
      val data = make_html$
        "<html><head>"+Css4Html::flx_head+"</head><body><pre>"+
        (xlat_py (flx,"")).1 +"</pre></body></html>\n\r",
         list[string*string](("Cache-control","max-age=86400"))
      ;
      write_string (k, data, &eof_flag);
    | #None =>
      serve_not_found (k,fname,get);
    endmatch;
  }
  
  proc serve_ocaml (k:socket_t, fname:string, get:bool) {
    var eof_flag = false;
    match get_file (fname, INSTALL_ROOT,FLX_PATH) with
    | Some path =>
      var flx = load path;
      println$ f"Loaded Ocaml file %S, len=%d" (fname, flx.len.int);
      val data = make_html$
        "<html><head>"+ Css4Html::flx_head +"</head><body><pre>"+
        (xlat_ocaml (flx,"")).1
        +"</pre></body></html>\n\r",
        list[string*string](("Cache-control","max-age=86400"))
      ;
      write_string (k, data, &eof_flag);
    | #None =>
      serve_not_found (k,fname,get);
    endmatch;
  }
  
  proc serve_cpp (k:socket_t, fname:string, get:bool) {
    var eof_flag = false;
    match get_file(fname,INSTALL_ROOT,C_PATH) with
    | Some path =>
      val text=load path;
  println$ f"Loaded C++ file %S, len=%d" (fname, text.len.int);
      val dirname = Filename::dirname path;
      val data = make_html$
        "<html><head>"+ Css4Html::flx_head +"</head><body><pre>"+
        (xlat_cpp (text, dirname)).1
        +"</pre></body></html>\n\r",
        list[string*string](("Cache-control","max-age=86400"))
      ;
      write_string (k, data, &eof_flag);
    | #None =>
        serve_not_found (k,fname,get);
    endmatch;
  }
  
  val text_suffices = (
    "txt","py","ml","mli",
    "tex","pl","dyp",
    "why","resh","pak","ipk",
    "dep","stdout","expect"
  );
  
  proc serve_text (k:socket_t, fname:string, get:bool) {
    var eof_flag = false;
    var txt = load(fname);
    println$ f"Loaded text file %S, len=%d" (fname, txt.len.int);
    val data = make_html$
      "<html><head></head><body><pre>"+
      txt
      +"</pre></body></html>\n\r",
      list[string*string](("Cache-control","max-age=86400"))
    ;
    write_string (k, data, &eof_flag);
  }
  
  proc serve_html (k:socket_t, fname:string, get:bool) {
    var eof_flag = false;
    var txt = load fname;
    println$ f"Loaded html file %S, len=%d" (fname, txt.len.int);
    val data = make_html$ txt,
      list[string*string](("Cache-control","max-age=86400"))
    ;
    write_string (k, data, &eof_flag);
  }
  
  proc serve_xhtml (k:socket_t, fname:string, get:bool) {
    var eof_flag = false;
    var txt = load fname;
    println$ f"Loaded xhtml file %S, len=%d" (fname, txt.len.int);
    val data = make_xhtml$ txt,
      list[string*string](("Cache-control","max-age=86400"))
    ;
    write_string (k, data, &eof_flag);
  }
  
  
  proc serve_fdoc (k:socket_t, fname:string, get:bool) {
    var eof_flag = false;
    match get_file(fname,INSTALL_ROOT,FDOC_PATH) with
    | Some path=>
      var txt = load(path);
      //println$ "Contents=" + flx;
      var result = xlat_fdoc (txt, fname);
      var needs_mathjax = #(result.mathjax_required);
      var html = #(result.html_page);
      var title = #(result.html_title);
      val data = make_html(
        "<html><head>"+Css4Html::flx_head+
        if needs_mathjax then mathjax else "" endif +
        if title != "" then "<title>"+title+"</title>" else "" endif +
        "</head><body>"+
        html+
        "</body></html>\n\r",
        list[string*string](("Cache-control","max-age=86400"))
      );
      write_string(k,data,&eof_flag);
    | #None => serve_not_found(k,fname,get);
    endmatch;
  }
  
  proc serve_xfdoc (k:socket_t, fname:string, get:bool) {
    var eof_flag = false;
    match get_file(fname,INSTALL_ROOT,FDOC_PATH) with
    | Some path=>
      var txt = load(path);
      println$ "Serve fdoc "+fname+" as xhtml";
      //println$ "Contents=" + flx;
      var result = xlat_fdoc (txt, fname);
      var needs_mathjax = #(result.mathjax_required);
      var html = #(result.html_page);
      var title = #(result.html_title);
      val data = make_html(
        "<html><head>"+Css4Html::flx_head+
        if needs_mathjax then mathjax else "" endif +
        if title != "" then "<title>"+title+"</title>" else "" endif +
        "</head>"+
        "<body>"+ html
        "</body></html>\n\r",
        list[string*string](("Cache-control","max-age=86400"))
      );
      write_string(k,data,&eof_flag);
    | #None => serve_not_found(k,fname,get);
    endmatch;
  }
  
  proc serve_raw (k:socket_t, fname:string, suffix:string, get:bool) {
    var eof_flag = false;
    var txt = load fname;
    println$ f"Loaded raw file %S, len=%d" (fname, txt.len.int);
    var mime = MIMEType::mime_type_from_file fname;
    println$ "File " + fname + " taken to be " + str mime;
    //println$ "Contents=" + flx;
    val data = make_mime (mime,txt);
    //val data = make_raw txt;
    write_string (k, data, &eof_flag);
  }
  
  proc serve_image (k:socket_t, fname:string, suffix:string, get:bool) {
    var eof_flag = false;
    var txt = load fname;
    println$ f"Loaded image file %S, len=%d" (fname, txt.len.int);
    //println$ "Contents=" + flx;
    val data = make_image_from_suffix (suffix,txt,
      list[string*string](("Cache-control","max-age=86400"))
    );
    write_string (k, data, &eof_flag);
  }
  
  // NOTE: TRICKY! serving css to be used in a page
  // is quite different to serving a css file to be
  // used by some program! In the first case it has to
  // to be sent verbatim. In the second it is colourised.
  proc serve_css(k:socket_t, fname:string, suffix:string, get:bool) {
    var eof_flag = false;
    var txt = load fname;
    println$ f"Loaded css file %S, len=%d" (fname, txt.len.int);
    //println$ "Contents=" + flx;
    val data = make_css txt;
    write_string(k,data,&eof_flag);
  }
  
  fun mk_dir_lines (fname:string, dirs: list[string]) = {
    fun rf(f:string)=>'  <a href="/$'+ fname + '/' +f+'">'+f+'</a>';
    return
      fold_left (fun (acc: string) (f:string) =>
        match f with
        | "." => acc
        | ".." => acc
        | _ => acc + rf f + "\r\n"
        endmatch
      )
      ""
      dirs
    ;
  }
  
  
  fun mk_reg_lines (fname:string, files: list[string]) = {
    var eof = false;
    var s = "";
    var old_base = "";
    var base = "";
    var extn = "";
    var entry = "";
    var exts = Empty[string];
    var rest = files;
  
    proc hd() { chd; }
    proc chd() { exts=list(extn); old_base=base; }
    proc cft() {
      //println$ "Cft for key " + old_base + " exts=" + str exts;
      fun rf(x:string)=>
        '  <a href="/$'+ fname + '/' +old_base+x+'">'+
        if x == "" then "(none)" else x endif +
        '</a>'
      ;
      def var extn, var rest = match exts with | Cons(h,t)=> h,t endmatch;
      s+= '  <a href="/$'+ fname + '/' +old_base+extn +'">'+old_base+extn+'</a>';
      List::iter (proc (x:string){ s+=" "+rf x; }) rest;
    }
    proc ft() { cft; s+="\r\n"; }
    proc twixt() { s+="\r\n"; }
    proc cbrk () { cft; twixt; chd; }
    proc nxt() {
      match rest with
      | Cons(h,t) =>
        entry = h; rest = t;
        base,extn =
          match rfind (entry, ".") with
          | #None => entry, ""
          | Some pos => entry.[to pos], entry.[pos to]
          endmatch
        ;
      | #Empty => eof = true;
      endmatch;
    }
  
    //special case for empty list
    if len files == 0uz do return ""; done
  
    nxt;                    //prime the system
    hd;                     // head off
  
  again:>
    nxt;
    if eof goto fin;        //check for eof
    if base == old_base do  //check for control break
      exts += extn;         // nope, same key
    else
      cbrk;                 // key changed
    done
    goto again;
  fin:>
    ft;                     // foot off
    return s;
  }
  
  proc serve_directory (k:socket_t, fname:string, get:bool) {
    var dirname = Filename::basename fname;
    var eof_flag = false;
    val top = "A DIRECTORY " + fname + "\r\n";
    val flist =
      match Directory::filesin fname with
      | Some files =>
        let aux =
            fun (ls2:list[string] * list[string]) (f:string) =>
            match ls2 with | ds,rs => match FileStat::filetype (Filename::join (fname,f)) with
              | #DIRECTORY => Cons (f,ds), rs
              | #REGULAR => ds, Cons (f,rs)
              | _ => ls2
              endmatch
            endmatch
        in
        let dirs,regs = fold_left aux (Empty[string], Empty[string]) files in
        let dirs,regs = sort dirs, sort regs in
        let dir_lines = mk_dir_lines (fname,dirs) in
        let reg_lines = mk_reg_lines (fname,regs) in
          "<pre>"+
          '  <a href="/"><em>home</em></a>\r\n'+
          if dir_lines.len != 0uz then ' Directories: \r\n' + dir_lines else "" endif +
          if reg_lines.len != 0uz then ' Files: \r\n' + reg_lines else "" endif +
          "</pre>"
      | #None => "ERROR ACCESSING DIRECTORY"
      endmatch
    ;
    val page = make_html(top + flist,
      list[string*string](("Cache-control","max-age=86400"))
    );
    write_string(k,page,&eof_flag);
  }
  
  
  proc serve_file(s: socket_t, infname: string) => serve (s, infname, true);
  proc serve_head(s: socket_t, infname: string) => serve (s,infname,false);
  
  proc serve(s: socket_t, infname: string, get:bool)
  {
    var eof_flag = false;
    // if empty string, serve index.html
    // not quite right - needs to handle directories too, so
    // not only foo.com/ -> index.html, but foo.com/images/ -> images/index.html
    var fname = if "" == infname then "share/src/web/index.html" else infname endif;
  
    fname =
      if fname.[0] == char "$" then fname.[1 to]
      elif fname.[0 to 3] == "%24" then fname.[3 to]
      else fname
      endif
    ;
  
    // set mime type depending on extension...
    // serve a "not found page" for that case (check for recursion)
    //print "serve file: "; print fname; endl;
  
    // figure out the filetype
    // we first check if the filename has a suffix like cpp
    // which is a trick done by us to force the filetype
    // to be "c++" for C++ standard include file names
    // which have no suffix. If we find that, we strip it
    // out of the filename too. Otherwise we just find
    // the suffix.
  
    var suffix = "";
    fun split_suffix (fname:string) =>
      match rfind (fname, "?") with
      | Some pos => fname.[pos + 1 to], fname.[0 to pos]
      | #None =>
          match rfind (fname, ".") with
          | #None => "",fname
          | Some pos => fname.[pos + 1 to], fname
          endmatch
      endmatch
    ;
    suffix,fname = split_suffix fname;
  
    if fname == "STOP" do
      run = false;
      println$ "STOP DETECTED";
    elif fname == "robots.txt" do
      serve_raw (s,INSTALL_ROOT + "/robots.txt","txt", get);
    elif suffix \(\in\) list ("flx","flxh") do
      serve_felix(s, fname, get);
    elif suffix \(\in\) list ("py") do
      serve_py(s, fname, get);
    elif suffix \(\in\) list ("ml","mli") do
      serve_ocaml(s, fname, get);
    elif suffix \(\in\) list("cpp","hpp","h","c","cc","i","cxx","rtti","includes","ctors_cpp") do
      serve_cpp(s, fname, get);
    elif suffix == "fpc" do
      serve_fpc(s, fname, get);
    elif suffix == "fdoc" do
      serve_xfdoc(s, fname, get);
    elif suffix \(\in\) ("html","htm") do
      fname = if fname.[0] == char "/" then fname else INSTALL_ROOT+"/"+fname endif;
      serve_html(s,fname, get);
    elif suffix == "xhtml" do
      fname = if fname.[0] == char "/" then fname else INSTALL_ROOT+"/"+fname endif;
      serve_xhtml(s,fname, get);
    elif suffix \(\in\) text_suffices do
      fname = if fname.[0] == char "/" then fname else INSTALL_ROOT+"/"+fname endif;
      serve_text(s,fname, get);
    elif suffix \(\in\) ("gif","png","jpg","svg") do
      fname = if fname.[0] == char "/" then fname else INSTALL_ROOT+"/"+fname endif;
      serve_image(s,fname,suffix, get);
    elif suffix == "css" do
      // path lookup for css files
      fname = if fname.[0] == char "/" then fname else INSTALL_ROOT+"/"+fname endif;
      serve_css(s,fname,suffix, get);
    else
      match get_file(fname, INSTALL_ROOT,Empty[string]) with
      | #None => serve_not_found(s,fname, get);
      | Some f =>
          if prefix(fname,"/etc") do serve_forbidden(s,fname, get);
          else
          match FileStat::filetype f with
          | #REGULAR => serve_raw(s,f,suffix, get);
          | #DIRECTORY => serve_directory (s,f, get);
          | _ => serve_not_found(s,f, get);
          endmatch;
          done
      endmatch;
    done
  }
  val webby_port = PORT;
  var run = true;
  
  print "FLX WEB!!! listening on port "; print webby_port; endl;
  
  // up the queue len for stress testing
  var p = webby_port;
  var listener: socket_t;
  mk_listener(&listener, &p, 10);
  
  var clock = Faio::mk_alarm_clock();
  
  // noinline is necessary to stop the closure being
  // inlined into the loop, preventing the socket variable k
  // being duplicated as it must be [a bug in Felix]
  noinline proc handler (var k:socket_t) ()
  {
    //dbg$ "Spawned fthread running for socket "+str k+"\n";
    // should spawn fthread here to allow for more io overlap
    //dbg$ "here we go .. read a line\n";
  
    var line: string;
    get_line(k, &line);  // should be the GET line.
    //dbg$ "Got a line from socket " + str k + "\n";
    //cat(s, DEVNULL);
  
  
    // now I need to parse the GET line, get a file name out of its url
    // (e.g. unqualfied -> index.html and name/flx.jpg -> flx.jpg
    var req = parse_request_type line;
  
    match req with
    | #reqGET =>
      match parse_get_line line with
      | Some (base, file) =>
        print "file="; print file; endl;
        serve_file(k,file);
      | #None => println$ "BAD GET line: '"+line+"'";
      endmatch;
    | #reqHEAD =>
      match parse_get_line line with
      | Some (base, file) =>
        print "file="; print file; endl;
        serve_head(k,file);
      | #None => println$ "BAD HEAD line: '"+line+"'";
      endmatch;
    | #reqPOST =>
      println$ "Unsupported POST; line: '"+line+"'";
    | #reqERROR =>
      println$ "BAD request line: '"+line+"'";
    endmatch;
  
  broken:>
  
    // we've only read the GET line, so let's flush out the rest of
    // the http request so we don't get connection reset errors when
    // we close the socket. shutting down stops cat blocking (?)
    //Faio_posix::shutdown(s, 1); // disallow further sends.
    //cat(s, DEVNULL);
  
    //fprint$ cstderr,"fthread socket "+str k+" close delay ..\n";
    Faio::sleep(clock,DELAY); // give OS time to empty its buffers
    //fprint$ cstderr,"fthread socket "+str k+" shutdown now\n";
  
  // try this:
  // Advised by: koettermarkus@gmx.de, MANY THANKS!
  
    gen hack_recv: socket_t * &char * int * int -> int = "recv($1,$2,$3,$4)";
  
    var buf:char ^1025;
    var counter = 0;
    var extra = 0;
    shutdown(k,1); // shutdown read
  retry:>
    var b = hack_recv(k,C_hack::cast[&char] (&buf),1024,0);
    //println$ "Error code " + str b + " from read after shutdown";
    if b > 0 do
      extra += b;
      if extra > 2000 do
        println$ "Read too many extraneous bytes from OS buffer";
        goto force_close;
       done;
     goto retry;
    elif b == -1 do
      ++counter;
      if counter > 200 do
        println "Timeout waiting for write buffers to be flushed";
        goto force_close;
      done;
      Faio::sleep(clock,0.1); // 100 ms
      goto retry;
    done;
    assert b==0;
  
  force_close:>
    Socket::shutdown(k,2);
    ioclose(k);
    //fprint$ stderr,"fthread "+str k+" terminating!\n";
  };
  
  spawn_fthread { while run do Faio::sleep(clock, 60.0); collect(); done };
  while run do
    var s: socket_t;
    //dbg$ "Waiting for connection\n";
    accept(listener, &s);  // blocking
    //dbg$ "got connection "+str s + "\n";  // error check here
  
    // hmm - spawning an fthread is blocking the web server. don't know why
    //dbg$ "spawning fthread to handle connection "+str s+"\n";
    var h = handler s;
    spawn_fthread  h;
   //collect(); // this hangs everything, no idea why!
  done
  
  println "WEB SERVER FINNISHED?";
  println$ "Closing listener socket " + str listener;
  iclose (listener);