diff options
-rw-r--r-- | Presence/LocalPeerCred.hs | 8 | ||||
-rw-r--r-- | Presence/main.hs | 20 |
2 files changed, 20 insertions, 8 deletions
diff --git a/Presence/LocalPeerCred.hs b/Presence/LocalPeerCred.hs index 2d5c0628..14f5234a 100644 --- a/Presence/LocalPeerCred.hs +++ b/Presence/LocalPeerCred.hs | |||
@@ -107,15 +107,17 @@ unmap6mapped4 addr = addr | |||
107 | identifyTTY tty_pids uid inode = do | 107 | identifyTTY tty_pids uid inode = do |
108 | pid <- scanProc (show uid) (L.unpack inode) | 108 | pid <- scanProc (show uid) (L.unpack inode) |
109 | -- putStrLn $ "scanProc --> "++show pid | 109 | -- putStrLn $ "scanProc --> "++show pid |
110 | flip (maybe (return Nothing)) pid $ \(pid,ttydev) -> do | 110 | flip (maybe (return (Nothing,Nothing))) pid $ \(pid,ttydev) -> do |
111 | tty <- ttyOrDisplay pid ttydev | 111 | tty <- ttyOrDisplay pid ttydev |
112 | -- putStrLn $ "users = " ++ show tty_pids | 112 | -- putStrLn $ "users = " ++ show tty_pids |
113 | dts <- ttyToXorgs tty_pids | 113 | dts <- ttyToXorgs tty_pids |
114 | -- putStrLn $ "displays = " ++ show dts | 114 | -- putStrLn $ "displays = " ++ show dts |
115 | -- putStrLn $ "tty = " ++ show tty | 115 | -- putStrLn $ "tty = " ++ show tty |
116 | -- -- displays = [(":5",Chunk "tty7" Empty)] | 116 | -- -- displays = [(":5",Chunk "tty7" Empty)] |
117 | let tty' = if take 3 tty=="tty" then Just (L.pack tty) else lookup (parseTty tty) (map (first parseTty) dts) | 117 | let tty' = if take 3 tty=="tty" |
118 | return tty' | 118 | then Just (L.pack tty) |
119 | else lookup (parseTty tty) (map (first parseTty) dts) | ||
120 | return (tty',Just pid) | ||
119 | where | 121 | where |
120 | parseTty :: String -> Float | 122 | parseTty :: String -> Float |
121 | parseTty = read . tail . dropWhile (/=':') | 123 | parseTty = read . tail . dropWhile (/=':') |
diff --git a/Presence/main.hs b/Presence/main.hs index 7b3a7826..cd7d7898 100644 --- a/Presence/main.hs +++ b/Presence/main.hs | |||
@@ -97,7 +97,7 @@ getJabberUserForId muid = | |||
97 | 97 | ||
98 | data ClientSession = ClientSession { | 98 | data ClientSession = ClientSession { |
99 | localhost :: Peer, -- ByteString, | 99 | localhost :: Peer, -- ByteString, |
100 | unix_uid :: (IORef (Maybe UserID)), | 100 | unix_uid :: (IORef (Maybe (UserID,L.ByteString))), |
101 | unix_resource :: (IORef (Maybe L.ByteString)), | 101 | unix_resource :: (IORef (Maybe L.ByteString)), |
102 | presence_state :: PresenceState | 102 | presence_state :: PresenceState |
103 | } | 103 | } |
@@ -106,7 +106,9 @@ instance JabberClientSession ClientSession where | |||
106 | data XMPPClass ClientSession = ClientSessions PresenceState | 106 | data XMPPClass ClientSession = ClientSessions PresenceState |
107 | 107 | ||
108 | newSession (ClientSessions state) sock = do | 108 | newSession (ClientSessions state) sock = do |
109 | muid <- getLocalPeerCred sock | 109 | -- muid <- getLocalPeerCred sock |
110 | addr <- getPeerName sock | ||
111 | muid <- getLocalPeerCred' addr | ||
110 | L.putStrLn $ "CLIENT SESSION: open " <++> bshow muid | 112 | L.putStrLn $ "CLIENT SESSION: open " <++> bshow muid |
111 | uid_ref <- newIORef muid | 113 | uid_ref <- newIORef muid |
112 | res_ref <- newIORef Nothing | 114 | res_ref <- newIORef Nothing |
@@ -114,12 +116,20 @@ instance JabberClientSession ClientSession where | |||
114 | 116 | ||
115 | setResource s resource = do | 117 | setResource s resource = do |
116 | -- TODO: handle resource = empty string | 118 | -- TODO: handle resource = empty string |
117 | writeIORef (unix_resource s) (Just resource) | 119 | us <- fmap Set.toList . readTVarIO $ activeUsers (presence_state s) |
118 | L.putStrLn $ "CLIENT SESSION: resource " <++> resource | 120 | muid <- readIORef (unix_uid s) |
121 | let tailOf3 (_,a,b) = (a,b) | ||
122 | (t,pid) <- case muid of | ||
123 | Just (uid,inode) -> identifyTTY (map tailOf3 us) uid inode | ||
124 | Nothing -> return (Nothing,Nothing) | ||
125 | let rsc = t `mplus` fmap ( ("pid."<++>) . bshow ) pid | ||
126 | rsc' = maybe resource id rsc | ||
127 | writeIORef (unix_resource s) (Just rsc') | ||
128 | L.putStrLn $ "CLIENT SESSION: resource " <++> rsc' | ||
119 | 129 | ||
120 | getJID s = do | 130 | getJID s = do |
121 | let host = localhost s | 131 | let host = localhost s |
122 | muid <- readIORef (unix_uid s) | 132 | muid <- fmap (fmap fst) $ readIORef (unix_uid s) |
123 | user <- getJabberUserForId muid | 133 | user <- getJabberUserForId muid |
124 | 134 | ||
125 | rsc <- readIORef (unix_resource s) | 135 | rsc <- readIORef (unix_resource s) |