posix-pty 0.2.1 → 0.2.2

raw patch · 4 files changed

Files

• System/Posix/Pty.hs +4/−2
• cbits/fork_exec_with_pty.c +28/−14
• posix-pty.cabal +15/−13
• tests/stty.hs +15/−0

@@ -54,6 +54,7 @@ import Control.Applicative #endif +import Control.Concurrent (withMVar) import Control.Exception (bracket, throwIO, ErrorCall(..)) import Control.Monad (when) @@ -74,7 +75,7 @@ import System.IO.Error (mkIOError, eofErrorType) import System.Posix.IO (fdReadBuf, fdWriteBuf,closeFd) import System.Posix.Types-import System.Process.Internals (mkProcessHandle, ProcessHandle)+import System.Process.Internals (mkProcessHandle, runInteractiveProcess_lock, ProcessHandle)  import qualified System.Posix.Terminal as T import System.Posix.Terminal hiding@@ -225,7 +226,8 @@         bracket allocLists cleanupLists $ \(argv, env) -> do             alloca $ \pidPtr -> do                 fd <- throwErrnoIfMinus1Retry "failed to fork or open pty" $-                        fork_exec_with_pty x y search path argv env pidPtr+                        withMVar runInteractiveProcess_lock $ \_ ->+                          fork_exec_with_pty x y search path argv env pidPtr                  pid <- peek pidPtr                 handle <- mkProcessHandle (fromIntegral pid) True

@@ -13,14 +13,20 @@  #if defined(__APPLE__) #include <util.h>-#elif defined(__linux__)+#elif defined(__GLIBC__) #include <pty.h>-#else /* bsd */+#else /* bsd without glibc */ #include <libutil.h> #endif  #include <HsFFI.h> +#include "Rts.h"++// Rts internal API, not exposed in a public header file+extern void blockUserSignals(void);+extern void unblockUserSignals(void);+ #include "fork_exec_with_pty.h"  /* Should be exported by unistd.h, but isn't on OSX. */@@ -41,27 +47,30 @@     int pty;     int packet_mode = 1;     struct winsize ws;-    struct termios tio;      /* Set the terminal size and settings. */     memset(&ws, 0, sizeof ws);     ws.ws_col = sx;     ws.ws_row = sy; -    memset(&tio, 0, sizeof tio);-    tio.c_iflag = TTYDEF_IFLAG;-    tio.c_oflag = TTYDEF_OFLAG;-    tio.c_lflag = TTYDEF_LFLAG;-    tio.c_cflag = TTYDEF_CFLAG;-    memcpy(&tio.c_cc, ttydefchars, sizeof tio.c_cc);-    cfsetspeed(&tio, TTYDEF_SPEED);-     /* Fork and exec, returning the master pty. */-    *child_pid = forkpty(&pty, NULL, &tio, &ws);+    blockUserSignals();+    stopTimer();++    *child_pid = forkpty(&pty, NULL, NULL, &ws);++    int ret = pty;+     switch (*child_pid) {     case -1:+        unblockUserSignals();+        startTimer();+         return -1;     case 0:+        /* Child process */+        unblockUserSignals();+         /* If an environment is specified, override the old one. */         if (env) environ = (char**) env; @@ -72,10 +81,15 @@         perror("exec failed");         exit(EXIT_FAILURE);     default:+        /* Parent process */+         /* Switch the pty to packet mode, we'll deal with packeting on the            haskell side of things. */-        if (ioctl(pty, TIOCPKT, &packet_mode) == -1) return 1;+        if (ioctl(pty, TIOCPKT, &packet_mode) == -1) ret = 1; -        return pty;+        unblockUserSignals();+        startTimer();++        return ret;     } }

@@ -1,12 +1,12 @@ Name:                posix-pty-Version:             0.2.1+Version:             0.2.2  Homepage:            https://bitbucket.org/merijnv/posix-pty Bug-Reports:         https://github.com/merijn/posix-pty/issues  Author:              Merijn Verstraaten Maintainer:          Merijn Verstraaten <merijn@inconsistent.nl>-Copyright:           Copyright © 2013-2015 Merijn Verstraaten,+Copyright:           Copyright © 2013-2020 Merijn Verstraaten,                      Copyright © 2014 Vladimir Kirillov  License:             BSD3@@ -28,31 +28,33 @@ Library   Default-Language:     Haskell2010   GHC-Options:          -Wall-  GHC-Prof-Options:     -auto-all -caf-all -rtsopts   Exposed-Modules:      System.Posix.Pty   Other-Modules:            C-Sources:            cbits/fork_exec_with_pty.c cbits/pty_size.c-  CC-Options:           -Wall -Wextra -pedantic -std=c99+  CC-Options:           -Wall -Wextra -std=c99   Include-Dirs:         cbits   Includes:             fork_exec_with_pty.h pty_size.h    Build-Depends:        base >= 4 && < 5                ,        bytestring >= 0.10-               ,        process >= 1.2+               ,        process >= 1.6.6.0                ,        unix >= 2.6    if os(linux) || os(freebsd)     Extra-Libraries: util +Test-Suite stty+  Type: exitcode-stdio-1.0+  Default-Language:     Haskell2010+  Main-Is:              stty.hs+  Ghc-Options:          -w -threaded -rtsopts -with-rtsopts=-N+  Hs-Source-Dirs:       tests+  Build-Depends:        base+               ,        bytestring+               ,        posix-pty+               ,        process+ Source-Repository head   Type:     git   Location: ssh://github.com:merijn/posix-pty.git--Source-Repository head-  Type:     mercurial-  Location: git+ssh://github.com:merijn/posix-pty.git--Source-Repository head-  Type:     mercurial-  Location: https://bitbucket.org/merijnv/posix-pty

@@ -0,0 +1,15 @@+{-# LANGUAGE LambdaCase #-}+module Main where++import Control.Monad (forever, void)+import Data.ByteString as BS (putStr)+import System.Process (waitForProcess)+import System.Posix.Pty++main :: IO ()+main = do+    (pty, hnd) <- spawnWithPty Nothing True "stty" ["-a"] (10, 10)+    forever $ tryReadPty pty >>= \case+        Left e -> print e+        Right s -> BS.putStr s >> putStrLn ""+    void $ waitForProcess hnd