вторник, 30 марта 2010 г.

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 {
while true do
let! context = Async.FromBeginEnd(listener.BeginGetContext, listener.EndGetContext)
printfn "requesting %O" context.Request.Url
Async.Start (async { HttpRuntime.ProcessRequest(HttpListenerWorkerRequest context)})
:? IOException as ioe -> ()
Async.Start processor
member this.Stop() =
override this.InitializeLifetimeService() = null

let runServer virtualPath physicalPath =
let host = ApplicationHost.CreateApplicationHost(typeof<Marshaller>, virtualPath, physicalPath) :?> Marshaller
{ 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() =
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) =

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)

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

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

  • File index.html
    <title>Test page</title>
    <img src="kitten.jpg"/>

  • File kitten.jpg
  • Sample aspx page test.aspx
    Current user: <%= Environment.UserName %>.

After making several requests in browser:

req1 req2

Комментариев нет:

Отправить комментарий

GeekySpeaky: Submit Your Site!