module System.Zfs (
module System.Zfs.Errors,
module System.Zfs.Types,
module System.Zfs.Zpool,
module System.Zfs.Mount,
module System.Zfs.Iter,
module System.Zfs.Dataset,
runZfs,
printZpoolConfig
) where
import Control.Monad
import Control.Monad.IO.Class
import qualified System.Zfs.Lowlevel as L
import System.Zfs.Errors
import System.Zfs.Types
import System.Zfs.Zpool
import System.Zfs.Mount
import System.Zfs.Iter
import System.Zfs.Dataset
import Foreign.ForeignPtr
import Foreign.StablePtr
import Foreign.C.String
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
runZfs :: MonadIO m => (forall z. ZfsT z m a) -> m (Either ZError a)
runZfs m = do
lzh <- liftIO L.libzfs_init
if lzh == nullPtr
then return $ Left EzInitFailed
else do
a <- runZfs' m $ ZfsContext lzh
liftIO $ L.libzfs_fini lzh
return a
printZpoolConfig :: Zpool z -> Zfs z ()
printZpoolConfig (Zpool fptr) = Zfs $ \_ -> liftIO $ do
nvl <- withForeignPtr fptr $ \ptr -> L.zpool_get_config ptr nullPtr
process nvl nullPtr
liftIO $ putStrLn " [ features ]"
nvl <- withForeignPtr fptr $ \ptr -> L.zpool_get_features ptr
process nvl nullPtr
return $ Right ()
where process nvl nvp = do
nvp' <- L.nvlist_next_nvpair nvl nvp
if nvp' == nullPtr
then return ()
else do
cstr <- L.nvpair_name nvp'
peekCString cstr >>= putStr
dt <- L.nvpair_type nvp'
putStr (" ("++show dt++")")
case dt of
8 -> alloca $ \ptr -> do
L.nvlist_lookup_uint64 nvl cstr ptr
i <- peek ptr
putStr $ show i
9 -> alloca $ \ptr -> do
L.nvlist_lookup_string nvl cstr ptr
cs <- peek ptr
peekCString cs >>= putStr
19 -> alloca $ \ptr -> do
L.nvlist_lookup_nvlist nvl cstr ptr
nvl' <- peek ptr
putStrLn " {"
process nvl' nullPtr
putStrLn "}"
_ -> return ()
putStrLn ""
process nvl nvp'