Socket library ghc 5.02.1

[Sigbjorn Finne]

This is a multi-part message in MIME format.

------=_NextPart_000_0804_01C17726.1850B6D0
Content-Type: text/plain;
	charset="iso-8859-1"
Content-Transfer-Encoding: 7bit


> 
> Conclusion: you're hosed with ghc-5.02.1 and its socket libs under
> Win32. Sorry.
> 

If you don't mind getting your hands a (little) bit dirty, here's a story
that will work ghc-5.02.1:

* edit SocketPrim.hi (and SocketPrim.p_hi), to instead of saying 
   "Socket" in its __export section it says "Socket{MkSocket}"

   (you'll find the .hi file in imports/net/ inside your 5.02.1 tree).

* compile up the attached NetExtra.hs as follows:
  
     foo$ ghc -c NetExtra.hs -fvia-C -fglasgow-exts -package net

* import and include NetExtra with your socket code, e.g.,

    main = Socket.withSocketsDo $ do
       protNum <- getProtocolNumber "tcp"
       s <- socket AF_INET Stream protNum
       hostAddr <- inet_addr "127.0.0.1"
       let sAddr =  (SockAddrInet 80 hostAddr)
       connect s sAddr
       send s "GET / HTTP/1.0\r\n\r\n"
       str <- recvAll s
       putStr str

    recvAll :: Socket -> IO String
    recvAll sock = do
         str <- catch (recv s 100) (\ _ -> return "")
         case str of
          "" -> return str
          _  -> do
             ls <- recvAll sock
             return (str ++ ls)


hth
--sigbjorn


------=_NextPart_000_0804_01C17726.1850B6D0
Content-Type: application/octet-stream;
	name="NetExtra.hs"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
	filename="NetExtra.hs"

{-# OPTIONS -#include "HsNet.h" #-}
module NetExtra=20
	( fdSocket 	-- :: Socket -> CInt
	, send		-- :: Socket -> String -> IO Int
	, recv		-- :: Socket -> Int -> IO String
	) where

import SocketPrim

import CForeign
import Foreign

import Concurrent ( threadWaitWrite, threadWaitRead )

import PrelCError
import CString
import CTypes
import Ptr
import Monad

fdSocket :: Socket -> CInt
fdSocket (MkSocket fd _ _ _ _) =3D fd

send :: Socket -> String -> IO Int
send sock xs =3D do
 let fd =3D fdSocket sock
 withCString xs $ \str -> do
  liftM fromIntegral $
     throwErrnoIfMinus1Retry_repeatOnBlock "send"
	(threadWaitWrite (fromIntegral fd)) $
	c_send fd str (fromIntegral $ length xs) 0{-flags-}=20

recv :: Socket -> Int -> IO String
recv sock nbytes =3D do
  let fd =3D fdSocket sock
  allocaBytes nbytes $ \ptr -> do
        len <- throwErrnoIfMinus1Retry_repeatOnBlock "recv"=20
        	   (threadWaitRead (fromIntegral fd)) $
        	   c_recv fd ptr (fromIntegral nbytes) 0{-flags-}=20
        let len' =3D fromIntegral len
        peekCStringLen (ptr,len')

-- ripped straight out of SocketPrim.hsc
throwErrnoIfMinus1Retry_repeatOnBlock :: Num a =3D> String -> IO b -> IO =
a -> IO a
throwErrnoIfMinus1Retry_repeatOnBlock name on_block act =3D do
  throwErrnoIfMinus1Retry_mayBlock name (on_block >> repeat) act
  where repeat =3D throwErrnoIfMinus1Retry_repeatOnBlock name on_block =
act

throwErrnoIfMinus1Retry_mayBlock :: Num a =3D> String -> IO a -> IO a -> =
IO a
throwErrnoIfMinus1Retry_mayBlock name on_block act =3D do
    res <- act
    if res =3D=3D -1
        then do
            err <- getErrno
            if err =3D=3D eINTR
                then throwErrnoIfMinus1Retry_mayBlock name on_block act
	        else if err =3D=3D eWOULDBLOCK || err =3D=3D eAGAIN
		        then on_block
                        else throwErrno name
        else return res

foreign import "send" unsafe
  c_send :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt

foreign import "recv" unsafe
  c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt

------=_NextPart_000_0804_01C17726.1850B6D0--