landlock 0.2.0.1 → 0.2.1.0

raw patch · 29 files changed

+2620/−891 lines, 29 filesdep +directorydep +optparse-applicativedep +quickcheck-classes-basedep −tasty-expected-failuredep ~basedep ~exceptionsdep ~unixsetup-changednew-component:exe:landlockedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: directory, optparse-applicative, quickcheck-classes-base, temporary

Dependencies removed: tasty-expected-failure

Dependency ranges changed: base, exceptions, unix

API changes (from Hackage documentation)

Files

• CHANGELOG.md +24/−0
• README.lhs +118/−0
• README.md +103/−0
• Setup.hs +1/−0
• bin/landlocked.hs +180/−0
• cbits/hs-landlock.c +18/−18
• cbits/hs-landlock.h +11/−10
• cbits/linux/GPL-2.0 +359/−0
• cbits/linux/Linux-syscall-note +25/−0
• cbits/linux/landlock.h +176/−0
• internal/System/Landlock/Flags.hs +247/−0
• internal/System/Landlock/Flags.hsc +0/−119
• internal/System/Landlock/Hsc.hsc +179/−0
• internal/System/Landlock/OpenPath.hs +123/−0
• internal/System/Landlock/OpenPath.hsc +0/−93
• internal/System/Landlock/Rules.hs +83/−0
• internal/System/Landlock/Rules.hsc +0/−66
• internal/System/Landlock/Syscalls.hs +127/−0
• internal/System/Landlock/Syscalls.hsc +0/−86
• internal/System/Landlock/Version.hs +28/−0
• internal/System/Landlock/Version.hsc +0/−15
• landlock.cabal +190/−99
• src/System/Landlock.hs +263/−0
• src/System/Landlock.hsc +0/−249
• test/ReadmeUtils.hs +53/−0
• test/ThreadedScenario.hs +38/−38
• test/landlock-test-threaded.hs +5/−12
• test/landlock-test.hs +209/−86
• test/landlocked-test.hs +60/−0

@@ -1,5 +1,29 @@ # Revision history for landlock +## 0.2.1.0 -- 2023-02-22++* Use vendored `linux/landlock.h` instead of system-provided header during+  build.++* Support Landlock ABI v2 and `LANDLOCK_ACCESS_FS_REFER` as part of it.++* Support Landlock ABI v3 and `LANDLOCK_ACCESS_FS_TRUNCATE` as part of it.++* Support GHC 9.4.2 / `base ^>=4.17`.++* Support `unix ^>=2.8`.++* Add a new executable,`landlocked`, which permits to run a command in+  a sandboxed environment.++* Add a flag, `landlocked`, which allows to not build the `landlocked`+  executable.++* Use `capi` foreign imports instead of `ccall` using the `CApiFFI` language+  extension.++* Add a Cabal flag, `werror`, to enable compiler `-Werror` and friends.+ ## 0.2.0.1 -- 2022-08-24  * Code-wise the same as version 0.2.0.0, but said version was incorrectly

@@ -0,0 +1,118 @@+# landlock-hs: Haskell bindings for the Linux Landlock API++This library exposes Haskell bindings for the Linux kernel Landlock API.++The Linux kernel Landlock API provides unprivileged access control. The goal+of Landlock is to enable to restrict ambient rights (e.g. global filesystem+access) for a set of processes. Because Landlock is a stackable LSM, it makes+possible to create safe security sandboxes as new security layers in addition+to the existing system-wide access-controls. This kind of sandbox is expected+to help mitigate the security impact of bugs or unexpected/malicious+behaviors in user space applications. Landlock empowers any process,+including unprivileged ones, to securely restrict themselves.++For more information, see the [Landlock homepage](https://landlock.io/) and its+[kernel documentation](https://docs.kernel.org/userspace-api/landlock.html).++## Example++Here's a simple example, allowing read-only access to the user's SSH public+key, full access to `tmp` and the ability to read and execute everything in+`/usr`:++```haskell+import System.Landlock (+      AccessFsFlag(..)+    , OpenPathFlags(..)+    , RulesetAttr(..)+    , abiVersion+    , accessFsFlags+    , accessFsFlagIsReadOnly+    , defaultOpenPathFlags+    , isSupported+    , landlock+    , pathBeneath+    , withOpenPath+    )++import ReadmeUtils++-- These tests run with a "fake" pre-populated rootfs+-- All files and directories in it are created using the current user,+-- readable, writable and (in case of scripts) executable, so without+-- Landlock, there would be no permission errors.++main :: IO ()+main = withFakeRoot $ \root -> do+    -- Check whether Landlock is supported+    hasLandlock <- isSupported++    unless hasLandlock $+        fail "Landlock not supported"++    version <- abiVersion+    -- Find all FS access flags for the running kernel's ABI version+    allFlags <- lookupAccessFsFlags version+    let roFlags = filter accessFsFlagIsReadOnly allFlags++    let homeDir = root </> "home" </> "user"+        publicKey = homeDir </> ".ssh" </> "id_ed25519.pub"+        privateKey = homeDir </> ".ssh" </> "id_ed25519"+        tmpDir = root </> "tmp"++    -- Construct the sandbox, locking down everything by default+    landlock (RulesetAttr allFlags) [] [] $ \addRule -> do+        -- /tmp is fully accessible+        withOpenPath tmpDir defaultOpenPathFlags{ directory = True } $ \tmp ->+            addRule (pathBeneath tmp allFlags) []++        -- SSH public key is readable+        withOpenPath publicKey defaultOpenPathFlags $ \key ->+            addRule (pathBeneath key [AccessFsReadFile]) []++        -- (Real) /usr is fully accessible, but read-only (includes executable permissions)+        withOpenPath "/usr" defaultOpenPathFlags{ directory = True } $ \usr -> do+            addRule (pathBeneath usr roFlags) []++    -- Can create and write to files in tmp+    writeFile (tmpDir </> "program.log") "Success!"++    -- Can read SSH key+    _pubKey <- readFile publicKey++    -- Can execute things in /usr+    "Linux\n" <- readProcess ("/usr" </> "bin" </> "uname") ["-s"] ""++    -- Can't read SSH private key+    assertPermissionDenied $+        readFile privateKey++    -- Can't write to SSH public key+    assertPermissionDenied $+        withFile publicKey WriteMode $ \fd ->+            hPutStrLn fd "Oops, key gone!"++    -- Can't remove SSH public key+    assertPermissionDenied $+        removeFile publicKey++    -- Can't create files in homedir+    assertPermissionDenied $+        writeFile (homeDir </> "whoops.txt") "This file should not exist!"++    -- Can't read files from (real) /etc+    assertPermissionDenied $+        readFile ("/etc" </> "hosts")++  where+    lookupAccessFsFlags version = case lookup version accessFsFlags of+        -- In a production implementation, we'd lookup the "best matching" flag+        -- set, not require an exact match.+        Nothing -> fail "Unsupported ABI version"+        Just flags -> return flags++    assertPermissionDenied act = handleJust permissionDenied return $ do+        _ <- act+        fail "Expected permission error"+    permissionDenied e = if isPermissionError e then Just () else Nothing+```

