This is a resubmission.  I am sending this in two bundles although
there is a semantic dependency from the "next" patch to this patch.

It should be ok to apply just this patch without applying the next
one.

Fri Jul  7 07:41:34 CEST 2006  Eric Kow <[EMAIL PROTECTED]>
  * Exec improvements : Windows redirection, and more redirection control.
  
  - Implement ability to redirect to /dev/null under Windows
    (eivuokko on #darcs points out that it is NUL under Windows)
  
  - Add exec_ function, which does the same thing as exec,
    but allows redirection on stderr, and also allows us
    to NOT redirect stdin/stderr
  

New patches:

[Exec improvements : Windows redirection, and more redirection control.
Eric Kow <[EMAIL PROTECTED]>**20060707054134
 
 - Implement ability to redirect to /dev/null under Windows
   (eivuokko on #darcs points out that it is NUL under Windows)
 
 - Add exec_ function, which does the same thing as exec,
   but allows redirection on stderr, and also allows us
   to NOT redirect stdin/stderr
 
] 
<
> {
hunk ./Exec.lhs 19
 
 \begin{code}
 {-# OPTIONS -fffi #-}
-module Exec ( exec, exec_interactive
+module Exec ( exec, exec_, exec_interactive
             ) where
 
 import System
hunk ./Exec.lhs 38
           wcss (s:ss) css = withCString s $ \cstr -> wcss ss (cstr:css)
 #endif
 
-exec :: String -> [String] -> FilePath -> FilePath -> IO ExitCode
+exec  :: String -> [String] -> FilePath -> FilePath -> IO ExitCode
+exec c args inp out = exec_ c args (Just inp) (Just out) Nothing
+
+-- lets you opt not to redirect streams, and to (optionally) redirect stderr
+exec_ :: String -> [String] -> Maybe FilePath -> Maybe FilePath -> Maybe FilePath -> IO ExitCode
 
 #ifdef WIN32
hunk ./Exec.lhs 45
-exec c args "/dev/null" "/dev/null" = system $ c++" "++careful_unwords args
-exec c args "/dev/null" out =
-  system $ c++" "++careful_unwords args++" > "++careful_unwords [out]
-exec c args inp "/dev/null" =
-  system $ c++" "++careful_unwords args++" < "++careful_unwords [inp]
-exec c args inp out =
-  system $ c++" "++careful_unwords args++" < "++careful_unwords [inp]++" > "++careful_unwords [out]
+exec_ c args minp mout merr =
+  let redirect side mp =
+        case mp of
+          Nothing          -> ""
+          Just "/dev/null" -> side ++ "NUL"
+          Just  p          -> side ++ careful_unwords [p]
+      redirectErr =
+        case merr of
+          Nothing -> "2>&1"
+          Just e  -> redirect " 2> " (Just e)
+  in system $ c ++" "++careful_unwords args
+                ++(redirect " < " minp)
+                ++(redirect " > " mout)
+                ++redirectErr
 
 careful_unwords :: [String] -> [Char]
 careful_unwords (a:as) = "\""++a++"\" "++ careful_unwords as
hunk ./Exec.lhs 64
 careful_unwords [] = ""
 #else
-exec c args inp out = do
+exec_ c args minp mout merr = do
   fval <- c_fork
hunk ./Exec.lhs 66
+  let -- set up stdin redirection if needed
+      withStdin job =
+       case minp of
+         Nothing  -> job
+         Just inp -> withCString inp $ \in_c -> do
+                       fdin <- open_read in_c
+                       c_dup2 fdin 0
+                       job
+      -- set up stdout/stderr redirection if needed
+      withStdout job =
+       case mout of
+        -- no stdout redirection
+        Nothing ->
+         case merr of
+           Nothing -> job
+           Just e  -> withCString e $ \err_c -> do
+                        fderr <- open_write err_c
+                        c_dup2 fderr 2
+                        job
+        -- stdout redirection
+        Just out -> withCString out $ \out_c -> do
+         fdout <- open_write out_c
+         c_dup2 fdout 1
+         case merr of
+           Nothing -> do c_dup2 fdout 2 -- stderr to stdout
+                         job
+           Just e  -> withCString e $ \err_c -> do
+                         fderr <- open_write err_c
+                         c_dup2 fderr 2
+                         job
+  -- fork and go
   case fval of
      -1 -> return $ ExitFailure $ 1
hunk ./Exec.lhs 99
-     0 -> withCString inp $ \in_c ->
-          withCString out $ \out_c ->
+     0 -> withStdin $ withStdout $
           withCString c $ \c_c ->
           withCStrings (c:args) $ \c_args -> do
hunk ./Exec.lhs 102
-              fdin <- open_read in_c
-              fdout <- open_write out_c
-              c_dup2 fdout 1
-              c_dup2 fdout 2
-              c_dup2 fdin 0
-              -- execvp only returns if there is an error:
-              ExitFailure `liftM` execvp_no_vtalarm c_c c_args
+                -- execvp only returns if there is an error:
+                ExitFailure `liftM` execvp_no_vtalarm c_c c_args
      pid -> do ecode <- smart_wait pid
                if ecode == 0 then return ExitSuccess
                              else return $ ExitFailure ecode
}

Context:

[overhaul the darcs.net front page.
Mark Stosberg <[EMAIL PROTECTED]>**20060820191415
 
 The themes to this change are:
 
 - Focus on the key benefits of darcs:
     Distributed. Interactive. Smart.
 
 - Recognize that the wiki is the central resource,
    and remove some information that is duplicated here
    and reference the wik instead. 
 
 I can post a demo of this HTML for easy comparison if you'd like.
 
     Mark
] 
[Reimplement --disable-ssh-cm flag (issue239).
Eric Kow <[EMAIL PROTECTED]>**20060812134856
 
 My patch to "Only launch SSH control master on demand" accidentally
 removed the ability to disable use of SSH ControlMaster.  Also, the
 way it was implemented is not compatible with launching on demand.
 This implementation relies on a notion of global variables using
 unsafe IORefs.
 
] 
[Compile Global.lhs in place of AtExit.lhs.
Eric Kow <[EMAIL PROTECTED]>**20060812121943] 
[Rename AtExit module to Global.
Eric Kow <[EMAIL PROTECTED]>**20060812121925
 
 The goal is to capture some broad "global" notions like exit handlers
 and global variables.  Note the GPL header thrown in for good measure.
 
] 
[Raise exception if unable to open logfile (issue142).
Zachary P. Landau <[EMAIL PROTECTED]>**20060810034035] 
[Make the pull 'permission test' work when run as root
Jon Olsson <[EMAIL PROTECTED]>**20060831193834] 
[TAG darcs-unstable-20060831
Juliusz Chroboczek <[EMAIL PROTECTED]>**20060831191554] 
Patch bundle hash:
5f0c17163821b117949a0e734d3c97bc5c17ca5c
_______________________________________________
darcs-devel mailing list
[email protected]
http://www.abridgegame.org/cgi-bin/mailman/listinfo/darcs-devel

Reply via email to