Add `--sandbox` option.

+ Add sandbox feature for readers.  When this option is used,
  readers and writers only have access to input files (and
  other files specified directly on command line).  This restriction
  is enforced in the type system.
+ Filters, PDF production, custom writers are unaffected.  This
  feature only insulates the actual readers and writers, not
  the pipeline around them in Text.Pandoc.App.
+ Note that when `--sandboxed` is specified, readers won't have
  access to the resource path, nor will anything have access to
  the user data directory.
+ Add module Text.Pandoc.Class.Sandbox, defining
  `sandbox`.  Exported via Text.Pandoc.Class. [API change]

Closes #5045.

1 files changed, 50 insertions, 0 deletions

diff --git a/src/Text/Pandoc/Class/Sandbox.hs b/src/Text/Pandoc/Class/Sandbox.hs
new file mode 100644
index 000000000..8bc0f1e77
--- /dev/null
+++ b/src/Text/Pandoc/Class/Sandbox.hs
@@ -0,0 +1,50 @@
+{- |
+Module      : Text.Pandoc.Class.Sandbox
+Copyright   : Copyright (C) 2021 John MacFarlane
+License     : GNU GPL, version 2 or above
+
+Maintainer  : John MacFarlane (<jgm@berkeley.edu>)
+Stability   : alpha
+Portability : portable
+
+This module provides a way to run PandocMonad actions in a sandbox
+(pure context, with no IO allowed and access only to designated files).
+-}
+
+module Text.Pandoc.Class.Sandbox
+  ( sandbox )
+where
+
+import Control.Monad (foldM)
+import Control.Monad.Except (throwError)
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import Text.Pandoc.Class.PandocMonad
+import Text.Pandoc.Class.PandocPure
+import Text.Pandoc.Class.CommonState (CommonState(..))
+import Text.Pandoc.Logging (messageVerbosity)
+
+-- | Lift a PandocPure action into any instance of PandocMonad.
+-- The main computation is done purely, but CommonState is preserved
+-- continuously, and warnings are emitted after the action completes.
+-- The parameter is a list of FilePaths which will be added to the
+-- ersatz file system and be available for reading.
+sandbox :: (PandocMonad m, MonadIO m) => [FilePath] -> PandocPure a -> m a
+sandbox files action = do
+  oldState <- getCommonState
+  tree <- liftIO $ foldM addToFileTree mempty files
+  case runPure (do putCommonState oldState
+                   modifyPureState $ \ps -> ps{ stFiles = tree }
+                   result <- action
+                   st <- getCommonState
+                   return (st, result)) of
+          Left e -> throwError e
+          Right (st, result) -> do
+            putCommonState st
+            let verbosity = stVerbosity st
+            -- emit warnings, since these are not printed in runPure
+            let newMessages = reverse $ take
+                  (length (stLog st) - length (stLog oldState)) (stLog st)
+            mapM_ logOutput
+              (filter ((<= verbosity) . messageVerbosity) newMessages)
+            return result
+