Repository : ssh://darcs.haskell.org//srv/darcs/packages/unix On branch : master
http://hackage.haskell.org/trac/ghc/changeset/c8fada0d863085b8ac10f4d1f578e6428215ac28 >--------------------------------------------------------------- commit c8fada0d863085b8ac10f4d1f578e6428215ac28 Author: Simon Marlow <[email protected]> Date: Wed Nov 23 09:35:29 2011 +0000 Move openPseudoTerminal into System.Posix.Terminal{.ByteString} It may depend on getSlaveTerminalName if !defined(HAVE_OPENPTY) >--------------------------------------------------------------- System/Posix/Terminal.hsc | 61 ++++++++++++++++++++++++++++++++++ System/Posix/Terminal/ByteString.hsc | 60 +++++++++++++++++++++++++++++++++ System/Posix/Terminal/Common.hsc | 61 +--------------------------------- 3 files changed, 122 insertions(+), 60 deletions(-) diff --git a/System/Posix/Terminal.hsc b/System/Posix/Terminal.hsc index 0a2866a..5657662 100644 --- a/System/Posix/Terminal.hsc +++ b/System/Posix/Terminal.hsc @@ -141,3 +141,64 @@ getSlaveTerminalName _ = ioError (errnoToIOError "getSlaveTerminalName" eNOSYS Nothing Nothing) #endif +-- ----------------------------------------------------------------------------- +-- openPseudoTerminal needs to be here because it depends on +-- getSlaveTerminalName. + +-- | @openPseudoTerminal@ creates a pseudoterminal (pty) pair, and +-- returns the newly created pair as a (@master@, @slave@) tuple. +openPseudoTerminal :: IO (Fd, Fd) + +#ifdef HAVE_OPENPTY +openPseudoTerminal = + alloca $ \p_master -> + alloca $ \p_slave -> do + throwErrnoIfMinus1_ "openPty" + (c_openpty p_master p_slave nullPtr nullPtr nullPtr) + master <- peek p_master + slave <- peek p_slave + return (Fd master, Fd slave) + +foreign import ccall unsafe "openpty" + c_openpty :: Ptr CInt -> Ptr CInt -> CString -> Ptr CTermios -> Ptr a + -> IO CInt +#else +openPseudoTerminal = do + (Fd master) <- openFd "/dev/ptmx" ReadWrite Nothing + defaultFileFlags{noctty=True} + throwErrnoIfMinus1_ "openPseudoTerminal" (c_grantpt master) + throwErrnoIfMinus1_ "openPseudoTerminal" (c_unlockpt master) + slaveName <- getSlaveTerminalName (Fd master) + slave <- openFd slaveName ReadWrite Nothing defaultFileFlags{noctty=True} + pushModule slave "ptem" + pushModule slave "ldterm" +# ifndef __hpux + pushModule slave "ttcompat" +# endif /* __hpux */ + return (Fd master, slave) + +-- Push a STREAMS module, for System V systems. +pushModule :: Fd -> String -> IO () +pushModule (Fd fd) name = + withCString name $ \p_name -> + throwErrnoIfMinus1_ "openPseudoTerminal" + (c_push_module fd p_name) + +foreign import ccall unsafe "__hsunix_push_module" + c_push_module :: CInt -> CString -> IO CInt + +#ifdef HAVE_PTSNAME +foreign import ccall unsafe "__hsunix_grantpt" + c_grantpt :: CInt -> IO CInt + +foreign import ccall unsafe "__hsunix_unlockpt" + c_unlockpt :: CInt -> IO CInt +#else +c_grantpt :: CInt -> IO CInt +c_grantpt _ = return (fromIntegral 0) + +c_unlockpt :: CInt -> IO CInt +c_unlockpt _ = return (fromIntegral 0) +#endif /* HAVE_PTSNAME */ +#endif /* !HAVE_OPENPTY */ + diff --git a/System/Posix/Terminal/ByteString.hsc b/System/Posix/Terminal/ByteString.hsc index b3ca9a9..a75c37a 100644 --- a/System/Posix/Terminal/ByteString.hsc +++ b/System/Posix/Terminal/ByteString.hsc @@ -130,3 +130,63 @@ getSlaveTerminalName _ = ioError (errnoToIOError "getSlaveTerminalName" eNOSYS Nothing Nothing) #endif +-- ----------------------------------------------------------------------------- +-- openPseudoTerminal needs to be here because it depends on +-- getSlaveTerminalName. + +-- | @openPseudoTerminal@ creates a pseudoterminal (pty) pair, and +-- returns the newly created pair as a (@master@, @slave@) tuple. +openPseudoTerminal :: IO (Fd, Fd) + +#ifdef HAVE_OPENPTY +openPseudoTerminal = + alloca $ \p_master -> + alloca $ \p_slave -> do + throwErrnoIfMinus1_ "openPty" + (c_openpty p_master p_slave nullPtr nullPtr nullPtr) + master <- peek p_master + slave <- peek p_slave + return (Fd master, Fd slave) + +foreign import ccall unsafe "openpty" + c_openpty :: Ptr CInt -> Ptr CInt -> CString -> Ptr CTermios -> Ptr a + -> IO CInt +#else +openPseudoTerminal = do + (Fd master) <- openFd "/dev/ptmx" ReadWrite Nothing + defaultFileFlags{noctty=True} + throwErrnoIfMinus1_ "openPseudoTerminal" (c_grantpt master) + throwErrnoIfMinus1_ "openPseudoTerminal" (c_unlockpt master) + slaveName <- getSlaveTerminalName (Fd master) + slave <- openFd slaveName ReadWrite Nothing defaultFileFlags{noctty=True} + pushModule slave "ptem" + pushModule slave "ldterm" +# ifndef __hpux + pushModule slave "ttcompat" +# endif /* __hpux */ + return (Fd master, slave) + +-- Push a STREAMS module, for System V systems. +pushModule :: Fd -> String -> IO () +pushModule (Fd fd) name = + withCString name $ \p_name -> + throwErrnoIfMinus1_ "openPseudoTerminal" + (c_push_module fd p_name) + +foreign import ccall unsafe "__hsunix_push_module" + c_push_module :: CInt -> CString -> IO CInt + +#ifdef HAVE_PTSNAME +foreign import ccall unsafe "__hsunix_grantpt" + c_grantpt :: CInt -> IO CInt + +foreign import ccall unsafe "__hsunix_unlockpt" + c_unlockpt :: CInt -> IO CInt +#else +c_grantpt :: CInt -> IO CInt +c_grantpt _ = return (fromIntegral 0) + +c_unlockpt :: CInt -> IO CInt +c_unlockpt _ = return (fromIntegral 0) +#endif /* HAVE_PTSNAME */ +#endif /* !HAVE_OPENPTY */ diff --git a/System/Posix/Terminal/Common.hsc b/System/Posix/Terminal/Common.hsc index 39a2e30..3a6254d 100644 --- a/System/Posix/Terminal/Common.hsc +++ b/System/Posix/Terminal/Common.hsc @@ -26,6 +26,7 @@ module System.Posix.Terminal.Common ( TerminalState(..), setTerminalAttributes, + CTermios, TerminalMode(..), withoutMode, withMode, @@ -63,9 +64,6 @@ module System.Posix.Terminal.Common ( -- ** Testing a file descriptor queryTerminal, - - -- ** Pseudoterminal operations - openPseudoTerminal, ) where #include "HsUnix.h" @@ -504,63 +502,6 @@ queryTerminal (Fd fd) = do foreign import ccall unsafe "isatty" c_isatty :: CInt -> IO CInt --- | @openPseudoTerminal@ creates a pseudoterminal (pty) pair, and --- returns the newly created pair as a (@master@, @slave@) tuple. -openPseudoTerminal :: IO (Fd, Fd) - -#ifdef HAVE_OPENPTY -openPseudoTerminal = - alloca $ \p_master -> - alloca $ \p_slave -> do - throwErrnoIfMinus1_ "openPty" - (c_openpty p_master p_slave nullPtr nullPtr nullPtr) - master <- peek p_master - slave <- peek p_slave - return (Fd master, Fd slave) - -foreign import ccall unsafe "openpty" - c_openpty :: Ptr CInt -> Ptr CInt -> CString -> Ptr CTermios -> Ptr a - -> IO CInt -#else -openPseudoTerminal = do - (Fd master) <- openFd "/dev/ptmx" ReadWrite Nothing - defaultFileFlags{noctty=True} - throwErrnoIfMinus1_ "openPseudoTerminal" (c_grantpt master) - throwErrnoIfMinus1_ "openPseudoTerminal" (c_unlockpt master) - slaveName <- getSlaveTerminalName (Fd master) - slave <- openFd slaveName ReadWrite Nothing defaultFileFlags{noctty=True} - pushModule slave "ptem" - pushModule slave "ldterm" -# ifndef __hpux - pushModule slave "ttcompat" -# endif /* __hpux */ - return (Fd master, slave) - --- Push a STREAMS module, for System V systems. -pushModule :: Fd -> String -> IO () -pushModule (Fd fd) name = - withCString name $ \p_name -> - throwErrnoIfMinus1_ "openPseudoTerminal" - (c_push_module fd p_name) - -foreign import ccall unsafe "__hsunix_push_module" - c_push_module :: CInt -> CString -> IO CInt - -#ifdef HAVE_PTSNAME -foreign import ccall unsafe "__hsunix_grantpt" - c_grantpt :: CInt -> IO CInt - -foreign import ccall unsafe "__hsunix_unlockpt" - c_unlockpt :: CInt -> IO CInt -#else -c_grantpt :: CInt -> IO CInt -c_grantpt _ = return (fromIntegral 0) - -c_unlockpt :: CInt -> IO CInt -c_unlockpt _ = return (fromIntegral 0) -#endif /* HAVE_PTSNAME */ -#endif /* !HAVE_OPENPTY */ - -- ----------------------------------------------------------------------------- -- Local utility functions _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
