From 7f5e2dfd047bc58a0d01fdaa697e9395ad9c472d Mon Sep 17 00:00:00 2001 From: KevinRansom Date: Sun, 8 Nov 2015 11:08:26 -0800 Subject: [PATCH] HttpResponse Mappings and other minor fixes. --- paket.dependencies | 2 +- src/Suave/Owin.fs | 4 ++- src/Suave/Proxy.fs | 71 ++++++++++++++++++++++++++++++++++++++++-- src/Suave/State.fs | 4 ++- src/Suave/Suave.fsproj | 5 ++- src/Suave/Web.fs | 4 +-- 6 files changed, 81 insertions(+), 9 deletions(-) diff --git a/paket.dependencies b/paket.dependencies index b8c63859..fb1af397 100644 --- a/paket.dependencies +++ b/paket.dependencies @@ -33,10 +33,10 @@ nuget System.IO.FileSystem 4.0.1-beta-23506 nuget System.Reflection 4.1.0-beta-23506 nuget System.Reflection.TypeExtensions 4.1.0-beta-23506 nuget System.Runtime.Serialization.Json 4.0.1-beta-23506 +nuget System.Security.Claims 4.0.1-beta-23506 nuget System.Security.Cryptography.Algorithms 4.0.0-beta-23506 nuget System.Security.Cryptography.Primitives 4.0.0-beta-23506 nuget System.Security.Cryptography.X509Certificates 4.0.0-beta-23506 nuget System.Threading.Thread 4.0.0-beta-23506 nuget System.Text.RegularExpressions 4.0.11-beta-23506 - nuget runtime.win7-x64.Microsoft.FSharp.Compiler.netcore 1.0.0-alpha-0002 diff --git a/src/Suave/Owin.fs b/src/Suave/Owin.fs index 79403f09..54b2f2e4 100644 --- a/src/Suave/Owin.fs +++ b/src/Suave/Owin.fs @@ -266,6 +266,9 @@ module OwinApp = suaveLogger.Log LogLevel.Info (fun () -> LogLine.mk "Suave.Owin" LogLevel.Info TraceHeader.empty None str ) + override x.Write (c : char) = + // Required because it is abstract. Does nothing interesting + () } type private Clock = uint64 @@ -575,7 +578,6 @@ module OwinApp = type UnclosableMemoryStream() = inherit IO.MemoryStream() // I can't be bothered to do a full delegation... R# needed for that. - override x.Close () = () member x.Dispose() = () member x.RealDispose() = base.Dispose() diff --git a/src/Suave/Proxy.fs b/src/Suave/Proxy.fs index 1e833ac1..b73265e3 100644 --- a/src/Suave/Proxy.fs +++ b/src/Suave/Proxy.fs @@ -2,6 +2,7 @@ module Suave.Proxy open System +open System.Globalization open System.IO open System.Net open System.Collections.Generic @@ -19,6 +20,72 @@ open Suave.Http open Suave.Http.Response open Suave.Web.ParsingAndControl +let dateTimePatterns = [| "ddd, d MMM yyyy H:m:s 'GMT'"; // RFC 1123 (r, except it allows both 1 and 01 for date and time) + "ddd, d MMM yyyy H:m:s"; // RFC 1123, no zone - assume GMT + "d MMM yyyy H:m:s 'GMT'"; // RFC 1123, no day-of-week + "d MMM yyyy H:m:s"; // RFC 1123, no day-of-week, no zone + "ddd, d MMM yy H:m:s 'GMT'"; // RFC 1123, short year + "ddd, d MMM yy H:m:s"; // RFC 1123, short year, no zone + "d MMM yy H:m:s 'GMT'"; // RFC 1123, no day-of-week, short year + "d MMM yy H:m:s"; // RFC 1123, no day-of-week, short year, no zone + "dddd, d'-'MMM'-'yy H:m:s 'GMT'"; // RFC 850 + "dddd, d'-'MMM'-'yy H:m:s"; // RFC 850 no zone + "ddd MMM d H:m:s yyyy"; // ANSI C's asctime() format + "ddd, d MMM yyyy H:m:s zzz"; // RFC 5322 + "ddd, d MMM yyyy H:m:s"; // RFC 5322 no zone + "d MMM yyyy H:m:s zzz"; // RFC 5322 no day-of-week + "d MMM yyyy H:m:s" // RFC 5322 no day-of-week, no zone + |] + +/// See: https://msdn.microsoft.com/en-us/library/system.net.webheadercollection(v=vs.110).aspx +let restrictedHeaders = [| "Accept"; + "Connection"; + "Content-Length"; + "Content-Type"; + "Date"; + "Expect"; + "Host"; + "If-Modified-Since"; + "Range"; + "Referrer"; + "Transfer-Encoding"; + "User-Agent"; + "Proxy-Connection" + |] + +type private HttpWebRequest with + member this.GetRequestStream () = + let mutable value = null + let iar = this.BeginGetRequestStream(new AsyncCallback(fun r -> let req = r.AsyncState :?> HttpWebRequest + value <- req.EndGetRequestStream(r) + ()), this) + if not iar.IsCompleted then do + iar.AsyncWaitHandle.WaitOne() + iar.AsyncWaitHandle.Dispose() + value + + member this.Date + with get():DateTime = + let date = this.Headers.["Date"] + let result, value = DateTime.TryParseExact(date, + dateTimePatterns, DateTimeFormatInfo.InvariantInfo, + DateTimeStyles.AllowWhiteSpaces ||| DateTimeStyles.AssumeUniversal) + if result then value else Unchecked.defaultof + and set (value:DateTime) = + // Format according to RFC1123; 'r' uses invariant info (DateTimeFormatInfo.InvariantInfo) + let date = value.ToUniversalTime().ToString("r", CultureInfo.InvariantCulture) + this.Headers.["Date"] <- date + + member this.UserAgent + with get() = this.Headers.["User-Agent"] + and set value = this.Headers.["User-Agent"] <- value + +type private System.Net.WebHeaderCollection with + static member IsRestricted (key:string):bool = + match restrictedHeaders |> Array.tryFind(fun elem -> String.Compare(key, elem, StringComparison.OrdinalIgnoreCase) = 0) with + | Some(_) -> true + | None -> false + /// Copies the headers from 'headers1' to 'headers2' let private toHeaderList (headers : WebHeaderCollection) = headers.AllKeys @@ -43,7 +110,7 @@ let forward (ip : IPAddress) (port : uint16) (ctx : HttpContext) = for e in h do let key = fst e if not (WebHeaderCollection.IsRestricted key) then - r.Add(key, snd e) + r.[key] <- (snd e) r let url = new UriBuilder("http", ip.ToString(), int port, p.url.AbsolutePath, p.rawQuery) let q = WebRequest.Create(url.Uri) :?> HttpWebRequest @@ -69,7 +136,7 @@ let forward (ip : IPAddress) (port : uint16) (ctx : HttpContext) = header "transfer-encoding" |> Choice.iter (fun v -> q.TransferEncoding <- v) header "user-agent" |> Choice.iter (fun v -> q.UserAgent <- v) - q.Headers.Add("X-Real-IP", ctx.clientIpTrustProxy.ToString()) + q.Headers.["X-Real-IP"] <- (ctx.clientIpTrustProxy.ToString()) fun ctx -> socket { if p.``method`` = HttpMethod.POST || p.``method`` = HttpMethod.PUT then diff --git a/src/Suave/State.fs b/src/Suave/State.fs index c89a2156..01db3eb7 100644 --- a/src/Suave/State.fs +++ b/src/Suave/State.fs @@ -88,6 +88,7 @@ module CookieStateStore = |> Map.tryFind StateStoreType |> Option.map (mkStateStore ctx.runtime.cookieSerialiser ctx.userState) +#if SYSTEM_RUNTIME_CACHING /// This module contains the implementation for the memory-cache backed session /// state store, when the memory cache is global for the server. module MemoryCacheStateStore = @@ -152,4 +153,5 @@ module MemoryCacheStateStore = let stateId = ctx |> HttpContext.stateId Writers.setUserData StateStoreType (stateStore stateId)) - let DefaultExpiry = TimeSpan.FromMinutes 30. |> MaxAge \ No newline at end of file + let DefaultExpiry = TimeSpan.FromMinutes 30. |> MaxAge +#endif diff --git a/src/Suave/Suave.fsproj b/src/Suave/Suave.fsproj index 82de8ebc..2baa5b51 100644 --- a/src/Suave/Suave.fsproj +++ b/src/Suave/Suave.fsproj @@ -186,7 +186,7 @@ ..\..\packages\System.Net.Primitives\ref\netcore50\System.Net.Primitives.dll - ..\..\packages\System.Net.Requests\ref\netcore50\System.Net.Requests.dll + ..\..\packages\System.Net.Requests\ref\dotnet5.4\System.Net.Requests.dll ..\..\packages\System.Net.Sockets\ref\dotnet5.4\System.Net.Sockets.dll @@ -206,6 +206,9 @@ ..\..\packages\System.Runtime.Serialization.Json\ref\netcore50\System.Runtime.Serialization.Json.dll + + ..\..\packages\System.Security.Claims\ref\dotnet5.4\System.Security.Claims.dll + ..\..\packages\System.Security.Cryptography.Algorithms\ref\dotnet5.4\System.Security.Cryptography.Algorithms.dll diff --git a/src/Suave/Web.fs b/src/Suave/Web.fs index 02725493..6a4b9311 100644 --- a/src/Suave/Web.fs +++ b/src/Suave/Web.fs @@ -10,8 +10,6 @@ module internal ParsingAndControl = open System.Net.Sockets open System.Threading open System.Threading.Tasks - open System.Security.Permissions - open System.Security.Principal open System.Collections.Generic open Suave.Http @@ -615,7 +613,7 @@ module internal ParsingAndControl = let resolveDirectory homeDirectory = match homeDirectory with - | None -> Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location) + | None -> Path.GetDirectoryName((Internals.getExecutingAssembly).Location) | Some s -> s ////////////////////////////////////////////////////