Move openPseudoTerminal into System.Posix.Terminal{.ByteString}

It may depend on getSlaveTerminalName if !defined(HAVE_OPENPTY)

1 files changed, 61 insertions, 0 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 */
+