echo (empty) → 0.1

raw patch · 11 files changed

+654/−0 lines, 11 filesdep +Win32dep +basedep +echosetup-changed

Dependencies added: Win32, base, echo, filepath, process

Files

CHANGELOG.md +3/−0
LICENSE +30/−0
README.md +21/−0
Setup.hs +2/−0
echo.cabal +63/−0
example/Password.hs +29/−0
include/windows_cconv.h +12/−0
include/winternl_compat.h +39/−0
src/System/IO/Echo.hs +28/−0
src/System/IO/Echo/Internal.hs +187/−0
src/System/IO/Echo/MinTTY.hsc +240/−0

+ CHANGELOG.md view

@@ -0,0 +1,3 @@+## 0.1 [2016-12-22]++* First version.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2016, Ryan Scott <ryan.gl.scott@gmail.com>++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 <ryan.gl.scott@gmail.com> 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.

+ README.md view

@@ -0,0 +1,21 @@+# `echo`+[![Hackage](https://img.shields.io/hackage/v/echo.svg)][Hackage: echo]+[![Hackage Dependencies](https://img.shields.io/hackage-deps/v/echo.svg)](http://packdeps.haskellers.com/reverse/echo)+[![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/echo.svg)](https://travis-ci.org/RyanGlScott/echo)+[![Windows build](https://ci.appveyor.com/api/projects/status/a0dh9v7j995tjj2u?svg=true)](https://ci.appveyor.com/project/RyanGlScott/echo)++[Hackage: echo]:+  http://hackage.haskell.org/package/echo+  "text-show 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)"++The `base` library exposes the `hGetEcho` and `hSetEcho` functions for querying and setting echo status, but unfortunately, neither function works with MinTTY consoles on Windows. This is a serious issue, since `hGetEcho` and `hSetEcho` are often used to disable input echoing when a program prompts for a password, so many programs will reveal your password as you type it on MinTTY!++This library provides an alternative interface which works with both MinTTY and other consoles. An example is included which demonstrates how one might prompt for a password using this library. To build it, make sure to configure with the `-fexample` flag.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ echo.cabal view

@@ -0,0 +1,63 @@+name:                echo+version:             0.1+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+                     function works with MinTTY consoles on Windows. This is a serious+                     issue, since @hGetEcho@ and @hSetEcho@ are often used to disable+                     input echoing when a program prompts for a password, so many+                     programs will reveal your password as you type it on MinTTY!+                     .+                     This library provides an alternative interface which works+                     with both MinTTY and other consoles. An example is included+                     which demonstrates how one might prompt for a password using+                     this library. To build it, make sure to configure with the+                     @-fexample@ flag.+homepage:            https://github.com/RyanGlScott/echo+bug-reports:         https://github.com/RyanGlScott/echo/issues+license:             BSD3+license-file:        LICENSE+author:              Ryan Scott+maintainer:          Ryan Scott <ryan.gl.scott@gmail.com>+stability:           Provisional+copyright:           (C) 2016 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/echo++flag example+  description:         Build the bundled example program.+  default:             False++library+  exposed-modules:     System.IO.Echo+                       System.IO.Echo.Internal++  build-depends:       base >= 4.3 && < 5, process+  if os(windows)+    build-depends:     filepath, Win32+    build-tools:       hsc2hs+    include-dirs:      include+    includes:          windows_cconv.h, winternl_compat.h+    cpp-options:       "-DWINDOWS"+    other-modules:     System.IO.Echo.MinTTY+    extra-libraries:   ntdll++  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall++executable password+  if !flag(example)+    buildable:         False++  main-is:             Password.hs+  build-depends:       base >= 4.3 && < 5, echo+  hs-source-dirs:      example+  default-language:    Haskell2010+  ghc-options:         -Wall

+ example/Password.hs view

@@ -0,0 +1,29 @@+{-|+Module:      Password+Copyright:   (C) 2016 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: Portable++A simple program which prompts you for your username and password (without+leaking your password onto the screen as you type it).+-}+module Main (main) where++import System.IO (hFlush, stdout)+import System.IO.Echo (withoutInputEcho)++main :: IO ()+main = do+    putLabel "Username: "+    username <- getLine+    putLabel "Password: "+    password <- withoutInputEcho getLine++    putStrLn ""+    putStrLn "-----------------------------------"+    putStrLn $ "Your username is: " ++ username+    putStrLn $ "Your password is: " ++ password+  where+    putLabel label = putStr label >> hFlush stdout

