diff options
Diffstat (limited to 'Presence/LocalPeerCred.hs')
-rw-r--r-- | Presence/LocalPeerCred.hs | 17 |
1 files changed, 17 insertions, 0 deletions
diff --git a/Presence/LocalPeerCred.hs b/Presence/LocalPeerCred.hs index 3396358e..c73c39df 100644 --- a/Presence/LocalPeerCred.hs +++ b/Presence/LocalPeerCred.hs | |||
@@ -20,12 +20,16 @@ import System.Posix.Files | |||
20 | import Logging | 20 | import Logging |
21 | import Network.SocketLike | 21 | import Network.SocketLike |
22 | import ControlMaybe | 22 | import ControlMaybe |
23 | import Data.String | ||
24 | import System.IO | ||
23 | 25 | ||
26 | (??) :: (Num t, Ord t) => [a] -> t -> Maybe a | ||
24 | xs ?? n | n < 0 = Nothing | 27 | xs ?? n | n < 0 = Nothing |
25 | [] ?? _ = Nothing | 28 | [] ?? _ = Nothing |
26 | (x:_) ?? 0 = Just x | 29 | (x:_) ?? 0 = Just x |
27 | (_:xs) ?? n = xs ?? (n-1) | 30 | (_:xs) ?? n = xs ?? (n-1) |
28 | 31 | ||
32 | parseHex :: W8.ByteString -> W8.ByteString | ||
29 | parseHex bs = L.concat . parseHex' $ bs | 33 | parseHex bs = L.concat . parseHex' $ bs |
30 | where | 34 | where |
31 | parseHex' bs = | 35 | parseHex' bs = |
@@ -40,6 +44,7 @@ parseHex bs = L.concat . parseHex' $ bs | |||
40 | then [] | 44 | then [] |
41 | else parseHex' ts | 45 | else parseHex' ts |
42 | 46 | ||
47 | getLocalPeerCred' :: SockAddr -> IO (Maybe (UserID, W8.ByteString)) | ||
43 | getLocalPeerCred' (unmap6mapped4 -> SockAddrInet portn host) = do | 48 | getLocalPeerCred' (unmap6mapped4 -> SockAddrInet portn host) = do |
44 | let port = fromEnum portn | 49 | let port = fromEnum portn |
45 | {- trace ("tcp4 "++show(port,host)) $ -} | 50 | {- trace ("tcp4 "++show(port,host)) $ -} |
@@ -56,6 +61,7 @@ getLocalPeerCred' (unmap6mapped4 -> addr@(SockAddrUnix _)) = | |||
56 | -- see also: Network.Socket.getPeerCred | 61 | -- see also: Network.Socket.getPeerCred |
57 | return Nothing | 62 | return Nothing |
58 | 63 | ||
64 | getLocalPeerCred :: SocketLike sock => sock -> IO (Maybe UserID) | ||
59 | getLocalPeerCred sock = do | 65 | getLocalPeerCred sock = do |
60 | addr <- getPeerName sock | 66 | addr <- getPeerName sock |
61 | muid <- getLocalPeerCred' addr | 67 | muid <- getLocalPeerCred' addr |
@@ -72,6 +78,11 @@ from16 = fromEnum | |||
72 | as16 :: Word16 -> Word16 | 78 | as16 :: Word16 -> Word16 |
73 | as16 = id | 79 | as16 = id |
74 | 80 | ||
81 | parseProcNet :: (Binary t, Num t1, Eq t, Eq t1) => | ||
82 | t1 | ||
83 | -> t | ||
84 | -> Handle | ||
85 | -> IO (Maybe (UserID, W8.ByteString)) | ||
75 | parseProcNet port host h = do | 86 | parseProcNet port host h = do |
76 | tcp <- L.hGetContents h -- Failed: tcp <- hFileSize h >>= hGet h . fromIntegral | 87 | tcp <- L.hGetContents h -- Failed: tcp <- hFileSize h >>= hGet h . fromIntegral |
77 | let u = do | 88 | let u = do |
@@ -101,6 +112,7 @@ parseProcNet port host h = do | |||
101 | 112 | ||
102 | 113 | ||
103 | -- PEER NAME: [::ffff:127.0.0.1]:34307 | 114 | -- PEER NAME: [::ffff:127.0.0.1]:34307 |
115 | unmap6mapped4 :: SockAddr -> SockAddr | ||
104 | unmap6mapped4 addr@(SockAddrInet6 port _ (0,0,0xFFFF,a) _) = SockAddrInet port (toBE32 a) | 116 | unmap6mapped4 addr@(SockAddrInet6 port _ (0,0,0xFFFF,a) _) = SockAddrInet port (toBE32 a) |
105 | unmap6mapped4 addr = addr | 117 | unmap6mapped4 addr = addr |
106 | 118 | ||
@@ -141,6 +153,7 @@ ttyToXorgs tty_pids = do | |||
141 | return dts | 153 | return dts |
142 | 154 | ||
143 | 155 | ||
156 | scanProc :: t -> [Char] -> IO (Maybe (CPid, FilePath)) | ||
144 | scanProc uid inode = do | 157 | scanProc uid inode = do |
145 | contents <- getDirectoryContents "/proc" `catchIO_` return [] | 158 | contents <- getDirectoryContents "/proc" `catchIO_` return [] |
146 | let pids = reverse $ filter (\n -> not (null n) && isDigit (head n)) contents | 159 | let pids = reverse $ filter (\n -> not (null n) && isDigit (head n)) contents |
@@ -169,6 +182,7 @@ scanProc uid inode = do | |||
169 | 182 | ||
170 | fmap (fmap (first (read :: String -> CPid))) $ searchPids pids | 183 | fmap (fmap (first (read :: String -> CPid))) $ searchPids pids |
171 | 184 | ||
185 | ttyOrDisplay :: Show a => a -> FilePath -> IO [Char] | ||
172 | ttyOrDisplay pid ttydev = do | 186 | ttyOrDisplay pid ttydev = do |
173 | ptty <- searchParentsForTTY (show pid) ttydev | 187 | ptty <- searchParentsForTTY (show pid) ttydev |
174 | case ptty of | 188 | case ptty of |
@@ -181,6 +195,7 @@ ttyOrDisplay pid ttydev = do | |||
181 | _ -> return ttydev | 195 | _ -> return ttydev |
182 | 196 | ||
183 | 197 | ||
198 | readDisplayVariable :: Show a => a -> IO (Maybe ([Char], [Char])) | ||
184 | readDisplayVariable pid = do | 199 | readDisplayVariable pid = do |
185 | env <- handleIO_ (return "") | 200 | env <- handleIO_ (return "") |
186 | . readFile $ "/proc/"++show pid++"/environ" | 201 | . readFile $ "/proc/"++show pid++"/environ" |
@@ -198,10 +213,12 @@ readDisplayVariable pid = do | |||
198 | return display | 213 | return display |
199 | 214 | ||
200 | 215 | ||
216 | makeUidStr :: (Data.String.IsString t, Eq t) => t -> t | ||
201 | makeUidStr "4294967295" = "invalid" | 217 | makeUidStr "4294967295" = "invalid" |
202 | makeUidStr uid = uid | 218 | makeUidStr uid = uid |
203 | 219 | ||
204 | 220 | ||
221 | searchParentsForTTY :: String -> FilePath -> IO (Maybe [Char]) | ||
205 | searchParentsForTTY pid ttydev | take 8 ttydev == "/dev/tty" = return . Just $ drop 5 ttydev | 222 | searchParentsForTTY pid ttydev | take 8 ttydev == "/dev/tty" = return . Just $ drop 5 ttydev |
206 | searchParentsForTTY "1" ttydev | otherwise = return Nothing | 223 | searchParentsForTTY "1" ttydev | otherwise = return Nothing |
207 | searchParentsForTTY pid ttydev = do | 224 | searchParentsForTTY pid ttydev = do |