diff options
author | joe <joe@jerkface.net> | 2013-06-16 21:41:53 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2013-06-16 21:41:53 -0400 |
commit | 41c757e3e851ba197248df18f144805babc4e1f9 (patch) | |
tree | f025de6be7cfcf855aedbd242b3bb37b9f1e74cd /Presence/LocalPeerCred.hs | |
parent | eda067284b31189d198e5d94a969c9a8ba6b77a7 (diff) |
Now obtains uid of local peer.
Diffstat (limited to 'Presence/LocalPeerCred.hs')
-rw-r--r-- | Presence/LocalPeerCred.hs | 95 |
1 files changed, 95 insertions, 0 deletions
diff --git a/Presence/LocalPeerCred.hs b/Presence/LocalPeerCred.hs new file mode 100644 index 00000000..c58fe288 --- /dev/null +++ b/Presence/LocalPeerCred.hs | |||
@@ -0,0 +1,95 @@ | |||
1 | module LocalPeerCred where | ||
2 | |||
3 | import Data.ByteString.Lazy.Char8 as L hiding (map,putStrLn,tail,splitAt,tails,filter) | ||
4 | import qualified Data.ByteString.Lazy.Char8 as L (splitAt) | ||
5 | import qualified Data.ByteString.Lazy as W8 | ||
6 | import Data.List (tails) | ||
7 | import System.IO ( withFile, IOMode(..)) | ||
8 | import Data.Maybe | ||
9 | import Data.Binary | ||
10 | import Data.Bits | ||
11 | import Network.Socket | ||
12 | import System.Posix.Types | ||
13 | import Debug.Trace | ||
14 | -- import System.Environment (getArgs) | ||
15 | |||
16 | xs ?? n | n < 0 = Nothing | ||
17 | [] ?? _ = Nothing | ||
18 | (x:_) ?? 0 = Just x | ||
19 | (_:xs) ?? n = xs ?? (n-1) | ||
20 | |||
21 | parseHex bs = L.concat . parseHex' $ bs | ||
22 | where | ||
23 | parseHex' bs = | ||
24 | let (dnib,ts) = L.splitAt 2 bs | ||
25 | parseNibble x = W8.pack $ group2 toW8 (W8.unpack $ W8.map hexDigit x) | ||
26 | hexDigit d = d - (if d>0x39 then 0x37 else 0x30) | ||
27 | group2 f (x:y:ys) = f x y : group2 f ys | ||
28 | group2 _ _ = [] | ||
29 | toW8 a b = shift a 4 .|. b | ||
30 | in parseNibble dnib : | ||
31 | if L.null ts | ||
32 | then [] | ||
33 | else parseHex' ts | ||
34 | |||
35 | getLocalPeerCred' (SockAddrInet portn host) = do | ||
36 | let port = fromEnum portn | ||
37 | trace ("tcp4 "++show(port,host)) $ withFile "/proc/net/tcp" ReadMode (parseProcNet port host) | ||
38 | |||
39 | getLocalPeerCred' (SockAddrInet6 portn flow host scope) = do | ||
40 | let port = fromEnum portn | ||
41 | trace "tcp6" $ withFile "/proc/net/tcp6" ReadMode (parseProcNet port host) | ||
42 | |||
43 | getLocalPeerCred' addr@(SockAddrUnix _) = | ||
44 | -- TODO: parse /proc/net/unix | ||
45 | -- see also: Network.Socket.getPeerCred | ||
46 | return Nothing | ||
47 | |||
48 | getLocalPeerCred sock = do | ||
49 | addr <- getPeerName sock | ||
50 | muid <- getLocalPeerCred' addr | ||
51 | case muid of | ||
52 | Just uid -> return uid | ||
53 | Nothing -> return undefined -- trace "proc failed." $ fmap (CUid . fromIntegral . sndOf3) (getPeerCred sock) | ||
54 | where sndOf3 (pid,uid,gid) = uid | ||
55 | |||
56 | from16 :: Word16 -> Int | ||
57 | from16 = fromEnum | ||
58 | |||
59 | as16 :: Word16 -> Word16 | ||
60 | as16 = id | ||
61 | |||
62 | parseProcNet port host h = do | ||
63 | tcp <- hGetContents h | ||
64 | let u = do | ||
65 | ls <- listToMaybe . tail . tails . L.lines $ tcp | ||
66 | let ws = map L.words ls | ||
67 | let rs = ( catMaybes . flip map ws $ \xs -> do | ||
68 | let ys = snd (Prelude.splitAt 1 xs) | ||
69 | localaddr <- listToMaybe ys | ||
70 | let zs = L.splitWith (==':') localaddr | ||
71 | addr <- fmap parseHex $ listToMaybe zs | ||
72 | port <- fmap (fromIntegral . as16 . decode . parseHex) $ listToMaybe $ snd (Prelude.splitAt 1 zs) | ||
73 | let ys' = snd (Prelude.splitAt 5 (tail ys)) | ||
74 | uid <- listToMaybe ys' | ||
75 | let peer = (port,decode addr) | ||
76 | user = toEnum (read (unpack uid) ::Int) ::UserID -- CUid . fromIntegral $ (read (unpack uid)::Int) | ||
77 | return $ trace ("peer:"++show(peer,user)) (peer,user) | ||
78 | ) | ||
79 | fmap snd . listToMaybe $ filter ((===(port,host)).fst) rs | ||
80 | trace ("found:"++show u) $ u `seq` return u | ||
81 | where | ||
82 | a === b = let r= a==b in trace ("Comparing "++show (a,b)++"-->"++show r) r | ||
83 | |||
84 | {- | ||
85 | main = do | ||
86 | args <- getArgs | ||
87 | let addr = fromJust $ do | ||
88 | port <- args ?? 0 | ||
89 | host <- args ?? 1 | ||
90 | return $ SockAddrInet (toEnum . fromIntegral . readInt $ port) (toEnum (read host::Int)) | ||
91 | readInt x = read x :: Int | ||
92 | |||
93 | r <- getLocalPeerCred' addr | ||
94 | putStrLn $ "r = " ++ show r | ||
95 | -} | ||