F# and handling ASP.NET requests

Recently I’ve browsed through the old files and occasionaly found a description of the practical task given to me when I was still a student. Objective was the following: implement simple socket based application that will listen specified port, parse incoming HTTP requests (extract uri from request treating it as file) and return content of specified file. Roughly speaking it should be primitive http server. Initiallly it was implememented  in C++ but now I wanted to solve the same task with F# with some enchancements. Fortunatly BCL offers ApplicationHost class so ASP.NET requests can be processed outside IIS

type Marshaller() = 
    inherit MarshalByRefObject()
    let listener = new HttpListener()
    do listener.Prefixes.Add("http://+:8099/")
    member this.Start() = 
        let processor = async {
            try
                while true do
                    let! context = Async.FromBeginEnd(listener.BeginGetContext, listener.EndGetContext)
                    printfn "requesting %O" context.Request.Url
                    Async.Start (async { HttpRuntime.ProcessRequest(HttpListenerWorkerRequest context)})
            with
                :? IOException as ioe -> ()
            }
        listener.Start()
        Async.Start processor
    member this.Stop() = 
        listener.Stop()
    override this.InitializeLifetimeService() = null

let runServer virtualPath physicalPath = 
    let host = ApplicationHost.CreateApplicationHost(typeof<Marshaller>, virtualPath, physicalPath) :?> Marshaller
    host.Start()
    { new IDisposable with
        member this.Dispose() = host.Stop() }

ApplicationHost creates auxiliary domain, sets up ASP.NET infrastructure and instanciates specified type so new instance can be use to manipulate requests. With async workflows  usages of unblocking calls become trivial. Main workhorse type – custom implementation of HttpWorkerRequest that takes and stores data in HttpListenerContext.

type HttpListenerWorkerRequest(ctx : HttpListenerContext) =
    inherit HttpWorkerRequest() 
    override this.EndOfRequest() = 
        ctx.Response.OutputStream.Close()
        ctx.Response.Close()
    override this.GetUriPath() = ctx.Request.Url.LocalPath
    override this.GetQueryString() = 
        let idx = ctx.Request.RawUrl.IndexOf("?")
        if idx = -1 then "" else ctx.Request.RawUrl.Substring(idx + 1)
    override this.GetRawUrl() = ctx.Request.RawUrl
    override this.GetHttpVerbName() = ctx.Request.HttpMethod
    override this.GetHttpVersion() = sprintf "HTTP/%d.%d" ctx.Request.ProtocolVersion.Major ctx.Request.ProtocolVersion.Minor
    override this.GetRemoteAddress() = ctx.Request.RemoteEndPoint.Address.ToString()
    override this.GetRemotePort() = ctx.Request.RemoteEndPoint.Port
    override this.GetLocalAddress() = ctx.Request.LocalEndPoint.Address.ToString()
    override this.GetLocalPort() = ctx.Request.LocalEndPoint.Port
    override this.SendStatus(statusCode, statusDescription) = 
        ctx.Response.StatusCode <- statusCode
        ctx.Response.StatusDescription <- statusDescription
    override this.SendKnownResponseHeader(index, value) = 
        ctx.Response.Headers.[HttpWorkerRequest.GetKnownResponseHeaderName(index)] <- value
    override this.SendUnknownResponseHeader(name, value) = 
        ctx.Response.Headers.[name] <- value
    override this.SendResponseFromMemory(data, length) = 
        ctx.Response.OutputStream.Write(data, 0, length)
    override this.SendResponseFromFile(filename : string, offset : int64, length : int64) : unit = 
        use f = File.OpenRead(filename)
        f.Seek(offset, SeekOrigin.Begin) |> ignore
        let buf = Array.zeroCreate 1024 
        let read = ref length
        while !read > 0L do
            let bytesRead = f.Read (buf, offset = 0, count = buf.Length)
            ctx.Response.OutputStream.Write(buf, 0, bytesRead)
            read := !read - (int64 bytesRead)
    override this.SendResponseFromFile(handle : nativeint, offset : int64, length : int64) : unit = 
        failwith "not supported"
    override this.FlushResponse(finalFlush) = 
        ctx.Response.OutputStream.Flush()

Our mega server is almost completed, just a minor twist...

let (|Arg|_|) arg (s : string) = 
    if s.StartsWith(arg) then Some(s.Substring(arg.Length)) else None
let parse args = 
    ((null, null), args) ||> Array.fold(fun (dir, name) arg-> 
        match arg with
        | Arg "-dir:" dir -> (dir, name) 
        | Arg "-name:" name -> (dir, name)
        | _ -> (dir, name) 
    )        

[<EntryPoint>]
let main args = 
    let (dir, name) = parse args
    let handle = runServer name dir
    printfn "Press any key to stop..."
    Console.ReadKey() |> ignore
    handle.Dispose()
    0

Time for tests...Playground - folder named Site with the following context:

• File index.html
  

  <html>
  <head>
  <title>Test page</title>
  </head>
  <body>
  <img src="kitten.jpg"/>
  </body>
  </html>

  
  
• File kitten.jpg
• Sample aspx page test.aspx

  Current user: <%= Environment.UserName %>.

  
  

After making several requests in browser: