summaryrefslogtreecommitdiff
path: root/Presence/LocalPeerCred.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/LocalPeerCred.hs')
-rw-r--r--Presence/LocalPeerCred.hs234
1 files changed, 0 insertions, 234 deletions
diff --git a/Presence/LocalPeerCred.hs b/Presence/LocalPeerCred.hs
deleted file mode 100644
index f68557e8..00000000
--- a/Presence/LocalPeerCred.hs
+++ /dev/null
@@ -1,234 +0,0 @@
1{-# LANGUAGE ViewPatterns #-}
2{-# LANGUAGE TupleSections #-}
3module LocalPeerCred where
4
5import System.Endian
6import qualified Data.ByteString.Lazy.Char8 as L
7 -- hiding (map,putStrLn,tail,splitAt,tails,filter)
8 -- import qualified Data.ByteString.Lazy.Char8 as L (splitAt)
9import qualified Data.ByteString.Lazy as W8
10import Data.List as List (tails,groupBy)
11import System.IO ( withFile, IOMode(..))
12import System.Directory
13import Control.Arrow (first)
14import Data.Char
15import Data.Maybe
16import Data.Bits
17import Data.Serialize
18import Data.Word
19import System.Posix.Types
20import System.Posix.Files
21import Logging
22import Network.SocketLike
23import ControlMaybe
24import Data.String
25import System.IO
26
27(??) :: (Num t, Ord t) => [a] -> t -> Maybe a
28xs ?? n | n < 0 = Nothing
29[] ?? _ = Nothing
30(x:_) ?? 0 = Just x
31(_:xs) ?? n = xs ?? (n-1)
32
33parseHex :: W8.ByteString -> W8.ByteString
34parseHex bs = L.concat . parseHex' $ bs
35 where
36 parseHex' bs =
37 let (dnib,ts) = L.splitAt 2 bs
38 parseNibble x = W8.pack $ group2 toW8 (W8.unpack $ W8.map hexDigit x)
39 hexDigit d = d - (if d>0x39 then 0x37 else 0x30)
40 group2 f (x:y:ys) = f x y : group2 f ys
41 group2 _ _ = []
42 toW8 a b = shift a 4 .|. b
43 in parseNibble dnib :
44 if L.null ts
45 then []
46 else parseHex' ts
47
48getLocalPeerCred' :: SockAddr -> IO (Maybe (UserID, W8.ByteString))
49getLocalPeerCred' (unmap6mapped4 -> SockAddrInet portn host) = do
50 let port = fromEnum portn
51 {- trace ("tcp4 "++show(port,host)) $ -}
52 withFile "/proc/net/tcp" ReadMode (parseProcNet port host)
53
54getLocalPeerCred' (unmap6mapped4 -> SockAddrInet6 portn flow host scope) = do
55 let port = fromEnum portn
56 (a,b,c,d) = host
57 host' = (toBE32 a, toBE32 b, toBE32 c, toBE32 d)
58 withFile "/proc/net/tcp6" ReadMode (parseProcNet port host')
59
60getLocalPeerCred' (unmap6mapped4 -> addr@(SockAddrUnix _)) =
61 -- TODO: parse /proc/net/unix
62 -- see also: Network.Socket.getPeerCred
63 return Nothing
64
65getLocalPeerCred :: SocketLike sock => sock -> IO (Maybe UserID)
66getLocalPeerCred sock = do
67 addr <- getPeerName sock
68 muid <- getLocalPeerCred' addr
69 case muid of
70 Just (uid,inode) -> return (Just uid)
71 Nothing -> trace "proc failed." $ fmap (validate . CUid . fromIntegral . sndOf3) (getPeerCred sock)
72 where sndOf3 (pid,uid,gid) = uid
73 where
74 validate uid = Just uid -- TODO
75
76from16 :: Word16 -> Int
77from16 = fromEnum
78
79as16 :: Word16 -> Word16
80as16 = id
81
82parseProcNet :: (Serialize t, Num t1, Eq t, Eq t1) =>
83 t1
84 -> t
85 -> Handle
86 -> IO (Maybe (UserID, W8.ByteString))
87parseProcNet port host h = do
88 tcp <- L.hGetContents h -- Failed: tcp <- hFileSize h >>= hGet h . fromIntegral
89 let u = do
90 ls <- listToMaybe . tail . tails . L.lines $ tcp
91 let ws = map L.words ls
92 let rs = ( catMaybes . flip map ws $ \xs -> do
93 let ys = snd (Prelude.splitAt 1 xs)
94 localaddr <- listToMaybe ys
95 let zs = L.splitWith (==':') localaddr
96 addr <- fmap parseHex $ listToMaybe zs
97 port <- either (const Nothing) (Just . fromIntegral . as16) . decode . L.toStrict . parseHex
98 =<< listToMaybe (snd (Prelude.splitAt 1 zs))
99 let ys' = snd (Prelude.splitAt 5 (tail ys))
100 ys'' = snd (Prelude.splitAt 2 ys')
101 uid <- listToMaybe ys'
102 inode <- listToMaybe ys''
103 peer <- either (const Nothing) Just $ do
104 a <- decode $ L.toStrict addr
105 return (port,a)
106 let user = toEnum (read (L.unpack uid) ::Int) ::UserID -- CUid . fromIntegral $ (read (unpack uid)::Int)
107 return $ {-trace ("peer:"++show(peer,user,inode))-} (peer,(user,inode))
108 )
109 fmap snd . listToMaybe $ filter ((==(port,host)).fst) rs
110 {- trace ("found: "++show u) -}
111 u `seq` return u
112 {-
113 where
114 a === b = let r= a==b in trace ("Comparing "++show (a,b)++"-->"++show r) r
115 -}
116
117
118-- PEER NAME: [::ffff:127.0.0.1]:34307
119unmap6mapped4 :: SockAddr -> SockAddr
120unmap6mapped4 addr@(SockAddrInet6 port _ (0,0,0xFFFF,a) _) = SockAddrInet port (toBE32 a)
121unmap6mapped4 addr = addr
122
123identifyTTY ::
124 [(W8.ByteString, ProcessID)]
125 -> UserID -> W8.ByteString -> IO (Maybe W8.ByteString, Maybe CPid)
126identifyTTY tty_pids uid inode = do
127 pid <- scanProc (show uid) (L.unpack inode)
128 -- putStrLn $ "scanProc --> "++show pid
129 fromMaybe (return (Nothing,Nothing)) $ pid <&> \(pid,ttydev) -> do
130 tty <- ttyOrDisplay pid ttydev
131 -- putStrLn $ "users = " ++ show tty_pids
132 dts <- ttyToXorgs tty_pids
133 -- putStrLn $ "displays = " ++ show dts
134 -- putStrLn $ "tty = " ++ show tty
135 -- -- displays = [(":5",Chunk "tty7" Empty)]
136 let tty' = if take 3 tty=="tty"
137 then Just (L.pack tty)
138 else lookup (parseTty tty) (map (first parseTty) dts)
139 return (tty',Just pid)
140 where
141 parseTty :: String -> Float
142 parseTty = read . tail . dropWhile (/=':')
143
144ttyToXorgs :: Show a => [(t, a)] -> IO [([Char], t)]
145ttyToXorgs tty_pids = do
146 dts' <- flip mapM tty_pids $ \(tty,pid) -> do
147 cmd' <- readFile $ "/proc/"++show pid++"/cmdline"
148 case listToMaybe . words . takeWhile (/='\0') $ cmd' of
149 Nothing -> return Nothing
150 Just cmd -> do
151 if notElem cmd ["gdm-session-worker"]
152 then return Nothing
153 else do
154 display <- readDisplayVariable pid
155 return (fmap ( (,tty) . snd ) display)
156 let dts = catMaybes dts'
157 return dts
158
159
160scanProc :: t -> [Char] -> IO (Maybe (CPid, FilePath))
161scanProc uid inode = do
162 contents <- getDirectoryContents "/proc" `catchIO_` return []
163 let pids = reverse $ filter (\n -> not (null n) && isDigit (head n)) contents
164 let searchPids [] = return Nothing
165 searchPids (pid:pids) = do
166 loginuid <- fmap makeUidStr $ readFile $ "/proc/"++pid++"/loginuid"
167 if False -- (uid/=loginuid) -- this check proved bad when mcabber ran on tty3
168 then searchPids pids
169 else do
170 -- putStrLn $ "pid "++show pid ++ " --> uid "++show loginuid
171 let loop [] = return Nothing
172 loop ("0":fds) = loop fds
173 loop (fd:fds) = do
174 handleIO_ (loop fds) $ do
175 what <- readSymbolicLink $ "/proc/"++pid++"/fd/"++fd
176 -- putStrLn $ " what= "++show what
177 if (what=="socket:["++inode++"]")
178 then do
179 tty <- readSymbolicLink $ "/proc/"++pid++"/fd/0"
180 return (Just (pid,tty))
181 else loop fds
182 -- requires root (or same user as for pid)...
183 fds <- getDirectoryContents ("/proc/"++pid++"/fd") `catchIO_` return []
184 mb <- loop fds
185 maybe (searchPids pids) (return . Just) mb
186
187 fmap (fmap (first (read :: String -> CPid))) $ searchPids pids
188
189ttyOrDisplay :: Show a => a -> FilePath -> IO [Char]
190ttyOrDisplay pid ttydev = do
191 ptty <- searchParentsForTTY (show pid) ttydev
192 case ptty of
193 Just tty -> return tty
194 Nothing -> do
195 display <- readDisplayVariable pid
196 -- putStrLn $ "display = " ++ show display
197 case display of
198 Just (_,disp) -> return disp
199 _ -> return ttydev
200
201
202readDisplayVariable :: Show a => a -> IO (Maybe ([Char], [Char]))
203readDisplayVariable pid = do
204 env <- handleIO_ (return "")
205 . readFile $ "/proc/"++show pid++"/environ"
206 let vs = unzero $ List.groupBy (\_ c->c/='\0') env
207 unzero [] = []
208 unzero (v:vs) = v:map tail vs
209 keyvalue xs = (key,value)
210 where
211 (key,ys) = break (=='=') xs
212 value = case ys of { [] -> []; (_:ys') -> ys' }
213 display = listToMaybe
214 . filter ((=="DISPLAY").fst)
215 . map keyvalue
216 $ vs
217 return display
218
219
220makeUidStr :: (Data.String.IsString t, Eq t) => t -> t
221makeUidStr "4294967295" = "invalid"
222makeUidStr uid = uid
223
224
225searchParentsForTTY :: String -> FilePath -> IO (Maybe [Char])
226searchParentsForTTY pid ttydev | take 8 ttydev == "/dev/tty" = return . Just $ drop 5 ttydev
227searchParentsForTTY "1" ttydev | otherwise = return Nothing
228searchParentsForTTY pid ttydev = do
229 stat <- handleIO_ (return "") . readFile $ "/proc/"++pid++"/stat"
230 case words stat ?? 3 of
231 Nothing -> return Nothing
232 Just ppid -> do
233 tty <- handleIO_ (return "") $ readSymbolicLink $ "/proc/"++ppid++"/fd/0"
234 searchParentsForTTY ppid tty
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-22 14:32:25 +0000