Confine HTML export writes

11 files changed, 524 insertions, 16 deletions

diff --git a/source/Base.hs b/source/Base.hs
index 4c6a670..a6b9c6e 100644
--- a/source/Base.hs
+++ b/source/Base.hs
@@ -20,6 +20,7 @@ import Prelude as Export hiding
 
 import Control.Applicative as Export hiding (some)
 import Control.Applicative qualified as Applicative
+import Control.Exception as Export (bracketOnError)
 import Control.Monad
 import Control.Monad.IO.Class as Export
 import Control.Monad.State
@@ -48,6 +49,15 @@ import Data.Word as Export (Word64)
 import Debug.Trace as Export
 import GHC.Generics as Export (Generic(..), Generic1(..))
 import Prettyprinter as Export (pretty)
+import System.IO as Export
+    ( Handle
+    , hClose
+    , hFlush
+    , hSetEncoding
+    , openBinaryTempFileWithDefaultPermissions
+    , openTempFile
+    , utf8
+    )
 import System.IO.Error as Export (isDoesNotExistError, tryIOError)
 import UnliftIO as Export (throwIO)
 
diff --git a/source/CommandLine.hs b/source/CommandLine.hs
index 2cb7871..a2283c1 100644
--- a/source/CommandLine.hs
+++ b/source/CommandLine.hs
@@ -7,12 +7,14 @@ import Api
 import Base
 import Provers qualified
 import Render.Html qualified as Html
+import Render.Html.Output qualified as HtmlOutput
 import Version qualified
 import Report.Location
 
 import Control.Monad.Logger
 import Control.Monad.Reader
 import Data.Text qualified as StrictText
+import Data.Text.Encoding qualified as Encoding
 import Data.Text.IO qualified as Text
 import Options.Applicative
 import UnliftIO
@@ -80,13 +82,15 @@ run = do
             _ast <- parse (inputPath opts)
             pure CommandCompleted
         (WithoutParseOnly, WithHtml) -> do
+            outputPlanResult <-
+                liftIO (HtmlOutput.planHtmlOutput "html" (inputPath opts))
+            outputPlan <- either throwIO pure outputPlanResult
             html <- exportHtml (inputPath opts)
-            let outputFile = "html" </> replaceExtension (inputPath opts) "html"
-            let supportScriptFile = "html" </> Html.supportScriptAssetOutputPath
-            createDirectoryIfMissing True (takeDirectory outputFile)
-            createDirectoryIfMissing True (takeDirectory supportScriptFile)
-            liftIO (Text.writeFile outputFile html)
-            liftIO (Text.writeFile supportScriptFile Html.supportScriptAssetContents)
+            let output =
+                    HtmlOutput.preparedHtmlOutput
+                        (Encoding.encodeUtf8 html)
+                        (Encoding.encodeUtf8 Html.supportScriptAssetContents)
+            liftIO (HtmlOutput.writeHtmlOutput outputPlan output)
             pure CommandCompleted
         (WithoutParseOnly, WithoutHtml) -> do
             liftIO
diff --git a/source/Encoding.hs b/source/Encoding.hs
index dc2092c..e2d659a 100644
--- a/source/Encoding.hs
+++ b/source/Encoding.hs
@@ -9,7 +9,6 @@ import Bound
 import Bound.Scope
 import Data.Text qualified as Text
 import Data.Text.IO qualified as TextIO
-import System.IO (Handle)
 import TextBuilder
 
 
diff --git a/source/Provers.hs b/source/Provers.hs
index 18726a3..f82fa01 100644
--- a/source/Provers.hs
+++ b/source/Provers.hs
@@ -45,7 +45,6 @@ import Data.Text qualified as Text
 import Data.Text.Encoding qualified as TextEncoding
 import Data.Time
 import System.Exit (ExitCode(..))
