src/Network/WireGuard/Foreign/Tun.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

{-# LANGUAGE CPP #-}

module Network.WireGuard.Foreign.Tun
  ( openTun
  , tunReadBuf
  , tunWriteBuf
  ) where

import           Control.Concurrent     (threadWaitRead, threadWaitWrite)
import           Control.Monad          (forM_)
import           System.Posix.Internals (setNonBlockingFD)
import           System.Posix.Types     (Fd (..))

import           Foreign
import           Foreign.C

openTun :: String -> Int -> IO (Maybe [Fd])
openTun intfName threads =
    withCString intfName $ \intf_name_c ->
    allocaArray threads $ \fds_c -> do
        res <- tun_alloc_c intf_name_c (fromIntegral threads) fds_c  -- TODO: handle exception
        if res > 0
          then do
            fds <- peekArray (fromIntegral res) fds_c
            forM_ fds $ \fd -> setNonBlockingFD fd True
            return (Just (map Fd fds))
          else return Nothing

tunReadBuf :: Fd -> Ptr Word8 -> CSize -> IO CSize
tunReadBuf _fd _buf 0 = return 0
tunReadBuf fd buf nbytes =
    fmap fromIntegral $
        throwErrnoIfMinus1RetryMayBlock "tunReadBuf"
            (tun_read_c (fromIntegral fd) (castPtr buf) nbytes)
                (threadWaitRead fd)

tunWriteBuf :: Fd -> Ptr Word8 -> CSize -> IO CSize
tunWriteBuf fd buf len =
    fmap fromIntegral $
        throwErrnoIfMinus1RetryMayBlock "tunWriteBuf"
            (tun_write_c (fromIntegral fd) (castPtr buf) len)
                (threadWaitWrite fd)

foreign import ccall unsafe "tun.h tun_alloc" tun_alloc_c :: CString -> CInt -> Ptr CInt -> IO CInt

#ifdef OS_MACOS
foreign import ccall unsafe "tun.h utun_read" tun_read_c :: CInt -> Ptr CChar -> CSize -> IO CSize
foreign import ccall unsafe "tun.h utun_write" tun_write_c :: CInt -> Ptr CChar -> CSize -> IO CSize
#else
foreign import ccall unsafe "read" tun_read_c :: CInt -> Ptr CChar -> CSize -> IO CSize
foreign import ccall unsafe "write" tun_write_c :: CInt -> Ptr CChar -> CSize -> IO CSize
#endif