module LocalPeerCred where import 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 (tails) import System.IO ( withFile, IOMode(..)) import Data.Maybe import Data.Binary import Data.Bits import Network.Socket import System.Posix.Types import Debug.Trace -- import System.Environment (getArgs) xs ?? n | n < 0 = Nothing [] ?? _ = Nothing (x:_) ?? 0 = Just x (_:xs) ?? n = xs ?? (n-1) 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' (SockAddrInet portn host) = do let port = fromEnum portn trace ("tcp4 "++show(port,host)) $ withFile "/proc/net/tcp" ReadMode (parseProcNet port host) getLocalPeerCred' (SockAddrInet6 portn flow host scope) = do let port = fromEnum portn trace "tcp6" $ withFile "/proc/net/tcp6" ReadMode (parseProcNet port host) getLocalPeerCred' addr@(SockAddrUnix _) = -- TODO: parse /proc/net/unix -- see also: Network.Socket.getPeerCred return Nothing getLocalPeerCred sock = do addr <- getPeerName sock muid <- getLocalPeerCred' addr case muid of Just uid -> return uid Nothing -> return undefined -- trace "proc failed." $ fmap (CUid . fromIntegral . sndOf3) (getPeerCred sock) where sndOf3 (pid,uid,gid) = uid from16 :: Word16 -> Int from16 = fromEnum as16 :: Word16 -> Word16 as16 = id parseProcNet port host h = do tcp <- hGetContents h 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 <- fmap (fromIntegral . as16 . decode . parseHex) $ listToMaybe $ snd (Prelude.splitAt 1 zs) let ys' = snd (Prelude.splitAt 5 (tail ys)) uid <- 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) ) 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 {- main = do args <- getArgs let addr = fromJust $ do port <- args ?? 0 host <- args ?? 1 return $ SockAddrInet (toEnum . fromIntegral . readInt $ port) (toEnum (read host::Int)) readInt x = read x :: Int r <- getLocalPeerCred' addr putStrLn $ "r = " ++ show r -}