POpen
Jens Petersen
petersen@redhat.com
12 Mar 2002 23:06:25 +0900
Jens Petersen <petersen@redhat.com> writes:
> "Simon Marlow" <simonmar@microsoft.com> writes:
>
> > I would drop the file into the tree as hslibs/posix/POpen.hs for now,
>
> Ok, sure. (Btw is there is a LICENSE file for hslibs?)
>
> > and export popen and popenEnvDir from Posix.
>
> I have been pondering a little over popenEnvDir. I'm
> starting to think it might be preferable to have some idioms
> like "withCurrentDirectory" and "withEnv" instead.
But these are perhaps less useful for forked processes.
> > As regards the Posix library, I think we need a redesigned library that
> > supports more of IEEE 1003.1-2001 (the latest incarnation of POSIX
> > including all the extra bits from the Single Unix Spec). It certainly
> > needs to be completely re-implemented: the current Posix library uses
> > all kinds of old GHC features and libraries that we'd like to remove.
>
> Ok. The Posix popen seems to allow only reading from or
> writing to the subprocess, but not both.
> > > Yes, that's ok. Should I send you a new version with the
> > > header updated
> >
> > That would be great, thanks.
>
> Ok, basically it's ready, pending any changes from comments
> to the above.
I added a little sgml documentation too. I think this
should compile ok in posix. If you need changelog entries,
please let me know. Is the header ok?
Cheers, Jens
--- /dev/null Fri Feb 1 12:24:56 2002
+++ POpen.hs Tue Mar 12 19:41:17 2002
@@ -0,0 +1,112 @@
+-----------------------------------------------------------------------------
+--
+-- Module : POpen
+-- Copyright : (c) The GRASP/AQUA Project, Glasgow University, 1995-1996
+-- (c) 2001-2002 Jens-Ulrik Holger Petersen
+-- License : BSD-style
+--
+-- Maintainer : petersen@haskell.org
+-- Stability : experimental
+-- Portability : Platform-specific
+--
+-- $Id: POpen.hs,v 1.0 2002/02/25 10:44:01 petersen Exp $
+--
+-- Convenient string input to and output from a subprocess
+--
+-----------------------------------------------------------------------------
+--
+-- Description
+--
+-- POpen provides a convenient way of sending string input to a
+-- subprocess and reading output from it lazily.
+--
+-- It provides two functions popen and popenEnvDir.
+--
+-- * popen gives lazy output and error streams from a
+-- subprocess command, and optionally can direct input from a
+-- string to the process.
+--
+-- * popenEnvDir in addition lets one specify the environment
+-- and directory in which to run the subprocess command.
+--
+-- This code is originally based on Posix.runProcess, but it
+-- uses file descriptors and pipes internally instead of
+-- handles and returns the output and error streams lazily as
+-- strings and also the pid of forked process.
+
+module POpen (popen, popenEnvDir)
+where
+
+import PosixFiles (stdInput, stdOutput, stdError)
+import PosixIO (createPipe, dupTo, fdClose, fdToHandle)
+import PosixProcPrim (executeFile, forkProcess)
+import PosixUtil (Fd, ProcessID)
+
+import Directory
+import IO (isEOFError, hGetContents, Handle, hPutStr, hClose)
+import Maybe (fromJust, isJust)
+import Monad (when)
+
+popen :: FilePath -- Command
+ -> [String] -- Arguments
+ -> Maybe String -- Input
+ -> IO (String, String, ProcessID) -- (stdout, stderr, pid)
+popen path args inpt =
+ popenEnvDir path args inpt Nothing Nothing
+
+popenEnvDir :: FilePath -- Command
+ -> [String] -- Arguments
+ -> Maybe String -- Input
+ -> Maybe [(String, String)] -- Environment
+ -> Maybe FilePath -- Working directory
+ -> IO (String, String, ProcessID) -- (stdout, stderr, pid)
+popenEnvDir path args inpt env dir =
+ do
+ inr <- if (isJust inpt)
+ then
+ do
+ (inr', inw) <- createPipe
+ hin <- fdToHandle inw
+ hPutStr hin $ fromJust inpt
+ hClose hin
+ return $ Just inr'
+ else
+ return Nothing
+ (outr, outw) <- createPipe
+ (errr, errw) <- createPipe
+ pid <- forkProcess
+ case pid of
+ Nothing -> doTheBusiness inr outw errw
+ Just p -> do
+ -- close other end of pipes in here
+ when (isJust inr) $
+ fdClose $ fromJust inr
+ fdClose outw
+ fdClose errw
+ hout <- fdToHandle outr
+ outstrm <- hGetContents hout
+ herr <- fdToHandle errr
+ errstrm <- hGetContents herr
+ return (outstrm, errstrm , p)
+ where
+ doTheBusiness ::
+ Maybe Fd -- stdin
+ -> Fd -- stdout
+ -> Fd -- stderr
+ -> IO (String, String, ProcessID) -- (stdout, stderr)
+ doTheBusiness inr outw errw =
+ do
+ maybeChangeWorkingDirectory dir
+ when (isJust inr) $
+ dupTo (fromJust inr) stdInput
+ dupTo outw stdOutput
+ dupTo errw stdError
+ executeFile path True args env
+ -- for typing, should never actually run
+ error "executeFile failed!"
+
+maybeChangeWorkingDirectory :: Maybe FilePath -> IO ()
+maybeChangeWorkingDirectory dir =
+ case dir of
+ Nothing -> return ()
+ Just x -> setCurrentDirectory x
Index: Posix.lhs
===================================================================
RCS file: /cvs/fptools/hslibs/posix/Posix.lhs,v
retrieving revision 1.5
diff -u -r1.5 Posix.lhs
--- Posix.lhs 2002/02/12 15:17:33 1.5
+++ Posix.lhs 2002/03/12 12:57:29
@@ -14,6 +14,7 @@
module PosixProcEnv,
module PosixProcPrim,
module PosixTTY,
+ module POpen
runProcess,
@@ -44,6 +45,7 @@
import PosixProcPrim
import PosixTTY
import PosixUtil
+import POpen
-- [OLD COMMENT:]
-- runProcess is our candidate for the high-level OS-independent primitive
Index: doc/posix.sgml
===================================================================
RCS file: /cvs/fptools/hslibs/posix/doc/posix.sgml,v
retrieving revision 1.12
diff -u -r1.12 posix.sgml
--- doc/posix.sgml 2001/10/22 10:08:45 1.12
+++ doc/posix.sgml 2002/03/12 12:57:30
@@ -2372,4 +2372,66 @@
</Sect1>
+<Sect1 id="POpen">
+<Title>POpen
+</Title>
+
+<Para>
+<IndexTerm><Primary>POpen</Primary></IndexTerm>
+POpen provides a convenient way of sending string input to a
+subprocess and reading output from it lazily.
+</Para>
+
+<Para>
+
+<ProgramListing>
+popen :: FilePath -- Command
+ -> [String] -- Arguments
+ -> Maybe String -- Input
+ -> IO (String, String, ProcessID) -- (stdout, stderr, pid)
+</ProgramListing>
+
+</Para>
+
+<Para>
+<literal>popen cmd args inp</literal> executes
+<literal>cmd</literal> with <literal>args</literal> in a
+forked process. If <literal>inp</literal> is
+<literal>Just str</literal> then str in sent in a pipe to
+the standard input of the process. The output and error
+streams from the process are returned, together with the
+process id.
+</Para>
+
+<Para>
+
+<ProgramListing>
+popenEnvDir :: FilePath -- Command
+ -> [String] -- Arguments
+ -> Maybe String -- Input
+ -> Maybe [(String, String)] -- Environment
+ -> Maybe FilePath -- Working directory
+ -> IO (String, String, ProcessID) -- (stdout, stderr, pid)
+</ProgramListing>
+
+</Para>
+
+<Para>
+<literal>popenEnvDir cmd args inp env dir</literal> like
+<literal>popen</literal> executes
+<literal>cmd</literal> with <literal>args</literal> in a
+forked process. If <literal>inp</literal> is
+<literal>Just str</literal> then str in sent in a pipe to
+the standard input of the process. If <literal>env</literal>
+is <literal>Just pairs</literal>, the command in executed in
+the environment specified by <literal>pairs</literal>,
+instead of the current one. If <literal>dir</literal> is
+<literal>Just d</literal> the command is executed in
+directory <literal>d</literal> instead of the current
+directory. The output and error streams from the process
+are returned, together with the process id.
+</Para>
+
+</Sect1>
+
</Chapter>