SuaveIO · haf · Apr 18, 2014 · Apr 17, 2014 · Apr 17, 2014 · Apr 17, 2014
diff --git a/Example/Program.fs b/Example/Program.fs
@@ -6,6 +6,7 @@ open Suave.Web
 open Suave.Http
 open Suave.Types
 open Suave.Session
+open Suave.Log
 
 open OpenSSL.X509
 open OpenSSL.Core
@@ -15,6 +16,8 @@ let basic_auth  : WebPart =
 
 let sslCert = X509Certificate.FromPKCS12(BIO.File("suave.p12","r"), "easy")
 
+let logger = Loggers.sane_defaults_for Debug
+
 let myapp : WebPart =
   choose [
     GET >>= choose
@@ -30,7 +33,7 @@ let myapp : WebPart =
 // typed routes
 let testapp : WebPart =
   choose [
-    Console.OpenStandardOutput() |> log >>= never ; 
+    log logger log_format >>= never
     url_scan "/add/%d/%d"   (fun (a,b) -> OK((a + b).ToString()))
     url_scan "/minus/%d/%d" (fun (a,b) -> OK((a - b).ToString()))
     NOT_FOUND "Found no handlers"
@@ -49,9 +52,8 @@ let mime_types x =
     >=> (function | ".avi" -> mk_mime_type "video/avi" false | _ -> None)
 
 choose [
-  Console.OpenStandardOutput() |> log >>= never ;
-
-  GET >>= url "/hello" >>= never ;
+  log logger log_format >>= never
+  GET >>= url "/hello" >>= never
   url_regex "(.*?)\.(dll|mdb|log)$" >>= FORBIDDEN "Access denied."
   url "/neverme" >>= never >>= OK (Guid.NewGuid().ToString()) ;
   url "/guid" >>= OK (Guid.NewGuid().ToString()) ;
@@ -60,20 +62,20 @@ choose [
   GET >>= url "/query" >>= OK "Hello beautiful" ;
   url "/redirect" >>= redirect "/redirected"
   url "/redirected" >>=  OK "You have been redirected." ;
-  url "/date" >>= warbler (fun _ -> OK (DateTime.UtcNow.ToString("o")));
-  url "/timeout" >>= timeout;
+  url "/date" >>= warbler (fun _ -> OK (DateTime.UtcNow.ToString("o")))
+  url "/timeout" >>= timeout
   url "/session"
     >>= session_support
     >>= request (fun x ->
         cond (session x) ? counter
           (fun y ->
               (session x) ? counter <- (y :?> int) + 1 :> obj ;
               OK (sprintf "Hello %A time(s)"  y ))
-          ((session x) ? counter <- 1 :> obj ; OK "First time" )) ;
-  basic_auth; // from here on it will require authentication
-  GET >>= browse; //serves file if exists
-  GET >>= dir; //show directory listing
-  POST >>= url "/upload" >>= OK "Upload successful." ;
+          ((session x) ? counter <- 1 :> obj ; OK "First time" ))
+  basic_auth // from here on it will require authentication
+  GET >>= browse //serves file if exists
+  GET >>= dir //show directory listing
+  POST >>= url "/upload" >>= OK "Upload successful."
   POST >>= url "/upload2"
       >>= request(fun x ->
                     let files = x.files |> Seq.fold (fun x y -> x + "<br>" + (sprintf "(%s,%s,%s)" y.FileName y.MimeType y.Path)) "" ;
@@ -86,11 +88,13 @@ choose [
         [ HttpBinding.Create(HTTP, "127.0.0.1", 8082)
         ; { scheme = HTTPS(sslCert); ip = IPAddress.Parse "127.0.0.1"; port = 8083us } ]
       ; error_handler    = default_error_handler
-      ; web_part_timeout = TimeSpan.FromMilliseconds 1000.
+      // most of the time we should leave it up to the WebPart to time out internally
+      ; web_part_timeout = TimeSpan.FromHours 5.
       ; listen_timeout   = TimeSpan.FromMilliseconds 2000.
       ; ct               = Async.DefaultCancellationToken
       ; buffer_size      = 2048
       ; max_ops          = 100
       ; mime_types_map   = default_mime_types_map
       ; home_folder      = None
-      ; compressed_files_folder = None }
+      ; compressed_files_folder = None
+      ; logger           = logger }
diff --git a/Pong/Pong.fsproj b/Pong/Pong.fsproj
@@ -1,72 +1,72 @@
-<?xml version="1.0" encoding="utf-8"?>
-<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
-  <Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
-  <PropertyGroup>
-    <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
-    <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
-    <SchemaVersion>2.0</SchemaVersion>
-    <ProjectGuid>68d30567-3281-41fb-bd69-30fb32196b79</ProjectGuid>
-    <OutputType>Exe</OutputType>
-    <RootNamespace>Pong</RootNamespace>
-    <AssemblyName>Pong</AssemblyName>
-    <TargetFrameworkVersion>v4.5</TargetFrameworkVersion>
-    <Name>Pong</Name>
-  </PropertyGroup>
-  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
-    <DebugSymbols>true</DebugSymbols>
-    <DebugType>full</DebugType>
-    <Optimize>false</Optimize>
-    <Tailcalls>false</Tailcalls>
-    <OutputPath>bin\Debug\</OutputPath>
-    <DefineConstants>DEBUG;TRACE</DefineConstants>
-    <WarningLevel>3</WarningLevel>
-    <PlatformTarget>AnyCPU</PlatformTarget>
-    <DocumentationFile>bin\Debug\Pong.XML</DocumentationFile>
-    <Prefer32Bit>true</Prefer32Bit>
-  </PropertyGroup>
-  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
-    <DebugType>pdbonly</DebugType>
-    <Optimize>true</Optimize>
-    <Tailcalls>true</Tailcalls>
-    <OutputPath>bin\Release\</OutputPath>
-    <DefineConstants>TRACE</DefineConstants>
-    <WarningLevel>3</WarningLevel>
-    <PlatformTarget>AnyCPU</PlatformTarget>
-    <DocumentationFile>bin\Release\Pong.XML</DocumentationFile>
-    <Prefer32Bit>true</Prefer32Bit>
-  </PropertyGroup>
-  <ItemGroup>
-    <Reference Include="ManagedOpenSsl">
-      <HintPath>..\libs\ManagedOpenSsl.dll</HintPath>
-    </Reference>
-    <Reference Include="mscorlib" />
-    <Reference Include="FSharp.Core, Version=4.3.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
-      <Private>True</Private>
-    </Reference>
-    <Reference Include="System" />
-    <Reference Include="System.Core" />
-    <Reference Include="System.Numerics" />
-  </ItemGroup>
-  <ItemGroup>
-    <Compile Include="Program.fs" />
-    <None Include="App.config" />
-  </ItemGroup>
-  <ItemGroup>
-    <ProjectReference Include="..\Suave\suave.fsproj">
-      <Name>suave</Name>
-      <Project>{3dc9193e-bd0c-4486-9c58-56b630c36623}</Project>
-      <Private>True</Private>
-    </ProjectReference>
-  </ItemGroup>
-  <PropertyGroup>
-    <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
-  </PropertyGroup>
-  <Import Project="$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets" Condition=" Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')" />
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+  <Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
+  <PropertyGroup>
+    <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+    <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
+    <SchemaVersion>2.0</SchemaVersion>
+    <ProjectGuid>68d30567-3281-41fb-bd69-30fb32196b79</ProjectGuid>
+    <OutputType>Exe</OutputType>
+    <RootNamespace>Pong</RootNamespace>
+    <AssemblyName>Pong</AssemblyName>
+    <TargetFrameworkVersion>v4.5</TargetFrameworkVersion>
+    <Name>Pong</Name>
+  </PropertyGroup>
+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
+    <DebugSymbols>true</DebugSymbols>
+    <DebugType>full</DebugType>
+    <Optimize>false</Optimize>
+    <Tailcalls>false</Tailcalls>
+    <OutputPath>bin\Debug\</OutputPath>
+    <DefineConstants>DEBUG;TRACE</DefineConstants>
+    <WarningLevel>3</WarningLevel>
+    <PlatformTarget>x86</PlatformTarget>
+    <DocumentationFile>bin\Debug\Pong.XML</DocumentationFile>
+    <Prefer32Bit>false</Prefer32Bit>
+  </PropertyGroup>
+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
+    <DebugType>pdbonly</DebugType>
+    <Optimize>true</Optimize>
+    <Tailcalls>true</Tailcalls>
+    <OutputPath>bin\Release\</OutputPath>
+    <DefineConstants>TRACE</DefineConstants>
+    <WarningLevel>3</WarningLevel>
+    <PlatformTarget>AnyCPU</PlatformTarget>
+    <DocumentationFile>bin\Release\Pong.XML</DocumentationFile>
+    <Prefer32Bit>true</Prefer32Bit>
+  </PropertyGroup>
+  <ItemGroup>
+    <Reference Include="ManagedOpenSsl">
+      <HintPath>..\libs\ManagedOpenSsl.dll</HintPath>
+    </Reference>
+    <Reference Include="mscorlib" />
+    <Reference Include="FSharp.Core, Version=4.3.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
+      <Private>True</Private>
+    </Reference>
+    <Reference Include="System" />
+    <Reference Include="System.Core" />
+    <Reference Include="System.Numerics" />
+  </ItemGroup>
+  <ItemGroup>
+    <Compile Include="Program.fs" />
+    <None Include="App.config" />
+  </ItemGroup>
+  <ItemGroup>
+    <ProjectReference Include="..\Suave\suave.fsproj">
+      <Name>suave</Name>
+      <Project>{3dc9193e-bd0c-4486-9c58-56b630c36623}</Project>
+      <Private>True</Private>
+    </ProjectReference>
+  </ItemGroup>
+  <PropertyGroup>
+    <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
+  </PropertyGroup>
+  <Import Project="$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets" Condition=" Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')" />
   <!-- To modify your build process, add your task inside one of the targets below and uncomment it. 
        Other similar extension points exist, see Microsoft.Common.targets.
   <Target Name="BeforeBuild">
   </Target>
   <Target Name="AfterBuild">
   </Target>
-  -->
+  -->
 </Project>
diff --git a/Suave/Globals.fs b/Suave/Globals.fs
@@ -0,0 +1,18 @@
+module Suave.Globals
+
+/// the global random pool for quick random values, e.g. for generating
+/// random large numbers to identify requests
+let random = System.Random()
+
+/// the global crypto-random pool for uniform and therefore cryptographically
+/// secure random values
+let crypt_random = System.Security.Cryptography.RandomNumberGenerator.Create()
+
+// Note: these are global, because they can be (System.Random is) time-dependent
+// and therefore, "However, because the clock has finite resolution, using the
+// parameterless constructor to create different Random objects in close succession
+// creates random number generators that produce identical sequences of random numbers."
+// - MSDN.
+
+/// From the TCP module, keeps track of the number of clients
+let internal number_of_clients = ref 0L
diff --git a/Suave/Http.fs b/Suave/Http.fs
@@ -450,13 +450,19 @@ module Http =
     else
       challenge ctx
 
-  let log_format (http_request : HttpRequest) =
-    sprintf "%A\n" (http_request.``method``, http_request.remote_address, http_request.url, http_request.query, http_request.form, http_request.headers)
+  let log_format (ctx : HttpContext) =
+    let r = ctx.request
+    sprintf "%A\n" (r.``method``, ctx.connection.ipaddr, r.url, r.query, r.form, r.headers)
+
+  let log (logger : Log.Logger) (formatter : HttpContext -> string) (ctx : HttpContext) =
+    logger.Log Log.LogLevel.Debug <| fun _ ->
+      { trace         = ctx.request.trace
+      ; message       = formatter ctx
+      ; level         = Log.LogLevel.Debug
+      ; path          = "suave/web-requests"
+      ; ``exception`` = None
+      ; ts_utc_ticks  = DateTime.UtcNow.Ticks }
 
-  let log (s : Stream) (ctx : HttpContext) =
-    let http_request = ctx.request
-    let bytes = bytes (log_format http_request)
-    s.Write(bytes, 0, bytes.Length)
     succeed ctx
 
   open Suave.Sscanf

diff --git a/Suave/Http.fsi b/Suave/Http.fsi
@@ -1246,13 +1246,12 @@ module Http =
   /// <summary><para>
   /// Formats the HttpRequest as in the default manner
   /// </para></summary>
-  val log_format : ctx:HttpRequest -> string
+  val log_format : ctx:HttpContext -> string
 
   /// <summary><para>
-  /// HERE BE DRAGONS: Not thread-safe.
-  /// Log the HttpRequest to the given stream. For debugging purposes.
+  /// Log the HttpRequest to the given logger.
   /// </para></summary>
-  val log : s:System.IO.Stream -> ctx:HttpContext -> HttpContext option
+  val log : Log.Logger -> (HttpContext -> string) -> ctx:HttpContext -> HttpContext option
 
   /// <summary><para>
   /// Strongly typed route matching! Matching the uri can be used with the 'parsers'