-import System.IO (Handle, hClose)
 import System.Process
     ( CreateProcess(..)
     , ProcessHandle
diff --git a/source/Render/Html.hs b/source/Render/Html.hs
index 01ac638..71f1668 100644
--- a/source/Render/Html.hs
+++ b/source/Render/Html.hs
@@ -5,7 +5,6 @@
 
 module Render.Html
     ( renderDocument
-    , supportScriptAssetOutputPath
     , supportScriptAssetContents
     ) where
 
@@ -15,6 +14,7 @@ import Base
 import Lucid hiding (Term, for_)
 import Lucid.Base (makeAttributes)
 import Lucid.Math
+import Render.Html.Output (supportScriptAssetOutputPath)
 
 import Control.Monad (unless, when)
 import Data.Char (digitToInt, isAlphaNum, isDigit, isSpace, toUpper)
@@ -525,12 +525,9 @@ pageStyles = Text.unlines
     , "}"
     ]
 
-supportScriptAssetOutputPath :: FilePath
-supportScriptAssetOutputPath = "_static" </> "naproche-html.js"
-
 supportScriptAssetRelativePath :: FilePath -> FilePath
 supportScriptAssetRelativePath inputPath =
-    foldr1 (</>) (replicate depth ".." <> ["_static", "naproche-html.js"])
+    foldr1 (</>) (replicate depth ".." <> [supportScriptAssetOutputPath])
     where
         outputDir = takeDirectory (replaceExtension inputPath "html")
         depth = length (List.filter (`notElem` [".", ""]) (splitDirectories outputDir))
