summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Data/Torrent.hs15
-rw-r--r--src/System/IO/MMap/Fixed.hs9
-rw-r--r--src/System/Torrent/Storage.hs56
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
33 33
34 -- * Files layout 34 -- * Files layout
35 , Layout, contentLayout 35 , Layout, contentLayout
36 , contentLength, pieceCount, blockCount 36 , contentLength, fileOffset
37 , pieceCount, blockCount
37 , isSingleFile, isMultiFile 38 , isSingleFile, isMultiFile
38 39
39 , checkPiece 40 , checkPiece
@@ -54,6 +55,7 @@ module Data.Torrent
54 -- * Internal 55 -- * Internal
55 , Data.Torrent.hash 56 , Data.Torrent.hash
56 , Data.Torrent.hashlazy 57 , Data.Torrent.hashlazy
58 , layoutOffsets
57#endif 59#endif
58 ) where 60 ) where
59 61
@@ -449,6 +451,17 @@ contentLayout rootPath = filesLayout
449 451
450 fl (FileInfo { fiPath = p, fiLength = len }) = (p, fromIntegral len) 452 fl (FileInfo { fiPath = p, fiLength = len }) = (p, fromIntegral len)
451 453
454layoutOffsets :: Layout -> Layout
455layoutOffsets = go 0
456 where
457 go !_ [] = []
458 go !offset ((n, s) : xs) = (n, offset) : go (offset + s) xs
459
460-- | Gives global offset of a content file for a given full path.
461fileOffset :: FilePath -> ContentInfo -> Maybe Integer
462fileOffset fullPath
463 = fmap fromIntegral . lookup fullPath . layoutOffsets . contentLayout ""
464
452-- | Test if this is single file torrent. 465-- | Test if this is single file torrent.
453isSingleFile :: ContentInfo -> Bool 466isSingleFile :: ContentInfo -> Bool
454isSingleFile SingleFile {} = True 467isSingleFile 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 @@
46-- > http://hackage.haskell.org/package/mmap 46-- > http://hackage.haskell.org/package/mmap
47-- > man mmap 47-- > man mmap
48-- 48--
49{-# LANGUAGE RecordWildCards #-}
49module System.IO.MMap.Fixed 50module System.IO.MMap.Fixed
50 ( -- * Intervals 51 ( -- * Intervals
51 FixedOffset, FileOffset, FixedInterval, FileInterval 52 FixedOffset, FileOffset, FixedInterval, FileInterval
@@ -58,6 +59,7 @@ module System.IO.MMap.Fixed
58 59
59 -- ** Specialized 'insertTo' 60 -- ** Specialized 'insertTo'
60 , mmapTo, mallocTo 61 , mmapTo, mallocTo
62 , lookupRegion
61 63
62 -- * Query 64 -- * Query
63 , upperAddr 65 , upperAddr
@@ -146,6 +148,13 @@ mallocTo fi s = do
146 fptr <- mallocForeignPtrBytes bsize 148 fptr <- mallocForeignPtrBytes bsize
147 return (insertTo fi (fptr, 0) s) 149 return (insertTo fi (fptr, 0) s)
148 150
151lookupRegion :: FixedOffset -> Fixed -> Maybe B.ByteString
152lookupRegion offset Fixed {..} =
153 case intersecting imap $ IntervalCO offset (succ offset) of
154 [(i, (fptr, off))] -> let s = max 0 $ upperBound i - lowerBound i
155 in Just $ fromForeignPtr fptr off s
156 _ -> Nothing
157
149-- | Note: this is unsafe operation. 158-- | Note: this is unsafe operation.
150viewBytes :: FixedInterval -> Fixed -> Lazy.ByteString 159viewBytes :: FixedInterval -> Fixed -> Lazy.ByteString
151viewBytes fi s = fromChunks $ L.map mk $ (imap s `intersecting` fi) 160viewBytes 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
27 27
28 -- * Modification 28 -- * Modification
29 , getBlk, putBlk, selBlk 29 , getBlk, putBlk, selBlk
30
31 -- * File interface
32 , FD, openFD, closeFD, readFD, readFDAll
30 ) where 33 ) where
31 34
32import Control.Applicative 35import Control.Applicative
@@ -36,16 +39,19 @@ import Control.Monad
36import Control.Monad.Trans 39import Control.Monad.Trans
37 40
38import Data.ByteString as B 41import Data.ByteString as B
42import qualified Data.ByteString.Internal as B
39import qualified Data.ByteString.Lazy as Lazy 43import qualified Data.ByteString.Lazy as Lazy
40import Data.List as L 44import Data.List as L
41import Text.PrettyPrint 45import Text.PrettyPrint
42import System.FilePath 46import System.FilePath
43import System.Directory 47import System.Directory
48import Foreign.C.Error
44 49
45import Data.Bitfield as BF 50import Data.Bitfield as BF
46import Data.Torrent 51import Data.Torrent
47import Network.BitTorrent.Exchange.Protocol 52import Network.BitTorrent.Exchange.Protocol
48import System.IO.MMap.Fixed as Fixed 53import System.IO.MMap.Fixed as Fixed
54import Debug.Trace
49 55
50 56
51data Storage = Storage { 57data Storage = Storage {
@@ -183,7 +189,6 @@ validatePiece pix st @ Storage {..} = {-# SCC validatePiece #-} do
183 downloaded <- atomically $ isDownloaded pix st 189 downloaded <- atomically $ isDownloaded pix st
184 if not downloaded then return False 190 if not downloaded then return False
185 else do 191 else do
186 print $ show pix ++ " downloaded"
187 piece <- getPiece pix st 192 piece <- getPiece pix st
188 if checkPiece (tInfo metainfo) pix piece 193 if checkPiece (tInfo metainfo) pix piece
189 then return True 194 then return True
@@ -202,6 +207,55 @@ validateStorage :: Storage -> IO ()
202validateStorage st = undefined -- (`validatePiece` st) [0..pieceCount st] 207validateStorage st = undefined -- (`validatePiece` st) [0..pieceCount st]
203 208
204{----------------------------------------------------------------------- 209{-----------------------------------------------------------------------
210 POSIX-like file interface
211------------------------------------------------------------------------
212This is useful for virtual filesystem writers and just for per file
213interface.
214-----------------------------------------------------------------------}
215-- TODO reference counting: storage might be closed before all FDs
216-- gets closed!
217-- or we can forbid to close storage and use finalizers only?
218
219type Offset = Int
220type Size = Int
221
222newtype FD = FD { fdData :: ByteString }
223
224-- TODO implement blocking and non blocking modes?
225
226-- | This call correspond to open(2) with the following parameters:
227--
228-- * OpenMode = ReadOnly;
229--
230-- * OpenFileFlags = O_NONBLOCK.
231--
232openFD :: FilePath -> Storage -> IO (Either Errno FD)
233openFD path Storage {..}
234 | Just offset <- fileOffset path (tInfo metainfo)
235 , Just bs <- lookupRegion (fromIntegral offset) payload
236 = return $ Right $ FD bs
237 | otherwise = return $ Left $ eNOENT
238
239-- | This call correspond to close(2).
240closeFD :: FD -> IO ()
241closeFD _ = return ()
242
243-- TODO return "is dir" error
244-- TODO check if region is not out of bound
245-- TODO check if region completely downloaded
246-- TODO if not we could return EAGAIN
247-- TODO enqueue read to piece manager
248-- WARN use BS.copy?
249-- | This call correspond to pread(2).
250readFD :: FD -> Offset -> Size -> IO (Either Errno ByteString)
251readFD FD {..} offset len = do
252 let res = B.take len $ B.drop offset fdData
253 return $ Right res
254
255readFDAll :: FD -> IO ByteString
256readFDAll FD {..} = return fdData
257
258{-----------------------------------------------------------------------
205 Internal 259 Internal
206-----------------------------------------------------------------------} 260-----------------------------------------------------------------------}
207 261