diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/BitTorrent.hs | 70 | ||||
-rw-r--r-- | src/Network/BitTorrent/Sessions.hs | 6 |
2 files changed, 67 insertions, 9 deletions
diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs index 7ae43cec..e68d1597 100644 --- a/src/Network/BitTorrent.hs +++ b/src/Network/BitTorrent.hs | |||
@@ -26,19 +26,35 @@ module Network.BitTorrent | |||
26 | , getTorrentInfo | 26 | , getTorrentInfo |
27 | , getTorrentInfoStr | 27 | , getTorrentInfoStr |
28 | 28 | ||
29 | -- * Torrent Groups | ||
30 | , ClientLoc (..), ppClientLoc | ||
31 | , concreteLoc, concretePath | ||
32 | , addTorrents | ||
33 | , removeTorrents | ||
34 | |||
29 | -- * Extensions | 35 | -- * Extensions |
30 | , Extension | 36 | , Extension |
31 | , defaultExtensions | 37 | , defaultExtensions |
32 | , ppExtension | 38 | , ppExtension |
33 | ) where | 39 | ) where |
34 | 40 | ||
41 | import Control.Applicative | ||
42 | import Control.Exception | ||
43 | import Control.Monad | ||
44 | import Data.List as L | ||
45 | import Data.HashMap.Strict as HM | ||
35 | import Network | 46 | import Network |
47 | import Text.Read | ||
48 | import Text.PrettyPrint | ||
49 | import System.Directory | ||
50 | import System.FilePath | ||
51 | |||
36 | import Data.Torrent | 52 | import Data.Torrent |
37 | import Network.BitTorrent.Sessions.Types | 53 | import Network.BitTorrent.Sessions.Types |
38 | import Network.BitTorrent.Sessions | 54 | import Network.BitTorrent.Sessions |
39 | import Network.BitTorrent.Extension | 55 | import Network.BitTorrent.Extension |
40 | import Network.BitTorrent.Tracker | 56 | import Network.BitTorrent.Tracker |
41 | import Text.Read | 57 | |
42 | 58 | ||
43 | -- TODO remove fork from Network.BitTorrent.Exchange | 59 | -- TODO remove fork from Network.BitTorrent.Exchange |
44 | -- TODO make all forks in Internal. | 60 | -- TODO make all forks in Internal. |
@@ -48,6 +64,11 @@ withDefaultClient :: PortNumber -> PortNumber -> (ClientSession -> IO ()) -> IO | |||
48 | withDefaultClient listPort dhtPort action = do | 64 | withDefaultClient listPort dhtPort action = do |
49 | withClientSession defaultThreadCount [] listPort dhtPort action | 65 | withClientSession defaultThreadCount [] listPort dhtPort action |
50 | 66 | ||
67 | getTorrentInfoStr :: ClientSession -> String -> IO (Maybe Torrent) | ||
68 | getTorrentInfoStr cs str | ||
69 | | Just infohash <- readMaybe str = getTorrentInfo cs infohash | ||
70 | | otherwise = return Nothing | ||
71 | |||
51 | {----------------------------------------------------------------------- | 72 | {----------------------------------------------------------------------- |
52 | Torrent management | 73 | Torrent management |
53 | -----------------------------------------------------------------------} | 74 | -----------------------------------------------------------------------} |
@@ -61,12 +82,7 @@ addTorrent cs loc @ TorrentLoc {..} = do | |||
61 | 82 | ||
62 | -- | Unregister torrent and stop all running sessions. | 83 | -- | Unregister torrent and stop all running sessions. |
63 | removeTorrent :: ClientSession -> InfoHash -> IO () | 84 | removeTorrent :: ClientSession -> InfoHash -> IO () |
64 | removeTorrent ses loc = undefined -- atomically $ unregisterTorrent ses loc | 85 | removeTorrent = unregisterTorrent |
65 | |||
66 | getTorrentInfoStr :: ClientSession -> String -> IO (Maybe Torrent) | ||
67 | getTorrentInfoStr cs str | ||
68 | | Just infohash <- readMaybe str = getTorrentInfo cs infohash | ||
69 | | otherwise = return Nothing | ||
70 | 86 | ||
71 | {- | 87 | {- |
72 | -- | The same as 'removeTorrrent' torrent, but delete all torrent | 88 | -- | The same as 'removeTorrrent' torrent, but delete all torrent |
@@ -74,3 +90,43 @@ getTorrentInfoStr cs str | |||
74 | deleteTorrent :: ClientSession -> TorrentLoc -> IO () | 90 | deleteTorrent :: ClientSession -> TorrentLoc -> IO () |
75 | deleteTorrent ClientSession {..} TorrentLoc {..} = undefined | 91 | deleteTorrent ClientSession {..} TorrentLoc {..} = undefined |
76 | -} | 92 | -} |
93 | |||
94 | {----------------------------------------------------------------------- | ||
95 | Torrent group management | ||
96 | -----------------------------------------------------------------------} | ||
97 | -- TODO better name | ||
98 | |||
99 | data ClientLoc = ClientLoc | ||
100 | { tdir :: FilePath -- ^ Path to directory with .torrent files. | ||
101 | , ddir :: FilePath -- ^ Path to directory to place content. | ||
102 | } deriving (Show, Eq) | ||
103 | |||
104 | ppClientLoc :: ClientLoc -> Doc | ||
105 | ppClientLoc ClientLoc {..} = | ||
106 | text "torrent directory" <+> text tdir $$ | ||
107 | text "data directory" <+> text ddir | ||
108 | |||
109 | concretePath :: ClientLoc -> FilePath -> FilePath | ||
110 | concretePath ClientLoc {..} relPath = tdir </> relPath | ||
111 | |||
112 | concreteLoc :: ClientLoc -> FilePath -> TorrentLoc | ||
113 | concreteLoc loc @ ClientLoc {..} relPath | ||
114 | = TorrentLoc (concretePath loc relPath) ddir | ||
115 | |||
116 | addTorrents :: ClientSession -> ClientLoc -> IO () | ||
117 | addTorrents ses loc @ ClientLoc {..} = do | ||
118 | paths <- L.filter isTorrentPath <$> getDirectoryContents tdir | ||
119 | forM_ paths $ handle handler . addTorrent ses . concreteLoc loc | ||
120 | where | ||
121 | handler :: SomeException -> IO () | ||
122 | handler = print | ||
123 | |||
124 | removeTorrents :: ClientSession -> IO () | ||
125 | removeTorrents cs = do | ||
126 | tm <- getRegistered cs | ||
127 | forM_ (keys tm) (removeTorrent cs) | ||
128 | |||
129 | {- | ||
130 | deleteTorrents :: ClientSession -> IO () | ||
131 | deleteTorrents = undefined | ||
132 | -} \ No newline at end of file | ||
diff --git a/src/Network/BitTorrent/Sessions.hs b/src/Network/BitTorrent/Sessions.hs index 4e58be5c..6b73dd6c 100644 --- a/src/Network/BitTorrent/Sessions.hs +++ b/src/Network/BitTorrent/Sessions.hs | |||
@@ -306,8 +306,10 @@ registerTorrent ClientSession {..} loc @ TorrentLoc {..} = do | |||
306 | torrent <- fromFile metafilePath | 306 | torrent <- fromFile metafilePath |
307 | atomically $ modifyTVar' torrentMap $ HM.insert (tInfoHash torrent) loc | 307 | atomically $ modifyTVar' torrentMap $ HM.insert (tInfoHash torrent) loc |
308 | 308 | ||
309 | unregisterTorrent :: TVar TorrentMap -> InfoHash -> IO () | 309 | -- TODO kill sessions |
310 | unregisterTorrent = error "unregisterTorrent" | 310 | unregisterTorrent :: ClientSession -> InfoHash -> IO () |
311 | unregisterTorrent ClientSession {..} ih = do | ||
312 | atomically $ modifyTVar' torrentMap $ HM.delete ih | ||
311 | 313 | ||
312 | getRegistered :: ClientSession -> IO TorrentMap | 314 | getRegistered :: ClientSession -> IO TorrentMap |
313 | getRegistered ClientSession {..} = readTVarIO torrentMap | 315 | getRegistered ClientSession {..} = readTVarIO torrentMap |