#!/usr/bin/env rune

# Copyright 2004-2006 Kevin Reid, under the terms of the MIT X license
# found at http://www.opensource.org/licenses/mit-license.html ................


# This is a test application for an EIO <http://www.erights.org/elib/concurrency/eio/> implementation. It's a trivial web server.


pragma.enable("easy-return")
pragma.disable("explicit-result-guard")

pragma.enable("accumulator")
pragma.enable("dot-props")

def ALL                      := EIO::ALL
def FileNotFoundException    := <type:java.io.FileNotFoundException>
def network                  := <import:keio.networkAuthor>(privilegedScope)
def makePipe                 := <import:keio.makePipe>
def makeInFilter             := <import:keio.makeInFilter>

# Using dot-props everywhere as an experiment.

def [portStr, rootPathStr] := interp::args
def port := __makeInt(portStr, 10)
def root := <file: rootPathStr>

# --- Utilities ---

def extensionToMediaType := {
  def file := <file:/etc/httpd/mime.types>
  if (file.exists()) {
    accum [].asMap() for rx`\s*(@mt[^#\s][^\s]*)\s+(@exts.*)\n` in file {
      for ext ? (ext != "") in exts.split(" ") {
        _.with (ext, mt)
      }
    }
  } else {
    ["txt" => "text/plain", "html" => "text/html", "htm" => "text/html", "gif" => "image/gif", "xml" => "application/xml", "rdf" => "application/rdf+xml", "png" => "image/png", "svg" => "application/svg+xml", "xhtml" => "application/xhtml+xml"]
  }
}

def ourCharset := "UTF-8"

def standardHeaders := `$\
Server: kEIO-Demo-Web-Server/0.0 kEIO/0.0
`

def asLines(charsIn) {
  var lineBuffer := ""

  def charsToLinesFilter(elements) {
    def lines := (lineBuffer + __makeTwine.fromChars(elements, null)).split("\r\n")
    stderr.print("lines now: ")
    stderr.quote(lines)
    stderr.println()
    lineBuffer := lines.last()
    return lines(0, lines.size() - 1)
  }
  
  def finishCharsToLines() {
    return if (lineBuffer != "") { [lineBuffer] } else { [] }
  }
  
  return makeInFilter(charsIn, charsToLinesFilter,
    "optFinishThunk" => finishCharsToLines,
    "approxLengthFactor" => 1/50,
    "filteredElementType" => String,
    "likesAvailable" => 10,
    "stderr" => stderr
  )
}

# --- Making connection ---

def handler(ins, outs, originSpec, options) {
  stderr.println(`handler($ins, $outs, $originSpec, $options)`)
  def linesIn := asLines(ins)
  
  def requestHeadersFlex := [].asMap().diverge(String, String)
  def requestPath
  
  def handleRequest
  def pullHeaders
  
  def sendProblem(p) {
    stderr.println(`sendProblem($p)`)
    outs.write(`HTTP/1.0 500 Internal Error$\r$\nContent-Type: text/plain$\r$\n$\r$\n$p${p.eStack()}`)
    linesIn.close()
    outs.close()
    throw(p)
  }
  
  linesIn <- whenAvailable(1, fn{
    stderr.println(`first line thunk`)
    try {
      def [`GET /@{bind requestPath} HTTP/@_`] := linesIn.read(1, 1)
      pullHeaders()
    } catch p {
      sendProblem(p)
    }
  })
 
  bind pullHeaders() {
    stderr.println(`pullHeaders`)
    try {
      linesIn <- whenAvailable(1, fn{
        escape stopHeaders {
          for i => line in linesIn.peek(0, ALL) {
            switch (line) {
              match `` {
                linesIn.skip(1)
                handleRequest()
                stopHeaders()
              }
              match `@key: @value` {
                linesIn.skip(1)
                # requestHeadersFlex.put(key, value, true)
                # fixme: Work around E bug <http://www.eros-os.org/pipermail/e-lang/2004-August/009945.html>
                requestHeadersFlex.put(key :String, value :String, true)
              }
            }
          }
          pullHeaders()
        }
      })
    } catch p {
      sendProblem(p)
    }
  }
  
  bind handleRequest() {
    stderr.println(`handleRequest`)
    try {
      linesIn.close()
      # FIXME: we're assuming that there's unlimited buffer space - which is true with the current implementation but might not be in the future
      
      try {
        def file := if (requestPath == "") { root } else { root[requestPath] }
        
        def [body, type] :=        
          if (file.isDirectory()) {
            [file["index.html"].getText(), `text/html; charset="$ourCharset"`]
          } else {
            if (requestPath =~ rx`.*\.(@ext[^.]+)`) {
              [file.getText(), extensionToMediaType.fetch(ext, fn{"application/octet-stream"})]
            }
          }
          
        outs.write(`$\
HTTP/1.0 200 OK
$standardHeaders$\
Content-Length: ${body.size()}
Content-Type: text/plain; charset="$ourCharset"

$body`.replaceAll("\n", "\r\n"))
        outs.close()

      } catch p ? FileNotFoundException.accepts(p.leaf()) {
        outs.write(`$\
HTTP/1.0 404 Not Found
$standardHeaders$\
Content-Type: text/plain; charset="$ourCharset"

Not found: $requestPath
`       .replaceAll("\n", "\r\n"))
        outs.close()

      }
    } catch p {
      sendProblem(p)
    }
  }
}

when (network <- bindLocalTCPEndpoint(null, port, handler, "textStreams" => ourCharset, "reuseAddress" => true)) -> {
  stderr.println("Ready")
} catch p {
  interp.exitAtTop(p)
}

interp.blockAtTop()