summaryrefslogtreecommitdiff
path: root/bittorrent/src/System/Torrent/FileMap.hs
diff options
context:
space:
mode:
Diffstat (limited to 'bittorrent/src/System/Torrent/FileMap.hs')
-rw-r--r--bittorrent/src/System/Torrent/FileMap.hs163
1 files changed, 0 insertions, 163 deletions
diff --git a/bittorrent/src/System/Torrent/FileMap.hs b/bittorrent/src/System/Torrent/FileMap.hs
deleted file mode 100644
index 38c475e8..00000000
--- a/bittorrent/src/System/Torrent/FileMap.hs
+++ /dev/null
@@ -1,163 +0,0 @@
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE ViewPatterns #-}
3{-# OPTIONS -fno-warn-orphans #-}
4module System.Torrent.FileMap
5 ( FileMap
6
7 -- * Construction
8 , Mode (..)
9 , def
10 , mmapFiles
11 , unmapFiles
12
13 -- * Query
14 , System.Torrent.FileMap.size
15
16 -- * Modification
17 , readBytes
18 , writeBytes
19 , unsafeReadBytes
20
21 -- * Unsafe conversions
22 , fromLazyByteString
23 , toLazyByteString
24 ) where
25
26import Control.Applicative
27import Control.Monad as L
28import Data.ByteString as BS
29import Data.ByteString.Internal as BS
30import Data.ByteString.Lazy as BL
31import Data.ByteString.Lazy.Internal as BL
32import Data.Default
33import Data.Vector as V -- TODO use unboxed vector
34import Foreign
35import System.IO.MMap
36
37import Data.Torrent
38
39
40data FileEntry = FileEntry
41 { filePosition :: {-# UNPACK #-} !FileOffset
42 , fileBytes :: {-# UNPACK #-} !BS.ByteString -- XXX: mutable buffer (see 'writeBytes').
43 } deriving (Show, Eq)
44
45type FileMap = Vector FileEntry
46
47instance Default Mode where
48 def = ReadWriteEx
49
50mmapFiles :: Mode -> FileLayout FileSize -> IO FileMap
51mmapFiles mode layout = V.fromList <$> L.mapM mkEntry (accumPositions layout)
52 where
53 mkEntry (path, (pos, expectedSize)) = do
54 let esize = fromIntegral expectedSize -- FIXME does this safe?
55 (fptr, moff, msize) <- mmapFileForeignPtr path mode $ Just (0, esize)
56 if msize /= esize
57 then error "mmapFiles" -- TODO unmap mapped files on exception
58 else return $ FileEntry pos (PS fptr moff msize)
59
60unmapFiles :: FileMap -> IO ()
61unmapFiles = V.mapM_ unmapEntry
62 where
63 unmapEntry (FileEntry _ (PS fptr _ _)) = finalizeForeignPtr fptr
64
65-- Unsafe: FileMap 'writeBytes' will modify supplied bytestrings in place.
66fromLazyByteString :: BL.ByteString -> FileMap
67fromLazyByteString lbs = V.unfoldr f (0, lbs)
68 where
69 f (_, Empty ) = Nothing
70 f (pos, Chunk x xs) = Just (FileEntry pos x, ((pos + chunkSize), xs))
71 where chunkSize = fromIntegral $ BS.length x
72
73-- | /O(n)/.
74--
75-- Unsafe: mutable buffers are returned without copy.
76toLazyByteString :: FileMap -> BL.ByteString
77toLazyByteString = V.foldr f Empty
78 where
79 f FileEntry {..} bs = Chunk fileBytes bs
80
81-- | /O(1)/.
82size :: FileMap -> FileOffset
83size m
84 | V.null m = 0
85 | FileEntry {..} <- V.unsafeLast m
86 = filePosition + fromIntegral (BS.length fileBytes)
87
88-- | Find the file number for a particular byte offset within a torrent.
89bsearch :: FileOffset -> FileMap -> Maybe Int
90bsearch x m
91 | V.null m = Nothing
92 | otherwise = branch (V.length m `div` 2)
93 where
94 branch c @ ((m !) -> FileEntry {..})
95 | x < filePosition = bsearch x (V.take c m)
96 | x >= filePosition + fileSize = do
97 ix <- bsearch x (V.drop (succ c) m)
98 return $ succ c + ix
99 | otherwise = Just c
100 where
101 fileSize = fromIntegral (BS.length fileBytes)
102
103-- | /O(log n)/.
104drop :: FileOffset -> FileMap -> (FileSize, FileMap)
105drop off m
106 | Just ix <- bsearch off m
107 , FileEntry {..} <- m ! ix = (off - filePosition, V.drop ix m)
108 | otherwise = (0 , V.empty)
109
110-- | /O(log n)/.
111take :: FileSize -> FileMap -> (FileMap, FileSize)
112take len m
113 | len >= s = (m , 0)
114 | Just ix <- bsearch (pred len) m = let m' = V.take (succ ix) m
115 in (m', System.Torrent.FileMap.size m' - len)
116 | otherwise = (V.empty , 0)
117 where
118 s = System.Torrent.FileMap.size m
119
120-- | /O(log n + m)/. Do not use this function with 'unmapFiles'.
121--
122-- The returned bytestring points directly into an area memory mapped from a
123-- file.
124unsafeReadBytes :: FileOffset -> FileSize -> FileMap -> BL.ByteString
125unsafeReadBytes off s m
126 | (l , m') <- System.Torrent.FileMap.drop off m
127 , (m'', _ ) <- System.Torrent.FileMap.take (off + s) m'
128 = BL.take (fromIntegral s) $ BL.drop (fromIntegral l) $ toLazyByteString m''
129
130-- The returned bytestring is copied and safe to use after the file is
131-- unmapped.
132readBytes :: FileOffset -> FileSize -> FileMap -> IO BL.ByteString
133readBytes off s m = do
134 let bs_copy = BL.copy $ unsafeReadBytes off s m
135 forceLBS bs_copy
136 return bs_copy
137 where
138 forceLBS Empty = return ()
139 forceLBS (Chunk _ x) = forceLBS x
140
141-- UNSAFE: Uses the first byte string as a pointer to mutable data and writes
142-- the contents of the second bytestring there.
143bscpy :: BL.ByteString -> BL.ByteString -> IO ()
144bscpy (PS _ _ 0 `Chunk` dest_rest) src = bscpy dest_rest src
145bscpy dest (PS _ _ 0 `Chunk` src_rest) = bscpy dest src_rest
146bscpy (PS dest_fptr dest_off dest_size `Chunk` dest_rest)
147 (PS src_fptr src_off src_size `Chunk` src_rest)
148 = do let csize = min dest_size src_size
149 withForeignPtr dest_fptr $ \dest_ptr ->
150 withForeignPtr src_fptr $ \src_ptr ->
151 memcpy (dest_ptr `advancePtr` dest_off)
152 (src_ptr `advancePtr` src_off)
153 (fromIntegral csize) -- TODO memmove?
154 bscpy (PS dest_fptr (dest_off + csize) (dest_size - csize) `Chunk` dest_rest)
155 (PS src_fptr (src_off + csize) (src_size - csize) `Chunk` src_rest)
156bscpy _ _ = return ()
157
158-- UNSAFE: Mutates bytestring contents within the provided FileMap.
159writeBytes :: FileOffset -> BL.ByteString -> FileMap -> IO ()
160writeBytes off lbs m = bscpy dest src
161 where
162 src = BL.take (fromIntegral (BL.length dest)) lbs
163 dest = unsafeReadBytes off (fromIntegral (BL.length lbs)) m
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 14:29:32 +0000