diff --git a/source/Render/Html/Output.hs b/source/Render/Html/Output.hs
new file mode 100644
index 0000000..ef36b94
--- /dev/null
+++ b/source/Render/Html/Output.hs
@@ -0,0 +1,263 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Confined filesystem authority for HTML output.
+--
+-- The output root is assumed to be user-owned and not concurrently changed by
+-- a hostile actor between planning and writing.  Existing parent symlinks are
+-- accepted only when they resolve inside the canonical root.  Final-target
+-- symlinks are rejected without following them; regular generated files may be
+-- replaced.  This policy prevents stable-tree escapes, not TOCTOU attacks.
+module Render.Html.Output
+    ( HtmlOutputPlan
+    , HtmlOutputError(..)
+    , PreparedHtmlOutput
+    , planHtmlOutput
+    , preparedHtmlOutput
+    , writeHtmlOutput
+    , supportScriptAssetOutputPath
+    ) where
+
+import Base
+import Felix.Source
+    ( RelativePathError
+    , safeRelativePath
+    , safeRelativePathFilePath
+    )
+
+import Control.Exception (Exception, displayException)
+import Control.Monad (unless, when)
+import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as ByteString
+import Data.List qualified as List
+import Data.Text qualified as Text
+import System.Directory qualified as Directory
+import System.FilePath.Posix qualified as Posix
+import System.Posix.Files qualified as PosixFiles
+
+
+-- The constructor and paths stay private so only this module can write them.
+data HtmlOutputPlan = HtmlOutputPlan
+    !FilePath
+    !FilePath
+
+data HtmlOutputError
+    = EmptyHtmlOutputRoot
+    | InvalidHtmlInputRoute !FilePath !RelativePathError
+    | InvalidDerivedHtmlRoute !FilePath !RelativePathError
+    | CollidingHtmlOutputRoutes !FilePath
+    | HtmlOutputPathInspectionFailed !FilePath !Text
+    | HtmlOutputRootNotDirectory !FilePath
+    | HtmlOutputParentNotDirectory !FilePath
+    | HtmlOutputParentEscapesRoot !FilePath !FilePath
+    | HtmlOutputTargetIsSymbolicLink !FilePath
+    | HtmlOutputTargetNotRegularFile !FilePath
+    deriving stock (Show, Eq)
+
+instance Exception HtmlOutputError
+
+-- Strict bytes are prepared before the writer receives any authority.
+data PreparedHtmlOutput = PreparedHtmlOutput
+    !ByteString
+    !ByteString
+
+preparedHtmlOutput :: ByteString -> ByteString -> PreparedHtmlOutput
+preparedHtmlOutput = PreparedHtmlOutput
+
+
+-- | Validate and preflight every destination without changing the filesystem.
+planHtmlOutput
+    :: FilePath
+    -> FilePath
+    -> IO (Either HtmlOutputError HtmlOutputPlan)
+planHtmlOutput outputRoot inputSpelling = runExceptT do
+    when (null outputRoot) (throwE EmptyHtmlOutputRoot)
+    inputRoute <-
+        either
+            (throwE . InvalidHtmlInputRoute inputSpelling)
+            pure
+            (safeRelativePath inputSpelling)
+    let pageRouteSpelling =
+            Posix.replaceExtension
+                (safeRelativePathFilePath inputRoute)
+                "html"
+    pageRoute <-
+        either
+            (throwE . InvalidDerivedHtmlRoute pageRouteSpelling)
+            pure
+            (safeRelativePath pageRouteSpelling)
+    supportRoute <-
+        either
+            (throwE . InvalidDerivedHtmlRoute supportScriptAssetOutputPath)
+            pure
+            (safeRelativePath supportScriptAssetOutputPath)
+    when
+        (pageRoute == supportRoute)
+        (throwE (CollidingHtmlOutputRoutes pageRouteSpelling))
+
+    absoluteRoot <- inspectPath outputRoot (Directory.makeAbsolute outputRoot)
+    rootIsLink <- inspectSymbolicLink absoluteRoot
+    rootExists <- inspectPath absoluteRoot (Directory.doesPathExist absoluteRoot)
+    rootIsDirectory <-
+        inspectPath absoluteRoot (Directory.doesDirectoryExist absoluteRoot)
+    when
+        ((rootIsLink || rootExists) && not rootIsDirectory)
+        (throwE (HtmlOutputRootNotDirectory absoluteRoot))
+    canonicalRoot <-
+        inspectPath absoluteRoot (Directory.canonicalizePath absoluteRoot)
+
+    let pageComponents =
+            Posix.splitDirectories (safeRelativePathFilePath pageRoute)
+        supportComponents =
+            Posix.splitDirectories (safeRelativePathFilePath supportRoute)
+        pageDestination = confinedDestination absoluteRoot pageComponents
+        supportDestination =
+            confinedDestination absoluteRoot supportComponents
+    preflightDestination canonicalRoot absoluteRoot pageComponents pageDestination
+    preflightDestination
+        canonicalRoot
+        absoluteRoot
+        supportComponents
+        supportDestination
+    pure
+        (HtmlOutputPlan
+            pageDestination
+            supportDestination)
+
+
+-- | Write the two preflighted artifacts as binary strict bytes.
+writeHtmlOutput :: HtmlOutputPlan -> PreparedHtmlOutput -> IO ()
+writeHtmlOutput
+    (HtmlOutputPlan pageDestination supportDestination)
+    (PreparedHtmlOutput pageBytes supportBytes) = do
+        traverse_
+            (Directory.createDirectoryIfMissing True . Posix.takeDirectory)
+            [pageDestination, supportDestination]
+        replaceFile pageDestination pageBytes
+        replaceFile supportDestination supportBytes
+
+replaceFile :: FilePath -> ByteString -> IO ()
+replaceFile destination bytes =
+    bracketOnError
+        (openBinaryTempFileWithDefaultPermissions
+            (Posix.takeDirectory destination)
+            (Posix.takeFileName destination <> ".tmp"))
+        cleanupTemporary
+        \(temporary, handle) -> do
+            ByteString.hPut handle bytes
+            hFlush handle
+            hClose handle
+            Directory.renameFile temporary destination
+
+cleanupTemporary :: (FilePath, Handle) -> IO ()
+cleanupTemporary (temporary, handle) = do
+    void (tryIOError (hClose handle))
+    void (tryIOError (Directory.removeFile temporary))
+
+
+supportScriptAssetOutputPath :: FilePath
+supportScriptAssetOutputPath = "_static" Posix.</> "naproche-html.js"
+
+
+preflightDestination
+    :: FilePath
+    -> FilePath
+    -> [FilePath]
+    -> FilePath
+    -> ExceptT HtmlOutputError IO ()
+preflightDestination canonicalRoot outputRoot components destination = do
+    traverse_
+        (preflightParent canonicalRoot)
+        (destinationParents outputRoot components)
+    preflightTarget destination
+
+destinationParents :: FilePath -> [FilePath] -> [FilePath]
+destinationParents root components =
+    take
+        (length components)
+        (scanl (Posix.</>) root components)
+
+confinedDestination :: FilePath -> [FilePath] -> FilePath
+confinedDestination = foldl' (Posix.</>)
+
+preflightParent
+    :: FilePath
+    -> FilePath
+    -> ExceptT HtmlOutputError IO ()
+preflightParent canonicalRoot parent = do
+    parentIsLink <- inspectSymbolicLink parent
+    parentExists <- inspectPath parent (Directory.doesPathExist parent)
+    parentIsDirectory <-
+        inspectPath parent (Directory.doesDirectoryExist parent)
+    when (parentIsLink || parentExists) do
+        unless
+            parentIsDirectory
+            (throwE (HtmlOutputParentNotDirectory parent))
+        canonicalParent <-
+            inspectPath parent (Directory.canonicalizePath parent)
+        unless
+            (isComponentwiseChild canonicalRoot canonicalParent)
+            (throwE
+                (HtmlOutputParentEscapesRoot parent canonicalParent))
+
+preflightTarget :: FilePath -> ExceptT HtmlOutputError IO ()
+preflightTarget target = do
+    statusResult <- liftIO
+        (tryIOError (PosixFiles.getSymbolicLinkStatus target))
+    case statusResult of
+        Left err
+            | isDoesNotExistError err ->
+                pure ()
+            | otherwise ->
+                throwE
+                    (HtmlOutputPathInspectionFailed
+                        target
+                        (Text.pack (displayException err)))
+        Right status
+            | PosixFiles.isSymbolicLink status ->
+                throwE (HtmlOutputTargetIsSymbolicLink target)
+            | PosixFiles.isRegularFile status ->
+                pure ()
+            | otherwise ->
+                throwE (HtmlOutputTargetNotRegularFile target)
+
+isComponentwiseChild :: FilePath -> FilePath -> Bool
+isComponentwiseChild root child =
+    canonicalComponents root `List.isPrefixOf` canonicalComponents child
+
+canonicalComponents :: FilePath -> [FilePath]
+canonicalComponents =
+    Posix.splitDirectories . Posix.dropTrailingPathSeparator
+
+inspectSymbolicLink
+    :: FilePath
+    -> ExceptT HtmlOutputError IO Bool
+inspectSymbolicLink path = do
+    result <- liftIO (tryIOError (Directory.pathIsSymbolicLink path))
+    case result of
+        Right isLink ->
+            pure isLink
+        Left err
+            | isDoesNotExistError err ->
+                pure False
+            | otherwise ->
+                throwE
+                    (HtmlOutputPathInspectionFailed
+                        path
+                        (Text.pack (displayException err)))
+
+inspectPath
+    :: FilePath
+    -> IO a
+    -> ExceptT HtmlOutputError IO a
+inspectPath path action = do
+    result <- liftIO (tryIOError action)
+    case result of
+        Right value ->
+            pure value
+        Left err ->
+            throwE
+                (HtmlOutputPathInspectionFailed
+                    path
+                    (Text.pack (displayException err)))
diff --git a/source/Test/Unit.hs b/source/Test/Unit.hs
index e64bd80..662baba 100644
--- a/source/Test/Unit.hs
+++ b/source/Test/Unit.hs
@@ -6,6 +6,7 @@ import Test.Tasty.HUnit
 import Test.Unit.Checking qualified as Checking
 import Test.Unit.CommandLine qualified as CommandLine
 import Test.Unit.Html qualified as Html