@@ -13,3 +13,106 @@  For more information, see the [Landlock homepage](https://landlock.io/) and its [kernel documentation](https://docs.kernel.org/userspace-api/landlock.html).++## Example++Here's a simple example, allowing read-only access to the user's SSH public+key, full access to `tmp` and the ability to read and execute everything in+`/usr`:++```haskell+import System.Landlock (+      AccessFsFlag(..)+    , OpenPathFlags(..)+    , RulesetAttr(..)+    , abiVersion+    , accessFsFlags+    , accessFsFlagIsReadOnly+    , defaultOpenPathFlags+    , isSupported+    , landlock+    , pathBeneath+    , withOpenPath+    )++import ReadmeUtils++-- These tests run with a "fake" pre-populated rootfs+-- All files and directories in it are created using the current user,+-- readable, writable and (in case of scripts) executable, so without+-- Landlock, there would be no permission errors.++main :: IO ()+main = withFakeRoot $ \root -> do+    -- Check whether Landlock is supported+    hasLandlock <- isSupported++    unless hasLandlock $+        fail "Landlock not supported"++    version <- abiVersion+    -- Find all FS access flags for the running kernel's ABI version+    allFlags <- lookupAccessFsFlags version+    let roFlags = filter accessFsFlagIsReadOnly allFlags++    let homeDir = root </> "home" </> "user"+        publicKey = homeDir </> ".ssh" </> "id_ed25519.pub"+        privateKey = homeDir </> ".ssh" </> "id_ed25519"+        tmpDir = root </> "tmp"++    -- Construct the sandbox, locking down everything by default+    landlock (RulesetAttr allFlags) [] [] $ \addRule -> do+        -- /tmp is fully accessible+        withOpenPath tmpDir defaultOpenPathFlags{ directory = True } $ \tmp ->+            addRule (pathBeneath tmp allFlags) []++        -- SSH public key is readable+        withOpenPath publicKey defaultOpenPathFlags $ \key ->+            addRule (pathBeneath key [AccessFsReadFile]) []++        -- (Real) /usr is fully accessible, but read-only (includes executable permissions)+        withOpenPath "/usr" defaultOpenPathFlags{ directory = True } $ \usr -> do+            addRule (pathBeneath usr roFlags) []++    -- Can create and write to files in tmp+    writeFile (tmpDir </> "program.log") "Success!"++    -- Can read SSH key+    _pubKey <- readFile publicKey++    -- Can execute things in /usr+    "Linux\n" <- readProcess ("/usr" </> "bin" </> "uname") ["-s"] ""++    -- Can't read SSH private key+    assertPermissionDenied $+        readFile privateKey++    -- Can't write to SSH public key+    assertPermissionDenied $+        withFile publicKey WriteMode $ \fd ->+            hPutStrLn fd "Oops, key gone!"++    -- Can't remove SSH public key+    assertPermissionDenied $+        removeFile publicKey++    -- Can't create files in homedir+    assertPermissionDenied $+        writeFile (homeDir </> "whoops.txt") "This file should not exist!"++    -- Can't read files from (real) /etc+    assertPermissionDenied $+        readFile ("/etc" </> "hosts")++  where+    lookupAccessFsFlags version = case lookup version accessFsFlags of+        -- In a production implementation, we'd lookup the "best matching" flag+        -- set, not require an exact match.+        Nothing -> fail "Unsupported ABI version"+        Just flags -> return flags++    assertPermissionDenied act = handleJust permissionDenied return $ do+        _ <- act+        fail "Expected permission error"+    permissionDenied e = if isPermissionError e then Just () else Nothing+```

@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain

@@ -0,0 +1,180 @@+module Main (main) where++import Control.Applicative (many, (<**>))+import Control.Exception.Base (displayException, handleJust)+import Control.Monad (forM_, unless)+import Data.List (intercalate, sortOn)+import Data.Maybe (listToMaybe)+import Data.Ord (Down (Down))+import Data.Version (versionBranch)+import Options.Applicative+  ( ParserInfo,+    ReadM,+    action,+    execParser,+    footer,+    fullDesc,+    header,+    help,+    helper,+    hidden,+    info,+    infoOption,+    long,+    metavar,+    noIntersperse,+    option,+    progDesc,+    str,+    strArgument,+  )+import qualified Paths_landlock as Paths+import System.Exit (ExitCode (ExitFailure), exitWith)+import System.IO (hPutStrLn, stderr)+import System.IO.Error (isDoesNotExistError, isPermissionError)+import System.Landlock+  ( AccessFsFlag,+    RulesetAttr (..),+    Version,+    abiVersion,+    accessFsFlagIsReadOnly,+    accessFsFlags,+    defaultOpenPathFlags,+    getVersion,+    isSupported,+    landlock,+    pathBeneath,+    withOpenPath,+  )+import System.Posix.Process (executeFile)++main :: IO ()+main = do+  hasLandlock <- isSupported+  unless hasLandlock $ do+    hPutStrLn stderr "Landlock not supported on this system"+    exitWith (ExitFailure 2)++  version <- abiVersion++  (usedVersion, allFlags) <- case lookupAccessFsFlags version of+    Nothing -> fail $ "Unable to retrieve file-system access flags for Landlock ABI " ++ show (getVersion version)+    Just r -> return r+  let roFlags = filter accessFsFlagIsReadOnly allFlags++  args <- execParser (parser version usedVersion)++  landlock (RulesetAttr allFlags) [] [] $ \addRule -> do+    forM_ (argsROPaths args) $ \path ->+      withOpenPath path defaultOpenPathFlags $ \fd ->+        addRule (pathBeneath fd roFlags) []++    forM_ (argsRWPaths args) $ \path ->+      withOpenPath path defaultOpenPathFlags $ \fd ->+        addRule (pathBeneath fd allFlags) []++  handleJust permissionDenied handlePermissionDenied $+    handleJust notFound handleNotFound $ do+      _ <- executeFile (argsCommand args) True (argsArguments args) Nothing+      fail "executeFile returned"+  where+    notFound e = if isDoesNotExistError e then Just e else Nothing+    handleNotFound e = do+      hPutStrLn stderr $+        unlines+          [ "Failed to execute command: " ++ displayException e+          ]+      exitWith (ExitFailure 127)+    permissionDenied e = if isPermissionError e then Just e else Nothing+    handlePermissionDenied e = do+      hPutStrLn stderr $+        unlines+          [ "Failed to execute command: " ++ displayException e,+            "Hint: access to the binary, the interpreter or shared libraries may be denied."+          ]+      exitWith (ExitFailure 126)++data Args = Args+  { argsROPaths :: [FilePath],+    argsRWPaths :: [FilePath],+    argsCommand :: FilePath,+    argsArguments :: [String]+  }+  deriving (Show, Eq)++parser :: Version -> Version -> ParserInfo Args+parser version usedVersion =+  info+    (argsParser <**> versionFlag <**> helper)+    ( fullDesc+        <> noIntersperse+        <> progDesc "Execute a command in a sandboxed environment"+        <> header+          ( unwords+              [ "Use landlocked to run a program in a sandboxed environment,",+                "restricting access to system resources using the Linux",+                "Landlock API."+              ]+          )+        <> footer+          ( unwords+              [ "The command binary, its interpreter and any shared",+                "libraries must be accessible in the sandbox."+              ]+          )+    )+  where+    argsParser =+      Args+        <$> many+          ( option+              filePath+              ( long "ro"+                  <> metavar "PATH"+                  <> help "Allow read-only access to given file or directory"+                  <> action "default"+              )+          )+        <*> many+          ( option+              filePath+              ( long "rw"+                  <> metavar "PATH"+                  <> help "Allow write access to given file or directory"+                  <> action "default"+              )+          )+        <*> strArgument+          ( metavar "COMMAND"+              <> help "Command to spawn"+              <> action "command"+          )+        <*> many+          ( strArgument+              ( metavar "ARG"+                  <> help "Arguments to pass to spawned command"+              )+          )+    versionFlag =+      infoOption+        versionString+        ( long "version"+            <> help "Show version information"+            <> hidden+        )+    versionString =+      unlines+        [ "landlocked " ++ intercalate "." (map show (versionBranch Paths.version)),+          "System Landlock ABI version: " ++ show (getVersion version),+          "Using Landlock ABI version: " ++ show (getVersion usedVersion)+        ]++-- This is not really useful. It could be if 'ReaderM' were 'MonadIO'+filePath :: ReadM FilePath+filePath = str++lookupAccessFsFlags :: Version -> Maybe (Version, [AccessFsFlag])+lookupAccessFsFlags v =+  listToMaybe $+    sortOn (Down . fst) $+      filter (\(v', _) -> v' <= v) accessFsFlags

@@ -1,38 +1,38 @@-#define _GNU_SOURCE- #include <stddef.h> #include <unistd.h>-#include <linux/landlock.h> #include <sys/syscall.h> #include <sys/types.h>  #include <hs-psx.h>  #include "hs-landlock.h"+#include "linux/landlock.h" -#ifndef landlock_create_ruleset-long landlock_create_ruleset(const struct landlock_ruleset_attr *const attr,-                             const size_t size,-                             const __u32 flags) {+long hs_landlock_create_ruleset(const struct landlock_ruleset_attr *const attr,+                                const size_t size,+                                const __u32 flags) {+#ifdef landlock_create_ruleset+        return landlock_create_ruleset(attr, size, flags)+#else         return syscall(__NR_landlock_create_ruleset, attr, size, flags);-} #endif+} -#ifndef landlock_add_rule-long landlock_add_rule(const int ruleset_fd,-                       const enum landlock_rule_type rule_type,-                       const void *const rule_attr,-                       const __u32 flags) {+long hs_landlock_add_rule(const int ruleset_fd,+                          const enum landlock_rule_type rule_type,+                          const void *const rule_attr,+                          const __u32 flags) {+#ifdef landlock_add_rule+        return landlock_add_rule(ruleset_fd, rule_type, rule_attr, flags)+#else         return syscall(__NR_landlock_add_rule, ruleset_fd, rule_type, rule_attr, flags);-} #endif+} -#ifndef landlock_restrict_self-long landlock_restrict_self(const int ruleset_fd,-                            const __u32 flags) {+long hs_landlock_restrict_self(const int ruleset_fd,+                               const __u32 flags) {         return hs_psx_syscall3(__NR_landlock_restrict_self, ruleset_fd, flags, 0); }-#endif  int hs_landlock_prctl(int option,                       unsigned long arg2,

@@ -2,22 +2,23 @@ #define _HS_LANDLOCK_H_  #include <stddef.h>-#include <linux/landlock.h> #include <sys/types.h> +#include "linux/landlock.h"+ #ifdef __cplusplus extern "C" { #endif -long landlock_create_ruleset(const struct landlock_ruleset_attr *const attr,-                             const size_t size,-                             const __u32 flags);-long landlock_add_rule(const int ruleset_fd,-                       const enum landlock_rule_type rule_type,-                       const void *const rule_attr,-                       const __u32 flags);-long landlock_restrict_self(const int ruleset_fd,-                            const __u32 flags);+long hs_landlock_create_ruleset(const struct landlock_ruleset_attr *const attr,+                                const size_t size,+                                const __u32 flags);+long hs_landlock_add_rule(const int ruleset_fd,+                          const enum landlock_rule_type rule_type,+                          const void *const rule_attr,+                          const __u32 flags);+long hs_landlock_restrict_self(const int ruleset_fd,+                               const __u32 flags);  int hs_landlock_prctl(int option,                       unsigned long arg2,

@@ -0,0 +1,359 @@+Valid-License-Identifier: GPL-2.0+Valid-License-Identifier: GPL-2.0-only+Valid-License-Identifier: GPL-2.0++Valid-License-Identifier: GPL-2.0-or-later+SPDX-URL: https://spdx.org/licenses/GPL-2.0.html+Usage-Guide:+  To use this license in source code, put one of the following SPDX+  tag/value pairs into a comment according to the placement+  guidelines in the licensing rules documentation.+  For 'GNU General Public License (GPL) version 2 only' use:+    SPDX-License-Identifier: GPL-2.0+  or+    SPDX-License-Identifier: GPL-2.0-only+  For 'GNU General Public License (GPL) version 2 or any later version' use:+    SPDX-License-Identifier: GPL-2.0++  or+    SPDX-License-Identifier: GPL-2.0-or-later+License-Text:++		    GNU GENERAL PUBLIC LICENSE+		       Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+                       51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++			    Preamble++  The licenses for most software are designed to take away your+freedom to share and change it.  By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users.  This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it.  (Some other Free Software Foundation software is covered by+the GNU Library General Public License instead.)  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++  To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have.  You must make sure that they, too, receive or can get the+source code.  And you must show them these terms so they know their+rights.++  We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++  Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software.  If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++  Finally, any free program is threatened constantly by software+patents.  We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary.  To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++  The precise terms and conditions for copying, distribution and+modification follow.++		    GNU GENERAL PUBLIC LICENSE+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++  0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License.  The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language.  (Hereinafter, translation is included without limitation in+the term "modification".)  Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope.  The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++  1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++  2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++    a) You must cause the modified files to carry prominent notices+    stating that you changed the files and the date of any change.++    b) You must cause any work that you distribute or publish, that in+    whole or in part contains or is derived from the Program or any+    part thereof, to be licensed as a whole at no charge to all third+    parties under the terms of this License.++    c) If the modified program normally reads commands interactively+    when run, you must cause it, when started running for such+    interactive use in the most ordinary way, to print or display an+    announcement including an appropriate copyright notice and a+    notice that there is no warranty (or else, saying that you provide+    a warranty) and that users may redistribute the program under+    these conditions, and telling the user how to view a copy of this+    License.  (Exception: if the Program itself is interactive but+    does not normally print such an announcement, your work based on+    the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole.  If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works.  But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++  3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++    a) Accompany it with the complete corresponding machine-readable+    source code, which must be distributed under the terms of Sections+    1 and 2 above on a medium customarily used for software interchange; or,++    b) Accompany it with a written offer, valid for at least three+    years, to give any third party, for a charge no more than your+    cost of physically performing source distribution, a complete+    machine-readable copy of the corresponding source code, to be+    distributed under the terms of Sections 1 and 2 above on a medium+    customarily used for software interchange; or,++    c) Accompany it with the information you received as to the offer+    to distribute corresponding source code.  (This alternative is+    allowed only for noncommercial distribution and only if you+    received the program in object code or executable form with such+    an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it.  For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable.  However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++  4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License.  Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++  5. You are not required to accept this License, since you have not+signed it.  However, nothing else grants you permission to modify or+distribute the Program or its derivative works.  These actions are+prohibited by law if you do not accept this License.  Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++  6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions.  You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++  7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all.  For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices.  Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++  8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded.  In such case, this License incorporates+the limitation as if written in the body of this License.++  9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number.  If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation.  If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++  10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission.  For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this.  Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++			    NO WARRANTY++  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++		     END OF TERMS AND CONDITIONS++	    How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software; you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation; either version 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program; if not, write to the Free Software+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++    Gnomovision version 69, Copyright (C) year name of author+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary.  Here is a sample; alter the names:++  Yoyodyne, Inc., hereby disclaims all copyright interest in the program+  `Gnomovision' (which makes passes at compilers) written by James Hacker.++  <signature of Ty Coon>, 1 April 1989+  Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs.  If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library.  If this is what you want to do, use the GNU Library General+Public License instead of this License.

@@ -0,0 +1,25 @@+SPDX-Exception-Identifier: Linux-syscall-note+SPDX-URL: https://spdx.org/licenses/Linux-syscall-note.html+SPDX-Licenses: GPL-2.0, GPL-2.0+, GPL-1.0+, LGPL-2.0, LGPL-2.0+, LGPL-2.1, LGPL-2.1+, GPL-2.0-only, GPL-2.0-or-later+Usage-Guide:+  This exception is used together with one of the above SPDX-Licenses+  to mark user space API (uapi) header files so they can be included+  into non GPL compliant user space application code.+  To use this exception add it with the keyword WITH to one of the+  identifiers in the SPDX-Licenses tag:+    SPDX-License-Identifier: <SPDX-License> WITH Linux-syscall-note+License-Text:++   NOTE! This copyright does *not* cover user programs that use kernel+ services by normal system calls - this is merely considered normal use+ of the kernel, and does *not* fall under the heading of "derived work".+ Also note that the GPL below is copyrighted by the Free Software+ Foundation, but the instance of code that it refers to (the Linux+ kernel) is copyrighted by me and others who actually wrote it.++ Also note that the only valid version of the GPL as far as the kernel+ is concerned is _this_ particular version of the license (ie v2, not+ v2.2 or v3.x or whatever), unless explicitly otherwise stated.++			Linus Torvalds+

@@ -0,0 +1,176 @@+/* SPDX-License-Identifier: GPL-2.0 WITH Linux-syscall-note */+/*+ * Landlock - User space API+ *+ * Copyright © 2017-2020 Mickaël Salaün <mic@digikod.net>+ * Copyright © 2018-2020 ANSSI+ */++#ifndef _UAPI_LINUX_LANDLOCK_H+#define _UAPI_LINUX_LANDLOCK_H++#include <linux/types.h>++/**+ * struct landlock_ruleset_attr - Ruleset definition+ *+ * Argument of sys_landlock_create_ruleset().  This structure can grow in+ * future versions.+ */+struct landlock_ruleset_attr {+	/**+	 * @handled_access_fs: Bitmask of actions (cf. `Filesystem flags`_)+	 * that is handled by this ruleset and should then be forbidden if no+	 * rule explicitly allow them: it is a deny-by-default list that should+	 * contain as much Landlock access rights as possible. Indeed, all+	 * Landlock filesystem access rights that are not part of+	 * handled_access_fs are allowed.  This is needed for backward+	 * compatibility reasons.  One exception is the+	 * %LANDLOCK_ACCESS_FS_REFER access right, which is always implicitly+	 * handled, but must still be explicitly handled to add new rules with+	 * this access right.+	 */+	__u64 handled_access_fs;+};++/*+ * sys_landlock_create_ruleset() flags:+ *+ * - %LANDLOCK_CREATE_RULESET_VERSION: Get the highest supported Landlock ABI+ *   version.+ */+/* clang-format off */+#define LANDLOCK_CREATE_RULESET_VERSION			(1U << 0)+/* clang-format on */++/**+ * enum landlock_rule_type - Landlock rule type+ *+ * Argument of sys_landlock_add_rule().+ */+enum landlock_rule_type {+	/**+	 * @LANDLOCK_RULE_PATH_BENEATH: Type of a &struct+	 * landlock_path_beneath_attr .+	 */+	LANDLOCK_RULE_PATH_BENEATH = 1,+};++/**+ * struct landlock_path_beneath_attr - Path hierarchy definition+ *+ * Argument of sys_landlock_add_rule().+ */+struct landlock_path_beneath_attr {+	/**+	 * @allowed_access: Bitmask of allowed actions for this file hierarchy+	 * (cf. `Filesystem flags`_).+	 */+	__u64 allowed_access;+	/**+	 * @parent_fd: File descriptor, preferably opened with ``O_PATH``,+	 * which identifies the parent directory of a file hierarchy, or just a+	 * file.+	 */+	__s32 parent_fd;+	/*+	 * This struct is packed to avoid trailing reserved members.+	 * Cf. security/landlock/syscalls.c:build_check_abi()+	 */+} __attribute__((packed));++/**+ * DOC: fs_access+ *+ * A set of actions on kernel objects may be defined by an attribute (e.g.+ * &struct landlock_path_beneath_attr) including a bitmask of access.+ *+ * Filesystem flags+ * ~~~~~~~~~~~~~~~~+ *+ * These flags enable to restrict a sandboxed process to a set of actions on+ * files and directories.  Files or directories opened before the sandboxing+ * are not subject to these restrictions.+ *+ * A file can only receive these access rights:+ *+ * - %LANDLOCK_ACCESS_FS_EXECUTE: Execute a file.+ * - %LANDLOCK_ACCESS_FS_WRITE_FILE: Open a file with write access. Note that+ *   you might additionally need the %LANDLOCK_ACCESS_FS_TRUNCATE right in order+ *   to overwrite files with :manpage:`open(2)` using ``O_TRUNC`` or+ *   :manpage:`creat(2)`.+ * - %LANDLOCK_ACCESS_FS_READ_FILE: Open a file with read access.+ * - %LANDLOCK_ACCESS_FS_TRUNCATE: Truncate a file with :manpage:`truncate(2)`,+ *   :manpage:`ftruncate(2)`, :manpage:`creat(2)`, or :manpage:`open(2)` with+ *   ``O_TRUNC``. Whether an opened file can be truncated with+ *   :manpage:`ftruncate(2)` is determined during :manpage:`open(2)`, in the+ *   same way as read and write permissions are checked during+ *   :manpage:`open(2)` using %LANDLOCK_ACCESS_FS_READ_FILE and+ *   %LANDLOCK_ACCESS_FS_WRITE_FILE. This access right is available since the+ *   third version of the Landlock ABI.+ *+ * A directory can receive access rights related to files or directories.  The+ * following access right is applied to the directory itself, and the+ * directories beneath it:+ *+ * - %LANDLOCK_ACCESS_FS_READ_DIR: Open a directory or list its content.+ *+ * However, the following access rights only apply to the content of a+ * directory, not the directory itself:+ *+ * - %LANDLOCK_ACCESS_FS_REMOVE_DIR: Remove an empty directory or rename one.+ * - %LANDLOCK_ACCESS_FS_REMOVE_FILE: Unlink (or rename) a file.+ * - %LANDLOCK_ACCESS_FS_MAKE_CHAR: Create (or rename or link) a character+ *   device.+ * - %LANDLOCK_ACCESS_FS_MAKE_DIR: Create (or rename) a directory.+ * - %LANDLOCK_ACCESS_FS_MAKE_REG: Create (or rename or link) a regular file.+ * - %LANDLOCK_ACCESS_FS_MAKE_SOCK: Create (or rename or link) a UNIX domain+ *   socket.+ * - %LANDLOCK_ACCESS_FS_MAKE_FIFO: Create (or rename or link) a named pipe.+ * - %LANDLOCK_ACCESS_FS_MAKE_BLOCK: Create (or rename or link) a block device.+ * - %LANDLOCK_ACCESS_FS_MAKE_SYM: Create (or rename or link) a symbolic link.+ * - %LANDLOCK_ACCESS_FS_REFER: Link or rename a file from or to a different+ *   directory (i.e. reparent a file hierarchy).  This access right is+ *   available since the second version of the Landlock ABI.  This is also the+ *   only access right which is always considered handled by any ruleset in+ *   such a way that reparenting a file hierarchy is always denied by default.+ *   To avoid privilege escalation, it is not enough to add a rule with this+ *   access right.  When linking or renaming a file, the destination directory+ *   hierarchy must also always have the same or a superset of restrictions of+ *   the source hierarchy.  If it is not the case, or if the domain doesn't+ *   handle this access right, such actions are denied by default with errno+ *   set to ``EXDEV``.  Linking also requires a ``LANDLOCK_ACCESS_FS_MAKE_*``+ *   access right on the destination directory, and renaming also requires a+ *   ``LANDLOCK_ACCESS_FS_REMOVE_*`` access right on the source's (file or+ *   directory) parent.  Otherwise, such actions are denied with errno set to+ *   ``EACCES``.  The ``EACCES`` errno prevails over ``EXDEV`` to let user space+ *   efficiently deal with an unrecoverable error.+ *+ * .. warning::+ *+ *   It is currently not possible to restrict some file-related actions+ *   accessible through these syscall families: :manpage:`chdir(2)`,+ *   :manpage:`stat(2)`, :manpage:`flock(2)`, :manpage:`chmod(2)`,+ *   :manpage:`chown(2)`, :manpage:`setxattr(2)`, :manpage:`utime(2)`,+ *   :manpage:`ioctl(2)`, :manpage:`fcntl(2)`, :manpage:`access(2)`.+ *   Future Landlock evolutions will enable to restrict them.+ */+/* clang-format off */+#define LANDLOCK_ACCESS_FS_EXECUTE			(1ULL << 0)+#define LANDLOCK_ACCESS_FS_WRITE_FILE			(1ULL << 1)+#define LANDLOCK_ACCESS_FS_READ_FILE			(1ULL << 2)+#define LANDLOCK_ACCESS_FS_READ_DIR			(1ULL << 3)+#define LANDLOCK_ACCESS_FS_REMOVE_DIR			(1ULL << 4)+#define LANDLOCK_ACCESS_FS_REMOVE_FILE			(1ULL << 5)+#define LANDLOCK_ACCESS_FS_MAKE_CHAR			(1ULL << 6)+#define LANDLOCK_ACCESS_FS_MAKE_DIR			(1ULL << 7)+#define LANDLOCK_ACCESS_FS_MAKE_REG			(1ULL << 8)+#define LANDLOCK_ACCESS_FS_MAKE_SOCK			(1ULL << 9)+#define LANDLOCK_ACCESS_FS_MAKE_FIFO			(1ULL << 10)+#define LANDLOCK_ACCESS_FS_MAKE_BLOCK			(1ULL << 11)+#define LANDLOCK_ACCESS_FS_MAKE_SYM			(1ULL << 12)+#define LANDLOCK_ACCESS_FS_REFER			(1ULL << 13)+#define LANDLOCK_ACCESS_FS_TRUNCATE			(1ULL << 14)+/* clang-format on */++#endif /* _UAPI_LINUX_LANDLOCK_H */

@@ -0,0 +1,247 @@+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE EmptyDataDeriving #-}+{-# LANGUAGE LambdaCase #-}++module System.Landlock.Flags+  ( toBits,+    fromBits,+    AccessFsFlag (..),+    accessFsFlagToBit,+    accessFsFlags,+    accessFsFlagIsReadOnly,+    CreateRulesetFlag (..),+    createRulesetFlagToBit,+    RestrictSelfFlag,+    restrictSelfFlagToBit,+    AddRuleFlag,+    addRuleFlagToBit,+  )+where++import Data.Bits (Bits, (.&.), (.|.))+import System.Landlock.Hsc+  ( U32,+    U64,+    lANDLOCK_ACCESS_FS_EXECUTE,+    lANDLOCK_ACCESS_FS_MAKE_BLOCK,+    lANDLOCK_ACCESS_FS_MAKE_CHAR,+    lANDLOCK_ACCESS_FS_MAKE_DIR,+    lANDLOCK_ACCESS_FS_MAKE_FIFO,+    lANDLOCK_ACCESS_FS_MAKE_REG,+    lANDLOCK_ACCESS_FS_MAKE_SOCK,+    lANDLOCK_ACCESS_FS_MAKE_SYM,+    lANDLOCK_ACCESS_FS_READ_DIR,+    lANDLOCK_ACCESS_FS_READ_FILE,+    lANDLOCK_ACCESS_FS_REFER,+    lANDLOCK_ACCESS_FS_REMOVE_DIR,+    lANDLOCK_ACCESS_FS_REMOVE_FILE,+    lANDLOCK_ACCESS_FS_TRUNCATE,+    lANDLOCK_ACCESS_FS_WRITE_FILE,+    lANDLOCK_CREATE_RULESET_VERSION,+  )+import System.Landlock.Version (Version, version1, version2, version3)++-- | Fold a set of flags into a bitset/number.+toBits :: (Num b, Bits b, Foldable f) => (a -> b) -> f a -> b+toBits f = foldr (\a b -> b .|. f a) 0++-- | Expand a bitset/number into a set of flags.+fromBits :: (Enum a, Bounded a, Num b, Bits b) => (a -> b) -> b -> [a]+fromBits f b = filter (\a -> b .&. f a /= 0) [minBound .. maxBound]++-- | Filesystem flags.+--+-- These flags enable to restrict a sandboxed process to a set of actions on+-- files and directories. Files or directories opened before the sandboxing+-- are not subject to these restrictions.+--+-- A file can only receive these access rights:+--+-- - 'AccessFsExecute'+-- - 'AccessFsWriteFile'+-- - 'AccessFsReadFile'+-- - 'AccessFsTruncate'+--+-- A directory can receive access rights related to files or directories. The+-- following access right is applied to the directory itself, and the+-- directories beneath it:+--+-- - 'AccessFsReadDir'+--+-- However, the following access rights only apply to the content of a+-- directory, not the directory itself:+--+-- - 'AccessFsRemoveDir'+-- - 'AccessFsRemoveFile'+-- - 'AccessFsMakeChar'+-- - 'AccessFsMakeDir'+-- - 'AccessFsMakeReg'+-- - 'AccessFsMakeSock'+-- - 'AccessFsMakeFifo'+-- - 'AccessFsMakeBlock'+-- - 'AccessFsMakeSym'+-- - 'AccessFsRefer'+--+-- __Warning:__ It is currently not possible to restrict some file-related+-- actions acessible through these syscall families: @chdir@,+-- @stat@, @flock@, @chmod@, @chown@, @setxattr@, @utime@, @ioctl@, @fcntl@,+-- @access@. Future Landlock evolutions will enable to restrict them.+data AccessFsFlag+  = -- | Execute a file.+    AccessFsExecute+  | -- | Open a file with write access.+    AccessFsWriteFile+  | -- | Open a file with read access. Note that+    --   you might additionally need the @LANDLOCK_ACCESS_FS_TRUNCATE@ right in order+    --   to overwrite files with @open@ using @O_TRUNC@ or+    --   @creat@.+    AccessFsReadFile+  | -- | Open a directory or list its content.+    AccessFsReadDir+  | -- | Remove an empty directory or rename one+    AccessFsRemoveDir+  | -- | Unlink (or rename) a file.+    AccessFsRemoveFile+  | -- | Create (or rename or link) a character device.+    AccessFsMakeChar+  | -- | Create (or rename) a directory.+    AccessFsMakeDir+  | -- | Create (or rename or link) a regular file.+    AccessFsMakeReg+  | -- | Create (or rename or link) a UNIX domain socket.+    AccessFsMakeSock+  | -- | Create (or rename or link) a named pipe.+    AccessFsMakeFifo+  | -- | Create (or rename or link) a block device.+    AccessFsMakeBlock+  | -- | Create (or rename or link) a symbolic link.+    AccessFsMakeSym+  | -- | Link or rename a file from or to a different+    --   directory (i.e. reparent a file hierarchy).  This access right is+    --   available since the second version of the Landlock ABI.  This is also the+    --   only access right which is always considered handled by any ruleset in+    --   such a way that reparenting a file hierarchy is always denied by default.+    --   To avoid privilege escalation, it is not enough to add a rule with this+    --   access right.  When linking or renaming a file, the destination directory+    --   hierarchy must also always have the same or a superset of restrictions of+    --   the source hierarchy.  If it is not the case, or if the domain doesn't+    --   handle this access right, such actions are denied by default with @errno@+    --   set to @EXDEV@.  Linking also requires a @LANDLOCK_ACCESS_FS_MAKE_*@ access+    --   right on the destination directory, and renaming also requires a+    --   @LANDLOCK_ACCESS_FS_REMOVE_*@ access right on the source's (file or+    --   directory) parent.  Otherwise, such actions are denied with @errno@ set to+    --   @EACCES@.  The @EACCES@ @errno@ prevails over @EXDEV@ to let user space+    --   efficiently deal with an unrecoverable error.+    AccessFsRefer+  | -- | Truncate a file with @truncate@,+    --   @ftruncate@, @creat@, or @open@ with+    --   @O_TRUNC@. Whether an opened file can be truncated with+    --   @ftruncate@ is determined during @open@, in the+    --   same way as read and write permissions are checked during+    --   @open@ using @LANDLOCK_ACCESS_FS_READ_FILE@ and+    --   @LANDLOCK_ACCESS_FS_WRITE_FILE@. This access right is available since the+    --   third version of the Landlock ABI.+    AccessFsTruncate+  -- Note: when adding new flags, this likely means a new ABI version is+  -- available. Hence, add this to 'System.Landlock.Version' (and export it+  -- from 'System.Landlock'), and make sure to update both 'accessFsFlags' and+  -- 'accessFsFlagIsReadOnly'.+  deriving (Show, Eq, Enum, Bounded, Ord)++-- | Retrieve a number with the appropriate 'AccessFsFlag' bit set.+accessFsFlagToBit :: AccessFsFlag -> U64+accessFsFlagToBit = \case+  AccessFsExecute -> lANDLOCK_ACCESS_FS_EXECUTE+  AccessFsWriteFile -> lANDLOCK_ACCESS_FS_WRITE_FILE+  AccessFsReadFile -> lANDLOCK_ACCESS_FS_READ_FILE+  AccessFsReadDir -> lANDLOCK_ACCESS_FS_READ_DIR+  AccessFsRemoveDir -> lANDLOCK_ACCESS_FS_REMOVE_DIR+  AccessFsRemoveFile -> lANDLOCK_ACCESS_FS_REMOVE_FILE+  AccessFsMakeChar -> lANDLOCK_ACCESS_FS_MAKE_CHAR+  AccessFsMakeDir -> lANDLOCK_ACCESS_FS_MAKE_DIR+  AccessFsMakeReg -> lANDLOCK_ACCESS_FS_MAKE_REG+  AccessFsMakeSock -> lANDLOCK_ACCESS_FS_MAKE_SOCK+  AccessFsMakeFifo -> lANDLOCK_ACCESS_FS_MAKE_FIFO+  AccessFsMakeBlock -> lANDLOCK_ACCESS_FS_MAKE_BLOCK+  AccessFsMakeSym -> lANDLOCK_ACCESS_FS_MAKE_SYM+  AccessFsRefer -> lANDLOCK_ACCESS_FS_REFER+  AccessFsTruncate -> lANDLOCK_ACCESS_FS_TRUNCATE++-- | All 'AccessFsFlag' flags keyed by a Landlock ABI 'Version'.+accessFsFlags :: [(Version, [AccessFsFlag])]+accessFsFlags =+  [ (v, [f | f <- [minBound ..], version f <= v])+    | v <-+        [ version1,+          version2,+          version3+        ]+  ]+  where+    version = \case+      AccessFsExecute -> version1+      AccessFsWriteFile -> version1+      AccessFsReadFile -> version1+      AccessFsReadDir -> version1+      AccessFsRemoveDir -> version1+      AccessFsRemoveFile -> version1+      AccessFsMakeChar -> version1+      AccessFsMakeDir -> version1+      AccessFsMakeReg -> version1+      AccessFsMakeSock -> version1+      AccessFsMakeFifo -> version1+      AccessFsMakeBlock -> version1+      AccessFsMakeSym -> version1+      AccessFsRefer -> version2+      AccessFsTruncate -> version3++-- | Predicate for read-only 'AccessFsFlag' flags.+accessFsFlagIsReadOnly :: AccessFsFlag -> Bool+accessFsFlagIsReadOnly = \case+  AccessFsExecute -> True+  AccessFsWriteFile -> False+  AccessFsReadFile -> True+  AccessFsReadDir -> True+  AccessFsRemoveDir -> False+  AccessFsRemoveFile -> False+  AccessFsMakeChar -> False+  AccessFsMakeDir -> False+  AccessFsMakeReg -> False+  AccessFsMakeSock -> False+  AccessFsMakeFifo -> False+  AccessFsMakeBlock -> False+  AccessFsMakeSym -> False+  AccessFsRefer -> False+  AccessFsTruncate -> False++-- | Flags passed to @landlock_create_ruleset@.+--+-- In the current kernel API, only @LANDLOCK_CREATE_RULESET_VERSION@ is+-- defined, which should not be used when creating an actual Landlock+-- encironment (cf. 'landlock').+data CreateRulesetFlag = CreateRulesetVersion+  deriving (Show, Eq, Enum, Bounded)++createRulesetFlagToBit :: CreateRulesetFlag -> U32+createRulesetFlagToBit = \case+  CreateRulesetVersion -> lANDLOCK_CREATE_RULESET_VERSION++-- | Flags passed to @landlock_restrict_self@.+--+-- In the current kernel API, no such flags are defined, hence this is a type+-- without any constructors.+data RestrictSelfFlag+  deriving (Show, Eq)++restrictSelfFlagToBit :: RestrictSelfFlag -> U32+restrictSelfFlagToBit = \case {}++-- | Flags passed to @landlock_add_rule@.+--+-- In the current kernel API, no such flags are defined, hence this is a type+-- without any constructors.+data AddRuleFlag+  deriving (Show, Eq)++addRuleFlagToBit :: AddRuleFlag -> U32+addRuleFlagToBit = \case {}

@@ -1,119 +0,0 @@-{-# LANGUAGE LambdaCase #-}--module System.Landlock.Flags (-      toBits-    , fromBits-    , AccessFsFlag(..)-    , accessFsFlagToBit-    , accessFsFlags-    , accessFsFlagIsReadOnly-    ) where--#include <linux/landlock.h>--import Data.Bits (Bits, (.|.), (.&.))--import System.Landlock.Version (Version, version1)---- | Fold a set of flags into a bitset/number.-toBits :: (Num b, Bits b, Foldable f) => f a -> (a -> b) -> b-toBits l f = foldr (\a b -> b .|. f a) 0 l---- | Expand a bitset/number into a set of flags.-fromBits :: (Enum a, Bounded a, Num b, Bits b) => b -> (a -> b) -> [a]-fromBits b f = filter (\a -> b .&. f a /= 0) [minBound .. maxBound]---- | Filesystem flags.------ These flags enable to restrict a sandboxed process to a set of actions on--- files and directories. Files or directories opened before the sandboxing--- are not subject to these restrictions.------ A file can only receive these access rights:------ - 'AccessFsExecute'--- - 'AccessFsWriteFile'--- - 'AccessFsReadFile'------ A directory can receive access rights related to files or directories. The--- following access right is applied to the directory itself, and the--- directories beneath it:------ - 'AccessFsReadDir'------ However, the following access rights only apply to the content of a--- directory, not the directory itself:------ - 'AccessFsRemoveDir'--- - 'AccessFsRemoveFile'--- - 'AccessFsMakeChar'--- - 'AccessFsMakeDir'--- - 'AccessFsMakeReg'--- - 'AccessFsMakeSock'--- - 'AccessFsMakeFifo'--- - 'AccessFsMakeBlock'--- - 'AccessFsMakeSym'------ __Warning:__ It is currently not possible to restrict some file-related--- actions acessible through these syscall families: @chdir@, @truncate@,--- @stat@, @flock@, @chmod@, @chown@, @setxattr@, @utime@, @ioctl@, @fcntl@,--- @access@. Future Landlock evolutions will enable to restrict them.-data AccessFsFlag = AccessFsExecute     -- ^ Execute a file.-                  | AccessFsWriteFile   -- ^ Open a file with write access.-                  | AccessFsReadFile    -- ^ Open a file with read access.-                  | AccessFsReadDir     -- ^ Open a directory or list its content.-                  | AccessFsRemoveDir   -- ^ Remove an empty directory or rename one-                  | AccessFsRemoveFile  -- ^ Unlink (or rename) a file.-                  | AccessFsMakeChar    -- ^ Create (or rename or link) a character device.-                  | AccessFsMakeDir     -- ^ Create (or rename) a directory.-                  | AccessFsMakeReg     -- ^ Create (or rename or link) a regular file.-                  | AccessFsMakeSock    -- ^ Create (or rename or link) a UNIX domain socket.-                  | AccessFsMakeFifo    -- ^ Create (or rename or link) a named pipe.-                  | AccessFsMakeBlock   -- ^ Create (or rename or link) a block device.-                  | AccessFsMakeSym     -- ^ Create (or rename or link) a symbolic link.---- Note: when adding new flags, this likely means a new ABI version is--- available. Hence, add this to 'System.Landlock.Version' (and export it--- from 'System.Landlock'), and make sure to update both 'accessFsFlags' and--- 'accessFsFlagIsReadOnly'.-  deriving (Show, Eq, Enum, Bounded, Ord)---- | Retrieve a number with the appropriate 'AccessFsFlag' bit set.-accessFsFlagToBit :: Num a => AccessFsFlag -> a-accessFsFlagToBit = \case-    AccessFsExecute -> #{const LANDLOCK_ACCESS_FS_EXECUTE}-    AccessFsWriteFile -> #{const LANDLOCK_ACCESS_FS_WRITE_FILE}-    AccessFsReadFile -> #{const LANDLOCK_ACCESS_FS_READ_FILE}-    AccessFsReadDir -> #{const LANDLOCK_ACCESS_FS_READ_DIR}-    AccessFsRemoveDir -> #{const LANDLOCK_ACCESS_FS_REMOVE_DIR}-    AccessFsRemoveFile -> #{const LANDLOCK_ACCESS_FS_REMOVE_FILE}-    AccessFsMakeChar -> #{const LANDLOCK_ACCESS_FS_MAKE_CHAR}-    AccessFsMakeDir -> #{const LANDLOCK_ACCESS_FS_MAKE_DIR}-    AccessFsMakeReg -> #{const LANDLOCK_ACCESS_FS_MAKE_REG}-    AccessFsMakeSock -> #{const LANDLOCK_ACCESS_FS_MAKE_SOCK}-    AccessFsMakeFifo -> #{const LANDLOCK_ACCESS_FS_MAKE_FIFO}-    AccessFsMakeBlock -> #{const LANDLOCK_ACCESS_FS_MAKE_BLOCK}-    AccessFsMakeSym -> #{const LANDLOCK_ACCESS_FS_MAKE_SYM}---- | All 'AccessFsFlag' flags keyed by a Landlock ABI 'Version'.-accessFsFlags :: [(Version, [AccessFsFlag])]-accessFsFlags = [-      (version1, [AccessFsExecute .. AccessFsMakeSym])-    ]---- | Predicate for read-only 'AccessFsFlag' flags.-accessFsFlagIsReadOnly :: AccessFsFlag -> Bool-accessFsFlagIsReadOnly = \case-    AccessFsExecute -> True-    AccessFsWriteFile -> False-    AccessFsReadFile -> True-    AccessFsReadDir -> True-    AccessFsRemoveDir -> False-    AccessFsRemoveFile -> False-    AccessFsMakeChar -> False-    AccessFsMakeDir -> False-    AccessFsMakeReg -> False-    AccessFsMakeSock -> False-    AccessFsMakeFifo -> False-    AccessFsMakeBlock -> False-    AccessFsMakeSym -> False

@@ -0,0 +1,179 @@+module System.Landlock.Hsc (+  aT_FDCWD,++  o_PATH,+  o_RDONLY,+  o_DIRECTORY,+  o_NOFOLLOW,+  o_CLOEXEC,++  lANDLOCK_ACCESS_FS_EXECUTE,+  lANDLOCK_ACCESS_FS_WRITE_FILE,+  lANDLOCK_ACCESS_FS_READ_FILE,+  lANDLOCK_ACCESS_FS_READ_DIR,+  lANDLOCK_ACCESS_FS_REMOVE_DIR,+  lANDLOCK_ACCESS_FS_REMOVE_FILE,+  lANDLOCK_ACCESS_FS_MAKE_CHAR,+  lANDLOCK_ACCESS_FS_MAKE_DIR,+  lANDLOCK_ACCESS_FS_MAKE_REG,+  lANDLOCK_ACCESS_FS_MAKE_SOCK,+  lANDLOCK_ACCESS_FS_MAKE_FIFO,+  lANDLOCK_ACCESS_FS_MAKE_BLOCK,+  lANDLOCK_ACCESS_FS_MAKE_SYM,+  lANDLOCK_ACCESS_FS_REFER,+  lANDLOCK_ACCESS_FS_TRUNCATE,++  lANDLOCK_CREATE_RULESET_VERSION,++  U32,+  U64,+  Landlock_rule_type,++  pR_SET_NO_NEW_PRIVS,++  landlock_ruleset_attr_size,+  landlock_ruleset_attr_alignment,+  landlock_ruleset_attr_peek_handled_access_fs,+  landlock_ruleset_attr_poke_handled_access_fs,++  lANDLOCK_RULE_PATH_BENEATH,+  landlock_path_beneath_attr_size,+  landlock_path_beneath_attr_alignment,+  landlock_path_beneath_attr_peek_allowed_access,+  landlock_path_beneath_attr_poke_allowed_access,+  landlock_path_beneath_attr_peek_parent_fd,+  landlock_path_beneath_attr_poke_parent_fd,+) where++#define _GNU_SOURCE++#include <fcntl.h>+#include <stddef.h>+#include <sys/prctl.h>+#include <sys/types.h>++#include "hs-landlock.h"+#include "linux/landlock.h"++import Data.Int (Int32)+import Data.Word (Word32, Word64)+import Foreign.C.Types (CInt)+import Foreign.Ptr (Ptr)+import Foreign.Storable (peekByteOff, pokeByteOff)++aT_FDCWD :: CInt+aT_FDCWD = #{const AT_FDCWD}++o_PATH :: CInt+o_PATH = #{const O_PATH}++o_RDONLY :: CInt+o_RDONLY = #{const O_RDONLY}++o_DIRECTORY :: CInt+o_DIRECTORY = #{const O_DIRECTORY}++o_NOFOLLOW :: CInt+o_NOFOLLOW = #{const O_NOFOLLOW}++o_CLOEXEC :: CInt+o_CLOEXEC = #{const O_CLOEXEC}++lANDLOCK_ACCESS_FS_EXECUTE :: #{type __u64}+lANDLOCK_ACCESS_FS_EXECUTE = #{const LANDLOCK_ACCESS_FS_EXECUTE}++lANDLOCK_ACCESS_FS_WRITE_FILE :: #{type __u64}+lANDLOCK_ACCESS_FS_WRITE_FILE = #{const LANDLOCK_ACCESS_FS_WRITE_FILE}++lANDLOCK_ACCESS_FS_READ_FILE :: #{type __u64}+lANDLOCK_ACCESS_FS_READ_FILE = #{const LANDLOCK_ACCESS_FS_READ_FILE}++lANDLOCK_ACCESS_FS_READ_DIR :: #{type __u64}+lANDLOCK_ACCESS_FS_READ_DIR = #{const LANDLOCK_ACCESS_FS_READ_DIR}++lANDLOCK_ACCESS_FS_REMOVE_DIR :: #{type __u64}+lANDLOCK_ACCESS_FS_REMOVE_DIR = #{const LANDLOCK_ACCESS_FS_REMOVE_DIR}++lANDLOCK_ACCESS_FS_REMOVE_FILE :: #{type __u64}+lANDLOCK_ACCESS_FS_REMOVE_FILE = #{const LANDLOCK_ACCESS_FS_REMOVE_FILE}++lANDLOCK_ACCESS_FS_MAKE_CHAR :: #{type __u64}+lANDLOCK_ACCESS_FS_MAKE_CHAR = #{const LANDLOCK_ACCESS_FS_MAKE_CHAR}++lANDLOCK_ACCESS_FS_MAKE_DIR :: #{type __u64}+lANDLOCK_ACCESS_FS_MAKE_DIR = #{const LANDLOCK_ACCESS_FS_MAKE_DIR}++lANDLOCK_ACCESS_FS_MAKE_REG :: #{type __u64}+lANDLOCK_ACCESS_FS_MAKE_REG = #{const LANDLOCK_ACCESS_FS_MAKE_REG}++lANDLOCK_ACCESS_FS_MAKE_SOCK :: #{type __u64}+lANDLOCK_ACCESS_FS_MAKE_SOCK = #{const LANDLOCK_ACCESS_FS_MAKE_SOCK}++lANDLOCK_ACCESS_FS_MAKE_FIFO :: #{type __u64}+lANDLOCK_ACCESS_FS_MAKE_FIFO = #{const LANDLOCK_ACCESS_FS_MAKE_FIFO}++lANDLOCK_ACCESS_FS_MAKE_BLOCK :: #{type __u64}+lANDLOCK_ACCESS_FS_MAKE_BLOCK = #{const LANDLOCK_ACCESS_FS_MAKE_BLOCK}++lANDLOCK_ACCESS_FS_MAKE_SYM :: #{type __u64}+lANDLOCK_ACCESS_FS_MAKE_SYM = #{const LANDLOCK_ACCESS_FS_MAKE_SYM}++lANDLOCK_ACCESS_FS_REFER :: #{type __u64}+lANDLOCK_ACCESS_FS_REFER = #{const LANDLOCK_ACCESS_FS_REFER}++lANDLOCK_ACCESS_FS_TRUNCATE :: #{type __u64}+lANDLOCK_ACCESS_FS_TRUNCATE = #{const LANDLOCK_ACCESS_FS_TRUNCATE}++lANDLOCK_CREATE_RULESET_VERSION :: #{type __u32}+lANDLOCK_CREATE_RULESET_VERSION = #{const LANDLOCK_CREATE_RULESET_VERSION}++type U32 = #{type __u32}+type U64 = #{type __u64}++type Landlock_rule_type = #{type enum landlock_rule_type}++pR_SET_NO_NEW_PRIVS :: CInt+pR_SET_NO_NEW_PRIVS = #{const PR_SET_NO_NEW_PRIVS}++landlock_ruleset_attr_size :: Int+landlock_ruleset_attr_size = #{size struct landlock_ruleset_attr}++landlock_ruleset_attr_alignment :: Int+landlock_ruleset_attr_alignment = #{alignment struct landlock_ruleset_attr}++landlock_ruleset_attr_peek_handled_access_fs :: Ptr a -> IO #{type __u64}+landlock_ruleset_attr_peek_handled_access_fs =+  #{peek struct landlock_ruleset_attr, handled_access_fs}++landlock_ruleset_attr_poke_handled_access_fs :: Ptr a -> #{type __u64} -> IO ()+landlock_ruleset_attr_poke_handled_access_fs =+  #{poke struct landlock_ruleset_attr, handled_access_fs}++lANDLOCK_RULE_PATH_BENEATH :: #{type enum landlock_rule_type}+lANDLOCK_RULE_PATH_BENEATH = #{const LANDLOCK_RULE_PATH_BENEATH}++landlock_path_beneath_attr_size :: Int+landlock_path_beneath_attr_size = #{size struct landlock_path_beneath_attr}++landlock_path_beneath_attr_alignment :: Int+landlock_path_beneath_attr_alignment =+  #{alignment struct landlock_path_beneath_attr}++landlock_path_beneath_attr_peek_allowed_access :: Ptr a -> IO #{type __u64}+landlock_path_beneath_attr_peek_allowed_access =+  #{peek struct landlock_path_beneath_attr, allowed_access}++landlock_path_beneath_attr_peek_parent_fd :: Ptr a -> IO #{type __s32}+landlock_path_beneath_attr_peek_parent_fd =+  #{peek struct landlock_path_beneath_attr, parent_fd}++landlock_path_beneath_attr_poke_allowed_access ::+  Ptr a -> #{type __u64} -> IO ()+landlock_path_beneath_attr_poke_allowed_access =+  #{poke struct landlock_path_beneath_attr, allowed_access}++landlock_path_beneath_attr_poke_parent_fd :: Ptr a -> #{type __s32} -> IO ()+landlock_path_beneath_attr_poke_parent_fd =+  #{poke struct landlock_path_beneath_attr, parent_fd}++

@@ -0,0 +1,123 @@+{-# LANGUAGE CApiFFI #-}++module System.Landlock.OpenPath+  ( withOpenPath,+    withOpenPathAt,+    OpenPathFlags (..),+    defaultOpenPathFlags,+  )+where++import Control.Monad.Catch (MonadMask, bracket)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Bits ((.|.))+import Foreign.C.String (CString, withCString)+import Foreign.C.Types (CInt (..))+import System.Landlock.Hsc+  ( aT_FDCWD,+    o_CLOEXEC,+    o_DIRECTORY,+    o_NOFOLLOW,+    o_PATH,+    o_RDONLY,+  )+import System.Posix.Error (throwErrnoPathIfMinus1Retry)+import System.Posix.IO (closeFd)+import System.Posix.Types (Fd)++foreign import capi unsafe "fcntl.h openat"+  _openat ::+    CInt ->+    CString ->+    CInt ->+    IO CInt++openat ::+  Fd ->+  FilePath ->+  CInt ->+  IO Fd+openat dirfd pathname flags = withCString pathname $ \pathnamep -> do+  throwErrnoPathIfMinus1Retry "openat" pathname $+    fromIntegral <$> _openat (fromIntegral dirfd) pathnamep flags++-- | Extra flags used by 'withOpenPathAt' in the call to @openat@.+data OpenPathFlags = OpenPathFlags+  { -- | Set @O_DIRECTORY@.+    directory :: Bool,+    -- | Set @O_NOFOLLOW@.+    nofollow :: Bool,+    -- | Set @O_CLOEXEC@.+    cloexec :: Bool+  }+  deriving (Show, Eq)++-- | Default 'OpenPathFlags':+--+-- - 'directory' is @False@.+-- - 'nofollow' is @False@.+-- - 'cloexec' is @True@.+defaultOpenPathFlags :: OpenPathFlags+defaultOpenPathFlags =+  OpenPathFlags+    { directory = False,+      nofollow = False,+      cloexec = True+    }++-- | Perform an action with a path @open@ed using @O_PATH@.+--+-- The file descriptor provided to the action will be @close@d when the+-- function returns.+--+-- This internally calls @openat@ with @AT_FDCWD@ and the @O_PATH@ and+-- @O_RDONLY@ flags set, next to any flags specified in the 'OpenPathFlags'+-- argument.+withOpenPath ::+  (MonadIO m, MonadMask m) =>+  -- | Path to open.+  FilePath ->+  -- | Flag settings to pass.+  OpenPathFlags ->+  -- | Action to call with a file descriptor to the given path.+  (Fd -> m a) ->+  -- | Result of the invoked action.+  m a+withOpenPath = withOpenPathAt (fromIntegral aT_FDCWD)++-- | Perform an action with a path @openat@ed using @O_PATH@.+--+-- Like 'withOpenPath', exposing the @openat@ @dirfd@ argument.+--+-- The file descriptor provided to the action will be @close@d when the+-- function returns.+--+-- This internally calls @openat@ with the @O_PATH@ and @O_RDONLY@ flags set,+-- next to any flags specified in the 'OpenPathFlags' argument.+withOpenPathAt ::+  (MonadIO m, MonadMask m) =>+  -- | @dirfd@ argument to @openat@.+  Fd ->+  -- | Path to open.+  FilePath ->+  -- | Flag settings to pass.+  OpenPathFlags ->+  -- | Action to call with a file descriptor to the given path.+  (Fd -> m a) ->+  -- | Result of the invoked action.+  m a+withOpenPathAt dirfd pathname flags =+  bracket+    (liftIO $ openat dirfd pathname flags')+    (liftIO . closeFd)+  where+    flags' =+      foldr+        (.|.)+        0+        [ o_PATH,+          o_RDONLY,+          if directory flags then o_DIRECTORY else 0,+          if nofollow flags then o_NOFOLLOW else 0,+          if cloexec flags then o_CLOEXEC else 0+        ]

@@ -1,93 +0,0 @@-module System.Landlock.OpenPath (-      withOpenPath-    , withOpenPathAt-    , OpenPathFlags(..)-    , defaultOpenPathFlags-    ) where--#define _GNU_SOURCE--#include <fcntl.h>--import Control.Monad.Catch (MonadMask, bracket)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Bits ((.|.))-import Data.Int (Int32)-import Foreign.C.String (CString, withCString)-import System.Posix.Error (throwErrnoPathIfMinus1Retry)-import System.Posix.IO (closeFd)-import System.Posix.Types (Fd)--foreign import ccall unsafe "fcntl.h openat"-  _openat :: #{type int}-         -> CString-         -> #{type int}-         -> IO #{type int}--openat :: Fd-       -> FilePath-       -> #{type int}-       -> IO Fd-openat dirfd pathname flags = withCString pathname $ \pathnamep -> do-    fd <- throwErrnoPathIfMinus1Retry "openat" pathname $ _openat (fromIntegral dirfd) pathnamep flags-    return $ fromIntegral fd---- | Extra flags used by 'withOpenPathAt' in the call to @openat@.-data OpenPathFlags = OpenPathFlags { directory :: Bool-                                     -- ^ Set @O_DIRECTORY@.-                                   , nofollow :: Bool-                                     -- ^ Set @O_NOFOLLOW@.-                                   , cloexec :: Bool-                                     -- ^ Set @O_CLOEXEC@.-                                   }-  deriving (Show, Eq)---- | Default 'OpenPathFlags':------ - 'directory' is @False@.--- - 'nofollow' is @False@.--- - 'cloexec' is @True@.-defaultOpenPathFlags :: OpenPathFlags-defaultOpenPathFlags = OpenPathFlags { directory = False-                                     , nofollow = False-                                     , cloexec = True-                                     }---- | Perform an action with a path @open@ed using @O_PATH@.------ The file descriptor provided to the action will be @close@d when the--- function returns.------ This internally calls @openat@ with @AT_FDCWD@ and the @O_PATH@ and--- @O_RDONLY@ flags set, next to any flags specified in the 'OpenPathFlags'--- argument.-withOpenPath :: (MonadIO m, MonadMask m)-             => FilePath  -- ^ Path to open.-             -> OpenPathFlags  -- ^ Flag settings to pass.-             -> (Fd -> m a)  -- ^ Action to call with a file descriptor to the given path.-             -> m a  -- ^ Result of the invoked action.-withOpenPath = withOpenPathAt (fromIntegral (#{const AT_FDCWD} :: #{type int}))---- | Perform an action with a path @openat@ed using @O_PATH@.------ Like 'withOpenPath', exposing the @openat@ @dirfd@ argument.------ The file descriptor provided to the action will be @close@d when the--- function returns.------ This internally calls @openat@ with the @O_PATH@ and @O_RDONLY@ flags set,--- next to any flags specified in the 'OpenPathFlags' argument.-withOpenPathAt :: (MonadIO m, MonadMask m)-               => Fd  -- ^ @dirfd@ argument to @openat@.-               -> FilePath  -- ^ Path to open.-               -> OpenPathFlags  -- ^ Flag settings to pass.-               -> (Fd -> m a)  -- ^ Action to call with a file descriptor to the given path.-               -> m a  -- ^ Result of the invoked action.-withOpenPathAt dirfd pathname flags = bracket (liftIO $ openat dirfd pathname flags') (liftIO . closeFd)-  where-    flags' = foldr (.|.) 0 [ #{const O_PATH}-                           , #{const O_RDONLY}-                           , if directory flags then #{const O_DIRECTORY} else 0-                           , if nofollow flags then #{const O_NOFOLLOW} else 0-                           , if cloexec flags then #{const O_CLOEXEC} else 0-                           ]

@@ -0,0 +1,83 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE StandaloneDeriving #-}++module System.Landlock.Rules+  ( Rule,+    RuleType (..),+    ruleType,+    pathBeneath,+    AccessFsFlag (..),+  )+where++import Foreign.Storable (Storable (..))+import System.Landlock.Flags+  ( AccessFsFlag (..),+    accessFsFlagToBit,+    fromBits,+    toBits,+  )+import System.Landlock.Hsc+  ( Landlock_rule_type,+    lANDLOCK_RULE_PATH_BENEATH,+    landlock_path_beneath_attr_alignment,+    landlock_path_beneath_attr_peek_allowed_access,+    landlock_path_beneath_attr_peek_parent_fd,+    landlock_path_beneath_attr_poke_allowed_access,+    landlock_path_beneath_attr_poke_parent_fd,+    landlock_path_beneath_attr_size,+  )+import System.Posix.Types (Fd)++-- | Kind of 'Rule's.+data RuleType = PathBeneath++-- | A rule enforced by Landlock, to be registered using 'System.Landlock.addRule'.+--+-- 'Rule's can be constructed using the relevant functions, like 'pathBeneath'.+data Rule (a :: RuleType) where+  PathBeneathRule :: [AccessFsFlag] -> Fd -> Rule 'PathBeneath++deriving instance Show (Rule a)++deriving instance Eq (Rule a)++-- | Retrieve the @enum landlock_rule_type@ value of a given 'Rule'.+ruleType :: Rule a -> Landlock_rule_type+ruleType = \case+  PathBeneathRule {} -> lANDLOCK_RULE_PATH_BENEATH++instance Storable (Rule 'PathBeneath) where+  sizeOf _ = landlock_path_beneath_attr_size+  alignment _ = landlock_path_beneath_attr_alignment+  peek ptr = do+    allowedAccess <- landlock_path_beneath_attr_peek_allowed_access ptr+    parentFd <- landlock_path_beneath_attr_peek_parent_fd ptr+    return $+      PathBeneathRule+        (fromBits accessFsFlagToBit allowedAccess)+        (fromIntegral parentFd)+  poke ptr (PathBeneathRule flags fd) = do+    let allowedAccess = toBits accessFsFlagToBit flags+        parentFd = fromIntegral fd+    landlock_path_beneath_attr_poke_allowed_access ptr allowedAccess+    landlock_path_beneath_attr_poke_parent_fd ptr parentFd++-- | Construct a path hierarchy rule definition.+--+-- This corresponds to a rule of type @LANDLOCK_RULE_PATH_BENEATH@, with+-- attributes defined in a @struct landlock_path_beneath_attr@.+pathBeneath ::+  -- | File descriptor, preferably opened with @O_PATH@, which+  --   identifies the parent directory of a file hierarchy, or+  --   just a file.+  Fd ->+  -- | Allowed actions for this file hierarchy+  --   (cf. 'AccessFsFlag').+  [AccessFsFlag] ->+  Rule 'PathBeneath+pathBeneath fd flags = PathBeneathRule flags fd

@@ -1,66 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE StandaloneDeriving #-}--module System.Landlock.Rules (-      Rule-    , RuleType(..)-    , ruleType-    , pathBeneath-    , AccessFsFlag(..)-    ) where--#include <linux/landlock.h>-#include <sys/types.h>--import Data.Int (Int32)-import Data.Word (Word32, Word64)-import Foreign.Storable (Storable(..))-import System.Posix.Types (Fd)--import System.Landlock.Flags (AccessFsFlag(..), accessFsFlagToBit, fromBits, toBits)---- | Kind of 'Rule's.-data RuleType = PathBeneath---- | A rule enforced by Landlock, to be registered using 'System.Landlock.addRule'.------ 'Rule's can be constructed using the relevant functions, like 'pathBeneath'.-data Rule (a :: RuleType) where-    PathBeneathRule :: [AccessFsFlag] -> Fd -> Rule 'PathBeneath--deriving instance Show (Rule a)-deriving instance Eq (Rule a)---- | Retrieve the @enum landlock_rule_type@ value of a given 'Rule'.-ruleType :: Rule a -> #{type enum landlock_rule_type}-ruleType = \case-    PathBeneathRule{} -> #{const LANDLOCK_RULE_PATH_BENEATH}--instance Storable (Rule 'PathBeneath) where-    sizeOf _ = #{size struct landlock_path_beneath_attr}-    alignment _ = #{alignment struct landlock_path_beneath_attr}-    peek ptr = do-        allowedAccess <- #{peek struct landlock_path_beneath_attr, allowed_access} ptr :: IO #{type __u64}-        parentFd <- #{peek struct landlock_path_beneath_attr, parent_fd} ptr :: IO #{type __s32}-        return $ PathBeneathRule (fromBits allowedAccess accessFsFlagToBit) (fromIntegral parentFd)-    poke ptr (PathBeneathRule flags fd) = do-        let allowedAccess = toBits flags accessFsFlagToBit :: #{type __u64}-            parentFd = fromIntegral fd :: #{type __s32}-        #{poke struct landlock_path_beneath_attr, allowed_access} ptr allowedAccess-        #{poke struct landlock_path_beneath_attr, parent_fd} ptr parentFd---- | Construct a path hierarchy rule definition.------ This corresponds to a rule of type @LANDLOCK_RULE_PATH_BENEATH@, with--- attributes defined in a @struct landlock_path_beneath_attr@.-pathBeneath :: Fd  -- ^ File descriptor, preferably opened with @O_PATH@, which-                   --   identifies the parent directory of a file hierarchy, or-                   --   just a file.-            -> [AccessFsFlag]  -- ^ Allowed actions for this file hierarchy-                               --   (cf. 'AccessFsFlag').-            -> Rule 'PathBeneath-pathBeneath fd flags = PathBeneathRule flags fd

@@ -0,0 +1,127 @@+{-# LANGUAGE CApiFFI #-}++module System.Landlock.Syscalls+  ( LandlockRulesetAttr (..),+    landlock_create_ruleset,+    landlock_add_rule,+    landlock_restrict_self,+    prctl,+    pR_SET_NO_NEW_PRIVS,+    throwIfNonZero,+  )+where++import Control.Monad (unless)+import Foreign.C.Error (throwErrnoIfMinus1)+import Foreign.C.Types (CInt (..), CLong (..), CSize (..), CULong (..))+import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable (..))+import System.IO.Error (ioeSetLocation)+import System.Landlock.Hsc+  ( Landlock_rule_type,+    U32,+    U64,+    landlock_ruleset_attr_alignment,+    landlock_ruleset_attr_peek_handled_access_fs,+    landlock_ruleset_attr_poke_handled_access_fs,+    landlock_ruleset_attr_size,+    pR_SET_NO_NEW_PRIVS,+  )++{- HLINT ignore LandlockRulesetAttr "Use newtype instead of data" -}+data LandlockRulesetAttr = LandlockRulesetAttr+  { landlockRulesetAttrHandledAccessFs :: U64+  }+  deriving (Show, Eq)++instance Storable LandlockRulesetAttr where+  sizeOf _ = landlock_ruleset_attr_size+  alignment _ = landlock_ruleset_attr_alignment+  peek ptr =+    LandlockRulesetAttr+      <$> landlock_ruleset_attr_peek_handled_access_fs ptr+  poke ptr attr =+    landlock_ruleset_attr_poke_handled_access_fs+      ptr+      (landlockRulesetAttrHandledAccessFs attr)++foreign import capi unsafe "hs-landlock.h hs_landlock_create_ruleset"+  _landlock_create_ruleset ::+    Ptr LandlockRulesetAttr ->+    CSize ->+    U32 ->+    IO CLong++{- HLINT ignore landlock_create_ruleset "Use camelCase" -}+landlock_create_ruleset ::+  Ptr LandlockRulesetAttr ->+  CSize ->+  U32 ->+  IO CLong+landlock_create_ruleset attr size flags =+  throwErrnoIfMinus1 "landlock_create_ruleset" $+    _landlock_create_ruleset attr size flags++foreign import capi unsafe "hs-landlock.h hs_landlock_add_rule"+  _landlock_add_rule ::+    CInt ->+    Landlock_rule_type ->+    Ptr a ->+    U32 ->+    IO CLong++{- HLINT ignore landlock_add_rule "Use camelCase" -}+landlock_add_rule ::+  CInt ->+  Landlock_rule_type ->+  Ptr a ->+  U32 ->+  IO ()+landlock_add_rule ruleset_fd rule_type rule_attr flags =+  throwIfNonZero "landlock_add_rule" $+    throwErrnoIfMinus1 "landlock_add_rule" $+      _landlock_add_rule ruleset_fd rule_type rule_attr flags++foreign import capi unsafe "hs-landlock.h hs_landlock_restrict_self"+  _landlock_restrict_self ::+    CInt ->+    U32 ->+    IO CLong++{- HLINT ignore landlock_restrict_self "Use camelCase" -}+landlock_restrict_self ::+  CInt ->+  U32 ->+  IO ()+landlock_restrict_self ruleset_fd flags =+  throwIfNonZero "landlock_restrict_self" $+    throwErrnoIfMinus1 "landlock_restrict_self" $+      _landlock_restrict_self ruleset_fd flags++foreign import capi unsafe "hs-landlock.h hs_landlock_prctl"+  _prctl ::+    CInt ->+    CULong ->+    CULong ->+    CULong ->+    CULong ->+    IO CInt++prctl ::+  CInt ->+  CULong ->+  CULong ->+  CULong ->+  CULong ->+  IO CInt+prctl option arg2 arg3 arg4 arg5 =+  throwErrnoIfMinus1 "prctl" $ _prctl option arg2 arg3 arg4 arg5++throwIfNonZero :: (Num a, Eq a, Show a) => String -> IO a -> IO ()+throwIfNonZero location act = do+  rc <- act+  unless (rc == 0) $+    ioError $+      flip ioeSetLocation location $+        userError $+          "Unexpected return value: " ++ show rc ++ " /= 0"

@@ -1,86 +0,0 @@-module System.Landlock.Syscalls (-      LandlockRulesetAttr(..)-    , landlock_create_ruleset-    , landlock_add_rule-    , landlock_restrict_self-    , prctl-    ) where--#include <stddef.h>-#include <linux/landlock.h>-#include <sys/prctl.h>-#include <sys/types.h>--#include "hs-landlock.h"--import Data.Int (Int32, Int64)-import Data.Word (Word32, Word64)-import Foreign.C.Error (throwErrnoIfMinus1)-import Foreign.Ptr (Ptr)-import Foreign.Storable (Storable(..))--data LandlockRulesetAttr = LandlockRulesetAttr { landlockRulesetAttrHandledAccessFs :: #{type __u64} }-  deriving (Show, Eq)--instance Storable LandlockRulesetAttr where-  sizeOf _ = #{size struct landlock_ruleset_attr}-  alignment _ = #{alignment struct landlock_ruleset_attr}-  peek ptr = LandlockRulesetAttr <$> #{peek struct landlock_ruleset_attr, handled_access_fs} ptr-  poke ptr attr = do-      #{poke struct landlock_ruleset_attr, handled_access_fs} ptr (landlockRulesetAttrHandledAccessFs attr)--foreign import ccall unsafe "hs-landlock.h landlock_create_ruleset"-  _landlock_create_ruleset :: Ptr LandlockRulesetAttr-                           -> #{type size_t}-                           -> #{type __u32}-                           -> IO #{type long}--landlock_create_ruleset :: Ptr LandlockRulesetAttr-                        -> #{type size_t}-                        -> #{type __u32}-                        -> IO #{type long}-landlock_create_ruleset attr size flags =-    throwErrnoIfMinus1 "landlock_create_ruleset" $ _landlock_create_ruleset attr size flags--foreign import ccall unsafe "hs-landlock.h landlock_add_rule"-  _landlock_add_rule :: #{type int}-                     -> #{type enum landlock_rule_type}-                     -> Ptr a-                     -> #{type __u32}-                     -> IO #{type long}--landlock_add_rule :: #{type int}-                  -> #{type enum landlock_rule_type}-                  -> Ptr a-                  -> #{type __u32}-                  -> IO #{type long}-landlock_add_rule ruleset_fd rule_type rule_attr flags =-    throwErrnoIfMinus1 "landlock_add_rule" $ _landlock_add_rule ruleset_fd rule_type rule_attr flags--foreign import ccall unsafe "hs-landlock.h landlock_restrict_self"-  _landlock_restrict_self :: #{type int}-                          -> #{type __u32}-                          -> IO #{type long}--landlock_restrict_self :: #{type int}-                       -> #{type __u32}-                       -> IO #{type long}-landlock_restrict_self ruleset_fd flags =-    throwErrnoIfMinus1 "landlock_restrict_self" $ _landlock_restrict_self ruleset_fd flags--foreign import ccall unsafe "hs-landlock.h hs_landlock_prctl"-  _prctl :: #{type int}-        -> #{type unsigned long}-        -> #{type unsigned long}-        -> #{type unsigned long}-        -> #{type unsigned long}-        -> IO #{type int}--prctl :: #{type int}-      -> #{type unsigned long}-      -> #{type unsigned long}-      -> #{type unsigned long}-      -> #{type unsigned long}-      -> IO #{type int}-prctl option arg2 arg3 arg4 arg5 =-    throwErrnoIfMinus1 "prctl" $ _prctl option arg2 arg3 arg4 arg5

@@ -0,0 +1,28 @@+module System.Landlock.Version+  ( Version (..),+    version1,+    version2,+    version3,+  )+where++-- | Representation of a Landlock ABI version as reported by the kernel.+newtype Version = Version+  { -- | Get the numerical version.+    getVersion :: Word+  }+  deriving (Show, Eq, Ord)++-- All ABI versions supported by this library should be exposed as a value.++-- | ABI version 1.+version1 :: Version+version1 = Version 1++-- | ABI version 2.+version2 :: Version+version2 = Version 2++-- | ABI version 3.+version3 :: Version+version3 = Version 3

@@ -1,15 +0,0 @@-module System.Landlock.Version (-      Version(..)-    , version1-    ) where--import Data.Int (Int64)---- | Representation of a Landlock ABI version as reported by the kernel.-newtype Version = Version { getVersion :: #{type long} }-  deriving (Show, Eq, Ord)---- All ABI versions supported by this library should be exposed as a value.--- | ABI version 1.-version1 :: Version-version1 = Version 1

@@ -1,10 +1,9 @@-Cabal-Version:       2.2-Build-Type:          Simple--Name:                landlock-Version:             0.2.0.1-Synopsis:            Haskell bindings for the Linux Landlock API-Description:+cabal-version:      2.2+build-type:         Simple+name:               landlock+version:            0.2.1.0+synopsis:           Haskell bindings for the Linux Landlock API+description:   This library exposes Haskell bindings for the Linux kernel Landlock API.   .   The Linux kernel Landlock API provides unprivileged access control. The goal@@ -18,105 +17,197 @@   .   For more information, see the <https://landlock.io/ Landlock homepage> and its   <https://docs.kernel.org/userspace-api/landlock.html kernel documentation>.-Homepage:            https://github.com/NicolasT/landlock-hs-Bug-Reports:         https://github.com/NicolasT/landlock-hs/issues-License:             BSD-3-Clause-License-File:        LICENSE-Author:              Nicolas Trangez-Maintainer:          ikke@nicolast.be-Copyright:           (c) 2022 Nicolas Trangez-Category:            System-Stability:           alpha -Extra-Source-Files:+homepage:           https://github.com/NicolasT/landlock-hs+bug-reports:        https://github.com/NicolasT/landlock-hs/issues+license:            BSD-3-Clause+license-file:       LICENSE+author:             Nicolas Trangez+maintainer:         ikke@nicolast.be+copyright:          (c) 2022 Nicolas Trangez+category:           System+stability:          alpha+extra-doc-files:+  cbits/linux/GPL-2.0+  cbits/linux/Linux-syscall-note   CHANGELOG.md   README.md++extra-source-files:   cbits/hs-landlock.h+  cbits/linux/landlock.h -Tested-With:         GHC ==8.10.5-                   , GHC ==9.0.2-                   , GHC ==9.2.2+tested-with:        GHC ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.2 -Source-Repository head-  Type:                git-  Location:            https://github.com/NicolasT/landlock-hs.git-  Subdir:              landlock-  Branch:              main+source-repository head+  type:     git+  location: https://github.com/NicolasT/landlock-hs.git+  subdir:   landlock+  branch:   main -Library-  Exposed-Modules:     System.Landlock-  Build-Depends:       landlock-internal-                     , base ^>=4.14.2.0 || ^>=4.15 || ^>=4.16-                     , exceptions ^>=0.10.4-                     , unix ^>=2.7.2.2-  Build-Tool-Depends:  hsc2hs:hsc2hs-  Hs-Source-Dirs:      src-  Default-Language:    Haskell2010-  Other-Extensions:    EmptyCase-                       EmptyDataDeriving-                       FlexibleContexts-                       LambdaCase-                       RankNTypes-  Ghc-Options:         -Wall+flag landlocked+  description: Build the landlocked utility.+  default:     True+  manual:      True -Library landlock-internal-  Exposed-Modules:     System.Landlock.Flags-                     , System.Landlock.OpenPath-                     , System.Landlock.Rules-                     , System.Landlock.Syscalls-                     , System.Landlock.Version-  Include-Dirs:        cbits-  C-Sources:           cbits/hs-landlock.c-  Cc-Options:          -Wall-  Build-Depends:       psx ^>=0.1-                     , base-                     , exceptions-                     , unix-  Build-Tool-Depends:  hsc2hs:hsc2hs-  Hs-Source-Dirs:      internal-  Default-Language:    Haskell2010-  Other-Extensions:    DataKinds-                       FlexibleInstances-                       GADTs-                       KindSignatures-                       LambdaCase-                       StandaloneDeriving-  Ghc-Options:         -Wall+flag werror+  description: Turn compiler warnings into errors.+  default:     False+  manual:      True -Test-Suite landlock-test-  Type:                exitcode-stdio-1.0-  Hs-Source-Dirs:      test-  Main-Is:             landlock-test.hs-  Other-Modules:       ThreadedScenario-  Build-Depends:       landlock-                     , landlock-internal-                     , base-                     , async ^>=2.2.3-                     , filepath ^>=1.4.2.1-                     , process ^>=1.6.9.0-                     , QuickCheck ^>=2.14.2-                     , tasty ^>=1.4.1-                     , tasty-expected-failure ^>=0.12.3-                     , tasty-hunit ^>=0.10.0.3-                     , tasty-quickcheck ^>=0.10.1.2-  Default-Language:    Haskell2010-  Other-Extensions:    DataKinds-                       FlexibleInstances-                       LambdaCase-                       ScopedTypeVariables-                       TypeApplications-  Ghc-Options:         -Wall+common common-settings+  default-language: Haskell2010+  ghc-options:+    -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates+    -Wpartial-fields -Wmissing-home-modules -Widentities+    -Wredundant-constraints -Wcpp-undef -Wmissing-export-lists -Test-Suite landlock-test-threaded-  Type:                exitcode-stdio-1.0-  Hs-Source-Dirs:      test-  Main-Is:             landlock-test-threaded.hs-  Other-Modules:       ThreadedScenario-  Build-Depends:       landlock-                     , base-                     , async ^>=2.2.3-                     , tasty ^>=1.4.1-                     , tasty-expected-failure ^>=0.12.3-                     , tasty-hunit ^>=0.10.0.3-  Default-Language:    Haskell2010-  Ghc-Options:         -Wall -threaded -with-rtsopts -N2+  cc-options:       -Wall -Wextra -pedantic++  if flag(werror)+    ghc-options: -Werror -optc=-Werror++    -- Note: disable some warnings triggered by `hsc2hs` code+    cc-options:+      -Werror -Wno-error=overlength-strings -Wno-error=type-limits+      -Wno-error=variadic-macros++library+  import:           common-settings+  exposed-modules:  System.Landlock+  build-depends:+    , base               >=4.14.2.0 && <4.17 || ^>=4.17+    , exceptions         ^>=0.10.4+    , landlock-internal+    , unix               >=2.7.2.2  && <2.8  || ^>=2.8++  hs-source-dirs:   src+  other-extensions:+    FlexibleContexts+    RankNTypes++library landlock-internal+  import:             common-settings+  exposed-modules:+    System.Landlock.Flags+    System.Landlock.Hsc+    System.Landlock.OpenPath+    System.Landlock.Rules+    System.Landlock.Syscalls+    System.Landlock.Version++  include-dirs:       cbits+  c-sources:          cbits/hs-landlock.c+  build-depends:+    , base        >=4.14.2.0 && <4.17 || ^>=4.17+    , exceptions  ^>=0.10.4+    , psx         ^>=0.1+    , unix        >=2.7.2.2  && <2.8  || ^>=2.8++  build-tool-depends: hsc2hs:hsc2hs+  hs-source-dirs:     internal+  other-extensions:+    CApiFFI+    DataKinds+    EmptyCase+    EmptyDataDeriving+    FlexibleInstances+    GADTs+    KindSignatures+    LambdaCase+    StandaloneDeriving++executable landlocked+  import:          common-settings++  if !flag(landlocked)+    buildable: False++  main-is:         landlocked.hs+  other-modules:   Paths_landlock+  autogen-modules: Paths_landlock+  hs-source-dirs:  bin+  build-depends:+    , base                  >=4.14.2.0 && <4.17 || ^>=4.17+    , exceptions            ^>=0.10.4+    , landlock+    , optparse-applicative  >=0.16.1.0 && <0.17 || ^>=0.17+    , unix                  >=2.7.2.2  && <2.8  || ^>=2.8++test-suite landlock-test+  import:           common-settings+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          landlock-test.hs+  other-modules:    ThreadedScenario+  build-depends:+    , async                    ^>=2.2.3+    , base                     >=4.14.2.0  && <4.17 || ^>=4.17+    , filepath                 ^>=1.4.2.1+    , landlock+    , landlock-internal+    , process                  ^>=1.6.9.0+    , QuickCheck               ^>=2.14.2+    , quickcheck-classes-base  ^>=0.6.2.0+    , tasty                    ^>=1.4.1+    , tasty-hunit              ^>=0.10.0.3+    , tasty-quickcheck         ^>=0.10.1.2++  other-extensions:+    CApiFFI+    DataKinds+    FlexibleInstances+    LambdaCase+    TypeApplications++test-suite landlock-test-threaded+  import:           common-settings+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          landlock-test-threaded.hs+  other-modules:    ThreadedScenario+  build-depends:+    , async        ^>=2.2.3+    , base         >=4.14.2.0  && <4.17 || ^>=4.17+    , landlock+    , tasty        ^>=1.4.1+    , tasty-hunit  ^>=0.10.0.3++  ghc-options:      -threaded -with-rtsopts -N2+  other-extensions: CApiFFI++test-suite landlock-readme+  import:             common-settings+  type:               exitcode-stdio-1.0+  main-is:            README.lhs+  other-modules:      ReadmeUtils+  hs-source-dirs:     . test+  build-depends:+    , base       >=4.14.2.0 && <4.17 || ^>=4.17+    , directory  ^>=1.3.6.0+    , filepath   ^>=1.4.2.1+    , landlock+    , process    ^>=1.6.9.0+    , temporary  ^>=1.3++  build-tool-depends: markdown-unlit:markdown-unlit+  ghc-options:        -pgmL markdown-unlit++test-suite landlocked-test+  import:             common-settings++  if !flag(landlocked)+    buildable: False++  type:               exitcode-stdio-1.0+  hs-source-dirs:     test+  main-is:            landlocked-test.hs+  build-depends:+    , base         >=4.14.2.0  && <4.17 || ^>=4.17+    , filepath     ^>=1.4.2.1+    , process      ^>=1.6.9.0+    , tasty        ^>=1.4.1+    , tasty-hunit  ^>=0.10.0.3+    , temporary    ^>=1.3++  build-tool-depends: landlock:landlocked

@@ -0,0 +1,263 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}++-- |+-- Module:      System.Landlock+-- Description: Haskell bindings for the Linux kernel Landlock API+-- Copyright:   (c) Nicolas Trangez, 2022+-- License:     BSD-3-Clause+-- Maintainer:  ikke@nicolast.be+-- Stability:   alpha+-- Portability: Linux+--+-- This library exposes Haskell bindings for the Linux kernel Landlock API.+--+-- The Linux kernel Landlock API provides unprivileged access control. The goal+-- of Landlock is to enable to restrict ambient rights (e.g. global filesystem+-- access) for a set of processes. Because Landlock is a stackable LSM, it makes+-- possible to create safe security sandboxes as new security layers in addition+-- to the existing system-wide access-controls. This kind of sandbox is expected+-- to help mitigate the security impact of bugs or unexpected/malicious+-- behaviors in user space applications. Landlock empowers any process,+-- including unprivileged ones, to securely restrict themselves.+--+-- For more information, see the [Landlock homepage](https://landlock.io/) and its+-- [kernel documentation](https://docs.kernel.org/userspace-api/landlock.html).+module System.Landlock+  ( -- * Core API++    --++    -- | Use 'landlock' to sandbox a process.+    -- $example+    landlock,+    RulesetAttr (..),++    -- ** Filesystem Access Flags++    --++    -- | Filesystem access flags to sandbox filesystem access.+    AccessFsFlag (..),+    accessFsFlags,+    accessFsFlagIsReadOnly,++    -- * Sandboxing Rules++    --++    -- | Sandboxing rules to apply.+    Rule,+    pathBeneath,++    -- * Utility Functions++    --++    -- | Various utility functions.+    isSupported,++    -- ** Landlock ABI Version++    --++    -- | Retrieve and handle the kernel's Landlock ABI version.+    abiVersion,+    Version,+    getVersion,+    version1,+    version2,+    version3,++    -- ** Opening paths using @O_PATH@++    --++    -- | When creating a 'pathBeneath' rule, a file descriptor to a directory+    -- or file is needed. These can be safely @open@ed using the @O_PATH@ flag+    -- using the following functions.+    withOpenPath,+    withOpenPathAt,+    OpenPathFlags (..),+    defaultOpenPathFlags,+  )+where++import Control.Exception.Base (handleJust)+import Control.Monad (void)+import Control.Monad.Catch (MonadMask, bracket)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (nullPtr)+import Foreign.Storable (Storable, sizeOf)+import GHC.IO.Exception (IOErrorType (UnsupportedOperation))+import System.IO.Error (ioeGetErrorType)+import System.Landlock.Flags+  ( AccessFsFlag (..),+    AddRuleFlag,+    CreateRulesetFlag (..),+    RestrictSelfFlag,+    accessFsFlagIsReadOnly,+    accessFsFlagToBit,+    accessFsFlags,+    addRuleFlagToBit,+    createRulesetFlagToBit,+    restrictSelfFlagToBit,+    toBits,+  )+import System.Landlock.OpenPath (OpenPathFlags (..), defaultOpenPathFlags, withOpenPath, withOpenPathAt)+import System.Landlock.Rules (Rule, pathBeneath, ruleType)+import System.Landlock.Syscalls+  ( LandlockRulesetAttr (..),+    landlock_add_rule,+    landlock_create_ruleset,+    landlock_restrict_self,+    pR_SET_NO_NEW_PRIVS,+    prctl,+    throwIfNonZero,+  )+import System.Landlock.Version (Version (..), version1, version2, version3)+import System.Posix.IO (closeFd)+import System.Posix.Types (Fd)++-- | Retrieve the Landlock ABI version of the running system.+--+-- __Warning:__ calling this on a system without Landlock support, or with+-- Landlock disabled, will result in an exception.+abiVersion :: IO Version+abiVersion = Version . fromIntegral <$> landlock_create_ruleset nullPtr 0 flags+  where+    flags = toBits createRulesetFlagToBit [CreateRulesetVersion]++-- | Check whether Landlock is supported and enabled on the running system.+isSupported :: IO Bool+isSupported = handleJust unsupportedOperation (\() -> return False) $ do+  void abiVersion+  return True+  where+    unsupportedOperation exc = if isUnsupportedOperationError exc then Just () else Nothing+    isUnsupportedOperationError = isUnsupportedOperationErrorType . ioeGetErrorType+    isUnsupportedOperationErrorType = (== UnsupportedOperation)++-- | Ruleset attributes.+--+-- This represents a @struct landlock_ruleset_attr@ as passed to+-- @landlock_create_ruleset@.++{- HLINT ignore "Use newtype instead of data" -}+data RulesetAttr = RulesetAttr+  { -- | Actions (cf. 'AccessFsFlag') that ought to+    -- be handled by a ruleset and should be+    -- forbidden if no rule explicitly allow them.+    -- This is needed forbackward compatibility+    -- reasons.+    rulesetAttrHandledAccessFs :: [AccessFsFlag]+  }+  deriving (Show, Eq)++-- | Handle to a Landlock ruleset. Use 'addRule' to register new rules.+newtype LandlockFd = LandlockFd {unLandlockFd :: Fd}+  deriving (Show, Eq)++createRuleset :: RulesetAttr -> [CreateRulesetFlag] -> IO LandlockFd+createRuleset attr flags = with attr' $ \attrp -> wrap <$> landlock_create_ruleset attrp (fromIntegral $ sizeOf attr') flags'+  where+    wrap = LandlockFd . fromIntegral+    attr' = LandlockRulesetAttr {landlockRulesetAttrHandledAccessFs = handledAccessFs}+    handledAccessFs = toBits accessFsFlagToBit (rulesetAttrHandledAccessFs attr)+    flags' = toBits createRulesetFlagToBit flags++restrictSelf :: LandlockFd -> [RestrictSelfFlag] -> IO ()+restrictSelf fd flags =+  landlock_restrict_self (fromIntegral $ unLandlockFd fd) flags'+  where+    flags' = toBits restrictSelfFlagToBit flags++-- | Apply a Landlock sandbox to the current process.+--+-- The provided action can be used to register Landlock 'Rule's on the given+-- instance (see 'addRule').+--+-- Once this returns, the Landlock sandbox will be in effect (see+-- @landlock_restrict_self@), and no privileged processes can be spawned+-- (@prctl(PR_SET_NO_NEW_PRIVS, 1, 0, 0, 0)@ has been invoked).+--+-- __Warning:__ calling this on a system without Landlock support, or with+-- Landlock disabled, will result in an exception.+landlock ::+  (MonadMask m, MonadIO m) =>+  -- | Ruleset attribute passed to @landlock_create_ruleset@.+  RulesetAttr ->+  -- | Flags passed to @landlock_create_ruleset@. Since no flags but+  --   'CreateRulesetVersion' (@LANDLOCK_CREATE_RULESET_VERSION@) are+  --   defined, and this flag must not be used when creating an actual+  --   ruleset, this should be an empty list.+  [CreateRulesetFlag] ->+  -- | Flags passed to @landlock_restrict_self@. Since no flags are+  -- defined, this should be an empty list.+  [RestrictSelfFlag] ->+  -- | Action that will be called before the Landlock sandbox is+  -- enforced. The provided function can be used to register+  -- sandboxing rules (internally using @landlock_add_rule@),+  -- given a 'Rule' and a set of 'AddRuleFlag's. However, since no+  -- flags are currently defined, this should be an empty list.+  ((Storable (Rule r) => Rule r -> [AddRuleFlag] -> m ()) -> m a) ->+  -- | Result of the given action.+  m a+landlock attr createRulesetFlags restrictSelfFlags act =+  bracket (liftIO $ createRuleset attr createRulesetFlags) (liftIO . closeFd . unLandlockFd) $ \fd -> do+    res <- act (addRule fd)+    liftIO $ do+      throwIfNonZero "prtcl" $ prctl pR_SET_NO_NEW_PRIVS 1 0 0 0+      restrictSelf fd restrictSelfFlags+    return res++-- | Register a new 'Rule' with a Landlock instance.+addRule ::+  (MonadIO m, Storable (Rule a)) =>+  -- | Handle to a Landlock instance.+  LandlockFd ->+  -- | Sandboxing 'Rule' to register with the Landlock instance.+  Rule a ->+  -- | Flags. Since no flags are defined, this should be an empty+  --   list.+  [AddRuleFlag] ->+  m ()+addRule fd rule flags = liftIO $+  with rule $ \ruleAttrp ->+    landlock_add_rule (fromIntegral $ unLandlockFd fd) (ruleType rule) ruleAttrp flags'+  where+    flags' = toBits addRuleFlagToBit flags++-- $example+--+-- Example usage:+--+-- @+-- -- Retrieve the Landlock ABI version+-- abi <- abiVersion+--+-- -- Calculate access flag sets+-- -- Note: in production code, find the highest matching version or similar+-- let Just flags = lookup abi accessFsFlags+--     readOnlyFlags = filter accessFsFlagIsReadOnly flags+--+-- -- Sandbox the process+-- landlock (RulesetAttr flags) [] [] $ \\addRule -> do+--     -- Allow read-only access to the /usr hierarchy+--     withOpenPath "/usr" defaultOpenPathFlags{ directory = True } $ \\fd ->+--         addRule (pathBeneath fd readOnlyFlags) []+--+--     -- Allow read access to my public key+--     withOpenPath "\/home\/nicolas\/.ssh\/id_ed25519.pub" defaultOpenPathFlags $ \\fd ->+--         addRule (pathBeneath fd [AccessFsReadFile]) []+--+-- withFile "\/home\/nicolas\/.ssh\/id_ed25519.pub" ReadMode (\\fd -> putStrLn \"Success\")+-- -- Success+--+-- withFile "\/usr\/bin\/ghc" ReadMode (\\fd -> putStrLn \"Success\")+-- -- Success+--+-- openFile "\/home\/nicolas\/.ssh\/id_ed25519" ReadMode+-- -- *** Exception: \/home\/nicolas\/.ssh\/id_ed25519: openFile: permission denied (Permission denied)+-- @

@@ -1,249 +0,0 @@-{-# LANGUAGE EmptyCase #-}-{-# LANGUAGE EmptyDataDeriving #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE RankNTypes #-}---- |--- Module:      System.Landlock--- Description: Haskell bindings for the Linux kernel Landlock API--- Copyright:   (c) Nicolas Trangez, 2022--- License:     BSD-3-Clause--- Maintainer:  ikke@nicolast.be--- Stability:   alpha--- Portability: Linux------ This library exposes Haskell bindings for the Linux kernel Landlock API.------ The Linux kernel Landlock API provides unprivileged access control. The goal--- of Landlock is to enable to restrict ambient rights (e.g. global filesystem--- access) for a set of processes. Because Landlock is a stackable LSM, it makes--- possible to create safe security sandboxes as new security layers in addition--- to the existing system-wide access-controls. This kind of sandbox is expected--- to help mitigate the security impact of bugs or unexpected/malicious--- behaviors in user space applications. Landlock empowers any process,--- including unprivileged ones, to securely restrict themselves.------ For more information, see the [Landlock homepage](https://landlock.io/) and its--- [kernel documentation](https://docs.kernel.org/userspace-api/landlock.html).--module System.Landlock (-    -- * Core API-    ---    -- | Use 'landlock' to sandbox a process.-    ---    -- $example-      landlock-    , RulesetAttr(..)-    -- ** Filesystem Access Flags-    ---    -- | Filesystem access flags to sandbox filesystem access.-    , AccessFsFlag(..)-    , accessFsFlags-    , accessFsFlagIsReadOnly-    -- * Sandboxing Rules-    ---    -- | Sandboxing rules to apply.-    , Rule-    , pathBeneath-    -- * Utility Functions-    ---    -- | Various utility functions.-    , isSupported-    -- ** Landlock ABI Version-    ---    -- | Retrieve and handle the kernel's Landlock ABI version.-    , abiVersion-    , Version-    , version1-    -- ** Opening paths using @O_PATH@-    ---    -- | When creating a 'pathBeneath' rule, a file descriptor to a directory-    -- or file is needed. These can be safely @open@ed using the @O_PATH@ flag-    -- using the following functions.-    , withOpenPath-    , withOpenPathAt-    , OpenPathFlags(..)-    , defaultOpenPathFlags-    ) where--#define _GNU_SOURCE--#include <linux/landlock.h>-#include <sys/prctl.h>--import Control.Exception.Base (handleJust)-import Control.Monad (void)-import Control.Monad.Catch (MonadMask, bracket)-import Control.Monad.IO.Class (MonadIO, liftIO)-import GHC.IO.Exception (IOErrorType(UnsupportedOperation))-import Foreign.Marshal.Utils (with)-import Foreign.Ptr (nullPtr)-import Foreign.Storable (Storable, sizeOf)-import System.IO.Error (ioeGetErrorType)-import System.Posix.IO (closeFd)-import System.Posix.Types (Fd)--import System.Landlock.Flags (AccessFsFlag(..), accessFsFlagToBit, accessFsFlags, accessFsFlagIsReadOnly, toBits)-import System.Landlock.OpenPath (OpenPathFlags(..), defaultOpenPathFlags, withOpenPath, withOpenPathAt)-import System.Landlock.Rules (Rule, ruleType, pathBeneath)-import System.Landlock.Syscalls (LandlockRulesetAttr(..), landlock_create_ruleset, landlock_add_rule, landlock_restrict_self, prctl)-import System.Landlock.Version (Version(..), version1)---- | Retrieve the Landlock ABI version of the running system.------ __Warning:__ calling this on a system without Landlock support, or with--- Landlock disabled, will result in an exception.-abiVersion :: IO Version-abiVersion = Version <$> landlock_create_ruleset nullPtr 0 #{const LANDLOCK_CREATE_RULESET_VERSION}---- | Check whether Landlock is supported and enabled on the running system.-isSupported :: IO Bool-isSupported = handleJust unsupportedOperation (\() -> return False) $ do-    void abiVersion-    return True-  where-    unsupportedOperation exc = if isUnsupportedOperationError exc then Just () else Nothing-    isUnsupportedOperationError = isUnsupportedOperationErrorType . ioeGetErrorType-    isUnsupportedOperationErrorType = (== UnsupportedOperation)---- | Ruleset attributes.------ This represents a @struct landlock_ruleset_attr@ as passed to--- @landlock_create_ruleset@.-data RulesetAttr = RulesetAttr { rulesetAttrHandledAccessFs :: [AccessFsFlag]-                                 -- ^ Actions (cf. 'AccessFsFlag') that ought to-                                 -- be handled by a ruleset and should be-                                 -- forbidden if no rule explicitly allow them.-                                 -- This is needed forbackward compatibility-                                 -- reasons.-                               }-  deriving (Show, Eq)---- | Flags passed to @landlock_create_ruleset@.------ In the current kernel API, only @LANDLOCK_CREATE_RULESET_VERSION@ is--- defined, which should not be used when creating an actual Landlock--- encironment (cf. 'landlock').-data CreateRulesetFlag = CreateRulesetVersion-  deriving (Show, Eq, Enum, Bounded)---- | Handle to a Landlock ruleset. Use 'addRule' to register new rules.-newtype LandlockFd = LandlockFd { unLandlockFd :: Fd }-  deriving (Show, Eq)--createRuleset :: RulesetAttr -> [CreateRulesetFlag] -> IO LandlockFd-createRuleset attr flags = with attr' $ \attrp -> wrap <$> landlock_create_ruleset attrp (fromIntegral $ sizeOf attr') flags'-  where-    wrap = LandlockFd . fromIntegral-    attr' = LandlockRulesetAttr { landlockRulesetAttrHandledAccessFs = handledAccessFs }-    handledAccessFs = toBits (rulesetAttrHandledAccessFs attr) accessFsFlagToBit-    flags' = toBits flags $ \case-       CreateRulesetVersion -> #{const LANDLOCK_CREATE_RULESET_VERSION}---- | Flags passed to @landlock_restrict_self@.------ In the current kernel API, no such flags are defined, hence this is a type--- without any constructors.-data RestrictSelfFlag-  deriving (Show, Eq)--restrictSelf :: LandlockFd -> [RestrictSelfFlag] -> IO ()-restrictSelf fd flags =-    void $ landlock_restrict_self (fromIntegral $ unLandlockFd fd) flags'-  where-    flags' = toBits flags $ \case {}---- | Apply a Landlock sandbox to the current process.------ The provided action can be used to register Landlock 'Rule's on the given--- instance (see 'addRule').------ Once this returns, the Landlock sandbox will be in effect (see--- @landlock_restrict_self@), and no privileged processes can be spawned--- (@prctl(PR_SET_NO_NEW_PRIVS, 1, 0, 0, 0)@ has been invoked).------ __Warning:__ calling this on a system without Landlock support, or with--- Landlock disabled, will result in an exception.-landlock :: (MonadMask m, MonadIO m)-         => RulesetAttr-            -- ^ Ruleset attribute passed to @landlock_create_ruleset@.-         -> [CreateRulesetFlag]-            -- ^ Flags passed to @landlock_create_ruleset@. Since no flags but-            --   'CreateRulesetVersion' (@LANDLOCK_CREATE_RULESET_VERSION@) are-            --   defined, and this flag must not be used when creating an actual-            --   ruleset, this should be an empty list.-         -> [RestrictSelfFlag]-            -- ^ Flags passed to @landlock_restrict_self@. Since no flags are-            -- defined, this should be an empty list.-         -> ((Storable (Rule r) => Rule r -> [AddRuleFlag] -> m ()) -> m a)-            -- ^ Action that will be called before the Landlock sandbox is-            -- enforced. The provided function can be used to register-            -- sandboxing rules (internally using @landlock_add_rule@),-            -- given a 'Rule' and a set of 'AddRuleFlag's. However, since no-            -- flags are currently defined, this should be an empty list.-         -> m a-            -- ^ Result of the given action.-landlock attr createRulesetFlags restrictSelfFlags act =-    bracket (liftIO $ createRuleset attr createRulesetFlags) (liftIO . closeFd . unLandlockFd) $ \fd -> do-        res <- act (addRule fd)-        liftIO $ do-            void $ prctl #{const PR_SET_NO_NEW_PRIVS} 1 0 0 0-            restrictSelf fd restrictSelfFlags-        return res---- | Flags passed to @landlock_add_rule@.------ In the current kernel API, no such flags are defined, hence this is a type--- without any constructors.-data AddRuleFlag-  deriving (Show, Eq)---- | Register a new 'Rule' with a Landlock instance.-addRule :: (MonadIO m, Storable (Rule a))-        => LandlockFd-           -- ^ Handle to a Landlock instance.-        -> Rule a-           -- ^ Sandboxing 'Rule' to register with the Landlock instance.-        -> [AddRuleFlag]-           -- ^ Flags. Since no flags are defined, this should be an empty-           --   list.-        -> m ()-addRule fd rule flags = liftIO $ with rule $ \ruleAttrp ->-    void $ landlock_add_rule (fromIntegral $ unLandlockFd fd) (ruleType rule) ruleAttrp flags'-  where-    flags' = toBits flags $ \case {}---- |--- $example------ Example usage:------ @--- -- Retrieve the Landlock ABI version--- abi <- abiVersion------ -- Calculate access flag sets--- -- Note: in production code, find the highest matching version or similar--- let Just flags = lookup abi accessFsFlags---     readOnlyFlags = filter accessFsFlagIsReadOnly flags------ -- Sandbox the process--- landlock (RulesetAttr flags) [] [] $ \\addRule -> do---     -- Allow read-only access to the /usr hierarchy---     withOpenPath "/usr" defaultOpenPathFlags{ directory = True } $ \\fd ->---         addRule (pathBeneath fd readOnlyFlags) []------     -- Allow read access to my public key---     withOpenPath "\/home\/nicolas\/.ssh\/id_ed25519.pub" defaultOpenPathFlags $ \\fd ->---         addRule (pathBeneath fd [AccessFsReadFile]) []------ withFile "\/home\/nicolas\/.ssh\/id_ed25519.pub" ReadMode (\\fd -> putStrLn \"Success\")--- -- Success------ withFile "\/usr\/bin\/ghc" ReadMode (\\fd -> putStrLn \"Success\")--- -- Success------ openFile "\/home\/nicolas\/.ssh\/id_ed25519" ReadMode--- -- *** Exception: \/home\/nicolas\/.ssh\/id_ed25519: openFile: permission denied (Permission denied)--- @

@@ -0,0 +1,53 @@+module ReadmeUtils+  ( withFakeRoot,+    -- Control.Exception.Base+    handleJust,+    -- Control.Monad+    unless,+    -- System.Directory+    removeFile,+    -- System.FilePath+    (</>),+    -- System.IO+    IOMode (..),+    hPutStrLn,+    withFile,+    writeFile,+    -- System.IO.Error+    isPermissionError,+    -- System.Process+    readProcess,+  )+where++import Control.Exception.Base (handleJust)+import Control.Monad (unless)+import System.Directory (createDirectory, removeFile)+import System.FilePath ((</>))+import System.IO (IOMode (..), hPutStrLn, withFile)+import System.IO.Error (isPermissionError)+import System.IO.Temp (withSystemTempDirectory)+import System.Process (readProcess)++withFakeRoot :: (FilePath -> IO a) -> IO a+withFakeRoot fn = withSystemTempDirectory "landlock-readme" $ \tmp -> do+  let homeDir = tmp </> "home"+      userDir = homeDir </> "user"+      sshDir = userDir </> ".ssh"+      tmpDir = tmp </> "tmp"++  mapM_+    createDirectory+    [ homeDir,+      userDir,+      sshDir,+      tmpDir+    ]++  let privateKey = sshDir </> "id_ed25519"+      publicKey = sshDir </> "id_ed25519.pub"++  writeFile privateKey "private"+  writeFile publicKey "public"++  fn tmp

@@ -1,68 +1,68 @@+{-# LANGUAGE CApiFFI #-}+ module ThreadedScenario (scenario) where  import Control.Concurrent.Async (Async, wait)-import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) import Control.Exception.Base (handleJust)-import System.IO (IOMode(ReadMode), withFile)+import System.IO (IOMode (ReadMode), withFile) import System.IO.Error (isPermissionError)-import System.Posix.Types (CPid(..))-+import System.Landlock (AccessFsFlag (..), RulesetAttr (..), landlock)+import System.Posix.Types (CPid (..)) import Test.Tasty (TestTree) import Test.Tasty.HUnit (assertFailure, testCaseSteps) -import System.Landlock (AccessFsFlag(..), RulesetAttr(..), landlock)--foreign import ccall unsafe "unistd.h gettid"-    gettid :: IO CPid+foreign import capi unsafe "unistd.h gettid"+  gettid :: IO CPid  scenario :: (IO () -> (Async () -> IO ()) -> IO ()) -> TestTree scenario fn = testCaseSteps "Multithreaded Scenario" (scenario' fn)  scenario' :: (IO () -> (Async () -> IO ()) -> IO ()) -> (String -> IO ()) -> IO () scenario' withAsync step = do-    step "Starting scenario"--    mainTid <- gettid-    step $ "Main TID = " ++ show mainTid+  step "Starting scenario" -    tidMVar <- newEmptyMVar-    continueMVar <- newEmptyMVar+  mainTid <- gettid+  step $ "Main TID = " ++ show mainTid -    step "Launching thread"-    withAsync (thread tidMVar continueMVar) $ \child -> do-        _ <- takeMVar tidMVar+  tidMVar <- newEmptyMVar+  continueMVar <- newEmptyMVar -        step "Setting up Landlock sandbox"-        let flags = [AccessFsReadFile]-        landlock (RulesetAttr flags) [] [] $ \_ -> return ()+  step "Launching thread"+  withAsync (thread tidMVar continueMVar) $ \child -> do+    _ <- takeMVar tidMVar -        step "Assert file not readable from main thread"-        assertFileNotReadable "main"-        step "Success"+    step "Setting up Landlock sandbox"+    let flags = [AccessFsReadFile]+    landlock (RulesetAttr flags) [] [] $ \_ -> return () -        step "Letting thread continue"-        putMVar continueMVar ()+    step "Assert file not readable from main thread"+    assertFileNotReadable "main"+    step "Success" -        step "Waiting for thread to exit"-        wait child+    step "Letting thread continue"+    putMVar continueMVar () +    step "Waiting for thread to exit"+    wait child   where     thread tidMVar continueMVar = do-        step "Running in thread"+      step "Running in thread" -        tid <- gettid-        step $ "Thread TID = " ++ show tid-        putMVar tidMVar tid+      tid <- gettid+      step $ "Thread TID = " ++ show tid+      putMVar tidMVar tid -        step "Waiting for the signal..."-        () <- takeMVar continueMVar-        step "Received signal, continuing"+      step "Waiting for the signal..."+      () <- takeMVar continueMVar+      step "Received signal, continuing" -        step "Assert file not readable from thread"-        assertFileNotReadable "thread"-        step "Success"+      step "Assert file not readable from thread"+      assertFileNotReadable "thread"+      step "Success"      file = "/etc/resolv.conf"-    assertFileNotReadable env = handleJust permissionError return $ withFile file ReadMode $ \_ ->+    assertFileNotReadable env = handleJust permissionError return $+      withFile file ReadMode $ \_ ->         assertFailure $ "Still able to open file " ++ file ++ " in " ++ env     permissionError exc = if isPermissionError exc then Just () else Nothing

@@ -1,20 +1,13 @@ module Main (main) where  import Control.Concurrent.Async (withAsyncBound)- import Test.Tasty (defaultMain, testGroup)-import Test.Tasty.ExpectedFailure (expectFailBecause)--import System.Landlock (isSupported)- import ThreadedScenario (scenario)  main :: IO () main = do-    supported <- isSupported-    let scenario' = scenario withAsyncBound-    defaultMain $ testGroup "Threaded" [-          if supported-            then scenario'-            else expectFailBecause "Landlock not supported" scenario'-        ]+  defaultMain $+    testGroup+      "Threaded"+      [ scenario withAsyncBound+      ]

@@ -1,9 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}- {-# OPTIONS_GHC -Wno-orphans #-}  module Main (main) where@@ -11,28 +9,49 @@ import Control.Concurrent.Async (withAsync) import Control.Exception.Base (handleJust) import Control.Monad (unless)-import Data.List (nub, sort)-import Data.Proxy (Proxy(Proxy))-import Foreign.Marshal.Alloc (alloca)-import Foreign.Storable (Storable, peek, poke)+import Data.List (nub, sort, (\\))+import Data.Proxy (Proxy (Proxy)) import System.Environment (lookupEnv)-import System.Exit (ExitCode(..))+import System.Exit (ExitCode (..)) import System.FilePath ((</>))-import System.IO (IOMode(..), withFile)+import System.IO (IOMode (..), withFile) import System.IO.Error (isPermissionError)+import System.Landlock+  ( AccessFsFlag (..),+    OpenPathFlags (..),+    RulesetAttr (..),+    abiVersion,+    accessFsFlags,+    defaultOpenPathFlags,+    isSupported,+    landlock,+    version1,+    version2,+    version3,+    withOpenPath,+  )+import System.Landlock.Flags+  ( CreateRulesetFlag,+    accessFsFlagToBit,+    createRulesetFlagToBit,+  )+import System.Landlock.Rules (Rule, RuleType (..), pathBeneath)+import System.Landlock.Syscalls (LandlockRulesetAttr (..))+import System.Landlock.Version (Version (..)) import System.Posix.Types (Fd)-import System.Process (CreateProcess(..), proc, readCreateProcessWithExitCode)--import Test.QuickCheck.Monadic (assert, monadicIO, run)+import System.Process (CreateProcess (..), proc, readCreateProcessWithExitCode)+import Test.QuickCheck ((=/=), (===))+import Test.QuickCheck.Classes.Base+  ( Laws (..),+    boundedEnumLaws,+    eqLaws,+    ordLaws,+    showLaws,+    storableLaws,+  ) import Test.Tasty (TestTree, defaultMain, testGroup)-import Test.Tasty.ExpectedFailure (expectFailBecause)-import Test.Tasty.HUnit ((@?), (@=?), (@?=), testCase, testCaseSteps)-import Test.Tasty.QuickCheck as QC--import System.Landlock (AccessFsFlag(..), RulesetAttr(..), OpenPathFlags(..), abiVersion, accessFsFlags, defaultOpenPathFlags, isSupported, landlock, version1, withOpenPath)-import System.Landlock.Rules (Rule, RuleType(..), pathBeneath)-import System.Landlock.Syscalls (LandlockRulesetAttr(..))-+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, testCaseSteps, (@=?), (@?), (@?=))+import Test.Tasty.QuickCheck (Arbitrary (..), arbitraryBoundedEnum, testProperty) import ThreadedScenario (scenario)  -- This test-suite is a bit "weird". We want to test various privilege-related@@ -54,106 +73,210 @@ landlockTestEnvironmentVariable = "LANDLOCK_TEST"  main :: IO ()-main = lookupEnv "LANDLOCK_TEST" >>= \case+main =+  lookupEnv "LANDLOCK_TEST" >>= \case     Nothing -> do-        hasLandlock <- isSupported-        defaultMain (tests hasLandlock)+      defaultMain tests     Just testName -> case lookup testName functionalTestCases of-        Nothing -> fail $ "Unknown test: " ++ testName-        Just act -> act+      Nothing -> fail $ "Unknown test: " ++ testName+      Just act -> act -tests :: Bool -> TestTree-tests hasLandlock = testGroup "Tests" [-      properties-    , (if hasLandlock then id else expectFailBecause "Landlock not supported") functionalTests-    , (if hasLandlock then id else expectFailBecause "Landlock not supported") (scenario withAsync)+tests :: TestTree+tests =+  testGroup+    "Tests"+    [ properties,+      unitTests,+      functionalTests,+      scenario withAsync     ]  properties :: TestTree-properties = testGroup "Properties" [-      storable "LandlockRulesetAttr" (Proxy @LandlockRulesetAttr)-    , storable "Rule 'PathBeneath" (Proxy @(Rule 'PathBeneath))+properties =+  testGroup+    "Properties"+    [ testGroup "LandlockRulesetAttr" $+        map+          lawsToTestTree+          [ eqLaws (Proxy @LandlockRulesetAttr),+            showLaws (Proxy @LandlockRulesetAttr),+            storableLaws (Proxy @LandlockRulesetAttr)+          ],+      testGroup "RulesetAttr" $+        map+          lawsToTestTree+          [ eqLaws (Proxy @RulesetAttr),+            showLaws (Proxy @RulesetAttr)+          ],+      testGroup "CreateRulesetFlag" $+        map+          lawsToTestTree+          [ eqLaws (Proxy @CreateRulesetFlag),+            showLaws (Proxy @CreateRulesetFlag)+            -- boundedEnum laws don't work nicely with single-constructor enums+            -- , boundedEnumLaws (Proxy @CreateRulesetFlag)+          ],+      testGroup "AccessFsFlag" $+        map+          lawsToTestTree+          [ eqLaws (Proxy @AccessFsFlag),+            showLaws (Proxy @AccessFsFlag),+            boundedEnumLaws (Proxy @AccessFsFlag),+            ordLaws (Proxy @AccessFsFlag)+          ],+      testGroup "OpenPathFlags" $+        map+          lawsToTestTree+          [ eqLaws (Proxy @OpenPathFlags),+            showLaws (Proxy @OpenPathFlags)+          ],+      testGroup "Rule 'PathBeneath" $+        map+          lawsToTestTree+          [ eqLaws (Proxy @(Rule 'PathBeneath)),+            showLaws (Proxy @(Rule 'PathBeneath)),+            storableLaws (Proxy @(Rule 'PathBeneath))+          ],+      testGroup "Version" $+        map+          lawsToTestTree+          [ eqLaws (Proxy @Version),+            showLaws (Proxy @Version),+            ordLaws (Proxy @Version)+          ],+      testProperty "accessFsFlagToBit is different for different flags" $+        mapEq accessFsFlagToBit,+      testProperty "createRulesetFlagToBit is different for different flags" $+        mapEq createRulesetFlagToBit     ]+  where+    lawsToTestTree laws = testGroup (lawsTypeclass laws) $ flip map (lawsProperties laws) $ uncurry testProperty+    mapEq fn a b =+      let cmp = if a == b then (===) else (=/=)+       in fn a `cmp` fn b -storable :: forall proxy a. (Eq a, Show a, Arbitrary a, Storable a) => String -> proxy a -> TestTree-storable name _ = testGroup ("Storable for " ++ name) [-      QC.testProperty "peek . poke == id" $-          \a -> monadicIO $ do-              a' <- run $ alloca $ \ptr -> do-                  poke ptr (a :: a)-                  peek ptr-              assert $ a' == a-    ]+instance Arbitrary Version where+  arbitrary = Version <$> arbitrary +instance Arbitrary OpenPathFlags where+  arbitrary = OpenPathFlags <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary RulesetAttr where+  arbitrary = RulesetAttr <$> arbitrary++instance Arbitrary CreateRulesetFlag where+  arbitrary = arbitraryBoundedEnum+ instance Arbitrary LandlockRulesetAttr where-    arbitrary = LandlockRulesetAttr <$> arbitrary+  arbitrary = LandlockRulesetAttr <$> arbitrary  instance Arbitrary (Rule 'PathBeneath) where-    arbitrary = pathBeneath <$> fmap (fromIntegral :: Int -> Fd) arbitrary-                            <*> fmap (nub . sort) arbitrary+  arbitrary =+    pathBeneath+      <$> fmap (fromIntegral :: Int -> Fd) arbitrary+      <*> fmap (nub . sort) arbitrary  instance Arbitrary AccessFsFlag where-    arbitrary = arbitraryBoundedEnum+  arbitrary = arbitraryBoundedEnum +unitTests :: TestTree+unitTests =+  testGroup+    "Unit Tests"+    [ testCase "lookup version1 accessFsFlags" $+        lookup version1 accessFsFlags @?= Just [AccessFsExecute .. AccessFsMakeSym],+      testCase "lookup version2 accessFsFlags" $+        lookup version2 accessFsFlags @?= Just [AccessFsExecute .. AccessFsRefer],+      testCase "lookup version3 accessFsFlags" $+        lookup version3 accessFsFlags @?= Just [AccessFsExecute .. AccessFsTruncate],+      testCase "ABI v2 introduced [AccessFsRefer]" $+        (\\)+          <$> lookup version2 accessFsFlags+          <*> lookup version1 accessFsFlags+          @?= Just [AccessFsRefer],+      testCase "ABI v3 introduced [AccessFsTruncate]" $+        (\\)+          <$> lookup version3 accessFsFlags+          <*> lookup version2 accessFsFlags+          @?= Just [AccessFsTruncate],+      testCase "accessFsFlagToBit is unique for all AccessFsFlags" $+        length (nub (sort (map accessFsFlagToBit [minBound .. maxBound])))+          @?= length [minBound :: AccessFsFlag .. maxBound],+      testCase "createRulesetFlagToBit is unique for all CreateRulesetFlags" $+        length (nub (sort (map createRulesetFlagToBit [minBound .. maxBound])))+          @?= length [minBound :: CreateRulesetFlag .. maxBound]+    ]  functionalTests :: TestTree-functionalTests = testGroup "Functional Tests" $ [-      testCase "abiVersion >= 1" $ do-          v <- abiVersion-          v >= version1 @? "Unexpected version"-    , testCase "abiVersion is idempotent" $ do-          v1 <- abiVersion-          v2 <- abiVersion-          v1 @=? v2-    ] ++ map (\(name, _) -> testCaseSteps name (`runFunctionalTest` name)) functionalTestCases+functionalTests =+  testGroup "Functional Tests" $+    [ testCase "abiVersion >= 1" $ do+        v <- abiVersion+        v >= version1 @? "Unexpected version",+      testCase "abiVersion is idempotent" $ do+        v1 <- abiVersion+        v2 <- abiVersion+        v1 @=? v2,+      testCase "isSupported" $+        isSupported >>= assertBool "landlock API not supported"+    ]+      ++ map (\(name, _) -> testCaseSteps name (`runFunctionalTest` name)) functionalTestCases   where     runFunctionalTest step name = do-        step "Running test subprocess"-        (rc, stdout, stderr) <- readCreateProcessWithExitCode (mkCreateProcess name) ""-        step $ "Test subprocess exited with " ++ show rc-        unless (null stdout) $-            step $ "Test subprocess stdout:\n" ++ stdout-        unless (null stderr) $-            step $ "Test subprocess stderr:\n" ++ stderr-        rc @?= ExitSuccess+      step "Running test subprocess"+      (rc, stdout, stderr) <- readCreateProcessWithExitCode (mkCreateProcess name) ""+      step $ "Test subprocess exited with " ++ show rc+      unless (null stdout) $+        step $+          "Test subprocess stdout:\n" ++ stdout+      unless (null stderr) $+        step $+          "Test subprocess stderr:\n" ++ stderr+      rc @?= ExitSuccess -    mkCreateProcess name = (proc "/proc/self/exe" []) { env = Just [(landlockTestEnvironmentVariable, name)]-                                                      , close_fds = True-                                                      }+    mkCreateProcess name =+      (proc "/proc/self/exe" [])+        { env = Just [(landlockTestEnvironmentVariable, name)],+          close_fds = True+        }  functionalTestCases :: [(String, IO ())]-functionalTestCases = [-      ("All v1 restrictions in sandbox", testAllV1Restrictions)-    , ("Restrict read, except for /etc", testRestrictReadExceptEtc)-    ]+functionalTestCases =+  [ ("All v1 restrictions in sandbox", testAllV1Restrictions),+    ("Restrict read, except for /etc", testRestrictReadExceptEtc)+  ]  testAllV1Restrictions :: IO () testAllV1Restrictions = do-    let fn = "/etc/resolv.conf"-        try act = withFile fn ReadMode act+  let fn = "/etc/resolv.conf"+      try act = withFile fn ReadMode act -    -- First, try to open as-is-    try (\_ -> return ())+  -- First, try to open as-is+  try (\_ -> return ()) -    -- Then, sandbox and try again-    let Just v1Restrictions = lookup version1 accessFsFlags-    landlock (RulesetAttr v1Restrictions) [] [] $ \_ -> return ()-    catchPermissionDenied $ try $ \_ -> fail $ "Still able to open " ++ fn+  -- Then, sandbox and try again+  v1Restrictions <- case lookup version1 accessFsFlags of+    Nothing -> assertFailure $ "Unknown ABI version: " ++ show version1+    Just r -> return r+  landlock (RulesetAttr v1Restrictions) [] [] $ \_ -> return ()+  catchPermissionDenied $ try $ \_ -> fail $ "Still able to open " ++ fn  testRestrictReadExceptEtc :: IO () testRestrictReadExceptEtc = do-    let dir = "/etc"-        file = dir </> "passwd"-        act = withFile file ReadMode $ \_ -> return ()-        Just v1Restrictions = lookup version1 accessFsFlags+  let dir = "/etc"+      file = dir </> "passwd"+      act = withFile file ReadMode $ \_ -> return ()+  v1Restrictions <- case lookup version1 accessFsFlags of+    Nothing -> assertFailure $ "Unknown ABI version: " ++ show version1+    Just r -> return r -    act+  act -    landlock (RulesetAttr v1Restrictions) [] [] $ \addRule -> do-        withOpenPath dir defaultOpenPathFlags { directory = True } $ \fd -> do-            addRule (pathBeneath fd [AccessFsReadFile, AccessFsReadDir, AccessFsExecute]) []+  landlock (RulesetAttr v1Restrictions) [] [] $ \addRule -> do+    withOpenPath dir defaultOpenPathFlags {directory = True} $ \fd -> do+      addRule (pathBeneath fd [AccessFsReadFile, AccessFsReadDir, AccessFsExecute]) [] -    act+  act  catchPermissionDenied :: IO () -> IO () catchPermissionDenied = handleJust (\exc -> if isPermissionError exc then Just () else Nothing) return

@@ -0,0 +1,60 @@+module Main (main) where++import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Process (readProcessWithExitCode)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (assertFailure, testCase, (@?=))++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests =+  testGroup+    "landlocked"+    [ testCase "landlocked" $ do+        rc <- landlocked []+        case rc of+          ExitSuccess -> assertFailure "Unexpected success"+          ExitFailure _ -> return (),+      testCase "landlocked true" $ do+        rc <- landlocked ["true"]+        rc @?= ExitFailure 126,+      testCase "landlocked nosuchexecutablereally" $ do+        rc <- landlocked ["nosuchexecutablereally"]+        rc @?= ExitFailure 127,+      testCase "landlocked --ro /usr /usr/bin/true" $ do+        rc <- landlocked ["--ro", "/usr", "/usr/bin/true"]+        rc @?= ExitSuccess,+      testCase "landlocked --ro /usr true" $ do+        rc <- landlocked ["--ro", "/usr", "true"]+        rc @?= ExitSuccess,+      testCase "landlocked --ro /usr /usr/bin/false" $ do+        rc <- landlocked ["--ro", "/usr", "/usr/bin/false"]+        rc @?= ExitFailure 1,+      testCase "landlocked --ro /usr /usr/bin/touch TEMP_PATH/test" $+        withSystemTempDirectory "landlocked-test" $ \tmp -> do+          rc <- landlocked ["--ro", "/usr", "/usr/bin/touch", tmp </> "test"]+          rc @?= ExitFailure 1,+      testCase "landlocked --ro /usr --rw TEMP_PATH /usr/bin/touch TEMP_PATH/test" $+        withSystemTempDirectory "landlocked-test" $ \tmp -> do+          rc <- landlocked ["--ro", "/usr", "--rw", tmp, "/usr/bin/touch", tmp </> "test"]+          rc @?= ExitSuccess,+      testCase "landlocked --ro /usr --ro TEMP_PATH /usr/bin/touch TEMP_PATH/test" $+        withSystemTempDirectory "landlocked-test" $ \tmp -> do+          rc <- landlocked ["--ro", "/usr", "--ro", tmp, "/usr/bin/touch", tmp </> "test"]+          rc @?= ExitFailure 1,+      testCase "landlocked --version" $ do+        rc <- landlocked ["--version"]+        rc @?= ExitSuccess,+      testCase "landlocked --help" $ do+        rc <- landlocked ["--help"]+        rc @?= ExitSuccess+    ]++landlocked :: [String] -> IO ExitCode+landlocked args = do+  (rc, _, _) <- readProcessWithExitCode "landlocked" args ""+  return rc