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