Ticket #1568: mv_signals_unix.patch

File mv_signals_unix.patch, 26.3 KB (added by igloo, 7 years ago)
Line 
1
2New patches:
3
4[Move System.Posix.Signals from base
5Ian Lynagh <igloo@earth.li>**20070729215617
6 Also adds System.Posix.Process.Internals in order to make the deps work out.
7] {
8adddir ./System/Posix/Process
9hunk ./System/Posix/Process.hsc 77
10+import System.Posix.Process.Internals ( pPrPr_disableITimers, c_execvpe )
11hunk ./System/Posix/Process.hsc 80
12-import System.Process.Internals ( pPrPr_disableITimers, c_execvpe )
13addfile ./System/Posix/Process/Internals.hs
14hunk ./System/Posix/Process/Internals.hs 1
15+
16+module System.Posix.Process.Internals (pPrPr_disableITimers, c_execvpe) where
17+
18+import Foreign
19+import Foreign.C
20+
21+-- this function disables the itimer, which would otherwise cause confusing
22+-- signals to be sent to the new process.
23+foreign import ccall unsafe "pPrPr_disableITimers"
24+  pPrPr_disableITimers :: IO ()
25+
26+foreign import ccall unsafe "execvpe"
27+  c_execvpe :: CString -> Ptr CString -> Ptr CString -> IO CInt
28addfile ./System/Posix/Signals.hs
29hunk ./System/Posix/Signals.hs 1
30+-----------------------------------------------------------------------------
31+-- |
32+-- Module      :  System.Posix.Signals
33+-- Copyright   :  (c) The University of Glasgow 2002
34+-- License     :  BSD-style (see the file libraries/base/LICENSE)
35+--
36+-- Maintainer  :  libraries@haskell.org
37+-- Stability   :  provisional
38+-- Portability :  non-portable (requires POSIX)
39+--
40+-- POSIX signal support
41+--
42+-----------------------------------------------------------------------------
43+
44+#include "HsBaseConfig.h"
45+
46+module System.Posix.Signals (
47+  -- * The Signal type
48+  Signal,
49+
50+  -- * Specific signals
51+  nullSignal,
52+  internalAbort, sigABRT,
53+  realTimeAlarm, sigALRM,
54+  busError, sigBUS,
55+  processStatusChanged, sigCHLD,
56+  continueProcess, sigCONT,
57+  floatingPointException, sigFPE,
58+  lostConnection, sigHUP,
59+  illegalInstruction, sigILL,
60+  keyboardSignal, sigINT,
61+  killProcess, sigKILL,
62+  openEndedPipe, sigPIPE,
63+  keyboardTermination, sigQUIT,
64+  segmentationViolation, sigSEGV,
65+  softwareStop, sigSTOP,
66+  softwareTermination, sigTERM,
67+  keyboardStop, sigTSTP,
68+  backgroundRead, sigTTIN,
69+  backgroundWrite, sigTTOU,
70+  userDefinedSignal1, sigUSR1,
71+  userDefinedSignal2, sigUSR2,
72+#if CONST_SIGPOLL != -1
73+  pollableEvent, sigPOLL,
74+#endif
75+  profilingTimerExpired, sigPROF,
76+  badSystemCall, sigSYS,
77+  breakpointTrap, sigTRAP,
78+  urgentDataAvailable, sigURG,
79+  virtualTimerExpired, sigVTALRM,
80+  cpuTimeLimitExceeded, sigXCPU,
81+  fileSizeLimitExceeded, sigXFSZ,
82+
83+  -- * Sending signals
84+  raiseSignal,
85+  signalProcess,
86+  signalProcessGroup,
87+
88+#ifdef __GLASGOW_HASKELL__
89+  -- * Handling signals
90+  Handler(..),
91+  installHandler,
92+#endif
93+
94+  -- * Signal sets
95+  SignalSet,
96+  emptySignalSet, fullSignalSet,
97+  addSignal, deleteSignal, inSignalSet,
98+
99+  -- * The process signal mask
100+  getSignalMask, setSignalMask, blockSignals, unblockSignals,
101+
102+  -- * The alarm timer
103+  scheduleAlarm,
104+
105+  -- * Waiting for signals
106+  getPendingSignals,
107+#ifndef cygwin32_HOST_OS
108+  awaitSignal,
109+#endif
110+
111+#ifdef __GLASGOW_HASKELL__
112+  -- * The @NOCLDSTOP@ flag
113+  setStoppedChildFlag, queryStoppedChildFlag,
114+#endif
115+
116+  -- MISSING FUNCTIONALITY:
117+  -- sigaction(), (inc. the sigaction structure + flags etc.)
118+  -- the siginfo structure
119+  -- sigaltstack()
120+  -- sighold, sigignore, sigpause, sigrelse, sigset
121+  -- siginterrupt
122+  ) where
123+
124+import Foreign
125+import Foreign.C
126+import System.IO.Unsafe
127+import System.Posix.Types
128+import System.Posix.Internals
129+
130+#ifdef __GLASGOW_HASKELL__
131+#include "Signals.h"
132+import GHC.Conc        ( ensureIOManagerIsRunning )
133+#endif
134+
135+-- -----------------------------------------------------------------------------
136+-- Specific signals
137+
138+type Signal = CInt
139+
140+nullSignal :: Signal
141+nullSignal = 0
142+
143+sigABRT   :: CInt
144+sigABRT   = CONST_SIGABRT
145+sigALRM   :: CInt
146+sigALRM   = CONST_SIGALRM
147+sigBUS    :: CInt
148+sigBUS    = CONST_SIGBUS
149+sigCHLD   :: CInt
150+sigCHLD   = CONST_SIGCHLD
151+sigCONT   :: CInt
152+sigCONT   = CONST_SIGCONT
153+sigFPE    :: CInt
154+sigFPE    = CONST_SIGFPE
155+sigHUP    :: CInt
156+sigHUP    = CONST_SIGHUP
157+sigILL    :: CInt
158+sigILL    = CONST_SIGILL
159+sigINT    :: CInt
160+sigINT    = CONST_SIGINT
161+sigKILL   :: CInt
162+sigKILL   = CONST_SIGKILL
163+sigPIPE   :: CInt
164+sigPIPE   = CONST_SIGPIPE
165+sigQUIT   :: CInt
166+sigQUIT   = CONST_SIGQUIT
167+sigSEGV   :: CInt
168+sigSEGV   = CONST_SIGSEGV
169+sigSTOP   :: CInt
170+sigSTOP   = CONST_SIGSTOP
171+sigTERM   :: CInt
172+sigTERM   = CONST_SIGTERM
173+sigTSTP   :: CInt
174+sigTSTP   = CONST_SIGTSTP
175+sigTTIN   :: CInt
176+sigTTIN   = CONST_SIGTTIN
177+sigTTOU   :: CInt
178+sigTTOU   = CONST_SIGTTOU
179+sigUSR1   :: CInt
180+sigUSR1   = CONST_SIGUSR1
181+sigUSR2   :: CInt
182+sigUSR2   = CONST_SIGUSR2
183+sigPOLL   :: CInt
184+sigPOLL   = CONST_SIGPOLL
185+sigPROF   :: CInt
186+sigPROF   = CONST_SIGPROF
187+sigSYS    :: CInt
188+sigSYS    = CONST_SIGSYS
189+sigTRAP   :: CInt
190+sigTRAP   = CONST_SIGTRAP
191+sigURG    :: CInt
192+sigURG    = CONST_SIGURG
193+sigVTALRM :: CInt
194+sigVTALRM = CONST_SIGVTALRM
195+sigXCPU   :: CInt
196+sigXCPU   = CONST_SIGXCPU
197+sigXFSZ   :: CInt
198+sigXFSZ   = CONST_SIGXFSZ
199+
200+internalAbort ::Signal
201+internalAbort = sigABRT
202+
203+realTimeAlarm :: Signal
204+realTimeAlarm = sigALRM
205+
206+busError :: Signal
207+busError = sigBUS
208+
209+processStatusChanged :: Signal
210+processStatusChanged = sigCHLD
211+
212+continueProcess :: Signal
213+continueProcess = sigCONT
214+
215+floatingPointException :: Signal
216+floatingPointException = sigFPE
217+
218+lostConnection :: Signal
219+lostConnection = sigHUP
220+
221+illegalInstruction :: Signal
222+illegalInstruction = sigILL
223+
224+keyboardSignal :: Signal
225+keyboardSignal = sigINT
226+
227+killProcess :: Signal
228+killProcess = sigKILL
229+
230+openEndedPipe :: Signal
231+openEndedPipe = sigPIPE
232+
233+keyboardTermination :: Signal
234+keyboardTermination = sigQUIT
235+
236+segmentationViolation :: Signal
237+segmentationViolation = sigSEGV
238+
239+softwareStop :: Signal
240+softwareStop = sigSTOP
241+
242+softwareTermination :: Signal
243+softwareTermination = sigTERM
244+
245+keyboardStop :: Signal
246+keyboardStop = sigTSTP
247+
248+backgroundRead :: Signal
249+backgroundRead = sigTTIN
250+
251+backgroundWrite :: Signal
252+backgroundWrite = sigTTOU
253+
254+userDefinedSignal1 :: Signal
255+userDefinedSignal1 = sigUSR1
256+
257+userDefinedSignal2 :: Signal
258+userDefinedSignal2 = sigUSR2
259+
260+#if CONST_SIGPOLL != -1
261+pollableEvent :: Signal
262+pollableEvent = sigPOLL
263+#endif
264+
265+profilingTimerExpired :: Signal
266+profilingTimerExpired = sigPROF
267+
268+badSystemCall :: Signal
269+badSystemCall = sigSYS
270+
271+breakpointTrap :: Signal
272+breakpointTrap = sigTRAP
273+
274+urgentDataAvailable :: Signal
275+urgentDataAvailable = sigURG
276+
277+virtualTimerExpired :: Signal
278+virtualTimerExpired = sigVTALRM
279+
280+cpuTimeLimitExceeded :: Signal
281+cpuTimeLimitExceeded = sigXCPU
282+
283+fileSizeLimitExceeded :: Signal
284+fileSizeLimitExceeded = sigXFSZ
285+
286+-- -----------------------------------------------------------------------------
287+-- Signal-related functions
288+
289+-- | @signalProcess int pid@ calls @kill@ to signal process @pid@
290+--   with interrupt signal @int@.
291+signalProcess :: Signal -> ProcessID -> IO ()
292+signalProcess sig pid
293+ = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig)
294+
295+foreign import ccall unsafe "kill"
296+  c_kill :: CPid -> CInt -> IO CInt
297+
298+
299+-- | @signalProcessGroup int pgid@ calls @kill@ to signal
300+--  all processes in group @pgid@ with interrupt signal @int@.
301+signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
302+signalProcessGroup sig pgid
303+  = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig)
304+
305+foreign import ccall unsafe "killpg"
306+  c_killpg :: CPid -> CInt -> IO CInt
307+
308+-- | @raiseSignal int@ calls @kill@ to signal the current process
309+--   with interrupt signal @int@.
310+raiseSignal :: Signal -> IO ()
311+raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
312+
313+#if defined(__GLASGOW_HASKELL__) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
314+foreign import ccall unsafe "genericRaise"
315+  c_raise :: CInt -> IO CInt
316+#else
317+foreign import ccall unsafe "raise"
318+  c_raise :: CInt -> IO CInt
319+#endif
320+
321+#ifdef __GLASGOW_HASKELL__
322+data Handler = Default
323+             | Ignore
324+            -- not yet: | Hold
325+             | Catch (IO ())
326+             | CatchOnce (IO ())
327+
328+-- | @installHandler int handler iset@ calls @sigaction@ to install an
329+--   interrupt handler for signal @int@.  If @handler@ is @Default@,
330+--   @SIG_DFL@ is installed; if @handler@ is @Ignore@, @SIG_IGN@ is
331+--   installed; if @handler@ is @Catch action@, a handler is installed
332+--   which will invoke @action@ in a new thread when (or shortly after) the
333+--   signal is received.
334+--   If @iset@ is @Just s@, then the @sa_mask@ of the @sigaction@ structure
335+--   is set to @s@; otherwise it is cleared.  The previously installed
336+--   signal handler for @int@ is returned
337+installHandler :: Signal
338+               -> Handler
339+               -> Maybe SignalSet      -- ^ other signals to block
340+               -> IO Handler           -- ^ old handler
341+
342+#ifdef __PARALLEL_HASKELL__
343+installHandler =
344+  error "installHandler: not available for Parallel Haskell"
345+#else
346+
347+installHandler int handler maybe_mask = do
348+    ensureIOManagerIsRunning  -- for the threaded RTS
349+    case maybe_mask of
350+       Nothing -> install' nullPtr
351+        Just (SignalSet x) -> withForeignPtr x $ install'
352+  where
353+    install' mask =
354+      alloca $ \p_sp -> do
355+
356+      rc <- case handler of
357+             Default      -> stg_sig_install int STG_SIG_DFL p_sp mask
358+             Ignore       -> stg_sig_install int STG_SIG_IGN p_sp mask
359+             Catch m      -> hinstall m p_sp mask int STG_SIG_HAN
360+             CatchOnce m  -> hinstall m p_sp mask int STG_SIG_RST
361+
362+      case rc of
363+       STG_SIG_DFL -> return Default
364+       STG_SIG_IGN -> return Ignore
365+       STG_SIG_ERR -> throwErrno "installHandler"
366+       STG_SIG_HAN -> do
367+               m <- peekHandler p_sp
368+               return (Catch m)
369+       STG_SIG_RST -> do
370+               m <- peekHandler p_sp
371+               return (CatchOnce m)
372+       _other ->
373+          error "internal error: System.Posix.Signals.installHandler"
374+
375+    hinstall m p_sp mask int reset = do
376+      sptr <- newStablePtr m
377+      poke p_sp sptr
378+      stg_sig_install int reset p_sp mask
379+
380+    peekHandler p_sp = do
381+      osptr <- peek p_sp
382+      deRefStablePtr osptr
383+
384+foreign import ccall unsafe
385+  stg_sig_install
386+       :: CInt                         -- sig no.
387+       -> CInt                         -- action code (STG_SIG_HAN etc.)
388+       -> Ptr (StablePtr (IO ()))      -- (in, out) Haskell handler
389+       -> Ptr CSigset                  -- (in, out) blocked
390+       -> IO CInt                      -- (ret) action code
391+
392+#endif /* !__PARALLEL_HASKELL__ */
393+#endif /* __GLASGOW_HASKELL__ */
394+
395+-- -----------------------------------------------------------------------------
396+-- Alarms
397+
398+-- | @scheduleAlarm i@ calls @alarm@ to schedule a real time
399+--   alarm at least @i@ seconds in the future.
400+scheduleAlarm :: Int -> IO Int
401+scheduleAlarm secs = do
402+   r <- c_alarm (fromIntegral secs)
403+   return (fromIntegral r)
404+
405+foreign import ccall unsafe "alarm"
406+  c_alarm :: CUInt -> IO CUInt
407+
408+#ifdef __GLASGOW_HASKELL__
409+-- -----------------------------------------------------------------------------
410+-- The NOCLDSTOP flag
411+
412+foreign import ccall "&nocldstop" nocldstop :: Ptr Int
413+
414+-- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
415+-- installing new signal handlers.
416+setStoppedChildFlag :: Bool -> IO Bool
417+setStoppedChildFlag b = do
418+    rc <- peek nocldstop
419+    poke nocldstop $ fromEnum (not b)
420+    return (rc == (0::Int))
421+
422+-- | Queries the current state of the stopped child flag.
423+queryStoppedChildFlag :: IO Bool
424+queryStoppedChildFlag = do
425+    rc <- peek nocldstop
426+    return (rc == (0::Int))
427+#endif /* __GLASGOW_HASKELL__ */
428+
429+-- -----------------------------------------------------------------------------
430+-- Manipulating signal sets
431+
432+newtype SignalSet = SignalSet (ForeignPtr CSigset)
433+
434+emptySignalSet :: SignalSet
435+emptySignalSet = unsafePerformIO $ do
436+  fp <- mallocForeignPtrBytes sizeof_sigset_t
437+  throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
438+  return (SignalSet fp)
439+
440+fullSignalSet :: SignalSet
441+fullSignalSet = unsafePerformIO $ do
442+  fp <- mallocForeignPtrBytes sizeof_sigset_t
443+  throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
444+  return (SignalSet fp)
445+
446+infixr `addSignal`, `deleteSignal`
447+addSignal :: Signal -> SignalSet -> SignalSet
448+addSignal sig (SignalSet fp1) = unsafePerformIO $ do
449+  fp2 <- mallocForeignPtrBytes sizeof_sigset_t
450+  withForeignPtr fp1 $ \p1 ->
451+    withForeignPtr fp2 $ \p2 -> do
452+      copyBytes p2 p1 sizeof_sigset_t
453+      throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
454+  return (SignalSet fp2)
455+
456+deleteSignal :: Signal -> SignalSet -> SignalSet
457+deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
458+  fp2 <- mallocForeignPtrBytes sizeof_sigset_t
459+  withForeignPtr fp1 $ \p1 ->
460+    withForeignPtr fp2 $ \p2 -> do
461+      copyBytes p2 p1 sizeof_sigset_t
462+      throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
463+  return (SignalSet fp2)
464+
465+inSignalSet :: Signal -> SignalSet -> Bool
466+inSignalSet sig (SignalSet fp) = unsafePerformIO $
467+  withForeignPtr fp $ \p -> do
468+    r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
469+    return (r /= 0)
470+
471+-- | @getSignalMask@ calls @sigprocmask@ to determine the
472+--   set of interrupts which are currently being blocked.
473+getSignalMask :: IO SignalSet
474+getSignalMask = do
475+  fp <- mallocForeignPtrBytes sizeof_sigset_t
476+  withForeignPtr fp $ \p ->
477+    throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
478+  return (SignalSet fp)
479+   
480+sigProcMask :: String -> CInt -> SignalSet -> IO ()
481+sigProcMask fn how (SignalSet set) =
482+  withForeignPtr set $ \p_set ->
483+    throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
484+
485+-- | @setSignalMask mask@ calls @sigprocmask@ with
486+--   @SIG_SETMASK@ to block all interrupts in @mask@.
487+setSignalMask :: SignalSet -> IO ()
488+setSignalMask set = sigProcMask "setSignalMask" (CONST_SIG_SETMASK :: CInt) set
489+
490+-- | @blockSignals mask@ calls @sigprocmask@ with
491+--   @SIG_BLOCK@ to add all interrupts in @mask@ to the
492+--  set of blocked interrupts.
493+blockSignals :: SignalSet -> IO ()
494+blockSignals set = sigProcMask "blockSignals" (CONST_SIG_BLOCK :: CInt) set
495+
496+-- | @unblockSignals mask@ calls @sigprocmask@ with
497+--   @SIG_UNBLOCK@ to remove all interrupts in @mask@ from the
498+--   set of blocked interrupts.
499+unblockSignals :: SignalSet -> IO ()
500+unblockSignals set = sigProcMask "unblockSignals" (CONST_SIG_UNBLOCK :: CInt) set
501+
502+-- | @getPendingSignals@ calls @sigpending@ to obtain
503+--   the set of interrupts which have been received but are currently blocked.
504+getPendingSignals :: IO SignalSet
505+getPendingSignals = do
506+  fp <- mallocForeignPtrBytes sizeof_sigset_t
507+  withForeignPtr fp $ \p ->
508+   throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
509+  return (SignalSet fp)
510+
511+#ifndef cygwin32_HOST_OS
512+
513+-- | @awaitSignal iset@ suspends execution until an interrupt is received.
514+-- If @iset@ is @Just s@, @awaitSignal@ calls @sigsuspend@, installing
515+-- @s@ as the new signal mask before suspending execution; otherwise, it
516+-- calls @pause@.  @awaitSignal@ returns on receipt of a signal.  If you
517+-- have installed any signal handlers with @installHandler@, it may be
518+-- wise to call @yield@ directly after @awaitSignal@ to ensure that the
519+-- signal handler runs as promptly as possible.
520+awaitSignal :: Maybe SignalSet -> IO ()
521+awaitSignal maybe_sigset = do
522+  fp <- case maybe_sigset of
523+         Nothing -> do SignalSet fp <- getSignalMask; return fp
524+         Just (SignalSet fp) -> return fp
525+  withForeignPtr fp $ \p -> do
526+  c_sigsuspend p
527+  return ()
528+  -- ignore the return value; according to the docs it can only ever be
529+  -- (-1) with errno set to EINTR.
530+
531+foreign import ccall unsafe "sigsuspend"
532+  c_sigsuspend :: Ptr CSigset -> IO CInt
533+#endif
534+
535+#ifdef __HUGS__
536+foreign import ccall unsafe "sigdelset"
537+  c_sigdelset   :: Ptr CSigset -> CInt -> IO CInt
538+
539+foreign import ccall unsafe "sigfillset"
540+  c_sigfillset  :: Ptr CSigset -> IO CInt
541+
542+foreign import ccall unsafe "sigismember"
543+  c_sigismember :: Ptr CSigset -> CInt -> IO CInt
544+#else
545+foreign import ccall unsafe "__hscore_sigdelset"
546+  c_sigdelset   :: Ptr CSigset -> CInt -> IO CInt
547+
548+foreign import ccall unsafe "__hscore_sigfillset"
549+  c_sigfillset  :: Ptr CSigset -> IO CInt
550+
551+foreign import ccall unsafe "__hscore_sigismember"
552+  c_sigismember :: Ptr CSigset -> CInt -> IO CInt
553+#endif /* __HUGS__ */
554+
555+foreign import ccall unsafe "sigpending"
556+  c_sigpending :: Ptr CSigset -> IO CInt
557+
558addfile ./cbits/execvpe.c
559hunk ./cbits/execvpe.c 1
560+/* -----------------------------------------------------------------------------
561+   (c) The University of Glasgow 1995-2004
562+
563+   Our low-level exec() variant.
564+   -------------------------------------------------------------------------- */
565+#include "execvpe.h"
566+
567+#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) /* to the end */
568+
569+/* Evidently non-Posix. */
570+/* #include "PosixSource.h" */
571+
572+#include <unistd.h>
573+#include <sys/time.h>
574+#include <stdlib.h>
575+#include <string.h>
576+#include <errno.h>
577+
578+/*
579+ * We want the search semantics of execvp, but we want to provide our
580+ * own environment, like execve.  The following copyright applies to
581+ * this code, as it is a derivative of execvp:
582+ *-
583+ * Copyright (c) 1991 The Regents of the University of California.
584+ * All rights reserved.
585+ *
586+ * Redistribution and use in source and binary forms, with or without
587+ * modification, are permitted provided that the following conditions
588+ * are met:
589+ * 1. Redistributions of source code must retain the above copyright
590+ *    notice, this list of conditions and the following disclaimer.
591+ * 2. Redistributions in binary form must reproduce the above copyright
592+ *    notice, this list of conditions and the following disclaimer in the
593+ *    documentation and/or other materials provided with the distribution.
594+ * 3. All advertising materials mentioning features or use of this software
595+ *    must display the following acknowledgement:
596+ *     This product includes software developed by the University of
597+ *     California, Berkeley and its contributors.
598+ * 4. Neither the name of the University nor the names of its contributors
599+ *    may be used to endorse or promote products derived from this software
600+ *    without specific prior written permission.
601+ *
602+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
603+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
604+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
605+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
606+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
607+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
608+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
609+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
610+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
611+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
612+ * SUCH DAMAGE.
613+ */
614+
615+int
616+execvpe(char *name, char *const argv[], char **envp)
617+{
618+    register int lp, ln;
619+    register char *p;
620+    int eacces=0, etxtbsy=0;
621+    char *bp, *cur, *path, *buf = 0;
622+
623+    /* If it's an absolute or relative path name, it's easy. */
624+    if (strchr(name, '/')) {
625+       bp = (char *) name;
626+       cur = path = buf = NULL;
627+       goto retry;
628+    }
629+
630+    /* Get the path we're searching. */
631+    if (!(path = getenv("PATH"))) {
632+#ifdef HAVE_CONFSTR
633+        ln = confstr(_CS_PATH, NULL, 0);
634+        if ((cur = path = malloc(ln + 1)) != NULL) {
635+           path[0] = ':';
636+           (void) confstr (_CS_PATH, path + 1, ln);
637+       }
638+#else
639+        if ((cur = path = malloc(1 + 1)) != NULL) {
640+           path[0] = ':';
641+           path[1] = '\0';
642+       }
643+#endif
644+    } else
645+       cur = path = strdup(path);
646+
647+    if (path == NULL || (bp = buf = malloc(strlen(path)+strlen(name)+2)) == NULL)
648+       goto done;
649+
650+    while (cur != NULL) {
651+       p = cur;
652+        if ((cur = strchr(cur, ':')) != NULL)
653+           *cur++ = '\0';
654+
655+       /*
656+        * It's a SHELL path -- double, leading and trailing colons mean the current
657+        * directory.
658+        */
659+       if (!*p) {
660+           p = ".";
661+           lp = 1;
662+       } else
663+           lp = strlen(p);
664+       ln = strlen(name);
665+
666+       memcpy(buf, p, lp);
667+       buf[lp] = '/';
668+       memcpy(buf + lp + 1, name, ln);
669+       buf[lp + ln + 1] = '\0';
670+
671+      retry:
672+        (void) execve(bp, argv, envp);
673+       switch (errno) {
674+       case EACCES:
675+           eacces = 1;
676+           break;
677+       case ENOENT:
678+           break;
679+       case ENOEXEC:
680+           {
681+               register size_t cnt;
682+               register char **ap;
683+
684+               for (cnt = 0, ap = (char **) argv; *ap; ++ap, ++cnt)
685+                   ;
686+               if ((ap = malloc((cnt + 2) * sizeof(char *))) != NULL) {
687+                   memcpy(ap + 2, argv + 1, cnt * sizeof(char *));
688+
689+                   ap[0] = "sh";
690+                   ap[1] = bp;
691+                   (void) execve("/bin/sh", ap, envp);
692+                   free(ap);
693+               }
694+               goto done;
695+           }
696+       case ETXTBSY:
697+           if (etxtbsy < 3)
698+               (void) sleep(++etxtbsy);
699+           goto retry;
700+       default:
701+           goto done;
702+       }
703+    }
704+    if (eacces)
705+       errno = EACCES;
706+    else if (!errno)
707+       errno = ENOENT;
708+  done:
709+    if (path)
710+       free(path);
711+    if (buf)
712+       free(buf);
713+    return (-1);
714+}
715+
716+
717+/* Copied verbatim from ghc/lib/std/cbits/system.c. */
718+void pPrPr_disableITimers (void)
719+{
720+#  ifdef HAVE_SETITIMER
721+   /* Reset the itimers in the child, so it doesn't get plagued
722+    * by SIGVTALRM interrupts.
723+    */
724+   struct timeval tv_null = { 0, 0 };
725+   struct itimerval itv;
726+   itv.it_interval = tv_null;
727+   itv.it_value = tv_null;
728+   setitimer(ITIMER_REAL, &itv, NULL);
729+   setitimer(ITIMER_VIRTUAL, &itv, NULL);
730+   setitimer(ITIMER_PROF, &itv, NULL);
731+#  endif
732+}
733+
734+#endif
735addfile ./include/execvpe.h
736hunk ./include/execvpe.h 1
737+/* ----------------------------------------------------------------------------
738+   (c) The University of Glasgow 2004
739+
740+   Interface for code in execvpe.c
741+   ------------------------------------------------------------------------- */
742+
743+#include "HsUnixConfig.h"
744+// Otherwise these clash with similar definitions from other packages:
745+#undef PACKAGE_BUGREPORT
746+#undef PACKAGE_NAME
747+#undef PACKAGE_STRING
748+#undef PACKAGE_TARNAME
749+#undef PACKAGE_VERSION
750+
751+#include <errno.h>
752+#include <sys/types.h>
753+#if HAVE_SYS_WAIT_H
754+#include <sys/wait.h>
755+#endif
756+
757+#if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32)
758+extern int execvpe(char *name, char *const argv[], char **envp);
759+extern void pPrPr_disableITimers (void);
760+#endif
761+
762hunk ./unix.cabal 25
763+               System.Posix.Process.Internals
764hunk ./unix.cabal 32
765+        System.Posix.Signals
766hunk ./unix.cabal 43
767-build-depends: base, directory, process
768-extensions:    CPP
769+build-depends: base, directory
770+extensions:    CPP, ForeignFunctionInterface
771hunk ./unix.cabal 46
772-includes:       HsUnix.h
773+includes:       HsUnix.h execvpe.h
774hunk ./unix.cabal 48
775-               HsUnix.h HsUnixConfig.h
776-c-sources:     cbits/HsUnix.c
777+               HsUnix.h HsUnixConfig.h execvpe.h
778+c-sources:     cbits/HsUnix.c cbits/execvpe.c
779}
780
781Context:
782
783[GHC.Handle no longer exports openFd
784Ian Lynagh <igloo@earth.li>**20070722000926]
785[disable the getLoginName test, see #1487
786Simon Marlow <simonmar@microsoft.com>**20070703105224]
787[Don't do "< /dev/null" when running the user001 test
788Ian Lynagh <igloo@earth.li>**20070623205408
789 It can cause the test to fail.
790]
791[--configure-option and --ghc-option are now provided by Cabal
792Ross Paterson <ross@soi.city.ac.uk>**20070604115617]
793[Add support for named semaphores and shared memory objects
794Daniel Franke <df@dfranke.us>**20070503220003]
795[Remove Makefile and package.conf.in (used in the old build system)
796Ian Lynagh <igloo@earth.li>**20070524142637]
797[We now depend on process
798Ian Lynagh <igloo@earth.li>**20070523181544]
799[We now depend on directory
800Ian Lynagh <igloo@earth.li>**20070519160513]
801[add includes: field
802Simon Marlow <simonmar@microsoft.com>**20070517095025]
803[Fix calling getAllUserEntries twice (trac #1279).
804Ian Lynagh <igloo@earth.li>**20070504104956
805 It used to return [] on all but the first call.
806 Patch from an unidentified guest.
807]
808[Make it more obvious that the forkprocess01 test is really working
809Ian Lynagh <igloo@earth.li>**20070418114542]
810[Follow Cabal changes in Setup.hs
811Ian Lynagh <igloo@earth.li>**20070418114510]
812[Handle sysconf(3) return value -1 when checking _SC_GETGR_R_SIZE_MAX and _SC_GETPW_R_SIZE_MAX.
813bjorn@bringert.net**20070416214837
814 sysconf(3) returns -1 on failure, but this was not handled when checking _SC_GETGR_R_SIZE_MAX and _SC_GETPW_R_SIZE_MAX in System.Posix.User. This made getUserEntryForID, getUserEntryForName, getGroupEntryForID and getGroupEntryForName fail on OS X 10.4.9 on i386. Just checking that unistd.h defines _SC_GETGR_R_SIZE_MAX and _SC_GETPW_R_SIZE_MAX as was done before does not guarantee that sysconf(3) will succeed.
815 
816 sysconf(3) failure is now handled by using the same default values as were already used when sysconf(3) is not available, or the parameter names are not defined.
817]
818[Added tests/user001.hs which tests all the get* functions in System.Posix.User.
819bjorn@bringert.net**20070416220012
820 I added this since I noticed that getUserEntryForID, getUserEntryForName,
821 getGroupEntryForID and getGroupEntryForName failed on OS X 10.4.9 on i386.
822]
823[Fix -Wall warnings
824Ian Lynagh <igloo@earth.li>**20070411005028]
825[Add missing case in removePrefix
826Ian Lynagh <igloo@earth.li>**20070411002604]
827[parse (but don't pass on) options for ./configure
828Ian Lynagh <igloo@earth.li>**20070406153756]
829[make Setup suitable for building the libraries with GHC
830Ian Lynagh <igloo@earth.li>**20061112214741]
831[Don't use Fd/FD in foreign decls
832Ian Lynagh <igloo@earth.li>**20070404155930
833 Using CInt makes it much easier to verify that it is right, and we won't
834 get caught out by possible newtype switches between CInt/Int.
835]
836[Fix C/Haskell type mismatches
837Ian Lynagh <igloo@earth.li>**20070404003625]
838[Follow type changes in base
839Ian Lynagh <igloo@earth.li>**20070403195237
840 (of the dubiously exported c_access and c_fcntl_write)
841]
842[fix cut-and-pasto in error message
843Simon Marlow <simonmar@microsoft.com>**20070308134418]
844[add tests from GHC testsuite
845Simon Marlow <simonmar@microsoft.com>**20070305145258]
846[export the file-type modes, so that createDevice can be used
847Simon Marlow <simonmar@microsoft.com>**20070305113316]
848[Provide nanosleep if we have it, and use it to implement usleep
849Simon Marlow <simonmar@microsoft.com>**20070302132818
850 Fixes #1156
851]
852[don't retry usleep() on EINTR (see #850/#1156)
853Simon Marlow <simonmar@microsoft.com>**20070302114118]
854[expand docs for forkProcess
855Simon Marlow <simonmar@microsoft.com>**20070301151220]
856[add C wrappers for lstat() and mknod().  Fixes #1086.
857Simon Marlow <simonmar@microsoft.com>**20070226110311]
858[README about building from darcs
859Ross Paterson <ross@soi.city.ac.uk>**20070218110201]
860[TAG 6.6 release
861Ian Lynagh <igloo@earth.li>**20061011124740]
862Patch bundle hash:
863979100250f9ae922ff189f651b8462b3db599427