{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} module System.SendFile.Tests (tests) where ------------------------------------------------------------------------------ import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newMVar, readMVar) import Control.Exception (evaluate) import Data.ByteString.Builder (byteString) import qualified Data.ByteString.Char8 as S import Foreign.C.Error (Errno (..), eAGAIN, eCONNRESET, eOK) import Foreign.C.Types (CChar, CInt (..), CSize) import Foreign.Storable (peek) import Test.Framework (Test) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (assertEqual) ------------------------------------------------------------------------------ import Snap.Test.Common (expectException) import qualified System.SendFile as SF #if defined(LINUX) import Control.Monad (void) import Foreign.Ptr (Ptr, nullPtr) import System.Posix.Types (COff, CSsize, Fd) import qualified System.SendFile.Linux as SFI #elif defined(FREEBSD) import Control.Monad (void) import Foreign.Ptr (Ptr) import Foreign.Storable import System.Posix.Types (COff, Fd) import qualified System.SendFile.FreeBSD as SFI #elif defined(OSX) import Control.Monad (void, when) import Foreign.Ptr (Ptr) import Foreign.Storable (poke) import System.Posix.Types (COff, Fd) import qualified System.SendFile.Darwin as SFI #endif ------------------------------------------------------------------------------ tests :: [Test] tests = [ testSendHeaders , testSendHeaderCrash , testSendFile , testSendFileCrash , testSendFileZero , testTrivials ] ------------------------------------------------------------------------------ testSendHeaders :: Test testSendHeaders = testCase "sendfile/sendHeaders" $ do callLog <- newMVar [] sampleData <- newMVar sampleActions nWaits <- newMVar (0 :: Int) let bumpWaits = \x -> x `seq` modifyMVar_ nWaits (return . (+1)) SF.sendHeadersImpl (sendHeadersMockSendFunc sampleData callLog) bumpWaits builder 100 [c1, c2, c3] <- readMVar callLog assertEqual "sendHeaders1" c1 c2 assertEqual "sendHeaders2" 8 (_sz c3) readMVar nWaits >>= assertEqual "sendHeaders3" 1 where builder = byteString $ S.replicate 10 ' ' sampleActions = [ c_set_errno eAGAIN >> return (-1) , return 2 , return 8 ] ------------------------------------------------------------------------------ testSendHeaderCrash :: Test testSendHeaderCrash = testCase "sendfile/sendHeaders/crash" $ do callLog <- newMVar [] sampleData <- newMVar sampleActions nWaits <- newMVar (0 :: Int) let bumpWaits = \x -> x `seq` modifyMVar_ nWaits (return . (+1)) expectException $ SF.sendHeadersImpl (sendHeadersMockSendFunc sampleData callLog) bumpWaits builder 100 where builder = byteString $ S.replicate 10 ' ' sampleActions = [ c_set_errno eCONNRESET >> return (-1) ] ------------------------------------------------------------------------------ testTrivials :: Test testTrivials = testCase "sendfile/trivials" $ void (evaluate $ length SF.sendFileMode) ------------------------------------------------------------------------------ data SendHeadersCallLog = SendHeadersCallLog { _fd :: Fd , _str :: Ptr CChar , _sz :: CSize , _flags :: CInt } deriving (Eq, Show, Ord) ------------------------------------------------------------------------------ sendHeadersMockSendFunc :: MVar [IO CSize] -- ^ sample outputs -> MVar [SendHeadersCallLog] -- ^ log of calls -> Fd -> Ptr CChar -> CSize -> CInt -> IO CSize sendHeadersMockSendFunc sampleData callLog !fd !cstr !clen !flags = do modifyMVar_ callLog (return . (++ [SendHeadersCallLog fd cstr clen flags])) x <- modifyMVar sampleData $ \xs -> return $! if null xs then ([], return Nothing) else (tail xs, fmap Just $! head xs) x >>= maybe (c_set_errno eCONNRESET >> return (-1)) (return) foreign import ccall unsafe "set_errno" c_set_errno :: Errno -> IO () ------------------------------------------------------------------------------ -- Testing for internal sendfile via dep injection #if defined(LINUX) data SendFileCallLog = SendFileCallLog { _sf_fd1 :: Fd , _sf_fd2 :: Fd , _sf_off :: COff , _sf_sz :: CSize } deriving (Eq, Show, Ord) ------------------------------------------------------------------------------ sendFileMockSendFunc :: MVar [IO CSize] -- ^ sample outputs -> MVar [SendFileCallLog] -- ^ log of calls -> Fd -> Fd -> Ptr COff -> CSize -> IO CSsize sendFileMockSendFunc sampleData callLog !fd1 !fd2 !cstr !clen = do cp <- if cstr == nullPtr then return (-1) else peek cstr modifyMVar_ callLog (return . (++ [SendFileCallLog fd1 fd2 cp clen])) x <- modifyMVar sampleData $ \xs -> return $! if null xs then ([], return Nothing) else (tail xs, fmap Just $! head xs) x >>= maybe (c_set_errno eCONNRESET >> return (-1)) (return . fromIntegral) #elif defined(FREEBSD) data SendFileCallLog = SendFileCallLog { _sf_fd1 :: Fd , _sf_fd2 :: Fd , _sf_off :: COff , _sf_sz :: CSize } deriving (Eq, Show, Ord) ------------------------------------------------------------------------------ sendFileMockSendFunc :: MVar [IO CInt] -- ^ sample outputs -> MVar [SendFileCallLog] -- ^ log of calls -> Fd -> Fd -> COff -> CSize -> Ptr () -> Ptr COff -> CInt -> IO CInt sendFileMockSendFunc sampleData callLog !fd1 !fd2 !off !clen !_ !pbytes !_ = do modifyMVar_ callLog (return . (++ [SendFileCallLog fd1 fd2 off clen])) x <- modifyMVar sampleData $ \xs -> return $! if null xs then ([], return Nothing) else (tail xs, fmap Just $! head xs) x >>= maybe (c_set_errno eCONNRESET >> return (-1)) return #elif defined(OSX) data SendFileCallLog = SendFileCallLog { _sf_fd1 :: Fd , _sf_fd2 :: Fd , _sf_off :: COff , _sf_sz :: COff } deriving (Eq, Show, Ord) ------------------------------------------------------------------------------ sendFileMockSendFunc :: MVar [IO CInt] -- ^ sample outputs -> MVar [SendFileCallLog] -- ^ log of calls -> Fd -> Fd -> COff -> Ptr COff -> IO CInt sendFileMockSendFunc sampleData callLog !fd1 !fd2 !off !pnbytes = do !clen <- peek pnbytes modifyMVar_ callLog (return . (++ [SendFileCallLog fd1 fd2 off clen])) x <- modifyMVar sampleData $ \xs -> return $! if null xs then ([], return Nothing) else (tail xs, fmap Just $! head xs) x >>= maybe (c_set_errno eCONNRESET >> return (-1)) (\l -> do when (l > 0) (poke pnbytes (fromIntegral l)) return l) #endif ------------------------------------------------------------------------------ testSendFile :: Test testSendFile = testCase "sendfile/sendfile-impl" $ do callLog <- newMVar [] sampleData <- newMVar sampleActions nWaits <- newMVar (0 :: Int) let bumpWaits = \x -> x `seq` modifyMVar_ nWaits (return . (+1)) SFI.sendFileImpl (sendFileMockSendFunc sampleData callLog) bumpWaits 100 101 0 10 [c1, c2] <- readMVar callLog assertEqual "sendFile1" c1 c2 assertEqual "sendFile2" 10 (_sf_sz c2) readMVar nWaits >>= assertEqual "sendFile3" 1 modifyMVar_ callLog $ const $ return [] modifyMVar_ nWaits $ const $ return 0 modifyMVar_ sampleData $ const $ return sampleActions2 SFI.sendFileImpl (sendFileMockSendFunc sampleData callLog) bumpWaits 100 101 1 9 [_, c4] <- readMVar callLog readMVar nWaits >>= assertEqual "nwaits-2" 1 assertEqual "sendFile3" 9 (_sf_sz c4) assertEqual "sendFile3-off" 1 (_sf_off c4) where sampleActions = [ c_set_errno eAGAIN >> return (-1) , c_set_errno eOK >> return 2 ] sampleActions2 = [ c_set_errno eAGAIN >> return (-1) , c_set_errno eOK >> return 2 ] ------------------------------------------------------------------------------ testSendFileZero :: Test testSendFileZero = testCase "sendfile/sendfile-zero" $ do callLog <- newMVar [] sampleData <- newMVar sampleActions nWaits <- newMVar (0 :: Int) let bumpWaits = \x -> x `seq` modifyMVar_ nWaits (return . (+1)) c <- SFI.sendFileImpl (sendFileMockSendFunc sampleData callLog) bumpWaits 100 101 0 0 readMVar callLog >>= assertEqual "empty call log" [] readMVar nWaits >>= assertEqual "no waits" 0 assertEqual "no bytes read" 0 c where sampleActions = [ c_set_errno eAGAIN >> return (-1) , c_set_errno eOK >> return 2 ] ------------------------------------------------------------------------------ testSendFileCrash :: Test testSendFileCrash = testCase "sendfile/sendFile/crash" $ do callLog <- newMVar [] sampleData <- newMVar sampleActions nWaits <- newMVar (0 :: Int) let bumpWaits = \x -> x `seq` modifyMVar_ nWaits (return . (+1)) expectException $ SFI.sendFileImpl (sendFileMockSendFunc sampleData callLog) bumpWaits 100 101 0 10 where sampleActions = [ c_set_errno eCONNRESET >> return (-1) ]