Added -n hostname option

1 files changed, 30 insertions, 15 deletions

diff --git a/Presence/main.hs b/Presence/main.hs
index 211d7df9..86503a62 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -45,9 +45,11 @@ import qualified Data.ByteString.Lazy.Char8 as L
 import           Data.ByteString.Lazy.Char8 as L (ByteString,putStrLn)
 import qualified Prelude
 import           Prelude hiding (putStrLn)
+import System.Environment
 
 
 data UnixSession = UnixSession {
+    localhost :: ByteString,
     unix_uid :: (IORef (Maybe UserID)),
     unix_resource :: (IORef (Maybe L.ByteString)),
     presence_state :: PresenceState
@@ -60,12 +62,12 @@ instance XMPPSession UnixSession where
         L.putStrLn $ "SESSION: open " <++> bshow muid
         uid_ref <- newIORef muid
         res_ref <- newIORef Nothing
-        return $ UnixSession uid_ref res_ref state
+        return $ UnixSession (hostname state) uid_ref res_ref state
     setResource  s  resource    = do
         writeIORef (unix_resource s) (Just resource)
         L.putStrLn $ "SESSION: resource " <++> resource
     getJID       s             = do
-        let host = "localhost" -- TODO
+        let host = localhost s
         muid <- readIORef (unix_uid s)
         user <- maybe (return "nobody") 
                    (\uid -> 
@@ -78,7 +80,7 @@ instance XMPPSession UnixSession where
                    muid
         rsc <- readIORef (unix_resource s)
         let suf = maybe "" ("/"<++>) rsc
-            jid = user <++> "@" <++> L.pack host <++> suf
+            jid = user <++> "@" <++> host <++> suf
         L.putStrLn $ "SESSION: jid " <++> jid
         return jid
     closeSession _             = L.putStrLn "SESSION: close"
@@ -134,20 +136,21 @@ update_presence greedy subscribers state getStatus =
 type RefCount = Int
 
 data PresenceState = PresenceState 
-    { currentTTY    :: TVar ByteString
+    { hostname :: ByteString
+    , currentTTY    :: TVar ByteString
     , activeUsers   :: TVar (Set JID)
     , subscriberMap :: TVar (Map JID (RefCount,TChan Presence))
     , greedySubscriber :: TMVar (RefCount,TChan Presence)
     }
 
-newPresenceState = atomically $ do
+newPresenceState hostname = atomically $ do
     tty  <- newTVar ""
     us   <- newTVar (Set.empty)
     subs <- newTVar (Map.empty)
     greedy <- newEmptyTMVar
-    return $ PresenceState tty us subs greedy
+    return $ PresenceState hostname tty us subs greedy
 
-track_login state e = do
+track_login host state e = do
 #ifndef NOUTMP
     us <- UTmp.users
 #else
@@ -157,7 +160,7 @@ track_login state e = do
             if L.take 3 tty == "tty"
               then Just (jid user host tty)
               else Nothing
-        new_users = Set.fromList $ mapMaybe (toJabberId "localhost") us
+        new_users = Set.fromList $ mapMaybe (toJabberId host) us
     (tty,known_users,subs,greedy) <- atomically $ do
             tty <- readTVar                $ currentTTY state
             st  <- flip swapTVar new_users $ activeUsers state
@@ -181,10 +184,10 @@ on_chvt state vtnum = do
     update_presence greedy subs users $ matchResource tty
 
 
-start :: IO ()
-start = do
-    tracked <- newPresenceState
-    let dologin e = track_login tracked e
+start :: ByteString -> IO ()
+start host = do
+    tracked <- newPresenceState host
+    let dologin e = track_login host tracked e
         dologin :: t -> IO ()
     installHandler sigUSR1 (Catch (dologin (userError "signaled"))) Nothing
     -- installHandler sigTERM (CatchOnce (dologin (userError "term signaled"))) Nothing
@@ -197,14 +200,14 @@ start = do
             utmp_file
             dologin
 #endif
-    sock <- listenForXmppClients (UnixSessions tracked) 5222 HNil
+    sockLocals <- listenForXmppClients (UnixSessions tracked) 5222 HNil
     sockRemotes <- listenForRemotePeers (UnixSessions tracked) 5269 HNil
 
     threadDelay 1000 -- wait a moment to obtain current tty
     dologin ()
     putStrLn "\nHit enter to terminate...\n"
     getLine
-    sClose sock
+    sClose sockLocals
     sClose sockRemotes
     -- threadDelay 1000
     putStrLn "closed listener."
@@ -243,8 +246,20 @@ runOnce ps run notify = getStartupAction ps >>= doit
         run
         removeFile pidfile
 
+getOptions [] = Map.empty
+
+getOptions (('-':opt_name):xs) =
+    if xs/=[] && xs!!0!!0/='-'
+      then Map.insert (L.pack opt_name) (L.pack (xs!!0)) (getOptions (tail xs))
+      else Map.insert (L.pack opt_name) "" (getOptions xs)
+
+getOptions (x0:xs) = getOptions xs
+
 
 main = do
-    runOnce ["/var/run/presence.pid","/tmp/presence.pid"] start sendUSR1
+    opts <- fmap getOptions getArgs
+    let hostname = maybe "localhost" id (Map.lookup "n" opts)
+    L.putStrLn $ "hostname = " <++> hostname
+    runOnce ["/var/run/presence.pid","/tmp/presence.pid"] (start hostname) sendUSR1