+ include/windows_cconv.h view

@@ -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

+ include/winternl_compat.h view

@@ -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 <winternl.h>+#else+// Some declarations from winternl.h that we need in Win32+# include <windows.h>++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 */

+ src/System/IO/Echo.hs view

@@ -0,0 +1,28 @@+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Safe #-}+#endif++{-|+Module:      System.IO.Echo+Copyright:   (C) 2016 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: Portable++Exports functions that handle whether or not terminal input is handled in a way+that should be portable across different platforms and consoles.+-}+module System.IO.Echo (+      -- * Public interface+      withoutInputEcho, bracketInputEcho+    , getInputEchoState, setInputEchoState+    , EchoState, echoOff, echoOn++      -- * Alternative interface+    , getInputEcho, setInputEcho+    ) where++import System.IO.Echo.Internal

+ src/System/IO/Echo/Internal.hs view

@@ -0,0 +1,187 @@+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ >= 702+# if defined(WINDOWS)+{-# LANGUAGE Trustworthy #-}+# else+#  if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Safe #-}+#  else+{-# LANGUAGE Trustworthy #-}+#  endif+# endif+#endif++{-|+Module:      System.IO.Echo.Internal+Copyright:   (C) 2016 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: Portable++Exports functions that handle whether or not terminal input is handled in a way+that should be portable across different platforms and consoles.++Unlike "System.IO.Echo", this module exports internal functionality which, if+used improperly, can lead to runtime errors. Make sure to read the+documentation beforehand!+-}+module System.IO.Echo.Internal (+      -- * Safe public interface+      withoutInputEcho, bracketInputEcho+    , getInputEchoState, setInputEchoState+    , echoOff, echoOn++      -- * Alternative (safe) interface+    , getInputEcho, setInputEcho++      -- * Unsafe STTY internals+    , EchoState(..), STTYSettings+    , getInputEchoSTTY, setInputEchoSTTY, sttyRaw++      -- * MinTTY+    , minTTY+    ) where++import Control.Exception (bracket, throw)+import Control.Monad (void)++import Data.List (isInfixOf)++import System.Exit (ExitCode(..))+import System.IO (hGetContents, hGetEcho, hSetEcho, stdin)+import System.Process (StdStream(..), createProcess, shell,+                       std_in, std_out, waitForProcess)++#if defined(WINDOWS)+import Graphics.Win32.Misc (getStdHandle, sTD_INPUT_HANDLE)++import System.IO.Echo.MinTTY (isMinTTYHandle)+import System.IO.Unsafe (unsafePerformIO)+#endif++-- | Return whether the terminal's echoing is on ('True') or off ('False').+--+-- Note that while this works on MinTTY, it is not as efficient as+-- 'getInputEchoState', as it involves a somewhat expensive substring+-- computation.+getInputEcho :: IO Bool+getInputEcho = if minTTY+                  then do settings <- sttyRaw "-a"+                          -- This assumes that other settings come after+                          -- [-]echo in the output of `stty -a`. Luckily, this+                          -- seems to be the case on every incarnation of+                          -- MinTTY that I've tried.+                          return $ not ("-echo " `isInfixOf` settings)+                  else hGetEcho stdin++-- | Return the terminal's current input 'EchoState'.+getInputEchoState :: IO EchoState+getInputEchoState = if minTTY+                       then fmap MinTTY getInputEchoSTTY+                       else fmap DefaultTTY $ hGetEcho stdin++-- | Return all of @stty@'s current settings in a non-human-readable format.+--+-- This function is not very useful on its own. Its greater purpose is to+-- provide a compact 'STTYSettings' that can be fed back into+-- 'setInputEchoState'.+getInputEchoSTTY :: IO STTYSettings+getInputEchoSTTY = sttyRaw "-g"++-- | Set the terminal's echoing on ('True') or off ('False').+setInputEcho :: Bool -> IO ()+setInputEcho echo = if minTTY+                       then setInputEchoSTTY $ ['-' | not echo] ++ "echo"+                       else hSetEcho stdin echo++-- | Set the terminal's input 'EchoState'.+setInputEchoState :: EchoState -> IO ()+setInputEchoState (MinTTY settings) = setInputEchoSTTY settings+setInputEchoState (DefaultTTY echo) = hSetEcho stdin echo++-- | Create an @stty@ process and wait for it to complete. This is useful for+-- changing @stty@'s settings, after which @stty@ does not output anything.+--+-- @+-- setInputEchoSTTY = 'void' . 'sttyRaw'+-- @+setInputEchoSTTY :: STTYSettings -> IO ()+setInputEchoSTTY = void . sttyRaw++-- | Save the terminal's current input 'EchoState', perform a computation,+-- restore the saved 'EchoState', and then return the result of the+-- computation.+--+-- @+-- bracketInputEcho action = 'bracket' 'getInputEcho' 'setInputEcho' (const action)+-- @+bracketInputEcho :: IO a -> IO a+bracketInputEcho action = bracket getInputEcho setInputEcho (const action)++-- | Perform a computation with the terminal's input echoing disabled. Before+-- running the computation, the terminal's input 'EchoState' is saved, and the+-- saved 'EchoState' is restored after the computation finishes.+--+-- @+-- withoutInputEcho action = 'bracketInputEcho' ('setInputEchoState' 'echoOff' >> action)+-- @+withoutInputEcho :: IO a -> IO a+withoutInputEcho action = bracketInputEcho (setInputEchoState echoOff >> action)++-- | Create an @stty@ process, wait for it to complete, and return its output.+sttyRaw :: String -> IO STTYSettings+sttyRaw arg = do+  let stty = (shell $ "stty " ++ arg) {+        std_in  = UseHandle stdin+      , std_out = CreatePipe+      }+  (_, mbStdout, _, rStty) <- createProcess stty+  exStty <- waitForProcess rStty+  case exStty of+    e@ExitFailure{} -> throw e+    ExitSuccess     -> maybe (return "") hGetContents mbStdout++-- | A representation of the terminal input's current echoing state. Example+-- values include 'echoOff' and 'echoOn'.+data EchoState+  = MinTTY STTYSettings+    -- ^ The argument to (or value returned from) an invocation of the @stty@+    -- command-line utility. Most POSIX-like shells have @stty@, including+    -- MinTTY on Windows. Since neither 'hGetEcho' nor 'hSetEcho' work on+    -- MinTTY, when 'getInputEchoState' runs on MinTTY, it returns a value+    -- built with this constructor.+    --+    -- However, native Windows consoles like @cmd.exe@ or PowerShell do not+    -- have @stty@, so if you construct an 'EchoState' with this constructor+    -- manually, take care not to use it with a native Windows console.+  | DefaultTTY Bool+    -- ^ A simple on ('True') or off ('False') toggle. This is returned by+    -- 'hGetEcho' and given as an argument to 'hSetEcho', which work on most+    -- consoles, with the notable exception of MinTTY on Windows. If you+    -- construct an 'EchoState' with this constructor manually, take care not+    -- to use it with MinTTY.+  deriving (Eq, Ord, Show)++-- | Indicates that the terminal's input echoing is (or should be) off.+echoOff :: EchoState+echoOff = if minTTY then MinTTY "-echo" else DefaultTTY False++-- | Indicates that the terminal's input echoing is (or should be) on.+echoOn :: EchoState+echoOn = if minTTY then MinTTY "echo" else DefaultTTY True++-- | Settings used to configure the @stty@ command-line utility.+type STTYSettings = String++-- | Is the current process attached to a MinTTY console (e.g., Cygwin or MSYS)?+minTTY :: Bool+#if defined(WINDOWS)+minTTY = unsafePerformIO $ do+  h <- getStdHandle sTD_INPUT_HANDLE+  isMinTTYHandle h+{-# NOINLINE minTTY #-}+#else+minTTY = False+#endif

+ src/System/IO/Echo/MinTTY.hsc view

@@ -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 <ei@vuokko.info>+-- 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 <windows.h>+#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)