Add getHostName

CHANGELOG.md

@@ -9,6 +9,8 @@
 * Watchdog scheme for gracefulClose.
   [#620](https://github.com/haskell/network/pull/620)
 * Exporting recvBufNoWait.
+* Support for getHostName
+  [#621](https://github.com/haskell/network/pull/621)
 
 ## Version 3.2.8.0
 

Network/Socket.hs

@@ -112,7 +112,6 @@ module Network.Socket (
     getAddrInfo,
 
     -- ** Types
-    HostName,
     ServiceName,
     AddrInfo (..),
     defaultHints,
@@ -340,6 +339,10 @@ module Network.Socket (
     getNameInfo,
     NameInfoFlag (..),
 
+    -- * Host name information
+    getHostName,
+    HostName,
+
     -- * Low level
 
     -- ** socket operations
@@ -409,7 +412,8 @@ module Network.Socket (
 
     -- * Multicast Group
     MulticastGroup (..),
-) where
+)
+where
 
 import Network.Socket.Buffer hiding (
     recvBufFrom,
@@ -423,6 +427,11 @@ import Network.Socket.Flag
 import Network.Socket.Handle
 import Network.Socket.If
 import Network.Socket.Info
+#if !defined(mingw32_HOST_OS)
+import Network.Socket.Posix.HostName(getHostName)
+#else
+import Network.Socket.Win32.HostName(getHostName)
+#endif
 import Network.Socket.Internal
 import Network.Socket.Name hiding (getPeerName, getSocketName)
 import Network.Socket.Options

Network/Socket/Posix/HostName.hsc

@@ -0,0 +1,25 @@
+module Network.Socket.Posix.HostName (
+    getHostName,
+)
+where
+
+#include "HsNet.h"
+
+import Foreign.C.Error
+import Foreign.C.String
+import Foreign.C.Types
+import Foreign.Marshal.Array
+import Network.Socket.Info (HostName)
+
+foreign import ccall unsafe "gethostname"
+    gethostname :: CString -> CSize -> IO CInt
+
+-- | Get name of current host
+--
+--   Since: 3.3.0.0
+getHostName :: IO HostName
+getHostName = allocaArray0 size $ \cstr -> do
+    throwErrnoIfMinus1_ "getHostName" $ gethostname cstr (fromIntegral size)
+    peekCString cstr
+  where
+    size = 256

Network/Socket/Win32/HostName.hsc

@@ -0,0 +1,39 @@
+{-# LANGUAGE CPP #-}
+
+#include "HsNet.h"
+##include "HsNetDef.h"
+
+module Network.Socket.Win32.HostName (
+    getHostName,
+)
+where
+
+import Foreign.C.Types
+import Foreign.Marshal.Utils
+import Foreign.Ptr
+import Foreign.Storable
+import Network.Socket.Info (HostName)
+import System.Win32.Types
+
+foreign import CALLCONV unsafe "windows.h GetComputerNameExW"
+    getComputerNameEx :: COMPUTER_NAME_FORMAT -> LPTSTR -> LPDWORD -> IO BOOL
+
+type COMPUTER_NAME_FORMAT = CInt
+
+computerNamePhysicalDnsHostname :: COMPUTER_NAME_FORMAT
+computerNamePhysicalDnsHostname = 5
+
+-- | Get name of current host
+--
+--   Since: 3.3.0.0
+getHostName :: IO HostName
+getHostName = with 0 $ \p_charcount -> do
+    -- On the first run, determine the character count and ignore any error we get
+    _ <- getComputerNameEx computerNamePhysicalDnsHostname nullPtr p_charcount
+    charcount <- peek p_charcount
+
+    -- The second time around, use the correct character count to retrieve the data
+    withTString (replicate (fromIntegral charcount) ' ') $ \name -> do
+        failIfFalse_ "GetComputerNameExW" $
+            getComputerNameEx computerNamePhysicalDnsHostname name p_charcount
+        peekTString name

network.cabal

@@ -140,6 +140,7 @@ library
             Network.Socket.ByteString.Lazy.Posix
             Network.Socket.Posix.Cmsg
             Network.Socket.Posix.CmsgHdr
+            Network.Socket.Posix.HostName
             Network.Socket.Posix.IOVec
             Network.Socket.Posix.MsgHdr
 
@@ -160,6 +161,7 @@ library
             Network.Socket.ByteString.Lazy.Windows
             Network.Socket.Win32.Cmsg
             Network.Socket.Win32.CmsgHdr
+            Network.Socket.Win32.HostName
             Network.Socket.Win32.WSABuf
             Network.Socket.Win32.MsgHdr
 

tests/Network/SocketSpec.hs

@@ -409,6 +409,10 @@
         it "holds for CmsgId" $ forAll cmsgidGen $
             \x -> (read . show $ x) == (x :: CmsgId)
 
+    describe "hostname" $ do
+        it "is not empty" $ do
+          hostname <- getHostName
+          hostname `shouldSatisfy` (not . null)
 
 -- Type-specific generators with strong bias towards pattern synonyms
 
@@ -434,7 +438,7 @@
 cmsgidGen = biasedGen (\g -> CmsgId <$> g <*> g) cmsgidPatterns arbitrary
 
 genFds :: Gen [Fd]
 genFds = listOf (Fd <$> arbitrary)
 
 -- pruned lists of pattern synonym values for each type to generate values from