module LocalPeerCred where

{- for main
import System.Environment
import Control.Monad
-}

import System.Endian
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 System.Posix.Types
import Debug.Trace
import SocketLike

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
        (a,b,c,d) = host
        host' = (toBE32 a, toBE32 b, toBE32 c, toBE32 d)
    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,inode) -> 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 -- Failed: tcp <- hFileSize h >>= hGet h . fromIntegral
        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))
                              ys'' = snd (Prelude.splitAt 2 ys')
                          uid <- listToMaybe ys'
                          inode <- 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,inode))-} (peer,(user,inode))
                          )
                    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_str = fromJust (args??0)
        port_str = fromJust (args??1)
    info <- getAddrInfo (Just $ defaultHints { addrFlags = [ AI_NUMERICHOST ] }) 
                        (Just addr_str) 
                        (Just port_str)
    let addrs = map addrAddress info
    forM_ addrs $ \addr -> do
        r <- getLocalPeerCred' addr
        putStrLn $ "r{"++show addr++"} = " ++ show r
-}