From 7ad3fd1f6fe3c6719b69f3638542f24b32a3b09c Mon Sep 17 00:00:00 2001 From: Sam T Date: Tue, 16 Jul 2013 07:47:28 +0400 Subject: + Add posix-like file interface. --- src/Data/Torrent.hs | 15 +++++++++++- src/System/IO/MMap/Fixed.hs | 9 +++++++ src/System/Torrent/Storage.hs | 56 ++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 78 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs index 2ebe9374..5971aa9c 100644 --- a/src/Data/Torrent.hs +++ b/src/Data/Torrent.hs @@ -33,7 +33,8 @@ module Data.Torrent -- * Files layout , Layout, contentLayout - , contentLength, pieceCount, blockCount + , contentLength, fileOffset + , pieceCount, blockCount , isSingleFile, isMultiFile , checkPiece @@ -54,6 +55,7 @@ module Data.Torrent -- * Internal , Data.Torrent.hash , Data.Torrent.hashlazy + , layoutOffsets #endif ) where @@ -449,6 +451,17 @@ contentLayout rootPath = filesLayout fl (FileInfo { fiPath = p, fiLength = len }) = (p, fromIntegral len) +layoutOffsets :: Layout -> Layout +layoutOffsets = go 0 + where + go !_ [] = [] + go !offset ((n, s) : xs) = (n, offset) : go (offset + s) xs + +-- | Gives global offset of a content file for a given full path. +fileOffset :: FilePath -> ContentInfo -> Maybe Integer +fileOffset fullPath + = fmap fromIntegral . lookup fullPath . layoutOffsets . contentLayout "" + -- | Test if this is single file torrent. isSingleFile :: ContentInfo -> Bool isSingleFile SingleFile {} = True diff --git a/src/System/IO/MMap/Fixed.hs b/src/System/IO/MMap/Fixed.hs index 9d2e354f..df6a6603 100644 --- a/src/System/IO/MMap/Fixed.hs +++ b/src/System/IO/MMap/Fixed.hs @@ -46,6 +46,7 @@ -- > http://hackage.haskell.org/package/mmap -- > man mmap -- +{-# LANGUAGE RecordWildCards #-} module System.IO.MMap.Fixed ( -- * Intervals FixedOffset, FileOffset, FixedInterval, FileInterval @@ -58,6 +59,7 @@ module System.IO.MMap.Fixed -- ** Specialized 'insertTo' , mmapTo, mallocTo + , lookupRegion -- * Query , upperAddr @@ -146,6 +148,13 @@ mallocTo fi s = do fptr <- mallocForeignPtrBytes bsize return (insertTo fi (fptr, 0) s) +lookupRegion :: FixedOffset -> Fixed -> Maybe B.ByteString +lookupRegion offset Fixed {..} = + case intersecting imap $ IntervalCO offset (succ offset) of + [(i, (fptr, off))] -> let s = max 0 $ upperBound i - lowerBound i + in Just $ fromForeignPtr fptr off s + _ -> Nothing + -- | Note: this is unsafe operation. viewBytes :: FixedInterval -> Fixed -> Lazy.ByteString viewBytes fi s = fromChunks $ L.map mk $ (imap s `intersecting` fi) diff --git a/src/System/Torrent/Storage.hs b/src/System/Torrent/Storage.hs index cd1a8364..dd7258a0 100644 --- a/src/System/Torrent/Storage.hs +++ b/src/System/Torrent/Storage.hs @@ -27,6 +27,9 @@ module System.Torrent.Storage -- * Modification , getBlk, putBlk, selBlk + + -- * File interface + , FD, openFD, closeFD, readFD, readFDAll ) where import Control.Applicative @@ -36,16 +39,19 @@ import Control.Monad import Control.Monad.Trans import Data.ByteString as B +import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Lazy as Lazy import Data.List as L import Text.PrettyPrint import System.FilePath import System.Directory +import Foreign.C.Error import Data.Bitfield as BF import Data.Torrent import Network.BitTorrent.Exchange.Protocol import System.IO.MMap.Fixed as Fixed +import Debug.Trace data Storage = Storage { @@ -183,7 +189,6 @@ validatePiece pix st @ Storage {..} = {-# SCC validatePiece #-} do downloaded <- atomically $ isDownloaded pix st if not downloaded then return False else do - print $ show pix ++ " downloaded" piece <- getPiece pix st if checkPiece (tInfo metainfo) pix piece then return True @@ -201,6 +206,55 @@ validatePiece pix st @ Storage {..} = {-# SCC validatePiece #-} do validateStorage :: Storage -> IO () validateStorage st = undefined -- (`validatePiece` st) [0..pieceCount st] +{----------------------------------------------------------------------- + POSIX-like file interface +------------------------------------------------------------------------ +This is useful for virtual filesystem writers and just for per file +interface. +-----------------------------------------------------------------------} +-- TODO reference counting: storage might be closed before all FDs +-- gets closed! +-- or we can forbid to close storage and use finalizers only? + +type Offset = Int +type Size = Int + +newtype FD = FD { fdData :: ByteString } + +-- TODO implement blocking and non blocking modes? + +-- | This call correspond to open(2) with the following parameters: +-- +-- * OpenMode = ReadOnly; +-- +-- * OpenFileFlags = O_NONBLOCK. +-- +openFD :: FilePath -> Storage -> IO (Either Errno FD) +openFD path Storage {..} + | Just offset <- fileOffset path (tInfo metainfo) + , Just bs <- lookupRegion (fromIntegral offset) payload + = return $ Right $ FD bs + | otherwise = return $ Left $ eNOENT + +-- | This call correspond to close(2). +closeFD :: FD -> IO () +closeFD _ = return () + +-- TODO return "is dir" error +-- TODO check if region is not out of bound +-- TODO check if region completely downloaded +-- TODO if not we could return EAGAIN +-- TODO enqueue read to piece manager +-- WARN use BS.copy? +-- | This call correspond to pread(2). +readFD :: FD -> Offset -> Size -> IO (Either Errno ByteString) +readFD FD {..} offset len = do + let res = B.take len $ B.drop offset fdData + return $ Right res + +readFDAll :: FD -> IO ByteString +readFDAll FD {..} = return fdData + {----------------------------------------------------------------------- Internal -----------------------------------------------------------------------} -- cgit v1.2.3