From 41c757e3e851ba197248df18f144805babc4e1f9 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sun, 16 Jun 2013 21:41:53 -0400
Subject: Now obtains uid of local peer.

---
 Presence/LocalPeerCred.hs | 95 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 95 insertions(+)
 create mode 100644 Presence/LocalPeerCred.hs

(limited to 'Presence/LocalPeerCred.hs')

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 @@
+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
+-}
-- 
cgit v1.2.3