Tuesday, June 30, 2009

FFI: calling into kernel32.dll

Calling the Win32 API function GetComputerName makes for a nice demonstration of combining Haskell's FFI, hsc2hs, and Cabal.

The front matter:

{-# LANGUAGE ForeignFunctionInterface #-}

module Win32.Kernel32 (getComputerName) where

import Control.Monad (when, unless)
import Data.Bits ((.|.))
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (nullPtr)
import Foreign.Storable (peek, poke)
import System.Win32.Types (DWORD, LPDWORD, LPTSTR, LPVOID,
                           peekTStringLen, peekTString, withTString)

#include <windows.h>
With hsc2hs, it's possible to #include C headers and use constants in Haskell programs, as we'll see below.

Now to get hold of a few entry points in kernel32.dll. The types defined in System.Win32.Types are handy:

foreign import stdcall unsafe "GetComputerNameW"
  win32_getComputerName :: LPTSTR -> LPDWORD -> IO Bool

foreign import stdcall unsafe "GetLastError"
  win32_getLastError :: IO DWORD

foreign import stdcall unsafe "FormatMessageW"
  win32_formatMessage :: DWORD
                      -> LPVOID
                      -> DWORD
                      -> DWORD
                      -> LPTSTR
                      -> DWORD
                      -> LPVOID
                      -> IO DWORD
Note the use of the stdcall calling convention and that we're calling the wide-character versions.

GetComputerName takes two parameters, a pointer to a character-buffer and a pointer to an in-out DWORD (in: capacity; out: used). On the Haskell side, this means a couple of allocations, initialize the length parameter, call GetComputerName, and read the result:

getComputerName :: IO String
getComputerName =
  withTString maxBuf $
    \buf ->
      alloca $ \len -> do
        poke len (fromIntegral maxLength)

        success <- win32_getComputerName buf len
        unless success $ failWithLastError "GetComputerName"

        len' <- peek len
        peekTStringLen (buf, (fromIntegral len'))
    maxBuf = replicate maxLength '\0'
    maxLength = #const MAX_COMPUTERNAME_LENGTH
The #const bit at the end tells hsc2hs to substitute the value of the C preprocessor symbol MAX_COMPUTERNAME_LENGTH.

If all goes well, GetComputerName returns non-zero, but we'd like to handle cases when things go wrong. In the Win32 API, we'd call GetLastError and convert the error code to a human-readable diagnostic with FormatMessage:

failWithLastError :: String -> IO a
failWithLastError name = do
  code <- win32_getLastError
  withTString errbuf $
    \buf -> do
      gotmsg <- win32_formatMessage flags
                                    (fromIntegral errlen)
      fmtcode <- win32_getLastError
      when (gotmsg == 0) $
        fail $ name ++ " failed: " ++ show (code, fmtcode)

      msg <- peekTString buf
      fail $ name ++ ": " ++ filter notEOL msg
    errbuf = replicate errlen '\0'
    errlen = 300
    lang = 0
    notEOL c = c /= '\n' && c /= '\r'
FormatMessage can fail too, so in that case, the poor user is stuck with a couple of opaque error codes. Otherwise, peekTString copies the formatted error message for use with fail. Note also that Win32's FormatMessage is variadic, but this wrapper does not take advantage, instead passing a canned null pointer.

Having nice error messages can be sort of helpful with programming errors such as forgetting to initialize the length parameter in a call to GetComputerName:

$ cabal test
test: user error (GetComputerName: The file name is too long.)
The code above lives in a file named Kernel32.hsc. The package definition (.cabal file) points to the module name, and when Cabal finds the .hsc extension, it transparently runs the code through hsc2hs:
  hs-source-dirs:  src
  exposed-modules: Win32.Kernel32
  build-depends:   base, Win32
  extensions:      ForeignFunctionInterface
  ghc-options:     -Wall
The package includes a simple test that calls getComputerName and prints the result to the standard output, so the following sequence of commands should remind you of your machine's name:
cabal configure -ftest
cabal build
cabal test
The code is also available on GitHub.

No comments: