> module PortListener (startup, HookList, Tunnel.Eval)
>  where

> import DHSCore
> import ObjIO

#ifndef __HUGS__

> import NetTCP as Network hiding (startup)

#else

> import NetFIFO as Network hiding (startup, myGetVar)

#endif

#ifdef CONCDEBUG

> import ConcurrentDebug as Concurrent

#else

> import ConcurrentDebugLess as Concurrent

#endif

> import IO hiding (Handle)
> import Dictionary hiding (startup)
> import Register hiding (startup)
> import LinkList hiding (startup)
> import Maybe
> import Monad
> import Network.BSD as BSD
> import Prelude hiding ( lookup )
> import qualified Prelude
> import qualified Tunnel

> data TCPMsg = TCPDown | TCPData String
> data MuxMsg = Quit | Msg (Handle, Network.Hostname, Port)

> type HookList a = [(Char,(Network.Hostname -> Port -> a -> Tunnel.Eval a -> String -> IO Bool))]

We can´t use select() instead of heavy fork()ing: The hSelect function
will block all threads :(

> startup :: Net -> (Dictionary,Register,HookList Handle) ->
>	     Socket -> MVar () -> MVar () -> IO ()
> startup net args@(dict,register,hookList) socket syncMVar haltMVar = do
>   labelThread "PortListener.main"

Tell DHS we´re ready:

>   putMVar syncMVar ()

Fork a process which watches the haltMVar:

>   muxCh <- newChan
>   labelChan muxCh "PortListener.mux"
>   forkIOLabel "PortListener.halt" (takeMVar haltMVar >> writeChan muxCh Quit)

>   portListener socket muxCh
>    where
>     portListener socket mux = do
>      forkIOLabel "PortListener.accept" ( do
>        h <- socket#accept
>	 writeChan mux (Msg h))
>      msg <- readChan mux
>      case msg of
>        Quit -> return () -- We´re out
>	 Msg (handle,host,port) -> do
>	   he <- BSD.getHostByName host
>	   let ip = addressToIP (BSD.hostAddress he)
>	   forkIOLabel (host ++ ":" ++ (show port))
>	     (readLoop args handle ip port)
>	   portListener socket mux

Exported so we can get a grip on it from the outside:

> readLoop :: IOObj a => (Dictionary,Register, HookList a) -> a -> String -> Port -> IO ()
> readLoop args handle ip port = do
>   line <- catch (handle#readH)

We can draw no conclusions from any error. So just go on.

>		  (\e -> do putStrLn ("hGetLine failed for host " ++
>				      ip ++ ", reason:\n"++(show e))
>			    return [])
>   closeTun <- evalMsg args handle line ip port
>   if closeTun
>     then (handle#closeH)
>     else readLoop args handle ip port

XXX Note that evalMsg *must* *not* use the handle! This is just for passing on to hooks!

> evalMsg :: IOObj a => (Dictionary,Register, HookList a) ->
>	     a -> String -> Network.Hostname -> Port -> IO Bool
> evalMsg args@(dict,register,hookList) handle msg host port = do
>   -- print $ "eval " ++ msg
>   case msg of
>     '+':msg' -> do
>       let (pidStr,('+':vStr)) = span (/='+') msg'
>       let p = (read pidStr):: PidInt
>       res <- (dict#lookup) p
>       case res of

You tried sending to a process that didn't exist:

>         Nothing -> return ()

Otherwise deliver it via channel:

>         Just ch -> writeChan ch vStr 
>       return False

A message to a registered process:

>     '#':msg' -> do
>       let (serviceStr,('#':v)) = span (/='#') msg'
>       answer <- (register#rLookup) serviceStr
>       case answer of
>         Just i -> do
>	    d <- (dict#lookup) i
>	    case d of
>	      Just ch -> writeChan ch v
>	      Nothing -> putStrLn "Internal db inconsistency!"
>         Nothing -> do 
>           putStrLn "Message to unregistered service!"
>       return False

Lookup:

>     '$':msg' -> do
>       let (serviceStr,_) = span (/='\r') msg'
>	print serviceStr
>       answer <- (register#rLookup) serviceStr
>	(handle#writeH) (show answer)
>       return False

Hook-list:
  
>     c:str -> do
>       let f = Prelude.lookup c hookList
>       case f of
>         Nothing -> do
>           putStrLn ("Junk received: " ++ msg)
>           return False
>         Just f  -> do
>           f host port handle (evalMsg args) str