264 lines
9.7 KiB
Text
264 lines
9.7 KiB
Text
|
#load "sync.fsx"
|
||
|
|
|
||
|
|
open System
|
||
|
|
open System.Collections.Generic
|
||
|
|
open System.Net
|
||
|
|
open System.Net.Http
|
||
|
|
open System.Text
|
||
|
|
open System.Text.Json
|
||
|
|
open System.Threading.Tasks
|
||
|
|
open Sync
|
||
|
|
|
||
|
|
let unwrap =
|
||
|
|
function
|
||
|
|
| Ok value -> value
|
||
|
|
| Error error -> failwith error
|
||
|
|
|
||
|
|
let config =
|
||
|
|
{ Vault = Uri "https://synthetic.invalid/v1/"
|
||
|
|
Role = "ca-sync"
|
||
|
|
TokenFile = "synthetic-token"
|
||
|
|
Mount = "secret"
|
||
|
|
Sources =
|
||
|
|
sources [| "pki=ca/internal"; "pki_postgres=ca/postgres"; "pki_opnsense=ca/opnsense" |]
|
||
|
|
|> unwrap }
|
||
|
|
|
||
|
|
|
||
|
|
type Fixture() =
|
||
|
|
inherit HttpMessageHandler()
|
||
|
|
let source = Dictionary<string, string>()
|
||
|
|
let stored = Dictionary<string, string>()
|
||
|
|
let versions = Dictionary<string, int>()
|
||
|
|
let requests = ResizeArray<string>()
|
||
|
|
let mutable reject = None
|
||
|
|
let mutable jwt = "synthetic-jwt"
|
||
|
|
let mutable afterRead: (string -> unit) = ignore
|
||
|
|
let mutable afterSource: (string -> unit) = ignore
|
||
|
|
|
||
|
|
do
|
||
|
|
for value in config.Sources do
|
||
|
|
source.Add(value.Pki, "synthetic-" + value.Pki)
|
||
|
|
stored.Add(value.Kv, "PLACEHOLDER")
|
||
|
|
versions.Add(value.Kv, 1)
|
||
|
|
|
||
|
|
member _.AfterRead
|
||
|
|
with set value = afterRead <- value
|
||
|
|
|
||
|
|
member _.AfterSource
|
||
|
|
with set value = afterSource <- value
|
||
|
|
|
||
|
|
member _.Source = source
|
||
|
|
member _.Stored = stored
|
||
|
|
member _.Versions = versions
|
||
|
|
member _.Requests = requests
|
||
|
|
|
||
|
|
member _.Reject
|
||
|
|
with get () = reject
|
||
|
|
and set value = reject <- value
|
||
|
|
|
||
|
|
member _.Jwt
|
||
|
|
with set value = jwt <- value
|
||
|
|
|
||
|
|
member private _.Handle(request: HttpRequestMessage) =
|
||
|
|
let path = request.RequestUri.AbsolutePath.Substring("/v1/".Length)
|
||
|
|
let key = request.Method.Method + " " + path
|
||
|
|
requests.Add key
|
||
|
|
|
||
|
|
let response status payload =
|
||
|
|
new HttpResponseMessage(
|
||
|
|
status,
|
||
|
|
Content = new StringContent(JsonSerializer.Serialize payload, Encoding.UTF8, "application/json")
|
||
|
|
)
|
||
|
|
|
||
|
|
if reject = Some key then
|
||
|
|
response HttpStatusCode.ServiceUnavailable {| errors = [| "synthetic outage" |] |}
|
||
|
|
elif path = "auth/kubernetes/login" then
|
||
|
|
use body =
|
||
|
|
JsonDocument.Parse(request.Content.ReadAsStringAsync().GetAwaiter().GetResult())
|
||
|
|
|
||
|
|
if
|
||
|
|
request.Method <> HttpMethod.Post
|
||
|
|
|| body.RootElement.GetProperty("role").GetString() <> config.Role
|
||
|
|
|| body.RootElement.GetProperty("jwt").GetString() <> jwt
|
||
|
|
then
|
||
|
|
response HttpStatusCode.Forbidden {| errors = [| "synthetic authentication denied" |] |}
|
||
|
|
else
|
||
|
|
response HttpStatusCode.OK {| auth = {| client_token = "synthetic-vault-token" |} |}
|
||
|
|
elif
|
||
|
|
not (request.Headers.Contains "X-Vault-Token")
|
||
|
|
|| request.Headers.GetValues("X-Vault-Token") |> Seq.exactlyOne
|
||
|
|
<> "synthetic-vault-token"
|
||
|
|
then
|
||
|
|
response HttpStatusCode.Forbidden {| errors = [| "synthetic authorization denied" |] |}
|
||
|
|
elif path.EndsWith "/cert/ca" then
|
||
|
|
let mount = path.Substring(0, path.Length - "/cert/ca".Length)
|
||
|
|
|
||
|
|
let snapshot =
|
||
|
|
response HttpStatusCode.OK {| data = {| certificate = source[mount] |} |}
|
||
|
|
|
||
|
|
afterSource mount
|
||
|
|
snapshot
|
||
|
|
elif path.StartsWith "secret/data/ca/" then
|
||
|
|
let name = path.Substring("secret/data/".Length)
|
||
|
|
|
||
|
|
if request.Method = HttpMethod.Get then
|
||
|
|
let snapshot =
|
||
|
|
response
|
||
|
|
HttpStatusCode.OK
|
||
|
|
{| data =
|
||
|
|
{| data = {| certificate = stored[name] |}
|
||
|
|
metadata = {| version = versions[name] |} |} |}
|
||
|
|
|
||
|
|
afterRead name
|
||
|
|
snapshot
|
||
|
|
else
|
||
|
|
use body =
|
||
|
|
JsonDocument.Parse(request.Content.ReadAsStringAsync().GetAwaiter().GetResult())
|
||
|
|
|
||
|
|
let expected = body.RootElement.GetProperty("options").GetProperty("cas").GetInt32()
|
||
|
|
|
||
|
|
if expected <> versions[name] then
|
||
|
|
response HttpStatusCode.BadRequest {| errors = [| "CAS mismatch" |] |}
|
||
|
|
else
|
||
|
|
stored[name] <- body.RootElement.GetProperty("data").GetProperty("certificate").GetString()
|
||
|
|
versions[name] <- versions[name] + 1
|
||
|
|
response HttpStatusCode.OK {| data = {| version = versions[name] |} |}
|
||
|
|
else
|
||
|
|
failwith $"unexpected request: {key}"
|
||
|
|
|
||
|
|
override self.Send(request, _) = self.Handle request
|
||
|
|
override self.SendAsync(request, _) = Task.FromResult(self.Handle request)
|
||
|
|
|
||
|
|
let check condition message =
|
||
|
|
if not condition then
|
||
|
|
failwith message
|
||
|
|
|
||
|
|
let changed results =
|
||
|
|
results
|
||
|
|
|> List.sumBy (fun result ->
|
||
|
|
match result.Outcome with
|
||
|
|
| Ok(Publish _) -> 1
|
||
|
|
| Ok Unchanged
|
||
|
|
| Error _ -> 0)
|
||
|
|
|
||
|
|
let errors results =
|
||
|
|
results
|
||
|
|
|> List.choose (fun result ->
|
||
|
|
match result.Outcome with
|
||
|
|
| Error error -> Some error
|
||
|
|
| Ok _ -> None)
|
||
|
|
|
||
|
|
let run () =
|
||
|
|
for values in
|
||
|
|
[| [||]
|
||
|
|
[| "pki" |]
|
||
|
|
[| "=ca/internal" |]
|
||
|
|
[| "pki=" |]
|
||
|
|
[| "pki=ca/x"; "other=ca/x" |] |] do
|
||
|
|
check (sources values |> Result.isError) "invalid mappings were accepted"
|
||
|
|
|
||
|
|
check ((sources [| " pki = ca/internal " |] |> unwrap)[0] = config.Sources[0]) "mapping whitespace"
|
||
|
|
check (settings (fun _ -> null) [| "pki=ca/x" |] |> Result.isError) "missing configuration was accepted"
|
||
|
|
|
||
|
|
let env =
|
||
|
|
Map
|
||
|
|
[ "VAULT_ADDR", "https://synthetic.invalid"
|
||
|
|
"VAULT_ROLE", "ca-sync"
|
||
|
|
"JWT_PATH", "synthetic-token"
|
||
|
|
"VAULT_MOUNT", "secret" ]
|
||
|
|
|
||
|
|
check (settings (fun name -> env[name]) [| "pki=ca/x" |] |> Result.isOk) "valid configuration was rejected"
|
||
|
|
|
||
|
|
check
|
||
|
|
(plan
|
||
|
|
{ Certificate = "same"
|
||
|
|
Current = "same"
|
||
|
|
Version = 9 } = Unchanged)
|
||
|
|
"no-op plan"
|
||
|
|
|
||
|
|
check
|
||
|
|
(plan
|
||
|
|
{ Certificate = "new"
|
||
|
|
Current = "old"
|
||
|
|
Version = 9 } = Publish(9, "new"))
|
||
|
|
"CAS plan"
|
||
|
|
|
||
|
|
use fixture = new Fixture()
|
||
|
|
use client = new HttpClient(fixture, BaseAddress = config.Vault)
|
||
|
|
let sync jwt = reconcile config client jwt
|
||
|
|
check (sync "synthetic-jwt" |> unwrap |> changed = 3) "initial publication"
|
||
|
|
check (sync "synthetic-jwt" |> unwrap |> changed = 0) "unchanged publication"
|
||
|
|
check (fixture.Versions.Values |> Seq.forall ((=) 2)) "no-op changed KV versions"
|
||
|
|
fixture.Source["pki_postgres"] <- "synthetic-new-postgres"
|
||
|
|
check (sync "synthetic-jwt" |> unwrap |> changed = 1) "selective CA rotation"
|
||
|
|
|
||
|
|
check
|
||
|
|
(fixture.Versions["ca/internal"] = 2
|
||
|
|
&& fixture.Versions["ca/postgres"] = 3
|
||
|
|
&& fixture.Versions["ca/opnsense"] = 2)
|
||
|
|
"unrelated versions changed"
|
||
|
|
|
||
|
|
check (sync "synthetic-jwt" |> unwrap |> changed = 0) "rotation is not idempotent"
|
||
|
|
|
||
|
|
let snapshot () =
|
||
|
|
fixture.Versions |> Seq.map (fun pair -> pair.Key, pair.Value) |> Map.ofSeq
|
||
|
|
|
||
|
|
let before = snapshot ()
|
||
|
|
check (sync "synthetic-wrong-jwt" = Error "POST auth/kubernetes/login: HTTP 403") "unsafe or opaque login error"
|
||
|
|
check (snapshot () = before) "failed login wrote KV"
|
||
|
|
fixture.Reject <- Some "GET pki_postgres/cert/ca"
|
||
|
|
fixture.Source["pki_opnsense"] <- "synthetic-new-opnsense"
|
||
|
|
let independent = sync "synthetic-jwt" |> unwrap
|
||
|
|
check (errors independent = [ "GET pki_postgres/cert/ca: HTTP 503" ]) "source error context"
|
||
|
|
|
||
|
|
check
|
||
|
|
(changed independent = 1
|
||
|
|
&& fixture.Stored["ca/opnsense"] = "synthetic-new-opnsense")
|
||
|
|
"one failed CA blocked another"
|
||
|
|
|
||
|
|
check (fixture.Versions["ca/postgres"] = before["ca/postgres"]) "failed source changed KV"
|
||
|
|
|
||
|
|
for request in [| "GET secret/data/ca/internal"; "POST secret/data/ca/internal" |] do
|
||
|
|
fixture.Source["pki"] <- "synthetic-new-internal"
|
||
|
|
fixture.Reject <- Some request
|
||
|
|
let before = snapshot ()
|
||
|
|
check (sync "synthetic-jwt" |> unwrap |> errors = [ request + ": HTTP 503" ]) "KV error context"
|
||
|
|
check (snapshot () = before) "failed KV access wrote data"
|
||
|
|
|
||
|
|
fixture.Reject <- None
|
||
|
|
fixture.Jwt <- "synthetic-new-jwt"
|
||
|
|
check (sync "synthetic-new-jwt" |> unwrap |> changed = 1) "fresh login recovery"
|
||
|
|
check (sync "synthetic-new-jwt" |> unwrap |> changed = 0) "recovery no-op"
|
||
|
|
|
||
|
|
fixture.Source["pki"] <- "synthetic-stale"
|
||
|
|
|
||
|
|
fixture.AfterSource <-
|
||
|
|
fun name ->
|
||
|
|
if name = "pki" then
|
||
|
|
fixture.AfterSource <- ignore
|
||
|
|
fixture.Source["pki"] <- "synthetic-latest"
|
||
|
|
check (sync "synthetic-new-jwt" |> unwrap |> changed = 1) "newer poll did not publish"
|
||
|
|
|
||
|
|
let overlapping = sync "synthetic-new-jwt" |> unwrap
|
||
|
|
check (errors overlapping = [ "POST secret/data/ca/internal: HTTP 400" ]) "stale write was accepted"
|
||
|
|
check (fixture.Stored["ca/internal"] = "synthetic-latest") "old poll overwrote new certificate"
|
||
|
|
let before = snapshot ()
|
||
|
|
check (sync "synthetic-new-jwt" |> unwrap |> changed = 0 && snapshot () = before) "CAS recovery is not idempotent"
|
||
|
|
|
||
|
|
fixture.AfterRead <-
|
||
|
|
fun name ->
|
||
|
|
if name = "ca/internal" then
|
||
|
|
fixture.AfterRead <- ignore
|
||
|
|
fixture.Source["pki"] <- "synthetic-after-kv"
|
||
|
|
check (sync "synthetic-new-jwt" |> unwrap |> changed = 1) "overlap after KV read"
|
||
|
|
|
||
|
|
check
|
||
|
|
(sync "synthetic-new-jwt" |> unwrap |> errors = [ "POST secret/data/ca/internal: HTTP 400" ])
|
||
|
|
"KV snapshot overlap accepted"
|
||
|
|
|
||
|
|
check (fixture.Stored["ca/internal"] = "synthetic-after-kv") "KV snapshot overlap regressed"
|
||
|
|
|
||
|
|
printfn
|
||
|
|
"PASS: configuration, pure plans, no-op versions, isolated failures, safe diagnostics, fresh login and overlapping CAS writes"
|
||
|
|
|
||
|
|
run ()
|