{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Example: -- -- > do may <- dvdRead "/path/to/dvd/" (do Just s <- fileStat 1 TitleVobs -- > liftIO (print s) -- > file 1 TitleVobs (readBlocks 0 100) -- > ) -- > case may of -- > Just b -> writeFile "tmp.vob" b -- > Nothing -> putStrLn "Could not read file" module DVD.DVDRead ( -- * Datatypes DVDRead , File , Status , Offset , Size , Title , ReadDomain(..) -- , DiscID , VolumeIdentifier , VolumeSetIdentifier , dvdRead , fileStat , getUDFCacheLevel , setUDFCacheLevel -- * Disc info -- , discID , udfVolumeInfo , isoVolumeInfo , blockSize -- * File operations , file , size , readBlocks , readBytes -- * Utility read functions , readVMGInfoFile , readVMGInfoBackupFile , readVMGMenu , readVTSInfoFile , readVTSInfoBackupFile , readVTSMenu ) where import Control.Monad.State import Data.ByteString hiding (map) import Data.ByteString.Unsafe import qualified Data.ByteString.Char8 as C import Foreign import Foreign.C import Foreign.C.Types #include {#context lib = "libdvdread" prefix = "dvd"#} {#pointer *dvd_reader_t as DVDReader foreign newtype#} cFromEnum :: (Enum e, Integral i) => e -> i cFromEnum = fromIntegral . fromEnum toDVDReader :: Ptr DVDReader -> IO DVDReader toDVDReader ptr = newForeignPtr p_DVDClose ptr >>= return . DVDReader foreign import ccall "&DVDClose" p_DVDClose :: FunPtr (Ptr DVDReader -> IO ()) toMaybeDVDReader :: Ptr DVDReader -> IO (Maybe DVDReader) toMaybeDVDReader ptr | ptr == nullPtr = return Nothing | otherwise = toDVDReader ptr >>= return . Just {#fun DVDOpen as dvdOpen {withCString* `FilePath'} -> `Maybe DVDReader' toMaybeDVDReader*#} -- |This is the main data type in this module and represent an action -- in the underlying C library newtype DVDRead a = DVDRead (StateT DVDReader IO a) deriving (Functor, Monad, MonadIO) runDVDRead (DVDRead (StateT action)) = action -- |Runs an action of type @'DVDRead'@ on the specified device/image -- file. dvdRead :: FilePath -- ^A block device, mount point, image file or -- directory containing a copy of a DVD -> DVDRead a -- ^Action to perform on the DVD -> IO a -- ^Resulting action dvdRead file (DVDRead (StateT action)) = do md <- dvdOpen file case md of Nothing -> ioError $ userError ("Cannot open " ++ file) Just dvd -> do (a,DVDReader d) <- action dvd finalizeForeignPtr d return a -- |Returns whether or not some UDF operations are cached. getUDFCacheLevel :: DVDRead Bool getUDFCacheLevel = DVDRead $ StateT (\s -> do i <- dvdUDFCacheLevel s (-1) return (toEnum i,s) ) -- |Sets the cache level for UDF operations. setUDFCacheLevel :: Bool -> DVDRead () setUDFCacheLevel b = DVDRead $ StateT (\s -> do dvdUDFCacheLevel s (fromEnum b) return ((),s) ) {#fun DVDUDFCacheLevel as dvdUDFCacheLevel {withDVDReader* `DVDReader', fromIntegral `Int'} -> `Int' fromIntegral#} -- |The @'DiscID'@ is the MD5 sum of VIDEO_TS.IFO and the VTS_??_0.IFO -- files in title order (those that exist). newtype DiscID = DiscID ByteString ptr2DiscID :: Ptr a -> IO DiscID ptr2DiscID p = packCStringLen (castPtr p,16) >>= return . DiscID -- |Generates the @'DiscID'@ or @'Nothing'@ if an error occurs. discID :: DVDRead (Maybe DiscID) discID = DVDRead $ StateT (\s -> do p <- mallocBytes 16 i <- withDVDReader s (\q -> {#call unsafe DVDDiscID as c_DVDDiscID#} q p) if i == -1 then do free p return (Nothing,s) else do id <- ptr2DiscID p free p return (Just id,s) ) -- |Specifies a file type inside a 'Title' {#enum dvd_read_domain_t as ReadDomain {underscoreToCase} with prefix = "dvd_read" deriving (Eq,Read,Show)#} {#pointer *dvd_file_t as DVDFile foreign newtype#} toDVDFile :: Ptr DVDFile -> IO DVDFile toDVDFile ptr = newForeignPtr p_DVDCloseFile ptr >>= return . DVDFile toMaybeDVDFile :: Ptr DVDFile -> IO (Maybe DVDFile) toMaybeDVDFile ptr | ptr == nullPtr = return Nothing | otherwise = toDVDFile ptr >>= return . Just foreign import ccall "&DVDCloseFile" p_DVDCloseFile :: FunPtr (Ptr DVDFile -> IO ()) -- |The @'File' a@ monad represents a file operation returning the -- type @a@, to be executed on the content of a DVD. It can be -- converted into a @'DVDRead'@ action using @'file'@. newtype File a = File (StateT DVDFile DVDRead a) deriving (Functor, Monad, MonadIO) -- |The number of the title inside a DVD, between 0 and 99, with 0 -- referring to the Video Manager (VIDEO_TS.*). type Title = Word8 -- |Applies @'File' a@ to the given 'Title' and 'ReadDomain', and -- generates the corresponding @'DVDRead'@ action. file :: Title -- ^DVD title -> ReadDomain -- ^Domain -> File a -- ^Read operation -> DVDRead a -- ^Reasulting action file tit dom (File (StateT act)) = DVDRead $ StateT (\s -> do mf <- dvdOpenFile s tit dom case mf of Nothing -> do a <- ioError $ userError ("Cannot open title " ++ (show tit)) return (a,s) Just f -> do ((a, DVDFile g),r) <- (runDVDRead (act f)) s finalizeForeignPtr g return (a,r) ) {#fun DVDOpenFile as dvdOpenFile {withDVDReader* `DVDReader', fromIntegral `Title', cFromEnum `ReadDomain'} -> `Maybe DVDFile' toMaybeDVDFile*#} -- |Size in bytes or blocks of a file corresponding to a given -- @'Title'@ \/ @'ReadDomain'@. A block equals @'blockSize'@ bytes. type Size = Word64 -- |Returns the size of a file in blocks. size :: File Size size = File $ StateT (\f -> liftIO (do s <- withDVDFile f {#call unsafe DVDFileSize as c_DVDFileSize#} return (fromIntegral s,f)) ) -- |The number of bytes or blocks since the beginning of the file -- (offset 0). A block equals @'blockSize'@ bytes. type Offset = Word32 -- |@'Status'@ is a list containing the sizes in bytes of each file -- corresponding to a given @'Title'@ \/ @'ReadDomain'@. newtype Status = Status [Size] deriving (Eq, Read, Show) toStatus p = do n <- {#get dvd_stat_t->nr_parts#} p q <- {#get dvd_stat_t->parts_size#} p l <- peekArray (fromIntegral n*2) ((plusPtr p 12)::(Ptr Word32)) return $ Status (map fromIntegral (getEven l)) where getEven [] = [] getEven (x:[]) = [] getEven (x:(y:ys)) = y:(getEven ys) -- |Returns the @'Status'@ of the given @'Title'@ \/ @'ReadDomain'@, or @'Nothing'@ in case of error. fileStat :: Title -> ReadDomain -> DVDRead (Maybe Status) fileStat t d = DVDRead $ StateT (\s -> do p <- mallocBytes {#sizeof dvd_stat_t#} i <- withDVDReader s (\x -> {#call unsafe DVDFileStat as c_DVDFileStat#} x (fromIntegral t) (cFromEnum d) p) if i == (-1) then do free p return (Nothing,s) else do st <- toStatus p free p return (Just st,s) ) -- |Number of bytes in a logical block (2048). blockSize :: Word64 blockSize = 2048 -- |Reads @'Size'@ number of blocks from the file starting at the -- given block @'Offset'@. Returns @'Nothing'@ in case of error. This -- function should be used only for reading VOB data (VIDEO_TS.VOB or -- VTS_??_?.VOB). When reading from an encrypted drive, blocks are -- decrypted using libdvdcss where required. readBlocks :: Offset -- ^Starting offset in blocks -> Size -- ^Number of blocks to read -> File (Maybe ByteString) readBlocks off n = File $ StateT (\f -> DVDRead $ StateT (\d -> do p <- mallocBytes $ fromEnum (n * blockSize) s <- withDVDFile f (\x -> {#call unsafe DVDReadBlocks as c_DVDReadBlocks#} x (fromIntegral off) (fromIntegral n) p) if s == (-1) then do free p return ((Nothing,f),d) else do q <- reallocBytes p (fromEnum ((fromIntegral s) * blockSize)) b <- unsafePackCStringFinalizer (castPtr q) (fromEnum ((fromIntegral s) * blockSize)) (free q) return ((Just b,f),d) ) ) -- |Volume Identifier as described in ECMA-167. newtype VolumeIdentifier = VolumeID C.ByteString deriving (Eq, Read, Show) -- |Volume Set Identifier as described in ECMA-167. newtype VolumeSetIdentifier = VolumeSetID C.ByteString deriving (Eq, Read, Show) -- |Returns Volume Identifier and Volume Set Identifier of the UDF -- filesystem, or @'Nothing'@ in case of error. udfVolumeInfo :: DVDRead (Maybe (VolumeIdentifier,VolumeSetIdentifier)) udfVolumeInfo = DVDRead $ StateT (\s -> do p <- mallocBytes 33 q <- mallocBytes 128 i <- withDVDReader s (\x -> {#call unsafe DVDUDFVolumeInfo as c_DVDUDFVolumeInfo#} x p 33 (castPtr q) 128) if i == (-1) then do free p free q return (Nothing,s) else do v <- packCString p vs <- packCStringLen (q,128) free p free q return (Just (VolumeID v,VolumeSetID vs),s) ) -- |Only use this function as fallback if @'udfVolumeInfo'@ returns -- @'Nothing'@. This will happen on a disc mastered only with a -- iso9660 filesystem. isoVolumeInfo :: DVDRead (Maybe (VolumeIdentifier,VolumeSetIdentifier)) isoVolumeInfo = DVDRead $ StateT (\s -> do p <- mallocBytes 33 q <- mallocBytes 128 i <- withDVDReader s (\x -> {#call unsafe DVDISOVolumeInfo as c_DVDISOVolumeInfo#} x p 33 (castPtr q) 128) if i == (-1) then do free p free q return (Nothing,s) else do v <- packCString p vs <- packCStringLen (q,128) free p free q return (Just (VolumeID v,VolumeSetID vs),s) ) -- |Reads @'Size'@ number of bytes from the file starting at the given -- bytes @'Offset'@. Returns @'Nothing'@ in case of error. This -- function should be used only for reading Info data (VIDEO_TS.IFO, -- VIDEO_TS.BUP, VTS_??_?.IFO or VTS_??_?.BUP). readBytes :: Offset -- ^Starting offset in bytes -> Size -- ^Number of bytes to read -> File (Maybe ByteString) readBytes off n = File $ StateT (\f -> DVDRead $ StateT (\d -> do i <- withDVDFile f (\x -> {#call unsafe DVDFileSeek as c_DVDFileSeek#} x (fromIntegral off)) if i == -1 then return ((Nothing,f),d) else do p <- mallocBytes $fromEnum n s <- withDVDFile f (\x -> {#call unsafe DVDReadBytes as c_DVDReadBytes#} x p (fromIntegral n)) if s == (-1) then do free p return ((Nothing,f),d) else do b <- packCStringLen (castPtr p, fromIntegral s) free p return ((Just b,f),d) ) ) -- |Returns the content of VIDEO_TS.IFO file. readVMGInfoFile :: DVDRead ByteString readVMGInfoFile = readWholeFile 0 InfoFile -- |Returns the content of VIDEO_TS.BUP file. readVMGInfoBackupFile :: DVDRead ByteString readVMGInfoBackupFile = readWholeFile 0 InfoBackupFile -- |Returns the content of VIDEO_TS.VOB file. readVMGMenu ::DVDRead ByteString readVMGMenu = readWholeFile 0 MenuVobs -- |Returns the content of VTS_??_0.IFO file. Use with @'Title'@ from -- 1 to 99. readVTSInfoFile :: Title -> DVDRead ByteString readVTSInfoFile t = readWholeFile t InfoFile -- |Returns the content of VTS_??_0.BUP file. Use with @'Title'@ from -- 1 to 99. readVTSInfoBackupFile :: Title -> DVDRead ByteString readVTSInfoBackupFile t = readWholeFile t InfoBackupFile -- |Returns the content of VTS_??_0.VOB file. Use with @'Title'@ from -- 1 to 99. readVTSMenu :: Title -> DVDRead ByteString readVTSMenu t = readWholeFile t MenuVobs readWholeFile :: Title -> ReadDomain -> DVDRead ByteString readWholeFile t d = file t d (do l <- size if (d == InfoFile) || (d == InfoBackupFile) then do Just b <- readBytes 0 (l * blockSize) return b else do Just b <- readBlocks 0 l return b )