
   0 | module System.Posix.Signal.Prim
   1 | 
   2 | import Data.C.Ptr
   3 | import Data.Finite
   4 | 
   5 | import public Data.C.Integer
   6 | import public Data.C.Struct
   7 | import public System.Posix.Errno
   8 | import public System.Posix.Signal.Struct
   9 | import public System.Posix.Signal.Types
  10 | 
  11 | %default total
  12 | 
  13 | --------------------------------------------------------------------------------
  14 | -- FFI
  15 | --------------------------------------------------------------------------------
  16 | 
  17 | %foreign "C:li_kill, posix-idris"
  18 | prim__kill : PidT -> Bits32 -> PrimIO CInt
  19 | 
  20 | %foreign "C:raise, posix-idris"
  21 | prim__raise : Bits32 -> PrimIO ()
  22 | 
  23 | %foreign "C:li_sigprocmask1, posix-idris"
  24 | prim__sigprocmask1 : Bits8 -> AnyPtr -> PrimIO ()
  25 | 
  26 | %foreign "C:li_sigprocmask, posix-idris"
  27 | prim__sigprocmask : Bits8 -> AnyPtr -> PrimIO AnyPtr
  28 | 
  29 | %foreign "C:li_siggetprocmask, posix-idris"
  30 | prim__siggetprocmask : PrimIO AnyPtr
  31 | 
  32 | %foreign "C:li_sigpending, posix-idris"
  33 | prim__sigpending : PrimIO AnyPtr
  34 | 
  35 | %foreign "C:li_sigqueue, posix-idris"
  36 | prim__sigqueue : PidT -> Bits32 -> CInt -> PrimIO CInt
  37 | 
  38 | %foreign "C:li_pause, posix-idris"
  39 | prim__pause : PrimIO CInt
  40 | 
  41 | %foreign "C:li_sigsuspend, posix-idris"
  42 | prim__sigsuspend : AnyPtr -> PrimIO CInt
  43 | 
  44 | %foreign "C:li_sigwaitinfo, posix-idris"
  45 | prim__sigwaitinfo : AnyPtr -> AnyPtr -> PrimIO CInt
  46 | 
  47 | %foreign "C:li_sigtimedwait, posix-idris"
  48 | prim__sigtimedwait : AnyPtr -> AnyPtr -> TimeT -> NsecT -> PrimIO CInt
  49 | 
  50 | %foreign "C:li_sigwait, posix-idris"
  51 | prim__sigwait : AnyPtr -> PrimIO CInt
  52 | 
  53 | --------------------------------------------------------------------------------
  54 | -- API
  55 | --------------------------------------------------------------------------------
  56 | 
  57 | ||| Sends a signal to a running process or a group of processes.
  58 | export %inline
  59 | kill : PidT -> Signal -> EPrim ()
  60 | kill p s = toUnit $ prim__kill p s.sig
  61 | 
  62 | ||| Sends a signal to the calling thread.
  63 | export %inline
  64 | raise : Signal -> PrimIO ()
  65 | raise s = prim__raise s.sig
  66 | 
  67 | ||| Sends a realtime signal plus data word to a running process.
  68 | |||
  69 | ||| Note that `sig` must be in the range [SIGRTMIN, SIGRTMAX].
  70 | export %inline
  71 | sigqueue : PidT -> Signal -> (word : CInt) -> EPrim ()
  72 | sigqueue p s word = toUnit $ prim__sigqueue p s.sig word
  73 | 
  74 | ||| Adjust the process signal mask according to the given `How`
  75 | ||| and signal set.
  76 | |||
  77 | ||| Note: This allocates a new `sigset_t` pointer and returns the
  78 | |||       previously set signal mask. Client code is responsible to
  79 | |||       free the memory for this once it is no longer used.
  80 | |||       See also `sigprocmask` for a version that does not return
  81 | |||       the previous signal mask.
  82 | export %inline
  83 | sigprocmask_ : How -> SigsetT -> PrimIO SigsetT
  84 | sigprocmask_ h p w =
  85 |   let MkIORes p2 w := prim__sigprocmask (howCode h) (unwrap p) w
  86 |    in MkIORes (wrap p2) w
  87 | 
  88 | ||| Terminates the application by raising `SIGABRT` and dumps core.
  89 | |||
  90 | ||| While `SIGABRT` can be handled with a signal handler, `abort` is
  91 | ||| still guaranteed successfully terminate the process.
  92 | export %foreign "C:abort, posix-idris"
  93 | abort : PrimIO ()
  94 | 
  95 | ||| Suspends the current thread until a non-blocked signal is encountered.
  96 | export %inline
  97 | pause : EPrim ()
  98 | pause t =
  99 |   let r # t := toF1 (primMap fromNeg prim__pause) t
 100 |    in if r == EINTR then R () t else E (inject r) t
 101 | 
 102 | ||| Atomically blocks the signals in `set`, then
 103 | ||| pauses the thread (see `pause`) and restores the signal set
 104 | ||| afterwards.
 105 | export %inline
 106 | sigsuspend_ : (set : SigsetT) -> EPrim ()
 107 | sigsuspend_ s t =
 108 |   let r # t := toF1 (primMap fromNeg (prim__sigsuspend $ unwrap s)) t
 109 |    in if r == EINTR then R () t else E (inject r) t
 110 | 
 111 | ||| Synchronously awaits one of the signals in `set`.
 112 | |||
 113 | ||| Note: Usually, the signals in `set` should first be blocked via
 114 | |||       `sigprocmask`.
 115 | export %inline
 116 | sigwaitinfo_ : (set : SigsetT) -> (info : SiginfoT) -> EPrim ()
 117 | sigwaitinfo_ s i = toUnit $ prim__sigwaitinfo (unwrap s) (unwrap i)
 118 | 
 119 | ||| Synchronously awaits one of the signals in `set`.
 120 | |||
 121 | ||| This is like `sigwaitinfo` but with a simpler API.
 122 | export %inline
 123 | sigwait_ : (set : SigsetT) -> EPrim Signal
 124 | sigwait_ s = toVal (S . cast) $ prim__sigwait (unwrap s)
 125 | 
 126 | ||| Like `sigwaitinfo` but times out with `EAGAIN` after `sec` seconds and
 127 | ||| `nsec` nanoseconds.
 128 | export %inline
 129 | sigtimedwait :
 130 |      (set  : SigsetT)
 131 |   -> (info : SiginfoT)
 132 |   -> (sec  : TimeT)
 133 |   -> (nsec : NsecT)
 134 |   -> EPrim ()
 135 | sigtimedwait s i sec nsec =
 136 |   toUnit $ prim__sigtimedwait (unwrap s) (unwrap i) sec nsec
 137 | 
 138 | --------------------------------------------------------------------------------
 139 | -- Convenience API
 140 | --------------------------------------------------------------------------------
 141 | 
 142 | ||| Like `sigprocmask_` but does not allocate a pointer for the
 143 | ||| previous `sigset_t`.
 144 | export %inline
 145 | sigprocmask : How -> List Signal -> EPrim ()
 146 | sigprocmask h ss =
 147 |   withSignals ss $ \p,t =>
 148 |     let _ # t := toF1 (prim__sigprocmask1 (howCode h) (unwrap p)) t
 149 |      in R () t
 150 | 
 151 | ||| Returns the current signal mask of the process.
 152 | export %inline
 153 | siggetprocmask : PrimIO (List Signal)
 154 | siggetprocmask w =
 155 |   let MkIORes p  w := prim__siggetprocmask w
 156 |       MkIORes ss w := primRun (getSignals (wrap p)) w
 157 |       MkIORes _  w := prim__free p w
 158 |    in MkIORes ss w
 159 | 
 160 | ||| Returns the set of currently pending signals.
 161 | export %inline
 162 | sigpending : PrimIO (List Signal)
 163 | sigpending w =
 164 |   let MkIORes p  w := prim__sigpending w
 165 |       MkIORes ss w := primRun (getSignals (wrap p)) w
 166 |       MkIORes _  w := prim__free p w
 167 |    in MkIORes ss w
 168 | 
 169 | ||| Convenience alias for `sigsuspend_`
 170 | export %inline
 171 | sigsuspend : List Signal -> EPrim ()
 172 | sigsuspend ss = withSignals ss sigsuspend_
 173 | 
 174 | ||| Convenience alias for `sigwait_`.
 175 | export %inline
 176 | sigwait : List Signal -> EPrim Signal
 177 | sigwait ss = withSignals ss sigwait_
 178 | 
 179 | ||| Convenience alias for `sigwaitinfo_`.
 180 | export
 181 | sigwaitinfo : List Signal -> EPrim Siginfo
 182 | sigwaitinfo ss =
 183 |   withSignals ss $ \set => withStruct SSiginfoT $ \si,t =>
 184 |     let R _ t := sigwaitinfo_ set si t | E x t => E x t
 185 |         r # t := siginfo si t
 186 |      in R r t
 187 |