<commit_before>{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Hans.Device.Tap (listDevices,openDevice) where

#include <sys/types.h>
#include <sys/uio.h>
#include <unistd.h>

import           Hans.Ethernet.Types (Mac(..))
import           Hans.Device.Types

import           Control.Concurrent
                     (threadWaitRead,forkIO,killThread,newMVar,withMVar)
import           Control.Concurrent.BoundedChan
                     (BoundedChan,newBoundedChan,readChan,tryWriteChan)
import qualified Control.Exception as X
import           Control.Monad (forever,when,foldM_)
import qualified Data.ByteString.Internal as S
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Unsafe as S
import           Data.IORef (newIORef,atomicModifyIORef',readIORef,writeIORef)
import           Data.Word (Word8)
import           Foreign.C.String (CString)
import           Foreign.C.Types (CSize(..),CLong(..),CInt(..),CChar(..))
import           Foreign.Marshal.Alloc (allocaBytes)
import           Foreign.Marshal.Array (allocaArray,peekArray)
import           Foreign.Ptr (Ptr,plusPtr)
import           Foreign.Storable (pokeByteOff)
import           System.Posix.Types (Fd(..))


-- | Not sure how this should work yet... Should it only ever show tap device
-- names? Maybe this should return a singleton list of an ephemeral device?
listDevices :: IO [DeviceName]
listDevices  = return []

openDevice :: DeviceName -> DeviceConfig -> BoundedChan InputPacket -> IO Device
openDevice devName devConfig devRecvQueue =
  do (fd,devMac) <- initTapDevice devName

     -- The `starting` lock makes sure that only one set of threads will be
     -- started at once, while the `running` var holds the ids of the running
     -- threads.
     lock      <- newMVar ()
     threadIds <- newIORef Nothing

     devStats <- newDeviceStats

     devSendQueue <- newBoundedChan (dcSendQueueLen devConfig)

     let dev = Device { .. }

         devStart = withMVar lock $ \ () ->
           do mbTids <- readIORef threadIds

              when (mbTids == Nothing) $
                do recvThread <- forkIO (tapRecvLoop dev      fd devRecvQueue)
                   sendThread <- forkIO (tapSendLoop devStats fd devSendQueue)
                   writeIORef threadIds (Just (recvThread,sendThread))

         devStop = withMVar lock $ \ () ->
           do mb <- atomicModifyIORef' threadIds ( \mb -> (mb, Nothing) )
              case mb of
                Just (recvThread,sendThread) ->
                  do killThread recvThread
                     killThread sendThread

                Nothing ->
                     return ()

         devCleanup =
           do tapClose fd

     return dev

initTapDevice :: DeviceName -> IO (Fd,Mac)
initTapDevice devName =
  do (fd,[a,b,c,d,e,f]) <-
         allocaArray 6 $ \ macPtr ->
             do fd <- S.unsafeUseAsCString devName $ \ devNamePtr ->
                          c_init_tap_device devNamePtr macPtr

                mac <- peekArray 6 macPtr
                return (fd,mac)

     when (fd < 0) (X.throwIO (FailedToOpen devName))<commit_msg>Fix a bug in devStop for tap devices<commit_after>{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Hans.Device.Tap (listDevices,openDevice) where

#include <sys/types.h>
#include <sys/uio.h>
#include <unistd.h>

import           Hans.Ethernet.Types (Mac(..))
import           Hans.Device.Types

import           Control.Concurrent
                     (threadWaitRead,forkIO,killThread,newMVar,withMVar)
import           Control.Concurrent.BoundedChan
                     (BoundedChan,newBoundedChan,readChan,tryWriteChan)
import qualified Control.Exception as X
import           Control.Monad (forever,when,foldM_)
import qualified Data.ByteString.Internal as S
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Unsafe as S
import           Data.IORef (newIORef,atomicModifyIORef',readIORef,writeIORef)
import           Data.Word (Word8)
import           Foreign.C.String (CString)
import           Foreign.C.Types (CSize(..),CLong(..),CInt(..),CChar(..))
import           Foreign.Marshal.Alloc (allocaBytes)
import           Foreign.Marshal.Array (allocaArray,peekArray)
import           Foreign.Ptr (Ptr,plusPtr)
import           Foreign.Storable (pokeByteOff)
import           System.Posix.Types (Fd(..))


-- | Not sure how this should work yet... Should it only ever show tap device
-- names? Maybe this should return a singleton list of an ephemeral device?
listDevices :: IO [DeviceName]
listDevices  = return []

openDevice :: DeviceName -> DeviceConfig -> BoundedChan InputPacket -> IO Device
openDevice devName devConfig devRecvQueue =
  do (fd,devMac) <- initTapDevice devName

     -- The `starting` lock makes sure that only one set of threads will be
     -- started at once, while the `running` var holds the ids of the running
     -- threads.
     lock      <- newMVar ()
     threadIds <- newIORef Nothing

     devStats <- newDeviceStats

     devSendQueue <- newBoundedChan (dcSendQueueLen devConfig)

     let dev = Device { .. }

         devStart = withMVar lock $ \ () ->
           do mbTids <- readIORef threadIds

              when (mbTids == Nothing) $
                do recvThread <- forkIO (tapRecvLoop dev      fd devRecvQueue)
                   sendThread <- forkIO (tapSendLoop devStats fd devSendQueue)
                   writeIORef threadIds (Just (recvThread,sendThread))

         devStop = withMVar lock $ \ () ->
           do mb <- atomicModifyIORef' threadIds ( \mb -> (Nothing, mb) )
              case mb of
                Just (recvThread,sendThread) ->
                  do killThread recvThread
                     killThread sendThread

                Nothing ->
                     return ()

         devCleanup =
           do tapClose fd

     return dev

initTapDevice :: DeviceName -> IO (Fd,Mac)
initTapDevice devName =
  do (fd,[a,b,c,d,e,f]) <-
         allocaArray 6 $ \ macPtr ->
             do fd <- S.unsafeUseAsCString devName $ \ devNamePtr ->
                          c_init_tap_device devNamePtr macPtr

                mac <- peekArray 6 macPtr
                return (fd,mac)

     when (fd < 0) (X.throwIO (FailedToOpen devName))
{'fraction_non_alphanumeric': 0.09190302646173348, 'fraction_numerical': 0.0012676279511963239, 'mean_word_length': 2.1750503018108653, 'pattern_counts': {'":': 0, '<': 35, '<?xml version=': 0, '>': 31, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '82742', 'n_tokens_mistral': 1903, 'n_tokens_neox': 1770, 'n_words': 504}