Argument passing from Fake.Deploy.Web

Currently, no arguments are passed to the agent from
Deploy.Web. This pull request passes env=EnvironmentName
for the agent. This lets us parameterize deployments.

Currently, the mechanism of passing multiple arguments
alongside a package POST adds them as a ; separated string,
which is then available in the deployment script verbatim.
This pull request changes to the approach outlined by RFC 2616
(http://www.w3.org/Protocols/rfc2616/rfc2616-sec4.html) where
multiple values are added to the header comma separated and
quoted, with only quote characters percent encoded. To support
existing clients, POSTs without comma separated quoted format
are still passed verbatim.

src/app/Fake.Deploy.Lib/Fake.Deploy.Lib.fsproj

@@ -49,6 +49,7 @@
     <Compile Include="AssemblyInfo.fs" />
     <Compile Include="SshRsaModule.fs" />
     <Compile Include="Json.fs" />
+    <Compile Include="HttpHeaderHelper.fs" />
     <Compile Include="HttpListenerHelper.fs" />
     <Compile Include="FakeDeployAgentHelper.fs" />
     <None Include="app.config" />

src/app/Fake.Deploy.Lib/FakeDeployAgentHelper.fs

@@ -93,7 +93,7 @@ let uploadData (action: Action) (url: Url) (body: byte[]) =
 
 let uploadFile (action: Action) (url: Url) (file: FilePath) (args: string[]) = 
     let req = webRequest url action
-    req.Headers.Add(scriptArgumentsHeaderName, String.Join (";", args))
+    req.Headers.Add(scriptArgumentsHeaderName, args |> toHeaderValue)
     req.AllowWriteStreamBuffering <- false
     use fileStream = File.OpenRead file
     req.ContentLength <- fileStream.Length

src/app/Fake.Deploy.Lib/HttpHeaderHelper.fs

@@ -0,0 +1,34 @@
+[<AutoOpen>]
+module Fake.HttpHeaderHelper
+open System
+open System.Text.RegularExpressions
+
+let toHeaderValue (values:string []) : string = 
+    values
+    |> Array.map (fun x -> 
+        x.Replace("\"", "%22")
+        |> sprintf "\"%s\""
+    )
+    |> fun strs -> System.String.Join(",", strs
+    )
+
+let private regex = Regex("(\"[^\"]*\")(?:,(\"[^\"]*\"))*", RegexOptions.Compiled)
+let fromHeaderValue (value:string) : string [] = 
+    let matches = regex.Matches(value)
+    //back compat: existing agents not expecting quoted params will continue to function.
+    if matches.Count = 0 then [|value|]
+    else
+    matches |> Seq.cast
+    |> Seq.collect (fun (m:Match) -> m.Groups |> Seq.cast)
+    |> Seq.skip 1
+    |> Seq.collect (fun (g:Group) ->
+        g.Captures |> Seq.cast |> Seq.map (fun (c:Capture) -> c.Value)
+        |> Seq.map (fun (x:string) -> 
+            x.Substring(1, x.Length - 2)
+            |> fun y -> y.Replace("%22", "\"")
+        )
+    )
+    |> Array.ofSeq
+
+
+

src/app/Fake.Deploy/DeploymentAgent.fs

@@ -19,9 +19,10 @@ let getBodyFromNancyRequest (ctx : Nancy.Request) =
 
 let getScriptArgumentsFromNancyRequest (ctx : Nancy.Request) =
     ctx.Headers 
-    |> Seq.choose (fun pair -> if pair.Key = FakeDeployAgentHelper.scriptArgumentsHeaderName then Some pair.Value else None)
-    |> Seq.concat
-    |> Seq.toArray
+    |> Seq.choose (fun pair -> if pair.Key = FakeDeployAgentHelper.scriptArgumentsHeaderName then Some <| pair.Value else None)
+    |> Seq.head
+    |> Seq.head
+    |> fromHeaderValue
 
 let  runDeployment workDir (ctx : Nancy.Request) = 
     let packageBytes = getBodyFromNancyRequest ctx

src/deploy.web/Fake.Deploy.Web/Modules/Api.Package.fs

@@ -47,6 +47,12 @@ type ApiPackage (dataProvider : IDataProvider) as http =
                 let agentId = http.Request.Form ?> "agentId"
                 let agent = dataProvider.GetAgents [agentId] |> Seq.head
                 let url = agent.Address.AbsoluteUri + "fake/"
+                let env = 
+                    [agent.EnvironmentId] 
+                    |>dataProvider.GetEnvironments 
+                    |> Seq.head
+                    |> fun x -> x.Name
+                    |> sprintf "env=%s"
                 Directory.CreateDirectory(packageTemp) |> ignore
                 let files = 
                     http.Request.Files
@@ -58,7 +64,7 @@ type ApiPackage (dataProvider : IDataProvider) as http =
                 let code, message = 
                     files
                     |> Seq.map(fun file ->
-                        match postDeploymentPackage url file [||] with
+                        match postDeploymentPackage url file [|env|] with
                         | Failure(err) -> 
                             file, Some err, HttpStatusCode.InternalServerError, Some(err)
                         | Success a -> 

src/test/Test.Fake.Deploy/Http/HttpHeaderParsingSpecs.cs

@@ -0,0 +1,44 @@
+using Fake;
+using Machine.Specifications;
+
+namespace Test.Fake.Deploy.Http
+{
+    public class when_parsing_values_without_commas
+    {
+        private static string[] _results;
+
+        private Because of = () => _results = HttpHeaderHelper.fromHeaderValue("\"param%22one\",\"second\"");
+
+        private It should_parse_params_with_quotes = () =>
+            _results[0].ShouldEqual("param\"one");
+        private It should_parse_params_without_quotes = () =>
+            _results[1].ShouldEqual("second");
+    }
+
+
+    public class when_parsing_values_with_commas
+    {
+        private static string[] _results;
+
+        private Because of = () => _results = HttpHeaderHelper.fromHeaderValue("\"param,%22one\",\"second\",\"another, %22 parameter\"");
+
+        private It should_parse_params_with_comma_and_quotes = () =>
+            _results[0].ShouldEqual("param,\"one");
+        private It should_parse_params_without_quotes = () =>
+            _results[1].ShouldEqual("second");
+        private It should_parse_third_param = () =>
+            _results[2].ShouldEqual("another, \" parameter");
+    }
+
+    public class when_parsing_unquoted_params
+    {
+        private static string[] _results;
+
+        private Because of = () => _results = HttpHeaderHelper.fromHeaderValue("simple command");
+
+        private It should_parse_exact_value = () =>
+            _results[0].ShouldEqual("simple command");
+    }
+
+
+}

src/test/Test.Fake.Deploy/Test.Fake.Deploy.csproj

@@ -62,6 +62,7 @@
     <Compile Include="..\Test.FAKECore\Extensions.cs">
       <Link>Extensions.cs</Link>
     </Compile>
+    <Compile Include="Http\HttpHeaderParsingSpecs.cs" />
     <Compile Include="PackageMgt\ReleaseDiscoveringSpecs.cs" />
     <Compile Include="PackageMgt\RollbackSpecs.cs" />
     <Compile Include="PackageMgt\RoutingSpecs.cs" />