[Haskell] Faucet and drain programs no worky

[ihope]

Well, I was needing to make some circular pipelines, so I whipped up a
pair of programs called "faucet" and "drain". Stuff would flow into
the drain at the end of the pipe, when it comes out of the faucet at
the beginning. Here's the drain program:

> module Main where
>
> import Network
> import System.IO
> import System.Environment(getArgs)
>
> main = withSocketsDo $ do
>          input <- getContents
>          (args:_) <- getArgs
>          let port = PortNumber (fromInteger (read args))
>          sock <- listenOn port
>          loop sock input
>   where loop sock input = do (handle, hostname, _) <- accept sock
>                              hSetBuffering handle NoBuffering
>                              if hostname == "localhost"
>                                 then hLazyPutStr handle input
>                                 else return ()
>                              hClose handle
>                              loop sock input
>
> hLazyPutStr handle = foldr (\x xs -> hPutChar handle x >> xs) (return ())

And the faucet (much simpler, no?):

> module Main where
>
> import Network
> import System.IO
> import System.Environment(getArgs)
>
> main = withSocketsDo $ do
>          (args:_) <- getArgs
>          let port = PortNumber (fromInteger (read args))
>          conn <- connectTo "localhost" port
>          hGetContents conn >>= putStr

The problem: each drain only seems to support one faucet. You only
need multiple faucets if you want to branch off and stuff, but I like
my programs to be perfect :-) (By the way, the drain should send the
entirety of its input to every faucet, no matter when they connect.)

The other problem is that the faucet doesn't wait forever for a drain
to appear, but I'd like it to. How can I fix these problems?

--ihope