RS-232 terminal tunneled over TCP

tcp-tty.hs

#!/usr/bin/runhaskell

import Control.Concurrent
import Control.Monad

import qualified Data.ByteString.Lazy as BSL

import Network

import System.IO
import System.Posix.Terminal
import System.Serial

main = do tty <- openSerial "/dev/ttyS0" B19200 8 One NoParity Software
          hSetBuffering tty NoBuffering
          socket <- listenOn $ PortNumber 9898
          putStrLn "Listening on port 9898"
          acceptTerminal socket tty
          forever $ acceptClient socket tty

acceptTerminal :: Socket -> Handle -> IO ()
acceptTerminal socket tty = do
  (term, _, _) <- accept socket
  hSetBuffering term NoBuffering
  forkIO $ BSL.hGetContents tty >>= BSL.hPutStr term
  forkIO $ BSL.hGetContents term >>= BSL.hPutStr tty
  putStrLn "Terminal connected"

acceptClient :: Socket -> Handle -> IO ()
acceptClient socket tty = do
  (client, _, _) <- accept socket
  putStrLn "Client connected"
  input <- BSL.hGetContents client
  BSL.hPutStr tty input
  putStrLn $
    "Client disconnected after sending " ++ show (BSL.length input) ++ " bytes"