
   0 | module System.Posix.Process.Prim
   1 | 
   2 | import System.Posix.File
   3 | import System.Posix.Signal
   4 | import public Data.C.Ptr
   5 | import public System.Posix.Errno
   6 | import public System.Posix.Process.Flags
   7 | import public System.Posix.Process.ProcStatus
   8 | 
   9 | %default total
  10 | 
  11 | --------------------------------------------------------------------------------
  12 | -- FFI
  13 | --------------------------------------------------------------------------------
  14 | 
  15 | export %foreign "C:getpid, posix-idris"
  16 | getpid : PrimIO PidT
  17 | 
  18 | export %foreign "C:getppid, posix-idris"
  19 | getppid : PrimIO PidT
  20 | 
  21 | export %foreign "C:getuid, posix-idris"
  22 | getuid : PrimIO UidT
  23 | 
  24 | export %foreign "C:geteuid, posix-idris"
  25 | geteuid : PrimIO UidT
  26 | 
  27 | export %foreign "C:getgid, posix-idris"
  28 | getgid : PrimIO GidT
  29 | 
  30 | export %foreign "C:getegid, posix-idris"
  31 | getegid : PrimIO GidT
  32 | 
  33 | %foreign "C:li_setuid, posix-idris"
  34 | prim__setuid : UidT -> PrimIO CInt
  35 | 
  36 | %foreign "C:li_seteuid, posix-idris"
  37 | prim__seteuid : UidT -> PrimIO CInt
  38 | 
  39 | %foreign "C:li_setgid, posix-idris"
  40 | prim__setgid : GidT -> PrimIO CInt
  41 | 
  42 | %foreign "C:li_setegid, posix-idris"
  43 | prim__setegid : GidT -> PrimIO CInt
  44 | 
  45 | %foreign "C:li_fork, posix-idris"
  46 | prim__fork : PrimIO PidT
  47 | 
  48 | %foreign "C:li_wait, posix-idris"
  49 | prim__wait : AnyPtr -> PrimIO PidT
  50 | 
  51 | %foreign "C:li_waitpid, posix-idris"
  52 | prim__waitpid : PidT -> AnyPtr -> Bits32 -> PrimIO PidT
  53 | 
  54 | %foreign "C:li_waitid, posix-idris"
  55 | prim__waitid : Bits8 -> PidT -> AnyPtr -> Bits32 -> PrimIO PidT
  56 | 
  57 | %foreign "C:li_execve, posix-idris"
  58 | prim__execve : String -> AnyPtr -> AnyPtr -> PrimIO CInt
  59 | 
  60 | %foreign "C:li_execvp, posix-idris"
  61 | prim__execvp : String -> AnyPtr -> PrimIO CInt
  62 | 
  63 | %foreign "C:li_execv, posix-idris"
  64 | prim__execv : String -> AnyPtr -> PrimIO CInt
  65 | 
  66 | %foreign "C:li_system, posix-idris"
  67 | prim__system : String -> PrimIO CInt
  68 | 
  69 | --------------------------------------------------------------------------------
  70 | -- API
  71 | --------------------------------------------------------------------------------
  72 | 
  73 | ||| Tries to set the real user ID of the current process
  74 | export %inline
  75 | setuid : UidT -> EPrim ()
  76 | setuid uid = toUnit $ prim__setuid uid
  77 | 
  78 | ||| Tries to set the effective user ID of the current process
  79 | export %inline
  80 | seteuid : UidT -> EPrim ()
  81 | seteuid uid = toUnit $ prim__seteuid uid
  82 | 
  83 | ||| Tries to set the real group ID of the current process
  84 | export %inline
  85 | setgid : GidT -> EPrim ()
  86 | setgid gid = toUnit $ prim__setgid gid
  87 | 
  88 | ||| Tries to set the effective group ID of the current process
  89 | export %inline
  90 | setegid : GidT -> EPrim ()
  91 | setegid gid = toUnit $ prim__setegid gid
  92 | 
  93 | ||| Creates a new child process.
  94 | |||
  95 | ||| This creates a new process by copying the stack, head, and
  96 | ||| data memory segment of the parent process. If successful,
  97 | ||| the functions returns `0` for the child process and
  98 | ||| the child's process ID for the parent.
  99 | export %inline
 100 | fork : EPrim PidT
 101 | fork = toPidT Process.Prim.prim__fork
 102 | 
 103 | ||| Loads a new program into this process's memory.
 104 | |||
 105 | ||| `path` : The path of the program to run
 106 | ||| `args` : Command-line arguments (a `NULL` terminated array of strings)
 107 | ||| `env ` : Environment (a `NULL` terminated array of strings of the for "a=b")
 108 | |||
 109 | ||| This only returns in case of an error.
 110 | export %inline
 111 | execve :
 112 |      String
 113 |   -> (args : CArrayIO m (Maybe String))
 114 |   -> (env  : CArrayIO n (Maybe String))
 115 |   -> EPrim ()
 116 | execve s a e = toUnit $ prim__execve s (unsafeUnwrap a) (unsafeUnwrap e)
 117 | 
 118 | ||| Convenience alias of `execve` that uses Idris lists for passing
 119 | ||| the arguments list and environment.
 120 | export
 121 | execle : String -> List String -> List (String,String) -> EPrim ()
 122 | execle s a e t =
 123 |   let args # t := ioToF1 (fromList (map Just a ++ [Nothing])) t
 124 |       env  # t := ioToF1 (fromList (map envpair e ++ [Nothing])) t
 125 |       R res  t := execve s args env t | E x t => E x t
 126 |       _    # t := free1 args t
 127 |       _    # t := free1 env t
 128 |    in R res t
 129 | 
 130 |   where
 131 |     envpair : (String,String) -> Maybe String
 132 |     envpair (n,v) = Just "\{n}=\{v}"
 133 | 
 134 | ||| Like `execve` but uses the environment of the current process.
 135 | export %inline
 136 | execv : String -> CArrayIO m (Maybe String) -> EPrim ()
 137 | execv s a = toUnit $ prim__execv s (unsafeUnwrap a)
 138 | 
 139 | ||| Like `execv` but allows us to just use a filename
 140 | ||| and resolve in using the `$PATH` variable.
 141 | export %inline
 142 | execvp : String -> CArrayIO m (Maybe String) -> EPrim ()
 143 | execvp s a = toUnit $ prim__execvp s (unsafeUnwrap a)
 144 | 
 145 | ||| Convenience alias for `execvp` that uses an Idris list for
 146 | ||| the list of arguments.
 147 | export
 148 | execlp : String -> List String -> EPrim ()
 149 | execlp s a t =
 150 |   let args # t := ioToF1 (fromList (map Just a ++ [Nothing])) t
 151 |       R res  t := execvp s args t | E x t => E x t
 152 |       _    # t := free1 args t
 153 |    in R res t
 154 | 
 155 | ||| Runs the given shell command in a child process.
 156 | |||
 157 | ||| This has a slightly different type signature that the actual
 158 | ||| `system` call in C, which allows us to use the same mechanism
 159 | ||| as with `wait` to get the returned exit status.
 160 | export %inline
 161 | system : (cmd : String) -> EPrim ProcStatus
 162 | system cmd = toVal procStatus $ prim__system cmd
 163 | 
 164 | ||| Waits for one of the child processes of this process to
 165 | ||| terminate.
 166 | |||
 167 | ||| On success, this returns the process ID of the child process
 168 | ||| that terminated. In addition, the termination status of the child
 169 | ||| is written into the given pointer.
 170 | export %inline
 171 | wait_ : IOBox CInt -> EPrim PidT
 172 | wait_ s = toPidT $ prim__wait (unsafeUnwrap s)
 173 | 
 174 | ||| Waits for the given child processes of to terminate.
 175 | |||
 176 | ||| Unlike `wait`, this allows us to wait on a specific child process.
 177 | ||| In addition, it is possible to be notified about child processes that have
 178 | ||| been terminated by a signal.
 179 | export %inline
 180 | waitpid_ : PidT -> IOBox CInt -> WaitFlags -> EPrim PidT
 181 | waitpid_ chld s (F f) = toPidT $ prim__waitpid chld (unsafeUnwrap s) f
 182 | 
 183 | ||| More powerful version of `waitpid` supporting additional flags and
 184 | ||| waiting on groups of children. Wait results are stored in the
 185 | ||| provided `SiginfoT` pointer.
 186 | export %inline
 187 | waitid_ : IdType -> PidT -> SiginfoT -> WaitFlags -> EPrim ()
 188 | waitid_ t chld s (F f) =
 189 |   toUnit $ prim__waitid (idtypeCode t) chld (unwrap s) f
 190 | 
 191 | --------------------------------------------------------------------------------
 192 | -- Convenience API
 193 | --------------------------------------------------------------------------------
 194 | 
 195 | ||| Convenience version of `wait_`.
 196 | export %inline
 197 | wait : EPrim (PidT, ProcStatus)
 198 | wait =
 199 |   withBox CInt $ \box,t =>
 200 |     let R r t := wait_ box t | E x r => E x r
 201 |         c # t := unbox box t
 202 |      in R (r, procStatus c) t
 203 | 
 204 | ||| Convenience version of `waitpid_`.
 205 | export %inline
 206 | waitpid : PidT -> WaitFlags -> EPrim (PidT, ProcStatus)
 207 | waitpid pid flags =
 208 |   withBox CInt $ \box,t =>
 209 |     let R r t := waitpid_ pid box flags t | E x r => E x r
 210 |         c # t := unbox box t
 211 |      in R (r, procStatus c) t
 212 | 
 213 | ||| Convenience version of `waitid_`.
 214 | export %inline
 215 | waitid : IdType -> PidT -> WaitFlags -> EPrim Siginfo
 216 | waitid it pid fs =
 217 |   withStruct SSiginfoT $ \ss,t =>
 218 |     let R _  t := waitid_ it pid ss fs t | E x t => E x t
 219 |         si # t := siginfo ss t
 220 |      in R si t
 221 |