1 files changed, 91 insertions, 0 deletions

diff --git a/whosocket.hs b/whosocket.hs
new file mode 100644
index 00000000..5968b152
--- /dev/null
+++ b/whosocket.hs
@@ -0,0 +1,91 @@
+module Main where
+
+import LocalPeerCred
+import ControlMaybe
+
+import System.Directory
+import Data.Char
+import System.Posix.Types
+import System.Posix.Files
+import Data.ByteString.Lazy.Char8 as L (unpack)
+import Data.List (groupBy)
+import Data.Maybe (listToMaybe)
+
+import Network.Socket
+import System.Environment
+import Control.Arrow (first)
+
+usage = do
+    putStrLn $ "whosocket numeric-address port"
+
+main = do
+    args <- getArgs
+    case (args??0,args??1) of
+        (Just addr_str,Just port_str) -> whosocket addr_str port_str
+        _                             -> usage
+
+whosocket addr_str port_str = do
+    info <- getAddrInfo (Just $ defaultHints { addrFlags = [ AI_NUMERICHOST ] }) 
+                        (Just addr_str) 
+                        (Just port_str)
+    let addr = head $ map addrAddress info
+    r <- getLocalPeerCred' addr
+    putStrLn $ "r{"++show addr++"} = " ++ show r
+
+    let Just (uid,inode) = r
+    pid <- scanProc (show uid) (L.unpack inode)
+    putStrLn $ "scanProc --> "++show pid
+    withJust pid $ \(pid,ttydev) -> do
+    tty <- ttyOrDisplay pid ttydev
+    putStrLn $ "pid = " ++ show pid
+    putStrLn $ "tty = " ++ show tty
+
+    return ()
+
+
+makeUidStr "4294967295" = "invalid"
+makeUidStr uid          = uid
+
+
+scanProc uid inode = do
+    contents <- getDirectoryContents "/proc" `catchIO_` return []
+    let pids = reverse $ filter (\n -> not (null n) && isDigit (head n)) contents
+    let searchPids []         = return Nothing
+        searchPids (pid:pids) =  do
+            loginuid <- fmap makeUidStr $ readFile $ "/proc/"++pid++"/loginuid"
+            if False -- (uid/=loginuid) -- this check proved bad when mcabber ran on tty3
+             then searchPids pids
+             else do
+                -- putStrLn $ "pid "++show pid ++ " --> uid "++show loginuid
+                let loop [] = return Nothing
+                    loop ("0":fds) = loop fds
+                    loop (fd:fds) = do
+                      handleIO_ (loop fds) $ do
+                          what <- readSymbolicLink $ "/proc/"++pid++"/fd/"++fd
+                          -- putStrLn $ " what= "++show what
+                          if (what=="socket:["++inode++"]")
+                            then do
+                              tty <- readSymbolicLink $ "/proc/"++pid++"/fd/0"
+                              return (Just (pid,tty))
+                            else loop fds
+                fds <- getDirectoryContents ("/proc/"++pid++"/fd") `catchIO_` return []
+                mb <- loop fds
+                maybe (searchPids pids) (return . Just) mb
+
+    fmap (fmap (first (read :: String -> CPid))) $ searchPids pids
+
+ttyOrDisplay pid ttydev | take 8 ttydev == "/dev/tty" = return (drop 5 ttydev)
+ttyOrDisplay pid ttydev = do
+    env <- handleIO_ (return "") . readFile $ "/proc/"++show pid++"/environ"
+    let vs = unzero $ groupBy (\_ c->c/='\0') env
+        unzero []     = []
+        unzero (v:vs) = v:map tail vs
+        keyvalue xs = (key,value) 
+          where
+            (key,ys) = break (=='=') xs
+            value = case ys of { [] -> [];  (_:ys') -> ys' }
+        display = listToMaybe . filter ((=="DISPLAY").fst) . map keyvalue $ vs
+    putStrLn $ "display = " ++ show display
+    case display of
+        Just (_,disp) -> return disp
+        _             -> return ttydev