+ Add posix-like file interface.

3 files changed, 78 insertions, 2 deletions

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
@@ -202,6 +207,55 @@ 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
 -----------------------------------------------------------------------}