3 files changed, 32 insertions, 25 deletions

diff --git a/Presence/ControlMaybe.hs b/Presence/ControlMaybe.hs
index e277df12..37f6f93c 100644
--- a/Presence/ControlMaybe.hs
+++ b/Presence/ControlMaybe.hs
@@ -1,5 +1,9 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 module ControlMaybe where
 
+-- import GHC.IO.Exception (IOException(..))
+import Control.Exception as Exception (IOException(..),catch)
+
 withJust (Just x) f = f x
 withJust Nothing  f = return ()
 
@@ -8,3 +12,8 @@ whenJust acn f = do
     withJust x f
 
 
+catchIO_ :: IO a -> IO a -> IO a
+catchIO_ a h = Exception.catch a (\(_ :: IOException) -> h)
+
+handleIO_ = flip catchIO_
+
diff --git a/Presence/LocalPeerCred.hs b/Presence/LocalPeerCred.hs
index d3b8d189..b6ec9491 100644
--- a/Presence/LocalPeerCred.hs
+++ b/Presence/LocalPeerCred.hs
@@ -57,7 +57,7 @@ getLocalPeerCred sock = do
     addr <- getPeerName sock
     muid <- getLocalPeerCred' addr
     case muid of
-        Just uid -> return (Just uid)
+        Just (uid,inode) -> return (Just uid)
         Nothing  -> trace "proc failed." $ fmap (validate . CUid . fromIntegral . sndOf3) (getPeerCred sock)
                      where sndOf3 (pid,uid,gid) = uid
  where
@@ -81,10 +81,12 @@ parseProcNet port host h = do
                           addr <- fmap parseHex $ listToMaybe zs
                           port <- fmap (fromIntegral . as16 . decode . parseHex) $ listToMaybe $ snd (Prelude.splitAt 1 zs)
                           let ys' = snd (Prelude.splitAt 5 (tail ys))
+                              ys'' = snd (Prelude.splitAt 2 ys')
                           uid <- listToMaybe ys'
+                          inode <- listToMaybe ys''
                           let peer = (port,decode addr)
                               user = toEnum (read (unpack uid) ::Int) ::UserID  -- CUid . fromIntegral $ (read (unpack uid)::Int)
-                          return $ {- trace ("peer:"++show(peer,user)) -} (peer,user)
+                          return $ {-trace ("peer:"++show(peer,user,inode))-} (peer,(user,inode))
                           )
                     fmap snd . listToMaybe $ filter ((==(port,host)).fst) rs 
         {- trace ("found: "++show u) -} 
diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index 3f81f000..d35e5617 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -241,21 +241,25 @@ tagName (EventBeginElement n _) = n
 tagName _                       = ""
 
 handleIQSetBind session cmdChan stanza_id = do
-    whenJust nextElement $ \child -> do
-    let unhandledBind = liftIO $ putStrLn $ "unhandled-bind: "++show child
-    case tagName child of
-        "{urn:ietf:params:xml:ns:xmpp-bind}resource"
-          -> do
-            rsc <- lift content
-            liftIO $ do
-                putStrLn $ "iq-set-bind-resource " ++ show rsc
-                setResource session (L.fromChunks [S.encodeUtf8 rsc])
-                jid <- getJID session
-                atomically $ writeTChan cmdChan (Send $ iq_bind_reply stanza_id (toStrict $ L.decodeUtf8 $ L.show jid) )
-                forCachedPresence session $ \presence -> do
-                    xs <- xmlifyPresenceForClient presence
-                    atomically . writeTChan cmdChan . Send $ xs
-        _ -> unhandledBind
+    mchild <- nextElement
+    case mchild of
+     Just child -> do
+        let unhandledBind = liftIO $ putStrLn $ "unhandled-bind: "++show child
+        case tagName child of
+            "{urn:ietf:params:xml:ns:xmpp-bind}resource"
+              -> do
+                rsc <- lift content
+                liftIO $ do
+                    putStrLn $ "iq-set-bind-resource " ++ show rsc
+                    setResource session (L.fromChunks [S.encodeUtf8 rsc])
+                    jid <- getJID session
+                    atomically $ writeTChan cmdChan (Send $ iq_bind_reply stanza_id (toStrict $ L.decodeUtf8 $ L.show jid) )
+                    forCachedPresence session $ \presence -> do
+                        xs <- xmlifyPresenceForClient presence
+                        atomically . writeTChan cmdChan . Send $ xs
+            _ -> unhandledBind
+     Nothing -> do
+        liftIO $ putStrLn $ "empty bind request!"
 
 
 iq_session_reply host stanza_id =
@@ -598,14 +602,6 @@ fromPeer session = doNestingXML $ do
 
 
 
-{-
-seekRemotePeers :: XMPPConfig config =>
-     config -> TChan Presence -> IO ()
-seekRemotePeers config chan = do
-    putStrLn "unimplemented: seekRemotePeers"
-    -- TODO
-    return ()
--}
 
 data OutBoundMessage = OutBoundPresence Presence | PresenceProbe JID JID
  deriving Prelude.Show