{-# LANGUAGE CPP #-}
module Network.ONCRPC.Auth
( Auth(..)
, RPC.Authsys_parms(..)
, opacifyAuth
, unopacifyAuth
#ifdef VERSION_unix
, getAuthUnix
#endif
) where
import qualified Data.ByteString.Char8 as BSC
#ifdef VERSION_unix
import System.Posix.Process (getProcessID)
import System.Posix.Unistd (getSystemID, nodeName)
import System.Posix.User (getEffectiveUserID, getEffectiveGroupID, getGroups)
#endif
import qualified Network.ONCRPC.XDR as XDR
import Network.ONCRPC.XDR.Array
import Network.ONCRPC.XDR.Serial
import Network.ONCRPC.XDR.Opaque
import qualified Network.ONCRPC.Prot as RPC
data Auth
= AuthNone
| AuthSys !RPC.Authsys_parms
| AuthOpaque !RPC.Opaque_auth
deriving (Auth -> Auth -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Auth -> Auth -> Bool
$c/= :: Auth -> Auth -> Bool
== :: Auth -> Auth -> Bool
$c== :: Auth -> Auth -> Bool
Eq, Int -> Auth -> ShowS
[Auth] -> ShowS
Auth -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Auth] -> ShowS
$cshowList :: [Auth] -> ShowS
show :: Auth -> String
$cshow :: Auth -> String
showsPrec :: Int -> Auth -> ShowS
$cshowsPrec :: Int -> Auth -> ShowS
Show)
opacifyAuth :: Auth -> RPC.Opaque_auth
opacifyAuth :: Auth -> Opaque_auth
opacifyAuth Auth
AuthNone = Int -> Opaque_auth_body -> Opaque_auth
RPC.Opaque_auth (forall a. XDREnum a => a -> Int
xdrFromEnum Auth_flavor
RPC.AUTH_NONE) forall a b. (a -> b) -> a -> b
$ forall (n :: Natural) a.
(CmpNat 0 n ~ 'LT, Array a) =>
LengthArray 'LT n a
emptyBoundedLengthArray
opacifyAuth (AuthSys Authsys_parms
s) = Int -> Opaque_auth_body -> Opaque_auth
RPC.Opaque_auth (forall a. XDREnum a => a -> Int
xdrFromEnum Auth_flavor
RPC.AUTH_SYS) forall a b. (a -> b) -> a -> b
$ forall a (o :: Ordering) (n :: Natural).
(Opaqued a, KnownOrdering o, KnownNat n) =>
a -> LengthArray o n OpaqueString
toOpaque' Authsys_parms
s
opacifyAuth (AuthOpaque Opaque_auth
o) = Opaque_auth
o
unopacifyAuth :: RPC.Opaque_auth -> Auth
unopacifyAuth :: Opaque_auth -> Auth
unopacifyAuth o :: Opaque_auth
o@(RPC.Opaque_auth Int
n Opaque_auth_body
b) = case forall a (m :: * -> *). (XDREnum a, MonadFail m) => Int -> m a
xdrToEnum Int
n of
Just Auth_flavor
RPC.AUTH_NONE -> Auth
AuthNone
Just Auth_flavor
RPC.AUTH_SYS | Just Authsys_parms
s <- forall a (m :: * -> *) (o :: Ordering) (n :: Natural).
(Opaqued a, MonadFail m) =>
LengthArray o n OpaqueString -> m a
fromOpaque Opaque_auth_body
b -> Authsys_parms -> Auth
AuthSys Authsys_parms
s
Maybe Auth_flavor
_ -> Opaque_auth -> Auth
AuthOpaque Opaque_auth
o
instance XDR.XDR Auth where
xdrType :: Auth -> String
xdrType Auth
_ = String
"translucent_auth"
xdrPut :: Auth -> Put
xdrPut = forall a. XDR a => a -> Put
xdrPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. Auth -> Opaque_auth
opacifyAuth
xdrGet :: Get Auth
xdrGet = Opaque_auth -> Auth
unopacifyAuth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. XDR a => Get a
xdrGet
#ifdef VERSION_unix
getAuthUnix :: IO Auth
getAuthUnix :: IO Auth
getAuthUnix = do
ProcessID
pid <- IO ProcessID
getProcessID
SystemID
sysid <- IO SystemID
getSystemID
UserID
uid <- IO UserID
getEffectiveUserID
GroupID
gid <- IO GroupID
getEffectiveGroupID
[GroupID]
gids <- IO [GroupID]
getGroups
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Authsys_parms -> Auth
AuthSys RPC.Authsys_parms
{ authsys_parms'stamp :: UnsignedInt
RPC.authsys_parms'stamp = forall a b. (Integral a, Num b) => a -> b
fromIntegral ProcessID
pid
, authsys_parms'machinename :: String 255
RPC.authsys_parms'machinename = forall (n :: Natural) a.
(KnownNat n, Array a) =>
a -> LengthArray 'LT n a
boundLengthArray forall a b. (a -> b) -> a -> b
$ String -> ByteString
BSC.pack forall a b. (a -> b) -> a -> b
$ SystemID -> String
nodeName SystemID
sysid
, authsys_parms'uid :: UnsignedInt
RPC.authsys_parms'uid = forall a b. (Integral a, Num b) => a -> b
fromIntegral UserID
uid
, authsys_parms'gid :: UnsignedInt
RPC.authsys_parms'gid = forall a b. (Integral a, Num b) => a -> b
fromIntegral GroupID
gid
, authsys_parms'gids :: Array 16 UnsignedInt
RPC.authsys_parms'gids = forall (n :: Natural) a.
(KnownNat n, Array a) =>
[Elem a] -> LengthArray 'LT n a
boundLengthArrayFromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [GroupID]
gids
}
#endif