+import Test.Unit.HtmlOutput qualified as HtmlOutput
 import Test.Unit.Provers qualified as Provers
 import Test.Unit.Source qualified as Source
 import Test.Unit.Symdiff qualified as Symdiff
@@ -17,6 +18,7 @@ unitTests = testGroup "unit tests"
     , Checking.unitTests
     , CommandLine.unitTests
     , Html.unitTests
+    , HtmlOutput.unitTests
     , Provers.unitTests
     , Source.unitTests
     , Token.unitTests
diff --git a/source/Test/Unit/CommandLine.hs b/source/Test/Unit/CommandLine.hs
index dea07ad..4821b66 100644
--- a/source/Test/Unit/CommandLine.hs
+++ b/source/Test/Unit/CommandLine.hs
@@ -13,7 +13,6 @@ import System.Directory qualified as Directory
 import System.Environment (getEnvironment)
 import System.Exit (ExitCode(..))
 import System.FilePath.Posix ((</>))
-import System.IO (hClose, openTempFile)
 import System.Process
     ( CreateProcess(..)
     , proc
diff --git a/source/Test/Unit/HtmlOutput.hs b/source/Test/Unit/HtmlOutput.hs
new file mode 100644
index 0000000..822fd69
--- /dev/null
+++ b/source/Test/Unit/HtmlOutput.hs
@@ -0,0 +1,237 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Test.Unit.HtmlOutput (unitTests) where
+
+import Base
+import Felix.Source (RelativePathError(..))
+import Render.Html.Output
+
+import Control.Exception (bracket)
+import Data.ByteString qualified as ByteString
+import Data.Text.Encoding qualified as Text
+import System.Directory qualified as Directory
+import System.FilePath.Posix ((</>))
+import System.Posix.Files qualified as PosixFiles
+import Test.Tasty
+import Test.Tasty.HUnit
+
+
+unitTests :: TestTree
+unitTests =
+    testGroup "HTML output"
+        [ testCase
+            "rejects non-child input routes before creating output"
+            rejectsNonChildRoutes
+        , testCase
+            "writes the page and support asset as confined bytes"
+            writesConfinedUtf8Output
+        , testCase
+            "rejects a parent symlink escaping the output root"
+            rejectsEscapingParentSymlink
+        , testCase
+            "rejects a final symlink before changing either output"
+            rejectsFinalSymlinkWithoutPartialWrite
+        , testCase
+            "replaces hard-linked targets without changing their peers"
+            replacesHardLinkedTarget
+        , testCase
+            "rejects a FIFO before changing either output"
+            rejectsFifoWithoutPartialWrite
+        ]
+
+
+rejectsNonChildRoutes :: Assertion
+rejectsNonChildRoutes =
+    withTemporaryDirectory "felix-html-output-route" \temp -> do
+        let outputRoot = temp </> "html"
+            cases =
+                [ ("/absolute.tex", AbsoluteRelativePath)
+                , ("../escape.tex", ParentDirectoryComponent)
+                , ("nested/../escape.tex", ParentDirectoryComponent)
+                , ("./entry.tex", CurrentDirectoryComponent)
+                ]
+        for_ cases \(input, expectedError) -> do
+            result <- planHtmlOutput outputRoot input
+            case result of
+                Left (InvalidHtmlInputRoute actualInput actualError) -> do
+                    assertEqual "input spelling" input actualInput
+                    assertEqual "route error" expectedError actualError
+                Left err ->
+                    assertFailure
+                        ("unexpected HTML output error: " <> show err)
+                Right _plan ->
+                    assertFailure
+                        ("accepted unsafe HTML input route: " <> input)
+        outputExists <- Directory.doesPathExist outputRoot
+        assertBool "planning created the output root" (not outputExists)
+
+writesConfinedUtf8Output :: Assertion
+writesConfinedUtf8Output =
+    withTemporaryDirectory "felix-html-output-utf8" \temp -> do
+        let outputRoot = temp </> "html"
+            input = "nested/über.tex"
+            pageText = "∀ café"
+            supportText = "const π = 3;"
+            expectedPageBytes =
+                ByteString.pack
+                    [ 0xe2, 0x88, 0x80
+                    , 0x20
+                    , 0x63, 0x61, 0x66
+                    , 0xc3, 0xa9
+                    ]
+        plan <- requirePlan =<< planHtmlOutput outputRoot input
+        writeHtmlOutput
+            plan
+            (preparedHtmlOutput
+                (Text.encodeUtf8 pageText)
+                (Text.encodeUtf8 supportText))
+        pageBytes <-
+            ByteString.readFile (outputRoot </> "nested" </> "über.html")
+        supportBytes <-
+            ByteString.readFile
+                (outputRoot </> "_static" </> "naproche-html.js")
+        assertEqual "exact page UTF-8 bytes" expectedPageBytes pageBytes
+        assertEqual
+            "support asset bytes"
+            (Text.encodeUtf8 supportText)
+            supportBytes
+
+rejectsEscapingParentSymlink :: Assertion
+rejectsEscapingParentSymlink =
+    withTemporaryDirectory "felix-html-output-parent-link" \temp -> do
+        let outputRoot = temp </> "html"
+            outsideRoot = temp </> "outside"
+            outsidePage = outsideRoot </> "page.html"
+            supportAsset =
+                outputRoot </> "_static" </> "naproche-html.js"
+        Directory.createDirectory outputRoot
+        Directory.createDirectory outsideRoot
+        ByteString.writeFile outsidePage "outside page"
+        Directory.createDirectoryLink
+            outsideRoot
+            (outputRoot </> "nested")
+
+        result <- planHtmlOutput outputRoot "nested/page.tex"
+        case result of
+            Left (HtmlOutputParentEscapesRoot _parent canonicalParent) -> do
+                expectedOutside <- Directory.canonicalizePath outsideRoot
+                assertEqual
+                    "escaping parent target"
+                    expectedOutside
+                    canonicalParent
+            Left err ->
+                assertFailure
+                    ("unexpected HTML output error: " <> show err)
+            Right _plan ->
+                assertFailure "accepted an escaping output parent symlink"
+
+        outsideBytes <- ByteString.readFile outsidePage
+        supportExists <- Directory.doesPathExist supportAsset
+        assertEqual "outside page was changed" "outside page" outsideBytes
+        assertBool "support asset was written after rejection" (not supportExists)
+
+rejectsFinalSymlinkWithoutPartialWrite :: Assertion
+rejectsFinalSymlinkWithoutPartialWrite =
+    withTemporaryDirectory "felix-html-output-final-link" \temp -> do
+        let outputRoot = temp </> "html"
+            supportDirectory = outputRoot </> "_static"
+            page = outputRoot </> "page.html"
+            support =
+                supportDirectory </> "naproche-html.js"
+            outsideAsset = temp </> "outside.js"
+        Directory.createDirectory outputRoot
+        Directory.createDirectory supportDirectory
+        ByteString.writeFile page "old page"
+        ByteString.writeFile outsideAsset "outside asset"
+        Directory.createFileLink outsideAsset support
+
+        result <- planHtmlOutput outputRoot "page.tex"
+        case result of
+            Left (HtmlOutputTargetIsSymbolicLink target) ->
+                assertEqual "rejected target" support target
+            Left err ->
+                assertFailure
+                    ("unexpected HTML output error: " <> show err)
+            Right _plan ->
+                assertFailure "accepted a final output symlink"
+
+        pageBytes <- ByteString.readFile page
+        outsideBytes <- ByteString.readFile outsideAsset
+        supportIsLink <- Directory.pathIsSymbolicLink support
+        assertEqual "page changed before complete preflight" "old page" pageBytes
+        assertEqual "symlink referent was changed" "outside asset" outsideBytes
+        assertBool "final symlink was replaced" supportIsLink
+
+replacesHardLinkedTarget :: Assertion
+replacesHardLinkedTarget =
+    withTemporaryDirectory "felix-html-output-hard-link" \temp -> do
+        let outputRoot = temp </> "html"
+            page = outputRoot </> "page.html"
+            support =
+                outputRoot </> "_static" </> "naproche-html.js"
+            outsidePage = temp </> "outside.html"
+        Directory.createDirectory outputRoot
+        ByteString.writeFile outsidePage "outside page"
+        PosixFiles.createLink outsidePage page
+        plan <- requirePlan =<< planHtmlOutput outputRoot "page.tex"
+        writeHtmlOutput
+            plan
+            (preparedHtmlOutput "new page" "new support")
+        outsideBytes <- ByteString.readFile outsidePage
+        pageBytes <- ByteString.readFile page
+        supportBytes <- ByteString.readFile support
+        assertEqual "outside hard-link peer changed"
+            "outside page"
+            outsideBytes
+        assertEqual "page was not replaced" "new page" pageBytes
+        assertEqual "support asset was not written" "new support" supportBytes
+
+rejectsFifoWithoutPartialWrite :: Assertion
+rejectsFifoWithoutPartialWrite =
+    withTemporaryDirectory "felix-html-output-fifo" \temp -> do
+        let outputRoot = temp </> "html"
+            supportDirectory = outputRoot </> "_static"
+            page = outputRoot </> "page.html"
+            support = supportDirectory </> "naproche-html.js"
+        Directory.createDirectory outputRoot
+        Directory.createDirectory supportDirectory
+        PosixFiles.createNamedPipe support PosixFiles.ownerModes
+
+        result <- planHtmlOutput outputRoot "page.tex"
+        case result of
+            Left (HtmlOutputTargetNotRegularFile target) ->
+                assertEqual "rejected target" support target
+            Left err ->
+                assertFailure
+                    ("unexpected HTML output error: " <> show err)
+            Right _plan ->
+                assertFailure "accepted a FIFO output target"
+
+        pageExists <- Directory.doesPathExist page
+        supportStatus <- PosixFiles.getSymbolicLinkStatus support
+        assertBool "page changed before complete preflight" (not pageExists)
+        assertBool "FIFO target was replaced"
+            (PosixFiles.isNamedPipe supportStatus)
+
+
+requirePlan
+    :: Either HtmlOutputError HtmlOutputPlan
+    -> IO HtmlOutputPlan
+requirePlan = \case
+    Right plan ->
+        pure plan
+    Left err -> do
+        assertFailure ("HTML output planning failed: " <> show err)
+        pure (impossible "requirePlan: assertFailure returned")
+
+withTemporaryDirectory :: String -> (FilePath -> IO a) -> IO a
+withTemporaryDirectory template =
+    bracket create Directory.removePathForcibly
+  where
+    create = do
+        systemTemp <- Directory.getTemporaryDirectory
+        (path, handle) <- openTempFile systemTemp template
+        hClose handle
+        Directory.removeFile path
+        Directory.createDirectory path
+        pure path
diff --git a/source/Test/Unit/Provers.hs b/source/Test/Unit/Provers.hs
index 13f94c3..746d94a 100644
--- a/source/Test/Unit/Provers.hs
+++ b/source/Test/Unit/Provers.hs
@@ -20,7 +20,6 @@ import Data.Text qualified as Text
 import System.Directory qualified as Directory
 import System.Exit (ExitCode(..))
 import System.FilePath.Posix ((</>))
-import System.IO (hClose, openTempFile)
 import System.Timeout qualified as Timeout
 import Test.Tasty
 import Test.Tasty.HUnit
diff --git a/source/Test/Unit/Source.hs b/source/Test/Unit/Source.hs
index 868da08..31af325 100644
--- a/source/Test/Unit/Source.hs
+++ b/source/Test/Unit/Source.hs
@@ -31,7 +31,6 @@ import Data.Text qualified as Text
 import Data.Word (Word16)
 import System.Directory qualified as Directory
 import System.FilePath.Posix qualified as Posix
-import System.IO (hClose, openTempFile)
 import System.Posix.Files qualified as PosixFiles
 import Test.Tasty
 import Test.Tasty.HUnit