From d17b03d4d4525103f1995441045eae4c2c73355d Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Sat, 30 Jan 2016 16:46:56 +0100 Subject: Don't assume `tcdrain` and `ctermid` exist always This follows the scheme suggested in #24 This fixes #55 --- System/Posix/Terminal.hsc | 18 +++++++++++++++++- System/Posix/Terminal/ByteString.hsc | 17 ++++++++++++++++- System/Posix/Terminal/Common.hsc | 16 +++++++++++++++- changelog.md | 4 +++- configure.ac | 13 +++++++++++++ 5 files changed, 64 insertions(+), 4 deletions(-) diff --git a/System/Posix/Terminal.hsc b/System/Posix/Terminal.hsc index c8335a6..88bd93f 100644 --- a/System/Posix/Terminal.hsc +++ b/System/Posix/Terminal.hsc @@ -1,3 +1,4 @@ +{-# LANGUAGE CApiFFI #-} #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 703 @@ -83,6 +84,11 @@ import System.Posix.IO import System.Posix.Internals (peekFilePath) +#if !HAVE_CTERMID +import System.IO.Error ( ioeSetLocation ) +import GHC.IO.Exception ( unsupportedOperation ) +#endif + -- | @getTerminalName fd@ calls @ttyname@ to obtain a name associated -- with the terminal for @Fd@ @fd@. If @fd@ is associated -- with a terminal, @getTerminalName@ returns the name of the @@ -100,13 +106,23 @@ foreign import ccall unsafe "ttyname" -- controlling terminal exists, -- @getControllingTerminalName@ returns the name of the -- controlling terminal. +-- +-- Throws 'IOError' (\"unsupported operation\") if platform does not +-- provide @ctermid(3)@ (use @#if HAVE_CTERMID@ CPP guard to +-- detect availability). getControllingTerminalName :: IO FilePath +#if HAVE_CTERMID getControllingTerminalName = do s <- throwErrnoIfNull "getControllingTerminalName" (c_ctermid nullPtr) peekFilePath s -foreign import ccall unsafe "ctermid" +foreign import capi unsafe "termios.h ctermid" c_ctermid :: CString -> IO CString +#else +{-# WARNING getControllingTerminalName + "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_CTERMID@)" #-} +getControllingTerminalName = ioError (ioeSetLocation unsupportedOperation "getControllingTerminalName") +#endif -- | @getSlaveTerminalName@ calls @ptsname@ to obtain the name of the -- slave terminal associated with a pseudoterminal pair. The file diff --git a/System/Posix/Terminal/ByteString.hsc b/System/Posix/Terminal/ByteString.hsc index fd44c85..3c7abfb 100644 --- a/System/Posix/Terminal/ByteString.hsc +++ b/System/Posix/Terminal/ByteString.hsc @@ -1,3 +1,4 @@ +{-# LANGUAGE CApiFFI #-} #if __GLASGOW_HASKELL__ >= 709 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 703 @@ -91,6 +92,10 @@ import Foreign.C hiding ( import System.Posix.ByteString.FilePath +#if !HAVE_CTERMID +import System.IO.Error ( ioeSetLocation ) +import GHC.IO.Exception ( unsupportedOperation ) +#endif -- | @getTerminalName fd@ calls @ttyname@ to obtain a name associated -- with the terminal for @Fd@ @fd@. If @fd@ is associated @@ -109,13 +114,23 @@ foreign import ccall unsafe "ttyname" -- controlling terminal exists, -- @getControllingTerminalName@ returns the name of the -- controlling terminal. +-- +-- Throws 'IOError' (\"unsupported operation\") if platform does not +-- provide @ctermid(3)@ (use @#if HAVE_CTERMID@ CPP guard to +-- detect availability). getControllingTerminalName :: IO RawFilePath +#if HAVE_CTERMID getControllingTerminalName = do s <- throwErrnoIfNull "getControllingTerminalName" (c_ctermid nullPtr) peekFilePath s -foreign import ccall unsafe "ctermid" +foreign import capi unsafe "termios.h ctermid" c_ctermid :: CString -> IO CString +#else +{-# WARNING getControllingTerminalName + "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_CTERMID@)" #-} +getControllingTerminalName = ioError (ioeSetLocation unsupportedOperation "getControllingTerminalName") +#endif -- | @getSlaveTerminalName@ calls @ptsname@ to obtain the name of the -- slave terminal associated with a pseudoterminal pair. The file diff --git a/System/Posix/Terminal/Common.hsc b/System/Posix/Terminal/Common.hsc index 49418f5..4825b10 100644 --- a/System/Posix/Terminal/Common.hsc +++ b/System/Posix/Terminal/Common.hsc @@ -78,6 +78,11 @@ import Foreign.Storable ( Storable(..) ) import System.IO.Unsafe ( unsafePerformIO ) import System.Posix.Types +#if !HAVE_TCDRAIN +import System.IO.Error ( ioeSetLocation ) +import GHC.IO.Exception ( unsupportedOperation ) +#endif + -- ----------------------------------------------------------------------------- -- Terminal attributes @@ -408,12 +413,21 @@ foreign import capi unsafe "termios.h tcsendbreak" -- | @drainOutput fd@ calls @tcdrain@ to block until all output -- written to @Fd@ @fd@ has been transmitted. +-- +-- Throws 'IOError' (\"unsupported operation\") if platform does not +-- provide @tcdrain(3)@ (use @#if HAVE_TCDRAIN@ CPP guard to +-- detect availability). drainOutput :: Fd -> IO () +#if HAVE_TCDRAIN drainOutput (Fd fd) = throwErrnoIfMinus1_ "drainOutput" (c_tcdrain fd) foreign import capi unsafe "termios.h tcdrain" c_tcdrain :: CInt -> IO CInt - +#else +{-# WARNING drainOutput + "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TCDRAIN@)" #-} +drainOutput _ = ioError (ioeSetLocation unsupportedOperation "drainOutput") +#endif data QueueSelector = InputQueue -- TCIFLUSH diff --git a/changelog.md b/changelog.md index e9c4ece..c6d6b69 100644 --- a/changelog.md +++ b/changelog.md @@ -4,7 +4,9 @@ * Don't assume non-POSIX `WCOREDUMP(x)` macro exists - * Don't assume existence of termios constants beyond `B38400` + * Don't assume existence of `termios(3)` constants beyond `B38400` + + * Don't assume existence of `ctermid(3)`/`tcdrain(3)` * Turn build error into compile warnings for exotic `struct stat` configurations (GHC #8859). diff --git a/configure.ac b/configure.ac index 24ea3a5..f883624 100644 --- a/configure.ac +++ b/configure.ac @@ -80,6 +80,19 @@ AC_CHECK_DECLS([fdatasync],[AC_CHECK_FUNCS([fdatasync])]) AC_CHECK_FUNCS([posix_fadvise posix_fallocate]) +# Some termios(3) functions known to be missing sometimes (see also #55) +AC_CHECK_DECLS([tcdrain],[AC_DEFINE([HAVE_TCDRAIN],[1],[Define to 1 if you have the `tcdrain' function.])],[],[AC_INCLUDES_DEFAULT +#ifdef HAVE_TERMIOS_H +#include +#endif +]) + +AC_CHECK_DECLS([ctermid],[AC_DEFINE([HAVE_CTERMID],[1],[Define to 1 if you have the `ctermid' function.])],[],[AC_INCLUDES_DEFAULT +#ifdef HAVE_TERMIOS_H +#include +#endif +]) + # Avoid adding rt if absent or unneeded # shm_open needs -lrt on linux AC_SEARCH_LIBS(shm_open, rt, [AC_CHECK_FUNCS([shm_open shm_unlink])]) -- cgit v1.2.3