> module Main (main) where

XXX Too many critical errors on mistakes

TODO:
 - register as a node
 - register service names

> import DHSCore
> import Distributed (dhdLookup)
> import ObjIO
> import NetTCP as Network hiding (Hostname)
> import qualified NetTCP as Network
> import Control.Concurrent

> import IO
> import qualified IO

> -- import PosixUtil  (fdToInt)
> import System.Posix (handleToFd)

> import System
> import Char (isDigit)

> data DishPid = DishPid Hostname StrOrPort StrOrPid --Int Int | RPidR Hostname Nodename Int | RPidS Hostname Nodename String
>        -- deriving (Show)
> data StrOrPid  = StrPid String | NumPid PidInt deriving (Show)
> data StrOrPort = StrPort String | NumPort Port deriving (Show)

> main :: IO ()
> main = do
>  hSetBuffering stdout NoBuffering
>  putStr "Welcome to the Distributed Haskell Shell v1.0, "
>  net <- Network.startup "dish"

Create a socket to listen on

>  sin <- (net#listen) Nothing Nothing
>  let portInt = (sin#port)
>  putStrLn $ "listening on port " ++ (show portInt) ++ "."

Now we spawn a listener on this socket who will print any data received.

>  forkIO (listener sin)

Enter the readline-loop:

>  readLineLoop net portInt

>  where
>   listener :: Socket -> IO ()
>   listener s = do
>     --h  <- socketToHandle s ReadWriteMode
>     --fd <- handleToFd h
>     --threadWaitRead (fdToInt fd)
>     (ha,ho,po) <- s#accept
>     putStrLn $ "Connection from " ++ ho ++ ":" ++ (show po)
>     line <- ha#readH

Usually this should be a TunOpen-request:

>     line <- if (head line) == '='
>       then do
>	  line <- ha#readH
>	  return line
>       else return line
>     putStrLn line
>     putStr "> "
>     ha#closeH
>     listener s

>   readLineLoop :: Net -> Port -> IO ()
>   readLineLoop net portInt = do
>     putStr "> "
>     str <- getLine
>     case (head str) of
>       'q' -> do
>	  exitWith ExitSuccess
>	's' -> do
>	  putStr "Enter hostname,{node::String,port::Int},{service::String,pid::Int}\n  to send to: "
>	  str <- getLine
>	  let (host,(',':v)) = (\(x,y) -> (Hostname x,y)) (span (/=',') str)
>	  let (npStr,(',':v')) = span (/=',') v

Nodename or Port?

>	  let s = if (isDigit (head npStr)) then
>	               NumPort ((read npStr)::Port)
>	             else
>	               StrPort npStr

Servicename or Pid?

>	  let p = if (isDigit (head v')) then
>		     NumPid ((read v') :: PidInt)
>		else StrPid v'

>	  putStr "Message to send: "
>	  msgStr <- getLine

>	  hostname <- net#getHostName
>         sendMessage (DishPid host s p) (insert (dollarToSelf portInt hostname) msgStr)

>	'l' -> do
>	  putStr "Host to connect to [localhost]: "
>	  rhost <- getLine
>	  let host = if rhost == "" then "localhost" else rhost
>	  putStr "Nodename to look up: "
>	  node <- getLine
>	  res <- dhdLookup net (Hostname host) (Nodename node)
>	  putStrLn (show res)

>	'p' -> do
>	  putStr "Enter the pid: "
>	  p <- getLine
>	  let (Pid (host,port) pid) = ((read p) :: Pid)
>	  putStr "Message to send: "
>	  msg <- getLine
>	  sendMessage (DishPid (Hostname host) (NumPort port) (NumPid pid)) (insert (dollarToSelf portInt host) msg)

>	'h' -> do
>	  putStrLn "You can: (s)end a message to a process,"
>	  putStrLn "enter a (p)id to send a message to,"
>	  putStrLn "(l)ookup the port-number of a registered node,"
>	  putStrLn "(q)uit or try anot(h)er fixpoint iteration."
>	  putStrLn ""
>	  putStrLn "A '$' in a message will get replaced by your own Pid."
>	_ -> do
>	  putStrLn "What?"
>     readLineLoop net portInt
>    where
>      insert :: (Char -> String) -> String -> String
>      insert _ [] = []
>      insert f (s:tr) = (f s) ++ (insert f tr)
>      dollarToSelf :: Port -> String -> Char -> String
>      dollarToSelf portInt hostname '$' = "(Pid (\"" ++ hostname ++ "\"," ++ (show portInt) ++ ") 0)"
>      dollarToSelf portInt hostname x = [x]

>      sendMessage :: DishPid -> String -> IO ()
>      sendMessage (DishPid host (StrPort node) p) msg = do

Map servicename to port# using dhd. We don´t use the forward-feature(´*´) of dhd, we simply do a lookup(´$´) and handle things ourselves.

>        port <- dhdLookup net host (Nodename node)
>	 case port of
>	   Nothing -> do
>	     putStrLn "This nodename is not registered!"
>	   Just np -> do
>	     sendMessage (DishPid host (NumPort np) p) msg

>      sendMessage (DishPid (Hostname host) (NumPort port) p) msg = do
>        h <- (net#connect) host port
>	 case p of
>	   StrPid service -> do
>	     (h#writeH) ("#" ++ service ++ "#" ++ msg)
>	   NumPid p -> do
>	     (h#writeH) ("+" ++ (show p) ++ "+" ++ msg)
>        h#closeH
>	 return ()