diff --git a/plegg.cabal b/plegg.cabal new file mode 100644 --- /dev/null +++ b/plegg.cabal @@ -0,0 +1,21 @@ +cabal-version: 2.4 +name: plegg +version: 0.2.1.1 +synopsis: A semi-cross-platform interface for pledge(2) and unveil(2) +description: plegg offers a simple Haskell interface for OpenBSD's + pledge(2) and unveil(2). A useless but non-crashing + thing is the result of compiling (on a non-OpenBSD + operating system) the interface. +bug-reports: https://github.com/varikvalefor/plegg/issues +license: Unlicense +author: Varik Valefor +maintainer: varikvalefor@aol.com +copyright: (c) Varik Valefor 2023. No rights reserved. +category: System + +library + exposed-modules: System.OpenBSD.Plegg + build-depends: + base >= 4.14.1.0 && < 4.17 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/System/OpenBSD/Plegg.hs b/src/System/OpenBSD/Plegg.hs new file mode 100644 --- /dev/null +++ b/src/System/OpenBSD/Plegg.hs @@ -0,0 +1,236 @@ +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE CPP #-} + +-- | Module : System.OpenBSD.Plegg +-- Description : High-level interface for pledge(2) +-- Copyright : (c) Varik Valefor, 2021 +-- 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 tu'a ke'a filri'a lo nu pilno la'oi .Haskell. 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; +import Control.Monad; + +#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; + + + -- | = la .lojban. + -- + -- ni'o la'o zoi. @plegg k@ .zoi. na ru'e dunli la'o zoi. + -- @pledge(k, null)@ pe la'oi .C. .i ku'i drata ki'u le nu le me'oi + -- .'Promise'. pe la'oi .@plegg@. cu se me'oi .type. + -- + -- .i lo me'oi .'Promise'. poi selru'e la'oi .@plegg@. cu binxo lo + -- selci'a poi selru'e la'o gy. @pledge(2)@ .gy. + -- + -- = English + -- + -- @plegg k@ is roughly equivalent to C's "@pledge(k, nulll)@". + -- 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 ke'a goi ko'a zo'u cadga fa lo nu me'oi .enforce. + -- tu'a ko'a + -- + -- = English + -- + -- The pledges which should be used + -> IO (); + 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; + + -- | = la .lojban. + -- + -- ni'o la'oi .@univac@. korbipe la'oi .Haskell. je ko'a goi la'o gy. + -- @unveil(2)@ .gy. + -- + -- .i ro da poi .orsi re je poi se vasru la'oi .@g@. zo'u la'o zoi. + -- @univac g@ .zoi. pilno lo te .orsi fa'u lo ve .orsi lo pamoi sumti + -- be ko'a be'o fa'u lo remoi sumti be ko'a je cu co'e ko'a + -- + -- .i la'o zoi. @univac [("", "")]@ .zoi. dunli la'o zoi. + -- @unveil(NULL, NULL)@ .zoi. pe la'oi .C. + -- + -- .i le clinoi be la'o gy. @unveil(2)@ .gy. cu xamgu velski le tcila + -- be la'o gy. @unveil(2) .gy. + -- + -- = 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 me'oi .permission.)] + -- + -- = English + -- + -- [(PATH WHICH SHOULD BE EXPOSED, PERMISSIONS)] + -> IO (); + univac = mapM_ expose + where + expose = teim1_ "unveil" . uncurry unveil <=< toCStrings + teim1_ = throwErrnoIfMinus1_ + toCStrings = uncurry (liftM2 (,)) . both (`withCString` pure) + both f (a, b) = (f a, f b); + +#else + + -- | = la .lojban. + -- + -- ni'o la'o zoi. @plegg k@ .zoi. na ru'e dunli la'o zoi. + -- @pledge(k, null)@ pe la'oi .C. .i ku'i drata ki'u le nu le me'oi + -- .'Promise'. pe la'oi .@plegg@. cu se me'oi .type. + -- + -- .i lo me'oi .'Promise'. poi selru'e la'oi .@plegg@. cu binxo lo + -- selci'a poi selru'e la'o gy. @pledge(2)@ .gy. + -- + -- = English + -- + -- @plegg k@ is roughly equivalent to C's "@pledge(k, nulll)@". + -- 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 ke'a goi ko'a zo'u cadga fa lo nu me'oi .enforce. + -- tu'a ko'a + -- + -- = English + -- + -- The pledges which should be used + -> IO (); + plegg _ = return (); + + -- | = la .lojban. + -- + -- ni'o la'oi .@univac@. korbipe la'oi .Haskell. je ko'a goi la'o gy. + -- @unveil(2)@ .gy. + -- + -- .i ro da poi .orsi re je poi se vasru la'oi .@g@. zo'u la'o zoi. + -- @univac g@ .zoi. pilno lo te .orsi fa'u lo ve .orsi lo pamoi sumti + -- be ko'a be'o fa'u lo remoi sumti be ko'a je cu co'e ko'a + -- + -- .i la'o zoi. @univac [("", "")]@ .zoi. dunli la'o zoi. + -- @unveil(NULL, NULL)@ .zoi. pe la'oi .C. + -- + -- .i le clinoi be la'o gy. @unveil(2)@ .gy. cu xamgu velski le tcila + -- be la'o gy. @unveil(2) .gy. + -- + -- = 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 me'oi .permission.)] + -- + -- = English + -- + -- [(PATH WHICH SHOULD BE EXPOSED, PERMISSIONS)] + -> IO (); + 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 se skicu fo lo mu'oi +-- gy. man(1) .gy. papri poi ke'a velski la'o gy. pledge(2) .gy. +-- +-- = 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;