diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,3 +5,6 @@ * Binding to `socket`, `bind`, `listen`, `getsocketname`, `accept`, `connect`, `send*`, `recv*`, and `shutdown`. * Data type for UNIX, INET, and INET6 address. * Transmiting file descriptors over UNIX ancillary data. + +## 0.1.1.0 -- 2024-04-30 +* Expose `Socket` constructor. diff --git a/netw.cabal b/netw.cabal --- a/netw.cabal +++ b/netw.cabal @@ -1,7 +1,8 @@ cabal-version: 3.4 name: netw -version: 0.1.0.0 +version: 0.1.1.0 synopsis: Binding to C socket API operating on bytearrays. +description: Provide access to low-level socket api. Work on bytearrays. license: GPL-3.0-or-later license-file: LICENSE author: Vu Hoang Hung @@ -10,8 +11,6 @@ homepage: https://github.com/k355l3r-5yndr0m3/netw bug-reports: https://github.com/k355l3r-5yndr0m3/netw/issues -description: Provide access to low-level socket api. Work with both bytearrays and pointers. - -- copyright: category: Network build-type: Simple @@ -52,9 +51,9 @@ Netw.Internal.Cmsg Netw.Internal.Type - build-depends: base ^>=4.17.2.1, + build-depends: base >= 4.17.2.1 && < 4.19, primitive >= 0.9.0 && < 0.10, - template-haskell >= 2.19.0 && < 2.20, + template-haskell >= 2.19.0 && < 2.21, primitive-unaligned >= 0.1.1 && < 0.2, unix >= 2.7.3 && < 2.8, @@ -76,7 +75,7 @@ hs-source-dirs: test/server-client main-is: Main.hs build-depends: - base ^>=4.17.2.1, + base >= 4.17.2.1 && < 4.19, primitive, unix, netw @@ -88,7 +87,7 @@ hs-source-dirs: test/msgs main-is: Main.hs build-depends: - base ^>=4.17.2.1, + base >= 4.17.2.1 && < 4.19, primitive, unix, netw @@ -100,7 +99,7 @@ hs-source-dirs: test/unix-scm-rights main-is: Main.hs build-depends: - base ^>=4.17.2.1, + base >= 4.17.2.1 && < 4.19, primitive, unix, netw @@ -112,7 +111,7 @@ hs-source-dirs: test/send-and-recv-msgs main-is: Main.hs build-depends: - base ^>=4.17.2.1, + base >=4.17.2.1 && < 4.19, primitive, unix, netw @@ -124,6 +123,6 @@ hs-source-dirs: test/codegen main-is: Main.hs build-depends: - base ^>=4.17.2.1, + base >=4.17.2.1 && < 4.19, netw diff --git a/src/Netw/Ancillary.hs b/src/Netw/Ancillary.hs --- a/src/Netw/Ancillary.hs +++ b/src/Netw/Ancillary.hs @@ -5,6 +5,7 @@ {-| Module : Netw.Ancillary Description : Ancillary data +Portabilty : Linux This module contains ancillary data types. Ancillary data can be send and received via the sendmsg and recvmsg functions. -} diff --git a/src/Netw/Inet.hs b/src/Netw/Inet.hs --- a/src/Netw/Inet.hs +++ b/src/Netw/Inet.hs @@ -7,6 +7,7 @@ {-| Module : Netw.Inet Description : Internet +Portabilty : Linux This module contains internet address types and some utility functions. -} diff --git a/src/Netw/SockAddr.hsc b/src/Netw/SockAddr.hsc --- a/src/Netw/SockAddr.hsc +++ b/src/Netw/SockAddr.hsc @@ -5,6 +5,7 @@ {-| Module : Netw.SockAddr Description : Various socket address types +Portabilty : Linux -} module Netw.SockAddr ( SockAddr (..), Addr(..) diff --git a/src/Netw/Socket.hs b/src/Netw/Socket.hs --- a/src/Netw/Socket.hs +++ b/src/Netw/Socket.hs @@ -5,11 +5,12 @@ {-| Module : Netw.Socket Description : Core functions +Portabilty : Linux This module contains all the functions required to create and use sockets. -} module Netw.Socket -( Socket +( Socket (..) , socket, closeSocket , bind, listen, getsockname , accept, accept_ @@ -54,7 +55,7 @@ -- | -- A file descriptor that is a socket. -- All socket used by this library is in nonblocking mode (O_NONBLOCK) -newtype Socket = MkSocket { unSocket :: Fd } +newtype Socket = MkSocket { unSocket :: Fd } -- | Create a new socket (see `man 3 socket`) socket :: ProtocolFamily -> SocketType -> Protocol -> IO Socket diff --git a/test/msgs/Main.hs b/test/msgs/Main.hs --- a/test/msgs/Main.hs +++ b/test/msgs/Main.hs @@ -64,7 +64,6 @@ s <- forkProcess (serverMain sunPath) c <- forkProcess (clientMain sunPath) - serverExit <- maybe (fail "Server failure") return =<< getProcessStatus True True s clientExit <- maybe (fail "Client failure") return =<< getProcessStatus True True c diff --git a/test/send-and-recv-msgs/Main.hs b/test/send-and-recv-msgs/Main.hs --- a/test/send-and-recv-msgs/Main.hs +++ b/test/send-and-recv-msgs/Main.hs @@ -5,6 +5,7 @@ import Netw.SockAddr import Control.Monad +import Control.Exception import Data.Function import Data.Primitive @@ -30,34 +31,36 @@ server :: IO () server = do servSock <- socket PF_UNIX SOCK_STREAM DefaultProtocol - bind servSock (SockAddrUn serverPath) - listen servSock 1 - clieSock <- accept_ servSock - - bufs <- mapM (\ (sizeofByteArray -> n) -> (, 0, n) <$> newByteArray n) messages - fix (\ recvmore buffers nbytes -> - let incrementBuffer 0 b = b - incrementBuffer n (b:bs) = - let (mba, offs, size) = b - in if size > n - then - (mba, offs + n, size - n):bs - else - incrementBuffer (n - size) bs - incrementBuffer n [] - | n == 0 = [] - | otherwise = error "Impossible" - in when (nbytes > 0) $ - do - (brecv, _, _) <- recvmsg_ clieSock buffers 0 zeroBits - recvmore (incrementBuffer brecv buffers) (nbytes - brecv)) bufs (sum (sizeofByteArray <$> messages)) - receivedMessage <- mapM (\ (b, _, _) -> unsafeFreezeByteArray b) bufs - - print (if receivedMessage == messages then "Success" else "Failure") - - closeSocket clieSock - closeSocket servSock - removeLink serverPath + finally (do + bind servSock (SockAddrUn serverPath) + listen servSock 1 + clieSock <- accept_ servSock + + bufs <- mapM (\ (sizeofByteArray -> n) -> (, 0, n) <$> newByteArray n) messages + fix (\ recvmore buffers nbytes -> + let incrementBuffer 0 b = b + incrementBuffer n (b:bs) = + let (mba, offs, size) = b + in if size > n + then + (mba, offs + n, size - n):bs + else + incrementBuffer (n - size) bs + incrementBuffer n [] + | n == 0 = [] + | otherwise = error "Impossible" + in when (nbytes > 0) $ + do + (brecv, _, _) <- recvmsg_ clieSock buffers 0 zeroBits + recvmore (incrementBuffer brecv buffers) (nbytes - brecv)) bufs (sum (sizeofByteArray <$> messages)) + receivedMessage <- mapM (\ (b, _, _) -> unsafeFreezeByteArray b) bufs + + print (if receivedMessage == messages then "Success" else "Failure") + + closeSocket clieSock + ) (do + closeSocket servSock + removeLink serverPath) client :: IO () client = do