system-posix-redirect (empty) → 1.0

raw patch · 6 files changed

+206/−0 lines, 6 filesdep +basedep +unixsetup-changed

Dependencies added: base, unix

Files

LICENSE +30/−0
Setup.hs +2/−0
System/Posix/Redirect.hs +120/−0
cbits/hsredirect.c +14/−0
include/hsredirect.h +4/−0
system-posix-redirect.cabal +36/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c)2010, Edward Z. Yang++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Edward Z. Yang nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ System/Posix/Redirect.hs view

@@ -0,0 +1,120 @@+{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-}++{- |+Module      : System.Posix.Redirect+Copyright   : Galois, Inc. 2010+Maintainer  : ezyang@galois.com+Stability   : experimental+Portability : non-portable (POSIX, GHC)++Misbehaved third-party libraries (usually not written in Haskell)+may print error messages directly to stdout or stderr when we would+actually like to capture them and propagate them as a normal exception.+In such cases, it would be useful to temporarily override those file+descriptors to point to a pipe that we control.++This module is not portable and not thread safe.  However, it can+safely manage arbitrarily large amounts of data, as it spins off another+thread to read from the pipe created; therefore, you must use -threaded+to compile a program with this.  If you are making a foreign call,+you must ensure that the foreign call is marked safe or there is a+possibility of deadlock.++While this module is an interesting novelty, it is the module author's+opinion that it is not a sustainable method for making C libraries+behave properly, primarily due to its unportability (this trick does not+appear to be possible on Windows).  Use at your own risk.+-}++module System.Posix.Redirect +    ( redirectStdout+    , redirectStderr+    -- * Low-level operations+    , redirectWriteHandle+    , unsafeRedirectWriteFd+    ) where++import System.Posix.Types+import System.Posix.IO+import System.IO++import Foreign+import Foreign.C.Types++import Control.Concurrent+import Control.Exception++dupTo_ :: Fd -> Fd -> IO ()+dupTo_ a b = dupTo a b >>= \_ -> return ()++-- | @'unsafeRedirectFd' fd f@ executes the computation @f@, passing as+-- an argument a handle which is the read end of a pipe that+-- @fd@ now points to.  When the computation is done, the original file+-- descriptor is restored.  Use with care: if there are any file+-- handles with this descriptor that have unflushed buffers, they will+-- not flush to the old file descriptor, but the new file descriptor.+unsafeRedirectWriteFd :: Fd -> IO a -> IO (String, a)+unsafeRedirectWriteFd fd f = do+    -- setup+    (rfd, wfd) <- createPipe+    old <- dup fd+    dupTo_ wfd fd+    -- fork a thread to consume output+    outMVar <- newEmptyMVar+    outHandle <- fdToHandle rfd+    out <- hGetContents outHandle+    _ <- forkIO $ do+        _ <- evaluate (length out)+        putMVar outMVar ()+    -- run the code+    r <- f+    -- cleanup+    dupTo_ old fd+    closeFd wfd+    -- wait for output+    takeMVar outMVar+    hClose outHandle+    return (out, r)++-- | @'redirectWriteHandle' oldFd oldHandle oldCHandle f@ executes the+-- computation @f@, passing as an argument a handle which is the read+-- end of a pipe that @fd@ now points to.  This function appropriately+-- flushes the Haskell @oldHandle@ and the C @oldCHandle@ before+-- and after @f@'s execution.+redirectWriteHandle :: Fd -> Handle -> Ptr FILE -> IO a -> IO (String, a)+redirectWriteHandle oldFd oldHandle cOldHandle f = do+    hFlush oldHandle+    hFlush stdout+    _ <- c_fflush cOldHandle+    unsafeRedirectWriteFd oldFd $ do+        r <- f+        hFlush oldHandle+        _ <- c_fflush cOldHandle+        return r++-- | @'redirectStdout f' redirects standard output during the execution+-- of @f@ into a pipe passed as the first argument to @f@.+redirectStdout :: IO a -> IO (String, a)+redirectStdout f = do+    c_stdout <- cio_stdout+    redirectWriteHandle stdOutput stdout c_stdout f++-- | @'redirectStderr f' redirects standard error during the execution+-- of @f@ into a pipe passed as the first argument to @f@.+redirectStderr :: IO a -> IO (String, a)+redirectStderr f = do+    c_stderr <- cio_stderr+    redirectWriteHandle stdError stderr c_stderr f++---------------------------------------------------+-- FFI imports, since we need to flush the C buffer++data FILE++foreign import ccall safe "stdio.h fflush"+    c_fflush :: Ptr FILE -> IO CInt++foreign import ccall unsafe "hsredirect.h PosixRedirect_stdout"+    cio_stdout :: IO (Ptr FILE)+foreign import ccall unsafe "hsredirect.h PosixRedirect_stderr"+    cio_stderr :: IO (Ptr FILE)

+ cbits/hsredirect.c view

@@ -0,0 +1,14 @@+#include <stdio.h>++/**+ * Helper functions for stdout and stderr, because I can't evaluate them+ * at compile/link time.+ */++FILE *PosixRedirect_stdout() {+    return stdout;+}++FILE *PosixRedirect_stderr() {+    return stderr;+}

+ include/hsredirect.h view

@@ -0,0 +1,4 @@+#include <stdio.h>++FILE *PosixRedirect_stdout();+FILE *PosixRedirect_stderr();

+ system-posix-redirect.cabal view

@@ -0,0 +1,36 @@+Name:               system-posix-redirect+Version:            1.0+Synopsis:           A toy module that allows you to temporarily redirect+                    a program's stdout.+Description:        Due to the design of POSIX, it is possible to+                    temporarily overload the file descriptors+                    corresponding to stdout and stderr to point to an+                    arbitrary pipe.  It is, however, tricky to get+                    right.  This module gets it right, as far as such+                    a terrible hack can be made right.  It can be used+                    to make misbehaving third-party C libraries stop+                    spewing to standard output. Warning: the module+                    author has concluded that due to lack of+                    portability, this module should not be used in any+                    serious sytem.  But, for those who like living+                    dangerously...+License:            BSD3+License-file:       LICENSE+Author:             Galois Inc.+Maintainer:         ezyang@galois.com+Copyright:          (c) 2010 Galois Inc.+Category:           System+Build-type:         Simple+Extra-source-files: include/*.h+                    cbits/*.c+Cabal-Version: >= 1.6++Library+  Exposed-modules:      System.Posix.Redirect+  Extensions:           ForeignFunctionInterface,+                        EmptyDataDecls+  Build-depends:        base == 4.*,+                        unix >= 2.4.0 && < 2.5+  C-sources:            cbits/hsredirect.c+  Include-dirs:         include+  Install-includes:     include/hsredirect.h