ce7cb702218693d08ea6d83464d2457c9250027c

services/project-delivery/k8s/workflows/controller/contract.fsx

@@ -0,0 +1,321 @@
+#r "System.Formats.Tar"
+#r "/opt/fsi/packages/ZstdSharp.dll"
+
+open System
+open System.Collections.Generic
+open System.Diagnostics
+open System.Formats.Tar
+open System.IO
+open System.IO.Compression
+open System.Net.Security
+open System.Runtime.InteropServices
+open System.Security.Cryptography
+open System.Security.Cryptography.X509Certificates
+open System.Text.Json
+open System.Text.Json.Serialization
+open System.Threading
+open System.Threading.Tasks
+open ZstdSharp
+open ZstdSharp.Unsafe
+
+[<CLIMutable>]
+type Target =
+    { [<JsonPropertyName("kind")>]
+      Kind: string
+      [<JsonPropertyName("repository")>]
+      Repository: string }
+
+[<CLIMutable>]
+type Published =
+    { [<JsonPropertyName("kind")>]
+      Kind: string
+      [<JsonPropertyName("repository")>]
+      Repository: string
+      [<JsonPropertyName("reference")>]
+      Reference: string }
+
+[<CLIMutable>]
+type Delivery =
+    { [<JsonPropertyName("sourceRevision")>]
+      SourceRevision: string
+      [<JsonPropertyName("targets")>]
+      Targets: Published array }
+
+type ProcessResult =
+    { Code: int
+      Error: string
+      Output: string }
+
+let json =
+    JsonSerializerOptions(
+        PropertyNamingPolicy = null,
+        WriteIndented = false,
+        DefaultIgnoreCondition = JsonIgnoreCondition.WhenWritingNull
+    )
+
+let private stopping = new CancellationTokenSource()
+let mutable private signalExitCode = 143
+
+let private registerSignal signal exitCode =
+    PosixSignalRegistration.Create(
+        signal,
+        fun context ->
+            context.Cancel <- true
+            signalExitCode <- exitCode
+            stopping.Cancel()
+    )
+
+let private interrupt = registerSignal PosixSignal.SIGINT 130
+let private terminate = registerSignal PosixSignal.SIGTERM 143
+let cancellationToken = stopping.Token
+
+let private exitForSignal<'T> () =
+    Environment.Exit signalExitCode
+    Unchecked.defaultof<'T>
+
+let fail message = invalidOp message
+
+let require valid message =
+    if not valid then
+        fail message
+
+let directory (path: string) =
+    Directory.CreateDirectory path |> ignore
+    path
+
+let sha256 (path: string) =
+    use input = File.OpenRead path
+    Convert.ToHexString(SHA256.HashData input).ToLowerInvariant()
+
+let hashText (value: string) =
+    value
+    |> Text.Encoding.UTF8.GetBytes
+    |> SHA256.HashData
+    |> Convert.ToHexString
+    |> _.ToLowerInvariant()
+
+let validRevision (value: string) =
+    not <| isNull value
+    && (value.Length = 40 || value.Length = 64)
+    && value
+       |> Seq.forall (fun character -> Char.IsAsciiHexDigit character && not <| Char.IsUpper character)
+
+let validSha256 (value: string) =
+    not <| isNull value
+    && value.Length = 64
+    && value
+       |> Seq.forall (fun character -> Char.IsAsciiHexDigit character && not <| Char.IsUpper character)
+
+let validDigest (value: string) =
+    not <| isNull value
+    && value.StartsWith("sha256:", StringComparison.Ordinal)
+    && validSha256 value[7..]
+
+let decode<'T> (value: string) =
+    let result = JsonSerializer.Deserialize<'T>(value, json)
+    require (not <| isNull (box result)) "JSON document is missing"
+    result
+
+let sleep (milliseconds: int) =
+    try
+        Task.Delay(milliseconds, cancellationToken).GetAwaiter().GetResult()
+    with :? OperationCanceledException when cancellationToken.IsCancellationRequested ->
+        exitForSignal ()
+
+let run
+    (executable: string)
+    (arguments: string seq)
+    (workingDirectory: string option)
+    (environment: (string * string) seq)
+    =
+    let start = ProcessStartInfo executable
+    start.UseShellExecute <- false
+    start.RedirectStandardOutput <- true
+    start.RedirectStandardError <- true
+
+    workingDirectory |> Option.iter (fun path -> start.WorkingDirectory <- path)
+    arguments |> Seq.iter start.ArgumentList.Add
+    environment |> Seq.iter (fun (name, value) -> start.Environment[name] <- value)
+
+    use child = Process.Start start
+    let output = child.StandardOutput.ReadToEndAsync()
+    let error = child.StandardError.ReadToEndAsync()
+
+    try
+        child.WaitForExitAsync(cancellationToken).GetAwaiter().GetResult()
+    with :? OperationCanceledException when cancellationToken.IsCancellationRequested ->
+        if not child.HasExited then
+            child.Kill true
+            child.WaitForExit()
+
+        exitForSignal ()
+
+    { Code = child.ExitCode
+      Error = error.GetAwaiter().GetResult()
+      Output = output.GetAwaiter().GetResult() }
+
+let requireSuccess executable arguments workingDirectory environment =
+    let result = run executable arguments workingDirectory environment
+    require (result.Code = 0) $"{Path.GetFileName executable} failed: {result.Error.Trim()}"
+    result.Output
+
+let private descendants (root: string) =
+    seq {
+        let pending = Stack<string>(Directory.EnumerateFileSystemEntries root)
+
+        while pending.Count > 0 do
+            let path = pending.Pop()
+            yield path
+
+            let attributes = File.GetAttributes path
+
+            if
+                attributes.HasFlag FileAttributes.Directory
+                && not (attributes.HasFlag FileAttributes.ReparsePoint)
+            then
+                Directory.EnumerateFileSystemEntries path |> Seq.iter pending.Push
+    }
+
+let private tree (root: string) =
+    seq {
+        yield root
+
+        if Directory.Exists root then
+            yield! descendants root
+    }
+
+let private safePath (root: string) (name: string) =
+    require (not <| Path.IsPathFullyQualified name) "archive path is absolute"
+    let path = Path.GetFullPath(Path.Combine(root, name))
+    let prefix = root + string Path.DirectorySeparatorChar
+    require (path = root || path.StartsWith(prefix, StringComparison.Ordinal)) "archive path escapes destination"
+    path
+
+let private extract (input: Stream) (destination: string) =
+    let root = Path.GetFullPath destination
+    directory root |> ignore
+    let directoryModes = ResizeArray<string * UnixFileMode>()
+    use reader = new TarReader(input, leaveOpen = false)
+
+    for entry in
+        Seq.initInfinite (fun _ -> reader.GetNextEntry())
+        |> Seq.takeWhile (isNull >> not) do
+        let path = safePath root entry.Name
+
+        match entry.EntryType with
+        | TarEntryType.Directory ->
+            directory path |> ignore
+            directoryModes.Add(path, entry.Mode)
+        | TarEntryType.RegularFile
+        | TarEntryType.V7RegularFile
+        | TarEntryType.ContiguousFile ->
+            directory (Path.GetDirectoryName path) |> ignore
+            use output = File.Create path
+
+            if not <| isNull entry.DataStream then
+                entry.DataStream.CopyTo output
+
+            output.Dispose()
+            File.SetUnixFileMode(path, entry.Mode)
+        | TarEntryType.SymbolicLink ->
+            require (not <| Path.IsPathFullyQualified entry.LinkName) "archive link is absolute"
+
+            let target =
+                Path.GetFullPath(Path.Combine(Path.GetDirectoryName path, entry.LinkName))
+
+            let prefix = root + string Path.DirectorySeparatorChar
+
+            require
+                (target = root || target.StartsWith(prefix, StringComparison.Ordinal))
+                "archive link escapes destination"
+
+            directory (Path.GetDirectoryName path) |> ignore
+            File.CreateSymbolicLink(path, entry.LinkName) |> ignore
+        | TarEntryType.GlobalExtendedAttributes -> ()
+        | _ -> fail $"unsupported archive entry: {entry.Name}"
+
+    directoryModes
+    |> Seq.sortByDescending (fun (path, _) -> path.Length)
+    |> Seq.iter File.SetUnixFileMode
+
+let extractGzip (source: string) (destination: string) =
+    use input = File.OpenRead source
+    use gzip = new GZipStream(input, CompressionMode.Decompress)
+    extract gzip destination
+
+let extractZstd (source: string) (destination: string) =
+    use input = File.OpenRead source
+    use zstd = new DecompressionStream(input, 131072, false, false)
+    extract zstd destination
+
+let private relativeName (root: string) (path: string) =
+    Path.GetRelativePath(root, path).Replace(Path.DirectorySeparatorChar, '/')
+
+let private writeEntry (writer: TarWriter) (root: string) (path: string) =
+    let name = relativeName root path
+    let attributes = File.GetAttributes path
+
+    if attributes.HasFlag FileAttributes.ReparsePoint then
+        let item: FileSystemInfo =
+            if attributes.HasFlag FileAttributes.Directory then
+                DirectoryInfo path
+            else
+                FileInfo path
+
+        require (not <| isNull item.LinkTarget) "invalid symbolic link"
+        require (not <| Path.IsPathFullyQualified item.LinkTarget) "archive link is absolute"
+        let entry = PaxTarEntry(TarEntryType.SymbolicLink, name)
+        entry.LinkName <- item.LinkTarget
+        entry.Mode <- File.GetUnixFileMode path
+        entry.ModificationTime <- DateTimeOffset.UnixEpoch
+        writer.WriteEntry entry
+    elif attributes.HasFlag FileAttributes.Directory then
+        let entry = PaxTarEntry(TarEntryType.Directory, name)
+        entry.Mode <- File.GetUnixFileMode path
+        entry.ModificationTime <- DateTimeOffset.UnixEpoch
+        writer.WriteEntry entry
+    else
+        let entry = PaxTarEntry(TarEntryType.RegularFile, name)
+        entry.Mode <- File.GetUnixFileMode path
+        entry.ModificationTime <- DateTimeOffset.UnixEpoch
+        entry.DataStream <- File.OpenRead path
+        writer.WriteEntry entry
+        entry.DataStream.Dispose()
+
+let createZstd (root: string) (paths: string seq) (destination: string) =
+    use algorithm = SHA256.Create()
+    use output = File.Create destination
+    use hashing = new CryptoStream(output, algorithm, CryptoStreamMode.Write, true)
+    use zstd = new CompressionStream(hashing, 1, 131072, true)
+    zstd.SetParameter(ZSTD_cParameter.ZSTD_c_nbWorkers, 2)
+    use writer = new TarWriter(zstd, TarEntryFormat.Pax, leaveOpen = false)
+
+    paths
+    |> Seq.collect (fun path -> tree (Path.Combine(root, path)))
+    |> Seq.distinct
+    |> Seq.sortBy (relativeName root)
+    |> Seq.iter (writeEntry writer root)
+
+    writer.Dispose()
+    zstd.Dispose()
+    hashing.FlushFinalBlock()
+    Convert.ToHexString(algorithm.Hash).ToLowerInvariant()
+
+let validateCertificate
+    (root: X509Certificate2)
+    (certificate: X509Certificate)
+    (providedChain: X509Chain)
+    (errors: SslPolicyErrors)
+    =
+    not (isNull certificate)
+    && not (isNull providedChain)
+    && not (errors.HasFlag SslPolicyErrors.RemoteCertificateNameMismatch)
+    && (use chain = new X509Chain()
+        chain.ChainPolicy.TrustMode <- X509ChainTrustMode.CustomRootTrust
+        chain.ChainPolicy.CustomTrustStore.Add root |> ignore
+        chain.ChainPolicy.RevocationMode <- X509RevocationMode.NoCheck
+
+        providedChain.ChainElements
+        |> Seq.iter (fun item -> chain.ChainPolicy.ExtraStore.Add item.Certificate |> ignore)
+
+        chain.Build(new X509Certificate2(certificate)))