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
-}