diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,2 @@ +## 0.1 [2017-01-30] +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2017, Ryan Scott + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Ryan Scott nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,21 @@ +# `mintty` +[![Hackage](https://img.shields.io/hackage/v/mintty.svg)][Hackage: mintty] +[![Hackage Dependencies](https://img.shields.io/hackage-deps/v/mintty.svg)](http://packdeps.haskellers.com/reverse/mintty) +[![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)][Haskell.org] +[![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)][tl;dr Legal: BSD3] +[![Build](https://img.shields.io/travis/RyanGlScott/mintty.svg)](https://travis-ci.org/RyanGlScott/mintty) +[![Windows build](https://ci.appveyor.com/api/projects/status/kj3knsx19ebh9wly?svg=true)](https://ci.appveyor.com/project/RyanGlScott/mintty) + +[Hackage: mintty]: + http://hackage.haskell.org/package/mintty + "mintty package on Hackage" +[Haskell.org]: + http://www.haskell.org + "The Haskell Programming Language" +[tl;dr Legal: BSD3]: + https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29 + "BSD 3-Clause License (Revised)" + +MinTTY is a Windows-specific terminal emulator for the widely used Cygwin and MSYS projects, which provide Unix-like environments for Windows. MinTTY consoles behave differently from native Windows consoles (such as `cmd.exe` or PowerShell) in many ways, and in some cases, these differences make it necessary to treat MinTTY consoles differently in code. + +The `mintty` library provides a simple way to detect if your code in running in a MinTTY console on Windows. It exports `isMinTTY`, which does the right thing 90% of the time (by checking if standard error is attached to MinTTY), and it also exports `isMinTTYHandle` for the other 10% of the time (when you want to check is some arbitrary handle is attached to MinTTY). As you might expect, both of these functions will simply return `False` on any non-Windows operating system. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/include/windows_cconv.h b/include/windows_cconv.h new file mode 100644 --- /dev/null +++ b/include/windows_cconv.h @@ -0,0 +1,12 @@ +#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 new file mode 100644 --- /dev/null +++ b/include/winternl_compat.h @@ -0,0 +1,39 @@ +#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/mintty.cabal b/mintty.cabal new file mode 100644 --- /dev/null +++ b/mintty.cabal @@ -0,0 +1,62 @@ +name: mintty +version: 0.1 +synopsis: A reliable way to detect the presence of a MinTTY console on Windows +description: MinTTY is a Windows-specific terminal emulator for the + widely used Cygwin and MSYS projects, which provide + Unix-like environments for Windows. MinTTY consoles behave + differently from native Windows consoles (such as + @cmd.exe@ or PowerShell) in many ways, and in some cases, + these differences make it necessary to treat MinTTY + consoles differently in code. + . + The @mintty@ library provides a simple way to detect if + your code in running in a MinTTY console on Windows. It + exports @isMinTTY@, which does the right thing 90% of the + time (by checking if standard error is attached to + MinTTY), and it also exports @isMinTTYHandle@ for the + other 10% of the time (when you want to check is some + arbitrary handle is attached to MinTTY). As you might + expect, both of these functions will simply return @False@ + on any non-Windows operating system. +homepage: https://github.com/RyanGlScott/mintty +bug-reports: https://github.com/RyanGlScott/mintty/issues +license: BSD3 +license-file: LICENSE +author: Ryan Scott +maintainer: Ryan Scott +stability: Provisional +copyright: (C) 2017 Ryan Scott +category: System +build-type: Simple +extra-source-files: CHANGELOG.md, README.md, include/*.h +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/RyanGlScott/mintty + +flag Win32-2-5 + description: Use Win32-2.5.0.0 or later. + default: True + +library + exposed-modules: System.Console.MinTTY + build-depends: base >= 4.3 && < 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.Console.MinTTY.Win32 + extra-libraries: ntdll + + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall diff --git a/src/System/Console/MinTTY.hs b/src/System/Console/MinTTY.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/MinTTY.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE CPP #-} + +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Safe #-} +#endif + +{-| +Module: System.Console.Internal +Copyright: (C) 2017 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Provisional +Portability: Portable + +Exports functions that check if a process or handle is attached to a MinTTY +console on Windows, such as Cygwin or MSYS. On non-Windows operating systems, +the functions in this module will simply return 'False'. +-} +module System.Console.MinTTY (isMinTTY, isMinTTYHandle, HANDLE) where + +#if defined(WINDOWS) +import System.Win32.Types (HANDLE) + +# if MIN_VERSION_Win32(2,5,0) +import qualified System.Win32.MinTTY as Win32 (isMinTTY, isMinTTYHandle) +# else +-- NB: This is the backported definition local to this package, which we only +-- use if the bundled version of Win32 isn't recent enough. +import qualified System.Console.MinTTY.Win32 as Win32 (isMinTTY, isMinTTYHandle) +# endif +#else /* not Windows */ +import Foreign.Ptr (Ptr) +#endif + +-- | 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 +#if defined(WINDOWS) +isMinTTY = Win32.isMinTTY +#else +isMinTTY = return False +#endif + +-- | Returns 'True' is the given handle is attached to a MinTTY console +-- (e.g., Cygwin or MSYS). Returns 'False' otherwise. +isMinTTYHandle :: HANDLE -> IO Bool +#if defined(WINDOWS) +isMinTTYHandle = Win32.isMinTTYHandle +#else +isMinTTYHandle _ = return False +#endif + +#if !defined(WINDOWS) +type HANDLE = Ptr () +#endif diff --git a/src/System/Console/MinTTY/Win32.hsc b/src/System/Console/MinTTY/Win32.hsc new file mode 100644 --- /dev/null +++ b/src/System/Console/MinTTY/Win32.hsc @@ -0,0 +1,240 @@ +{- +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.Console.MinTTY.Win32 (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)