diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,6 @@ +### 0.1.3 [2017-01-30] +* The MinTTY-detection portion of this library has been split off into `mintty`, on which `echo` now depends. + ### 0.1.2 [2017-01-09] * Use more efficient implementation for `bracketInputEcho`. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -8,7 +8,7 @@ [Hackage: echo]: http://hackage.haskell.org/package/echo - "text-show package on Hackage" + "echo package on Hackage" [Haskell.org]: http://www.haskell.org "The Haskell Programming Language" diff --git a/echo.cabal b/echo.cabal --- a/echo.cabal +++ b/echo.cabal @@ -1,5 +1,5 @@ name: echo -version: 0.1.2 +version: 0.1.3 synopsis: A cross-platform, cross-console way to handle echoing terminal input description: The @base@ library exposes the @hGetEcho@ and @hSetEcho@ functions for querying and setting echo status, but unfortunately, neither @@ -23,17 +23,13 @@ copyright: (C) 2016-2017 Ryan Scott category: System build-type: Simple -extra-source-files: CHANGELOG.md, README.md, include/*.h +extra-source-files: CHANGELOG.md, README.md cabal-version: >=1.10 source-repository head type: git location: https://github.com/RyanGlScott/echo -flag Win32-2-5 - description: Use Win32-2.5.0.0 or later. - default: True - flag example description: Build the bundled example program. default: False @@ -42,21 +38,12 @@ exposed-modules: System.IO.Echo System.IO.Echo.Internal - build-depends: base >= 4.3 && < 5 - , process + build-depends: base >= 4.3 && < 5 + , process >= 1.0.1.1 && < 1.5 if os(windows) cpp-options: "-DWINDOWS" - - if flag(Win32-2-5) - build-depends: Win32 >= 2.5 - else - build-depends: filepath - , Win32 < 2.5 - build-tools: hsc2hs - include-dirs: include - includes: windows_cconv.h, winternl_compat.h - other-modules: System.IO.Echo.MinTTY - extra-libraries: ntdll + build-depends: mintty >= 0.1 && < 0.2 + , Win32 >= 2 && < 3 hs-source-dirs: src default-language: Haskell2010 diff --git a/include/windows_cconv.h b/include/windows_cconv.h deleted file mode 100644 --- a/include/windows_cconv.h +++ /dev/null @@ -1,12 +0,0 @@ -#ifndef WINDOWS_CCONV_H -#define WINDOWS_CCONV_H - -#if defined(i386_HOST_ARCH) -# define WINDOWS_CCONV stdcall -#elif defined(x86_64_HOST_ARCH) -# define WINDOWS_CCONV ccall -#else -# error Unknown mingw32 arch -#endif - -#endif diff --git a/include/winternl_compat.h b/include/winternl_compat.h deleted file mode 100644 --- a/include/winternl_compat.h +++ /dev/null @@ -1,39 +0,0 @@ -#ifndef WINTERNL_COMPAT_H -#define WINTERNL_COMPAT_H - -/* - * winternl.h is not included in MinGW, which was shipped with the 32-bit - * Windows version of GHC prior to the 7.10.3 release. - */ -#if defined(x86_64_HOST_ARCH) || \ - __GLASGOW_HASKELL__ >= 711 || \ - (__GLASGOW_HASKELL__ == 710 && \ - defined(__GLASGOW_HASKELL_PATCHLEVEL1__) && \ - __GLASGOW_HASKELL_PATCHLEVEL1__ >= 2) -# include -#else -// Some declarations from winternl.h that we need in Win32 -# include - -typedef enum _OBJECT_INFORMATION_CLASS { - ObjectBasicInformation, - ObjectNameInformation, - ObjectTypeInformation, - ObjectAllInformation, - ObjectDataInformation -} OBJECT_INFORMATION_CLASS, *POBJECT_INFORMATION_CLASS; - -typedef LONG NTSTATUS, *PNTSTATUS; - -typedef struct _UNICODE_STRING { - USHORT Length; - USHORT MaximumLength; - PWSTR Buffer; -} UNICODE_STRING, *PUNICODE_STRING; - -typedef struct _OBJECT_NAME_INFORMATION { - UNICODE_STRING Name; -} OBJECT_NAME_INFORMATION, *POBJECT_NAME_INFORMATION; -#endif - -#endif /* WINTERNL_COMPAT_H */ diff --git a/src/System/IO/Echo/Internal.hs b/src/System/IO/Echo/Internal.hs --- a/src/System/IO/Echo/Internal.hs +++ b/src/System/IO/Echo/Internal.hs @@ -56,12 +56,7 @@ #if defined(WINDOWS) import Graphics.Win32.Misc (getStdHandle, sTD_INPUT_HANDLE) - -# if MIN_VERSION_Win32(2,5,0) -import System.Win32.MinTTY (isMinTTYHandle) -# else -import System.IO.Echo.MinTTY (isMinTTYHandle) -# endif +import System.Console.MinTTY (isMinTTYHandle) import System.IO.Unsafe (unsafePerformIO) #endif diff --git a/src/System/IO/Echo/MinTTY.hsc b/src/System/IO/Echo/MinTTY.hsc deleted file mode 100644 --- a/src/System/IO/Echo/MinTTY.hsc +++ /dev/null @@ -1,240 +0,0 @@ -{- -This is a direct copy of System.Win32.MinTTY from the Win32 library. We need -this for backwards compatibility with older versions of Win32 which do not ship -with this module. --} - -{-# LANGUAGE CPP #-} -{-# LANGUAGE ScopedTypeVariables #-} - -#if __GLASGOW_HASKELL__ >= 709 -{-# LANGUAGE Safe #-} -#elif __GLASGOW_HASKELL__ >= 701 -{-# LANGUAGE Trustworthy #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : System.Win32.MinTTY --- Copyright : (c) University of Glasgow 2006 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Esa Ilari Vuokko --- Stability : provisional --- Portability : portable --- --- A function to check if the current terminal uses MinTTY. --- Much of this code was originally authored by Phil Ruffwind and the --- git-for-windows project. --- ------------------------------------------------------------------------------ - -module System.IO.Echo.MinTTY (isMinTTY, isMinTTYHandle) where - -import Graphics.Win32.Misc -import System.Win32.DLL -import System.Win32.File -import System.Win32.Types - -#if MIN_VERSION_base(4,6,0) -import Control.Exception (catch) -#endif -import Data.List (isPrefixOf, isInfixOf, isSuffixOf) -import Foreign -import Foreign.C.Types -import System.FilePath (takeFileName) - -#if __GLASGOW_HASKELL__ < 711 -#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) -#endif - --- The headers that are shipped with GHC's copy of MinGW-w64 assume Windows XP. --- Since we need some structs that are only available with Vista or later, --- we must manually set WINVER/_WIN32_WINNT accordingly. -#undef WINVER -#define WINVER 0x0600 -#undef _WIN32_WINNT -#define _WIN32_WINNT 0x0600 -##include "windows_cconv.h" -#include -#include "winternl_compat.h" - --- | Returns 'True' if the current process's standard error is attached to a --- MinTTY console (e.g., Cygwin or MSYS). Returns 'False' otherwise. -isMinTTY :: IO Bool -isMinTTY = do - h <- getStdHandle sTD_ERROR_HANDLE - `catch` \(_ :: IOError) -> - return nullHANDLE - if h == nullHANDLE - then return False - else isMinTTYHandle h - --- | Returns 'True' is the given handle is attached to a MinTTY console --- (e.g., Cygwin or MSYS). Returns 'False' otherwise. -isMinTTYHandle :: HANDLE -> IO Bool -isMinTTYHandle h = do - fileType <- getFileType h - if fileType /= fILE_TYPE_PIPE - then return False - else isMinTTYVista h `catch` \(_ :: IOError) -> isMinTTYCompat h - -- GetFileNameByHandleEx is only available on Vista and later (hence - -- the name isMinTTYVista). If we're on an older version of Windows, - -- getProcAddress will throw an IOException when it fails to find - -- GetFileNameByHandleEx, and thus we will default to using - -- NtQueryObject (isMinTTYCompat). - -isMinTTYVista :: HANDLE -> IO Bool -isMinTTYVista h = do - fn <- getFileNameByHandle h - return $ cygwinMSYSCheck fn - `catch` \(_ :: IOError) -> - return False - -isMinTTYCompat :: HANDLE -> IO Bool -isMinTTYCompat h = do - fn <- ntQueryObjectNameInformation h - return $ cygwinMSYSCheck fn - `catch` \(_ :: IOError) -> - return False - -cygwinMSYSCheck :: String -> Bool -cygwinMSYSCheck fn = ("cygwin-" `isPrefixOf` fn' || "msys-" `isPrefixOf` fn') && - "-pty" `isInfixOf` fn' && - "-master" `isSuffixOf` fn' - where - fn' = takeFileName fn --- Note that GetFileInformationByHandleEx might return a filepath like: --- --- \msys-dd50a72ab4668b33-pty1-to-master --- --- But NtQueryObject might return something like: --- --- \Device\NamedPipe\msys-dd50a72ab4668b33-pty1-to-master --- --- This means we can't rely on "\cygwin-" or "\msys-" being at the very start --- of the filepath. Therefore, we must take care to first call takeFileName --- before checking for "cygwin" or "msys" at the start using `isPrefixOf`. - -getFileNameByHandle :: HANDLE -> IO String -getFileNameByHandle h = do - let sizeOfDWORD = sizeOf (undefined :: DWORD) - -- note: implicitly assuming that DWORD has stronger alignment than wchar_t - bufSize = sizeOfDWORD + mAX_PATH * sizeOfTCHAR - allocaBytes bufSize $ \buf -> do - getFileInformationByHandleEx h fileNameInfo buf (fromIntegral bufSize) - fni <- peek buf - return $ fniFileName fni - -getFileInformationByHandleEx - :: HANDLE -> CInt -> Ptr FILE_NAME_INFO -> DWORD -> IO () -getFileInformationByHandleEx h cls buf bufSize = do - lib <- getModuleHandle (Just "kernel32.dll") - ptr <- getProcAddress lib "GetFileInformationByHandleEx" - let c_GetFileInformationByHandleEx = - mk_GetFileInformationByHandleEx (castPtrToFunPtr ptr) - failIfFalse_ "getFileInformationByHandleEx" - (c_GetFileInformationByHandleEx h cls buf bufSize) - -ntQueryObjectNameInformation :: HANDLE -> IO String -ntQueryObjectNameInformation h = do - let sizeOfONI = sizeOf (undefined :: OBJECT_NAME_INFORMATION) - bufSize = sizeOfONI + mAX_PATH * sizeOfTCHAR - allocaBytes bufSize $ \buf -> - alloca $ \p_len -> do - _ <- failIfNeg "NtQueryObject" $ c_NtQueryObject - h objectNameInformation buf (fromIntegral bufSize) p_len - oni <- peek buf - return $ usBuffer $ oniName oni - -fileNameInfo :: CInt -fileNameInfo = #const FileNameInfo - -mAX_PATH :: Num a => a -mAX_PATH = #const MAX_PATH - -objectNameInformation :: CInt -objectNameInformation = #const ObjectNameInformation - -type F_GetFileInformationByHandleEx = - HANDLE -> CInt -> Ptr FILE_NAME_INFO -> DWORD -> IO BOOL - -foreign import WINDOWS_CCONV "dynamic" - mk_GetFileInformationByHandleEx - :: FunPtr F_GetFileInformationByHandleEx -> F_GetFileInformationByHandleEx - -data FILE_NAME_INFO = FILE_NAME_INFO - { fniFileNameLength :: DWORD - , fniFileName :: String - } deriving Show - -instance Storable FILE_NAME_INFO where - sizeOf _ = #size FILE_NAME_INFO - alignment _ = #alignment FILE_NAME_INFO - poke buf fni = withTStringLen (fniFileName fni) $ \(str, len) -> do - let len' = (min mAX_PATH len) * sizeOfTCHAR - start = advancePtr (castPtr buf) (#offset FILE_NAME_INFO, FileName) - end = advancePtr start len' - (#poke FILE_NAME_INFO, FileNameLength) buf len' - copyArray start (castPtr str :: Ptr Word8) len' - poke (castPtr end) (0 :: TCHAR) - peek buf = do - vfniFileNameLength <- (#peek FILE_NAME_INFO, FileNameLength) buf - let len = fromIntegral vfniFileNameLength `div` sizeOfTCHAR - vfniFileName <- peekTStringLen (plusPtr buf (#offset FILE_NAME_INFO, FileName), len) - return $ FILE_NAME_INFO - { fniFileNameLength = vfniFileNameLength - , fniFileName = vfniFileName - } - -foreign import WINDOWS_CCONV "winternl.h NtQueryObject" - c_NtQueryObject :: HANDLE -> CInt -> Ptr OBJECT_NAME_INFORMATION - -> ULONG -> Ptr ULONG -> IO NTSTATUS - -type NTSTATUS = #type NTSTATUS -type ULONG = #type ULONG - -failIfNeg :: (Num a, Ord a) => String -> IO a -> IO a -failIfNeg = failIf (< 0) - -newtype OBJECT_NAME_INFORMATION = OBJECT_NAME_INFORMATION - { oniName :: UNICODE_STRING - } deriving Show - -instance Storable OBJECT_NAME_INFORMATION where - sizeOf _ = #size OBJECT_NAME_INFORMATION - alignment _ = #alignment OBJECT_NAME_INFORMATION - poke buf oni = (#poke OBJECT_NAME_INFORMATION, Name) buf (oniName oni) - peek buf = fmap OBJECT_NAME_INFORMATION $ (#peek OBJECT_NAME_INFORMATION, Name) buf - -data UNICODE_STRING = UNICODE_STRING - { usLength :: USHORT - , usMaximumLength :: USHORT - , usBuffer :: String - } deriving Show - -instance Storable UNICODE_STRING where - sizeOf _ = #size UNICODE_STRING - alignment _ = #alignment UNICODE_STRING - poke buf us = withTStringLen (usBuffer us) $ \(str, len) -> do - let len' = (min mAX_PATH len) * sizeOfTCHAR - start = advancePtr (castPtr buf) (#size UNICODE_STRING) - end = advancePtr start len' - (#poke UNICODE_STRING, Length) buf len' - (#poke UNICODE_STRING, MaximumLength) buf (len' + sizeOfTCHAR) - (#poke UNICODE_STRING, Buffer) buf start - copyArray start (castPtr str :: Ptr Word8) len' - poke (castPtr end) (0 :: TCHAR) - peek buf = do - vusLength <- (#peek UNICODE_STRING, Length) buf - vusMaximumLength <- (#peek UNICODE_STRING, MaximumLength) buf - vusBufferPtr <- (#peek UNICODE_STRING, Buffer) buf - let len = fromIntegral vusLength `div` sizeOfTCHAR - vusBuffer <- peekTStringLen (vusBufferPtr, len) - return $ UNICODE_STRING - { usLength = vusLength - , usMaximumLength = vusMaximumLength - , usBuffer = vusBuffer - } - -sizeOfTCHAR :: Int -sizeOfTCHAR = sizeOf (undefined :: TCHAR)