+{-
+ - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
+ -
+ - This file is part of FuncTorrent.
+ -
+ - FuncTorrent is free software; you can redistribute it and/or modify
+ - it under the terms of the GNU General Public License as published by
+ - the Free Software Foundation; either version 3 of the License, or
+ - (at your option) any later version.
+ -
+ - FuncTorrent is distributed in the hope that it will be useful,
+ - but WITHOUT ANY WARRANTY; without even the implied warranty of
+ - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ - GNU General Public License for more details.
+ -
+ - You should have received a copy of the GNU General Public License
+ - along with FuncTorrent; if not, see <http://www.gnu.org/licenses/>
+ -}
+
{-# LANGUAGE OverloadedStrings #-}
+
module FuncTorrent.Tracker.Http
- ( trackerLoop
+ (trackerLoop
) where
-import Prelude hiding (lookup, splitAt)
+import Prelude hiding (lookup)
import Control.Concurrent (threadDelay)
-import Control.Concurrent.MVar (readMVar, putMVar)
+import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar)
+import Control.Monad (forever, void)
import qualified Data.ByteString.Base16 as B16 (encode)
import Data.ByteString (ByteString)
-import Data.ByteString.Char8 as BC (pack, unpack, splitAt)
+import Data.ByteString.Char8 as BC (pack, unpack)
import Data.Char (chr)
-import Data.List (intercalate)
import Data.Map as M (lookup)
import Network (PortNumber)
import Network.HTTP.Base (urlEncode)
import qualified FuncTorrent.Bencode as Benc
import FuncTorrent.Bencode (BVal(..))
-import FuncTorrent.Metainfo (Info(..), Metainfo(..))
+import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats)
import FuncTorrent.Network (sendGetRequest)
-import FuncTorrent.Peer (Peer(..))
-import FuncTorrent.Utils (splitN)
-import FuncTorrent.Tracker.Types(TState(..), TrackerResponse(..), Port, IP)
+import FuncTorrent.PeerMsgs (makePeer)
+import FuncTorrent.Utils (splitN, IP, Port)
+import FuncTorrent.Tracker.Types(TState(..), HttpTrackerResponse(..))
--- | URL encode hash as per RFC1738
-- | Make arguments that should be posted to tracker.
-- This is a separate pure function for testability.
-mkArgs :: PortNumber -> String -> Integer -> Integer -> Metainfo -> [(String, ByteString)]
-mkArgs port peer_id up down m =
- let fileSize = lengthInBytes $ info m
- bytesLeft = fileSize - down
- in
- [("info_hash", pack . urlEncodeHash . B16.encode . infoHash $ m),
- ("peer_id", pack . urlEncode $ peer_id),
- ("port", pack $ show port),
- ("uploaded", pack $ show up),
- ("downloaded", pack $ show down),
- ("left", pack $ show bytesLeft),
- ("compact", "1"),
- ("event", "started")]
+mkArgs :: PortNumber -> String -> Integer -> Integer -> Integer -> ByteString -> [(String, ByteString)]
+mkArgs port peer_id up down left' infoHash =
+ [("info_hash", pack . urlEncodeHash . B16.encode $ infoHash),
+ ("peer_id", pack . urlEncode $ peer_id),
+ ("port", pack $ show port),
+ ("uploaded", pack $ show up),
+ ("downloaded", pack $ show down),
+ ("left", pack $ show left'),
+ ("compact", "1"),
+ ("event", "started")]
-trackerLoop :: PortNumber -> String -> Metainfo -> TState -> IO ByteString
-trackerLoop port peerId m st = do
- up <- readMVar $ uploaded st
- down <- readMVar $ downloaded st
- resp <- sendGetRequest (head . announceList $ m) $ mkArgs port peerId up down m
+trackerLoop :: String -> PortNumber -> String -> ByteString -> FS.MsgChannel -> TState -> IO ()
+trackerLoop url sport peerId infohash fschan tstate = forever $ do
+ st <- readMVar <$> FS.getStats fschan
+ up <- fmap FS.bytesRead st
+ down <- fmap FS.bytesWritten st
+ resp <- sendGetRequest url $ mkArgs sport peerId up down (left tstate) infohash
case Benc.decode resp of
- Left e -> return $ pack (show e)
+ Left e ->
+ return () -- $ pack (show e)
Right trackerInfo ->
case parseTrackerResponse trackerInfo of
- Left e -> return e
+ Left e -> return ()
Right tresp -> do
- _ <- threadDelay $ fromIntegral (interval tresp)
- _ <- putMVar (connectedPeers st) (peers tresp)
- trackerLoop port peerId m st
+ ps <- isEmptyMVar $ connectedPeers tstate
+ if ps
+ then
+ putMVar (connectedPeers tstate) (peers tresp)
+ else
+ void $ swapMVar (connectedPeers tstate) (peers tresp)
+ threadDelay $ fromIntegral (interval tresp)
-parseTrackerResponse :: BVal -> Either ByteString TrackerResponse
+parseTrackerResponse :: BVal -> Either ByteString HttpTrackerResponse
parseTrackerResponse resp =
case lookup "failure reason" body of
Just (Bstr err) -> Left err
let (Just (Bint i)) = lookup "interval" body
(Just (Bstr peersBS)) = lookup "peers" body
pl = map makePeer (splitN 6 peersBS)
- in Right TrackerResponse {
+ in Right HttpTrackerResponse {
interval = i
, peers = pl
, complete = Nothing
where
(Bdict body) = resp
-makePeer :: ByteString -> Peer
-makePeer peer = Peer "" (toIP ip') (toPort port')
- where (ip', port') = splitAt 4 peer
-
-toPort :: ByteString -> Port
-toPort = read . ("0x" ++) . unpack . B16.encode
-
-toIP :: ByteString -> IP
-toIP = Data.List.intercalate "." .
- map (show . toInt . ("0x" ++) . unpack) .
- splitN 2 . B16.encode
-
-toInt :: String -> Integer
-toInt = read