src/main/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-
   3 Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
   4
   5 This file is part of FuncTorrent.
   6
   7 FuncTorrent is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 3 of the License, or
  10 (at your option) any later version.
  11
  12 FuncTorrent is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
  19 -}
  20
  21 module Main where
  22
  23 import           Prelude hiding (log, length, readFile, getContents)
  24
  25 import           Control.Concurrent (forkIO, killThread)
  26
  27 import           Data.ByteString.Char8 (ByteString, getContents, readFile)
  28 import qualified FuncTorrent.FileSystem as FS (createMsgChannel, pieceMapFromFile, run)
  29 import           FuncTorrent.Logger (initLogger, logMessage, logStop)
  30 import           FuncTorrent.MagnetURI
  31 import           FuncTorrent.Metainfo (Info(..), Metainfo(..), torrentToMetainfo)
  32 import           FuncTorrent.Peer (handlePeerMsgs)
  33 import           FuncTorrent.PieceManager (initPieceMap)
  34 import qualified FuncTorrent.Server as Server
  35 import           FuncTorrent.Tracker (runTracker, getConnectedPeers, newTracker)
  36 import           Network (PortID (PortNumber))
  37 import           System.Directory (doesFileExist)
  38 import           System.Environment (getArgs)
  39 import           System.Exit (exitSuccess)
  40 import           System.IO (withFile, IOMode (ReadWriteMode))
  41 import           System.Random (getStdGen, randomRs)
  42
  43 logError :: String -> (String -> IO ()) -> IO ()
  44 logError e logMsg = logMsg $ "parse error: \n" ++ e
  45
  46 exit :: IO ByteString
  47 exit = exitSuccess
  48
  49 usage :: String
  50 usage = "usage: functorrent torrent-file"
  51
  52 parse :: [String] -> IO ByteString
  53 parse [] = getContents
  54 parse [a] = do
  55   fileExist <- doesFileExist a
  56   if fileExist
  57     then readFile a
  58     else error "file does not exist"
  59 parse _ = exit
  60
  61 -- peer id is exactly 20 bytes long.
  62 -- peer id starts with '-', followed by 2 char client id'
  63 -- followed by 4 ascii digits for version number, followed by
  64 -- a '-'. Rest are random digits to fill the 20 bytes.
  65 mkPeerID :: IO String
  66 mkPeerID = do
  67   stdgen <- getStdGen
  68   let digits = randomRs (0, 9) stdgen :: [Integer]
  69   return $ "-HS9001-" ++ (concatMap show $ take (20 - 8) digits)
  70
  71 main :: IO ()
  72 main = do
  73     args <- getArgs
  74     logR <- initLogger
  75     peerId <- mkPeerID
  76     let log = logMessage logR
  77     case args of
  78       [] -> do
  79         log usage
  80       _  -> do
  81         log "Starting up functorrent"
  82         log $ "Parsing arguments " ++ concat args
  83         torrentStr <- parse args
  84         case torrentToMetainfo torrentStr of
  85           Left e -> logError e log
  86           Right m -> do
  87             -- if we had downloaded the file before (partly or completely)
  88             -- then we should check the current directory for the existence
  89             -- of the file and then update the map of each piece' availability.
  90             -- This can be done by reading each piece and verifying the checksum.
  91             -- If the checksum does not match, we don't have that piece.
  92             let filePath = name (info m) -- really this is just the file name, not file path
  93                 fileLen = lengthInBytes (info m)
  94                 pieceHash = pieces (info m)
  95                 pLen = pieceLength (info m)
  96                 infohash = infoHash m
  97                 defaultPieceMap = initPieceMap pieceHash fileLen pLen
  98             log $ "create FS msg channel"
  99             fsMsgChannel <- FS.createMsgChannel
 100             log $ "Downloading file : " ++ filePath
 101             pieceMap <- FS.pieceMapFromFile filePath fileLen defaultPieceMap
 102             log $ "start filesystem manager thread"
 103             fsTid <- forkIO $ withFile filePath ReadWriteMode (FS.run pieceMap fsMsgChannel)
 104             log $ "starting server"
 105             (serverSock, (PortNumber portnum)) <- Server.start
 106             log $ "server started on " ++ show portnum
 107             log "Trying to fetch peers"
 108             _ <- forkIO $ Server.run serverSock peerId m pieceMap fsMsgChannel
 109             log $ "Trackers: " ++ head (announceList m)
 110             trackerMsgChan <- newTracker
 111             _ <- forkIO $ runTracker trackerMsgChan fsMsgChannel infohash portnum peerId (announceList m) fileLen
 112             ps <- getConnectedPeers trackerMsgChan
 113             log $ "Peers List : " ++ (show ps)
 114             let p1 = head ps
 115             handlePeerMsgs p1 peerId m pieceMap True fsMsgChannel
 116             logStop logR
 117             killThread fsTid