From 11987749fc6e6d3e53ea737d46d5ab13a16faeb8 Mon Sep 17 00:00:00 2001 From: James Crayne Date: Sat, 28 Sep 2019 13:43:29 -0400 Subject: Factor out some new libraries word64-map: Data.Word64Map network-addr: Network.Address tox-crypto: Crypto.Tox lifted-concurrent: Control.Concurrent.Lifted.Instrument Control.Concurrent.Async.Lifted.Instrument psq-wrap: Data.Wrapper.PSQInt Data.Wrapper.PSQ minmax-psq: Data.MinMaxPSQ tasks: Control.Concurrent.Tasks kad: Network.Kademlia Network.Kademlia.Bootstrap Network.Kademlia.Routing Network.Kademlia.CommonAPI Network.Kademlia.Persistence Network.Kademlia.Search --- Presence/LocalPeerCred.hs | 234 ---------------------------------------------- 1 file changed, 234 deletions(-) delete mode 100644 Presence/LocalPeerCred.hs (limited to 'Presence/LocalPeerCred.hs') 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 @@ -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE TupleSections #-} -module LocalPeerCred where - -import System.Endian -import qualified Data.ByteString.Lazy.Char8 as L - -- hiding (map,putStrLn,tail,splitAt,tails,filter) - -- import qualified Data.ByteString.Lazy.Char8 as L (splitAt) -import qualified Data.ByteString.Lazy as W8 -import Data.List as List (tails,groupBy) -import System.IO ( withFile, IOMode(..)) -import System.Directory -import Control.Arrow (first) -import Data.Char -import Data.Maybe -import Data.Bits -import Data.Serialize -import Data.Word -import System.Posix.Types -import System.Posix.Files -import Logging -import Network.SocketLike -import ControlMaybe -import Data.String -import System.IO - -(??) :: (Num t, Ord t) => [a] -> t -> Maybe a -xs ?? n | n < 0 = Nothing -[] ?? _ = Nothing -(x:_) ?? 0 = Just x -(_:xs) ?? n = xs ?? (n-1) - -parseHex :: W8.ByteString -> W8.ByteString -parseHex bs = L.concat . parseHex' $ bs - where - parseHex' bs = - let (dnib,ts) = L.splitAt 2 bs - parseNibble x = W8.pack $ group2 toW8 (W8.unpack $ W8.map hexDigit x) - hexDigit d = d - (if d>0x39 then 0x37 else 0x30) - group2 f (x:y:ys) = f x y : group2 f ys - group2 _ _ = [] - toW8 a b = shift a 4 .|. b - in parseNibble dnib : - if L.null ts - then [] - else parseHex' ts - -getLocalPeerCred' :: SockAddr -> IO (Maybe (UserID, W8.ByteString)) -getLocalPeerCred' (unmap6mapped4 -> SockAddrInet portn host) = do - let port = fromEnum portn - {- trace ("tcp4 "++show(port,host)) $ -} - withFile "/proc/net/tcp" ReadMode (parseProcNet port host) - -getLocalPeerCred' (unmap6mapped4 -> SockAddrInet6 portn flow host scope) = do - let port = fromEnum portn - (a,b,c,d) = host - host' = (toBE32 a, toBE32 b, toBE32 c, toBE32 d) - withFile "/proc/net/tcp6" ReadMode (parseProcNet port host') - -getLocalPeerCred' (unmap6mapped4 -> addr@(SockAddrUnix _)) = - -- TODO: parse /proc/net/unix - -- see also: Network.Socket.getPeerCred - return Nothing - -getLocalPeerCred :: SocketLike sock => sock -> IO (Maybe UserID) -getLocalPeerCred sock = do - addr <- getPeerName sock - muid <- getLocalPeerCred' addr - case muid of - Just (uid,inode) -> return (Just uid) - Nothing -> trace "proc failed." $ fmap (validate . CUid . fromIntegral . sndOf3) (getPeerCred sock) - where sndOf3 (pid,uid,gid) = uid - where - validate uid = Just uid -- TODO - -from16 :: Word16 -> Int -from16 = fromEnum - -as16 :: Word16 -> Word16 -as16 = id - -parseProcNet :: (Serialize t, Num t1, Eq t, Eq t1) => - t1 - -> t - -> Handle - -> IO (Maybe (UserID, W8.ByteString)) -parseProcNet port host h = do - tcp <- L.hGetContents h -- Failed: tcp <- hFileSize h >>= hGet h . fromIntegral - let u = do - ls <- listToMaybe . tail . tails . L.lines $ tcp - let ws = map L.words ls - let rs = ( catMaybes . flip map ws $ \xs -> do - let ys = snd (Prelude.splitAt 1 xs) - localaddr <- listToMaybe ys - let zs = L.splitWith (==':') localaddr - addr <- fmap parseHex $ listToMaybe zs - port <- either (const Nothing) (Just . fromIntegral . as16) . decode . L.toStrict . 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'' - peer <- either (const Nothing) Just $ do - a <- decode $ L.toStrict addr - return (port,a) - let user = toEnum (read (L.unpack uid) ::Int) ::UserID -- CUid . fromIntegral $ (read (unpack uid)::Int) - return $ {-trace ("peer:"++show(peer,user,inode))-} (peer,(user,inode)) - ) - fmap snd . listToMaybe $ filter ((==(port,host)).fst) rs - {- trace ("found: "++show u) -} - u `seq` return u - {- - where - a === b = let r= a==b in trace ("Comparing "++show (a,b)++"-->"++show r) r - -} - - --- PEER NAME: [::ffff:127.0.0.1]:34307 -unmap6mapped4 :: SockAddr -> SockAddr -unmap6mapped4 addr@(SockAddrInet6 port _ (0,0,0xFFFF,a) _) = SockAddrInet port (toBE32 a) -unmap6mapped4 addr = addr - -identifyTTY :: - [(W8.ByteString, ProcessID)] - -> UserID -> W8.ByteString -> IO (Maybe W8.ByteString, Maybe CPid) -identifyTTY tty_pids uid inode = do - pid <- scanProc (show uid) (L.unpack inode) - -- putStrLn $ "scanProc --> "++show pid - fromMaybe (return (Nothing,Nothing)) $ pid <&> \(pid,ttydev) -> do - tty <- ttyOrDisplay pid ttydev - -- putStrLn $ "users = " ++ show tty_pids - dts <- ttyToXorgs tty_pids - -- putStrLn $ "displays = " ++ show dts - -- putStrLn $ "tty = " ++ show tty - -- -- displays = [(":5",Chunk "tty7" Empty)] - let tty' = if take 3 tty=="tty" - then Just (L.pack tty) - else lookup (parseTty tty) (map (first parseTty) dts) - return (tty',Just pid) - where - parseTty :: String -> Float - parseTty = read . tail . dropWhile (/=':') - -ttyToXorgs :: Show a => [(t, a)] -> IO [([Char], t)] -ttyToXorgs tty_pids = do - dts' <- flip mapM tty_pids $ \(tty,pid) -> do - cmd' <- readFile $ "/proc/"++show pid++"/cmdline" - case listToMaybe . words . takeWhile (/='\0') $ cmd' of - Nothing -> return Nothing - Just cmd -> do - if notElem cmd ["gdm-session-worker"] - then return Nothing - else do - display <- readDisplayVariable pid - return (fmap ( (,tty) . snd ) display) - let dts = catMaybes dts' - return dts - - -scanProc :: t -> [Char] -> IO (Maybe (CPid, FilePath)) -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 - -- requires root (or same user as for pid)... - 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 :: Show a => a -> FilePath -> IO [Char] -ttyOrDisplay pid ttydev = do - ptty <- searchParentsForTTY (show pid) ttydev - case ptty of - Just tty -> return tty - Nothing -> do - display <- readDisplayVariable pid - -- putStrLn $ "display = " ++ show display - case display of - Just (_,disp) -> return disp - _ -> return ttydev - - -readDisplayVariable :: Show a => a -> IO (Maybe ([Char], [Char])) -readDisplayVariable pid = do - env <- handleIO_ (return "") - . readFile $ "/proc/"++show pid++"/environ" - let vs = unzero $ List.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 - return display - - -makeUidStr :: (Data.String.IsString t, Eq t) => t -> t -makeUidStr "4294967295" = "invalid" -makeUidStr uid = uid - - -searchParentsForTTY :: String -> FilePath -> IO (Maybe [Char]) -searchParentsForTTY pid ttydev | take 8 ttydev == "/dev/tty" = return . Just $ drop 5 ttydev -searchParentsForTTY "1" ttydev | otherwise = return Nothing -searchParentsForTTY pid ttydev = do - stat <- handleIO_ (return "") . readFile $ "/proc/"++pid++"/stat" - case words stat ?? 3 of - Nothing -> return Nothing - Just ppid -> do - tty <- handleIO_ (return "") $ readSymbolicLink $ "/proc/"++ppid++"/fd/0" - searchParentsForTTY ppid tty -- cgit v1.2.3