diff options
-rw-r--r-- | src/Data/Torrent.hs | 15 | ||||
-rw-r--r-- | src/System/IO/MMap/Fixed.hs | 9 | ||||
-rw-r--r-- | src/System/Torrent/Storage.hs | 56 |
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 | ||
454 | layoutOffsets :: Layout -> Layout | ||
455 | layoutOffsets = 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. | ||
461 | fileOffset :: FilePath -> ContentInfo -> Maybe Integer | ||
462 | fileOffset 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. |
453 | isSingleFile :: ContentInfo -> Bool | 466 | isSingleFile :: ContentInfo -> Bool |
454 | isSingleFile SingleFile {} = True | 467 | 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 @@ | |||
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 #-} | ||
49 | module System.IO.MMap.Fixed | 50 | module 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 | ||
151 | lookupRegion :: FixedOffset -> Fixed -> Maybe B.ByteString | ||
152 | lookupRegion 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. |
150 | viewBytes :: FixedInterval -> Fixed -> Lazy.ByteString | 159 | viewBytes :: FixedInterval -> Fixed -> Lazy.ByteString |
151 | viewBytes fi s = fromChunks $ L.map mk $ (imap s `intersecting` fi) | 160 | 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 | |||
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 | ||
32 | import Control.Applicative | 35 | import Control.Applicative |
@@ -36,16 +39,19 @@ import Control.Monad | |||
36 | import Control.Monad.Trans | 39 | import Control.Monad.Trans |
37 | 40 | ||
38 | import Data.ByteString as B | 41 | import Data.ByteString as B |
42 | import qualified Data.ByteString.Internal as B | ||
39 | import qualified Data.ByteString.Lazy as Lazy | 43 | import qualified Data.ByteString.Lazy as Lazy |
40 | import Data.List as L | 44 | import Data.List as L |
41 | import Text.PrettyPrint | 45 | import Text.PrettyPrint |
42 | import System.FilePath | 46 | import System.FilePath |
43 | import System.Directory | 47 | import System.Directory |
48 | import Foreign.C.Error | ||
44 | 49 | ||
45 | import Data.Bitfield as BF | 50 | import Data.Bitfield as BF |
46 | import Data.Torrent | 51 | import Data.Torrent |
47 | import Network.BitTorrent.Exchange.Protocol | 52 | import Network.BitTorrent.Exchange.Protocol |
48 | import System.IO.MMap.Fixed as Fixed | 53 | import System.IO.MMap.Fixed as Fixed |
54 | import Debug.Trace | ||
49 | 55 | ||
50 | 56 | ||
51 | data Storage = Storage { | 57 | data 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 () | |||
202 | validateStorage st = undefined -- (`validatePiece` st) [0..pieceCount st] | 207 | validateStorage st = undefined -- (`validatePiece` st) [0..pieceCount st] |
203 | 208 | ||
204 | {----------------------------------------------------------------------- | 209 | {----------------------------------------------------------------------- |
210 | POSIX-like file interface | ||
211 | ------------------------------------------------------------------------ | ||
212 | This is useful for virtual filesystem writers and just for per file | ||
213 | interface. | ||
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 | |||
219 | type Offset = Int | ||
220 | type Size = Int | ||
221 | |||
222 | newtype 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 | -- | ||
232 | openFD :: FilePath -> Storage -> IO (Either Errno FD) | ||
233 | openFD 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). | ||
240 | closeFD :: FD -> IO () | ||
241 | closeFD _ = 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). | ||
250 | readFD :: FD -> Offset -> Size -> IO (Either Errno ByteString) | ||
251 | readFD FD {..} offset len = do | ||
252 | let res = B.take len $ B.drop offset fdData | ||
253 | return $ Right res | ||
254 | |||
255 | readFDAll :: FD -> IO ByteString | ||
256 | readFDAll FD {..} = return fdData | ||
257 | |||
258 | {----------------------------------------------------------------------- | ||
205 | Internal | 259 | Internal |
206 | -----------------------------------------------------------------------} | 260 | -----------------------------------------------------------------------} |
207 | 261 | ||