Main.hs

{-# LANGUAGE OverloadedLists #-}
module Main (main) where
import System.Posix.IO

import System.Posix.Process

import Netw.Socket
import Netw.SockAddr
import Netw.Ancillary

import Control.Monad

import Data.Bits
import Data.List
import Data.Primitive

import System.Posix
import System.Exit

serverMain :: FilePath -> IO ()
serverMain sunPath = do
  server <- socket PF_UNIX SOCK_STREAM DefaultProtocol
  bind server addr
  listen server 1
  
  client <- accept_ server
  buffer <- newByteArray 8
  
  (_, _, ancil) <- recvmsg_ client [(buffer, 0, 8)] 64 zeroBits
  let x :: Maybe ScmRights = (\ a -> ancillaryData a) . fst =<< uncons ancil
      y = case x of
            Nothing ->
              putStrLn "Failed to recv ancillary data"
            Just (ScmRights fds) -> do
              putStrLn "Received ancillary data"
              print fds
  y

  closeSocket client
  removeLink sunPath
  closeSocket server
  where addr = SockAddrUn sunPath
        

clientMain :: FilePath -> IO ()
clientMain sunPath = do
  server <- socket PF_UNIX SOCK_STREAM DefaultProtocol
  connect server addr
  fd <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags
  void (sendmsg server SockAddrNull [([0], 0, 1)] [mkAncillaryData (ScmRights [fd])] zeroBits)
  closeSocket server
  where addr = SockAddrUn sunPath

main :: IO ()
main = do
  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

  case (serverExit, clientExit) of
    (Exited ExitSuccess, Exited ExitSuccess) -> exitSuccess
    _otherwise -> exitFailure

  where sunPath = "/run/user/1000/test"