Hello,
I've thought it would be nice if Haskell type checker would work into
our strength. Attached patch defines algebraic data type Promise and
use this for calling pledge sys call. The patch also provides two
version of Promise to string conversion function. One is explicit and
another is using show capability and just fixes prot_exec case.
Any comments highly appreciated.
Thanks,
Karel
Index: Process.hsc
===================================================================
RCS file: /cvs/ports/lang/ghc/files/Process.hsc,v
retrieving revision 1.1
diff -u -p -u -r1.1 Process.hsc
--- Process.hsc 20 Jan 2016 16:02:06 -0000 1.1
+++ Process.hsc 23 Jan 2016 13:15:42 -0000
@@ -1,14 +1,77 @@
{-# LANGUAGE Safe #-}
-module System.OpenBSD.Process ( pledge ) where
+module System.OpenBSD.Process ( pledge, Promise(..) ) where
import Foreign
import Foreign.C
import System.Posix.Internals ( withFilePath )
+import Data.Char
-pledge :: String -> Maybe [FilePath] -> IO ()
+data Promise = Stdio
+ | RPath
+ | WPath
+ | CPath
+ | DPath
+ | TmpPath
+ | Inet
+ | FAttr
+ | FLock
+ | Unix
+ | Dns
+ | GetPW
+ | SendFD
+ | RecvFD
+ | IOCtl
+ | Tty
+ | Proc
+ | Exec
+ | ProtExec
+ | SetTime
+ | Ps
+ | VMInfo
+ | Id
+ | Pf
+ deriving (Show)
+{-
+promise2String :: Promise -> String
+promise2String p = case p of
+ Stdio -> "stdio"
+ RPath -> "rpath"
+ WPath -> "wpath"
+ CPath -> "cpath"
+ DPath -> "dpath"
+ TmpPath -> "tmppath"
+ Inet -> "inet"
+ FAttr -> "fattr"
+ FLock -> "flock"
+ Unix -> "unix"
+ Dns -> "dns"
+ GetPW -> "getpw"
+ SendFD -> "sendfd"
+ RecvFD -> "recvfd"
+ IOCtl -> "ioctl"
+ Tty -> "tty"
+ Proc -> "proc"
+ Exec -> "exec"
+ ProtExec -> "prot_exec"
+ SetTime -> "settime"
+ Ps -> "ps"
+ VMInfo -> "vminfo"
+ Id -> "id"
+ Pf -> "pf"
+-}
-pledge promises paths =
+promise2String :: Promise -> String
+promise2String p = case p of
+ ProtExec -> "prot_exec"
+ _ -> map toLower (show p)
+
+pledge :: [Promise] -> Maybe [FilePath] -> IO ()
+pledge promises = cpledge (unwords $ map promise2String promises)
+
+cpledge :: String -> Maybe [FilePath] -> IO ()
+
+cpledge promises paths =
withCString promises $ \cproms ->
withPaths2Array0 paths $ \paths_arr ->
throwErrnoIfMinus1_ "pledge" (c_pledge cproms paths_arr)
On Wed, Jan 20, 2016 at 5:38 AM, Matthias Kilian <k...@outback.escape.de> wrote:
> On Tue, Jan 19, 2016 at 08:43:17PM +0100, Matthias Kilian wrote:
>> > Below is a hopefully correct and more complete diff. Again without
>> > bump because I'll also merge -main and -doc.
>>
>> Famous last words. I missed the plist changes. Will send a new diff
>> later (at the moment i'm rebuilding ghc).
>
> Here it is. Works fine for me, so I'm going to commit this in a few
> hours.
>
> Index: Makefile
> ===================================================================
> RCS file: /cvs/ports/lang/ghc/Makefile,v
> retrieving revision 1.131
> diff -u -p -r1.131 Makefile
> --- Makefile 28 Dec 2015 19:18:52 -0000 1.131
> +++ Makefile 20 Jan 2016 04:24:09 -0000
> @@ -157,6 +157,11 @@ PORTHOME = ${WRKDIR}
>
> TEST_DEPENDS = print/ghostscript/gnu
>
> +post-extract:
> + cd ${WRKSRC}/libraries/unix && \
> + mkdir -p System/OpenBSD && \
> + install -m 644 ${FILESDIR}/Process.hsc System/OpenBSD
> +
> post-patch:
> # - Install a precompiled binary.
> cd ${WRKDIR}/ghc-${BIN_VER} && \
> Index: files/Process.hsc
> ===================================================================
> RCS file: files/Process.hsc
> diff -N files/Process.hsc
> --- /dev/null 1 Jan 1970 00:00:00 -0000
> +++ files/Process.hsc 20 Jan 2016 04:24:09 -0000
> @@ -0,0 +1,26 @@
> +{-# LANGUAGE Safe #-}
> +
> +module System.OpenBSD.Process ( pledge ) where
> +
> +import Foreign
> +import Foreign.C
> +import System.Posix.Internals ( withFilePath )
> +
> +pledge :: String -> Maybe [FilePath] -> IO ()
> +
> +pledge promises paths =
> + withCString promises $ \cproms ->
> + withPaths2Array0 paths $ \paths_arr ->
> + throwErrnoIfMinus1_ "pledge" (c_pledge cproms paths_arr)
> +
> +withPaths2Array0 :: Maybe [FilePath] -> (Ptr (Ptr CChar) -> IO a) -> IO a
> +
> +withPaths2Array0 Nothing f = f nullPtr
> +
> +withPaths2Array0 (Just paths) f =
> + withMany withFilePath paths $ \cstrs ->
> + withArray0 nullPtr cstrs $ \paths_arr ->
> + f paths_arr
> +
> +foreign import ccall unsafe "unistd.h pledge"
> + c_pledge :: CString -> Ptr CString -> IO CInt
> Index: patches/patch-libraries_unix_unix_cabal
> ===================================================================
> RCS file: patches/patch-libraries_unix_unix_cabal
> diff -N patches/patch-libraries_unix_unix_cabal
> --- /dev/null 1 Jan 1970 00:00:00 -0000
> +++ patches/patch-libraries_unix_unix_cabal 20 Jan 2016 04:24:09 -0000
> @@ -0,0 +1,12 @@
> +$OpenBSD$
> +--- libraries/unix/unix.cabal.orig Sun Jan 4 23:56:26 2015
> ++++ libraries/unix/unix.cabal Tue Jan 19 00:42:33 2016
> +@@ -109,6 +109,8 @@ library
> + System.Posix.Terminal
> + System.Posix.Terminal.ByteString
> +
> ++ System.OpenBSD.Process
> ++
> + other-modules:
> + System.Posix.Directory.Common
> + System.Posix.DynamicLinker.Common
> Index: pkg/PLIST-main
> ===================================================================
> RCS file: /cvs/ports/lang/ghc/pkg/PLIST-main,v
> retrieving revision 1.17
> diff -u -p -r1.17 PLIST-main
> --- pkg/PLIST-main 2 Nov 2015 21:31:26 -0000 1.17
> +++ pkg/PLIST-main 20 Jan 2016 04:24:09 -0000
> @@ -2228,6 +2228,9 @@ lib/ghc/trans_${TRANSFORMERS_KEY}/libHSt
> lib/ghc/unix_${UNIX_KEY}/
> lib/ghc/unix_${UNIX_KEY}/HSunix-${UNIX_VER}-${UNIX_KEY}.o
> lib/ghc/unix_${UNIX_KEY}/System/
> +lib/ghc/unix_${UNIX_KEY}/System/OpenBSD/
> +lib/ghc/unix_${UNIX_KEY}/System/OpenBSD/Process.hi
> +lib/ghc/unix_${UNIX_KEY}/System/OpenBSD/Process.p_hi
> lib/ghc/unix_${UNIX_KEY}/System/Posix/
> lib/ghc/unix_${UNIX_KEY}/System/Posix.hi
> lib/ghc/unix_${UNIX_KEY}/System/Posix.p_hi
>
