src/main/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Main where
   3
   4 import           Prelude hiding (log, length, readFile, getContents)
   5
   6 import           Control.Concurrent (forkIO, killThread)
   7 import           Control.Concurrent.MVar (readMVar)
   8 import           Data.ByteString.Char8 (ByteString, getContents, readFile)
   9 import qualified FuncTorrent.FileSystem as FS (createMsgChannel, pieceMapFromFile, startThread)
  10 import           FuncTorrent.Logger (initLogger, logMessage, logStop)
  11 import           FuncTorrent.Metainfo (Info(..), Metainfo(..), torrentToMetainfo)
  12 import           FuncTorrent.Peer (handlePeerMsgs)
  13 import           FuncTorrent.PieceManager (initPieceMap)
  14 import qualified FuncTorrent.Server as Server
  15 import           FuncTorrent.Tracker (connectedPeers, initialTrackerState, trackerLoop, udpTrackerLoop)
  16 import           Network (PortID (PortNumber))
  17 import           System.IO (withFile, IOMode (ReadWriteMode))
  18 import           System.Directory (doesFileExist)
  19 import           System.Environment (getArgs)
  20 import           System.Exit (exitSuccess)
  21 import           System.Random (getStdGen, randomRs)
  22
  23 logError :: String -> (String -> IO ()) -> IO ()
  24 logError e logMsg = logMsg $ "parse error: \n" ++ e
  25
  26 exit :: IO ByteString
  27 exit = exitSuccess
  28
  29 usage :: IO ()
  30 usage = putStrLn "usage: functorrent torrent-file"
  31
  32 parse :: [String] -> IO ByteString
  33 parse [] = getContents
  34 parse [a] = do
  35   fileExist <- doesFileExist a
  36   if fileExist
  37     then readFile a
  38     else error "file does not exist"
  39 parse _ = exit
  40
  41 -- peer id is exactly 20 bytes long.
  42 -- peer id starts with '-', followed by 2 char client id'
  43 -- followed by 4 ascii digits for version number, followed by
  44 -- a '-'. Rest are random digits to fill the 20 bytes.
  45 mkPeerID :: IO String
  46 mkPeerID = do
  47   stdgen <- getStdGen
  48   let digits = randomRs (0, 9) stdgen :: [Integer]
  49   return $ "-HS9001-" ++ (concatMap show $ take (20 - 8) digits)
  50
  51 main :: IO ()
  52 main = do
  53     args <- getArgs
  54     logR <- initLogger
  55     peerId <- mkPeerID
  56     let log = logMessage logR
  57     log "Starting up functorrent"
  58     log $ "Parsing arguments " ++ concat args
  59     torrentStr <- parse args
  60     case torrentToMetainfo torrentStr of
  61      Left e -> logError e log
  62      Right m -> do
  63        -- if we had downloaded the file before (partly or completely)
  64        -- then we should check the current directory for the existence
  65        -- of the file and then update the map of each piece' availability.
  66        -- This can be done by reading each piece and verifying the checksum.
  67        -- If the checksum does not match, we don't have that piece.
  68        let filePath = name (info m) -- really this is just the file name, not file path
  69            fileLen = lengthInBytes (info m)
  70            pieceHash = pieces (info m)
  71            pLen = pieceLength (info m)
  72            defaultPieceMap = initPieceMap pieceHash fileLen pLen
  73        log $ "create FS msg channel"
  74        fsMsgChannel <- FS.createMsgChannel
  75        log $ "Downloading file : " ++ filePath
  76        pieceMap <- FS.pieceMapFromFile filePath fileLen defaultPieceMap
  77        log $ "start filesystem manager thread"
  78        fsTid <- withFile filePath ReadWriteMode (FS.startThread pieceMap fsMsgChannel)
  79        log $ "starting server"
  80        (serverSock, (PortNumber portnum)) <- Server.start
  81        log $ "server started on " ++ show portnum
  82        log "Trying to fetch peers"
  83        _ <- forkIO $ Server.run serverSock peerId m pieceMap fsMsgChannel
  84        log $ "Trackers: " ++ head (announceList m)
  85        -- (tstate, errstr) <- runTracker portnum peerId m
  86        tstate <- initialTrackerState $ lengthInBytes $ info m
  87        _ <- forkIO $ trackerLoop portnum peerId m tstate >> return ()
  88        ps <- readMVar (connectedPeers tstate)
  89        log $ "Peers List : " ++ (show ps)
  90        let p1 = head ps
  91        handlePeerMsgs p1 peerId m pieceMap True fsMsgChannel
  92        logStop logR
  93        killThread fsTid