1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
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 (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 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
-}
|
