src/main/Main.hs

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