Plegg.hs

{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE CPP #-}

-- | Module    : System.OpenBSD.Plegg
-- Description : High-level interface for pledge(2)
-- Copyright   : (c) Varik Valefor, 2026
-- License     : Unlicense
-- Maintainer  : varikvalefor@aol.com
-- Stability   : experimental
-- Portability : portable
--
-- = la .lojban.
--
-- ni'o le me'oi .module. cu vasru le mu'oi glibau. high-level .glibau.
-- poi ke'a jai filri'a lo nu lo te gerna be la'oi .Haskell. cu jai
-- rinka tu'a vu'oi la'o zoi. pledge(2) .zoi. ju'e la'o zoi. unveil(2) .zoi.
-- vu'o pe la'oi .OpenBSD.
--
-- = English
--
-- This module contains high-level interfaces for OpenBSD's @pledge(2)@
-- and @unveil(2)@.
module System.OpenBSD.Plegg where
import Data.Char (toLower);
import Control.Monad (liftM2, (<=<));
#ifdef openbsd_HOST_OS
  import Foreign.Ptr (nullPtr);
  import Foreign.C.Error (throwErrnoIfMinus1_);
  import Foreign.C.String (CString, withCString);

  foreign import capi "unistd.h pledge" pledge :: CString -> CString -> IO Int;
  foreign import capi "unistd.h unveil" unveil :: CString -> CString -> IO Int;
#endif

-- | = la .lojban.
--
-- ni'o la'o zoi. @plegg k@ .zoi. panra la'o zoi.
-- @pledge(k, null)@ .zoi. pe la'oi .C.  .i ku'i drata ki'u zo'e joi
-- tu'a le se ctaipe be lo me'oi .'Promise'. pe la'oi .@plegg@.
--
-- .i lo me'oi .'Promise'. poi ke'a selru'e la'oi .@plegg@. cu binxo
-- pe'a lo se tcidu poi ke'a selru'e la'o gy. @pledge(2)@ .gy.
--
-- = English
--
-- @plegg k@ is roughly equivalent to C's "@pledge(k, null)@".
-- However, unlike the standard @pledge(2)@, @plegg@'s 'Promise's are
-- typed.
--
-- 'Promise's which are passed to @plegg@ are converted into text
-- which is passed to @pledge(2)@.
plegg :: [Promise]
      -- ^ = la .lojban.
      --
      -- zo'e poi cadga fa lo nu me'oi .enforce. tu'a ke'a
      --
      -- = English
      --
      -- The pledges which should be used
      -> IO ();

-- | = la .lojban.
--
-- ni'o la'oi .@univac@. korbipe la'oi .Haskell. ce ko'a goi la'o gy.
-- @unveil(2)@ .gy.
--
-- .i ro da poi ke'a .orsi li re je cu selvau pe'a la'oi .@g@. zo'u
-- la'o zoi. @univac g@ .zoi. jai rinka tu'a lo me ko'a
-- be lo te .orsi be da be'o bei lo ve .orsi be da
--
-- .i la'o zoi. @univac [("", "")]@ .zoi. mapti la'o zoi.
-- @unveil(NULL, NULL)@ .zoi. pe la'oi .C.
--
-- .i la .varik. cu jinvi le du'u le velcki be
-- la'o zoi. @unveil(2)@ .gy. cu jai filri'a lo nu jimpe
--
-- = English
--
-- @univac@ is a high-level interface for @unveil(2)@.
--
-- For all @(a,b)@ in @g@, @univac g@ runs C's @unveil(a, b)@.
--
-- @univac [("", "")]@ is equivalent to C's @unveil(NULL, NULL)@.
--
-- @unveil(2)@'s manual page documents the specifics of this thing
-- pretty well.
univac :: [(FilePath, String)]
       -- ^ = la .lojban.
       --
       -- [(le me'oi .filepath. poi ke'a goi ko'a zo'u cadga fa lo nu
       -- me'oi .expose. ko'a, lo torveki be lo jai se curmi... be'o
       -- noi ke'a mapti lo me'oi .@permissions@. co'e pe la'o gy.
       -- @unveil(2)@ .gy.)]
       --
       -- = English
       --
       -- [(PATH WHICH SHOULD BE EXPOSED, PERMISSIONS)]
       -> IO ();

#ifdef openbsd_HOST_OS
  plegg k = throwErrnoIfMinus1_ "pledge" $
            withCString (promises k) $ \premises ->
            withCString "" $ \execpremises ->
            pledge premises execpremises;

  -- | = la .lojban.
  --
  -- ni'o ko'a goi la'o zoi. @promises k@ .zoi. liste lo
  -- me'oi .promise. pe la'oi @k@.  .i cumki fa lo nu ko'a selru'e la'o
  -- gy. @pledge(2)@ .gy.
  --
  -- = English
  --
  -- @promises k@ is a @pledge(2)@-suitable list of the promises
  -- which are specified by @k@.
  promises :: [Promise] -> String;
  promises = map toLower . unwords . map show;

  univac = mapM_ expose
    where
    expose = teim1_ "unveil" . uncurry unveil <=< toCStrings
    teim1_ = throwErrnoIfMinus1_
    toCStrings ("","") = pure (nullPtr, nullPtr)
    toCStrings x = (uncurry (liftM2 (,)) . both (`withCString` pure)) x
    both f (a, b) = (f a, f b);
#else
  plegg _ = return ();

  univac _ = return ();
#endif

-- | = la .lojban.
--
-- ni'o ro da poi ke'a ctaipe la'oi .'Promise'. zo'u ga je cumki fa lo
-- nu da selru'e la'oi .plegg. gi da mapti lo co'e be lo me'oi .lowercase.
-- versiio be lo cmene be da be'o pe la'o gy. pledge(2) .gy.  .i la .varik.
-- cu jinvi le du'u le velcki be tu'a la'o gy. pledge(2) .gy. cu jai filri'a
-- lo nu jimpe
--
-- = English
--
-- For all 'Promise' @k@, @k@ is a 'Promise' which can be passed to
-- 'plegg'.  Each 'Promise' is best documented by the documentation of
-- @pledge(2)@.
data Promise = Stdio
             | RPath
             | WPath
             | CPath
             | DPath
             | TmpPath
             | INet
             | MCast
             | FAttr
             | Chown
             | Flock
             | Unix
             | Dns
             | GetPW
             | SendFD
             | RecvFD
             | Tape
             | TTY
             | Proc
             | Exec
             | Prot_Exec
             | Settime
             | Ps
             | VMInfo
             | Id
             | Pf
             | Route
             | WRoute
             | Audio
             | Video
             | Bpf
             | Unveil
             | Error
             deriving Show;