summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
Diffstat (limited to 'examples')
-rw-r--r--examples/Client.hs74
-rw-r--r--examples/FS.hs74
-rw-r--r--examples/MkTorrent.hs500
3 files changed, 0 insertions, 648 deletions
diff --git a/examples/Client.hs b/examples/Client.hs
deleted file mode 100644
index 26711676..00000000
--- a/examples/Client.hs
+++ /dev/null
@@ -1,74 +0,0 @@
1{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE ExistentialQuantification #-}
4{-# LANGUAGE RecordWildCards #-}
5module Main (main) where
6import Control.Concurrent
7import Control.Monad.Trans
8import Data.Maybe
9import Options.Applicative
10import System.Environment
11import System.Exit
12import System.IO
13import Text.Read
14
15import Network.BitTorrent
16
17#if MIN_VERSION_optparse_applicative(0,13,0)
18-- maybeReader imported from Options.Applicative.Builder
19#elif MIN_VERSION_optparse_applicative(0,11,0)
20maybeReader f = eitherReader (maybe (Left ":(") Right . f)
21#else
22maybeReader f = f
23#endif
24
25{-----------------------------------------------------------------------
26-- Command line arguments
27-----------------------------------------------------------------------}
28
29data TorrentBox = forall s. TorrentSource s => TorrentBox { unTorrentBox :: s }
30
31data Args = Args
32 { topic :: TorrentBox
33 , contentDir :: FilePath
34 }
35
36argsParser :: Parser Args
37argsParser = Args <$> (TorrentBox <$> infohashP <|> TorrentBox <$> torrentP)
38 <*> destDirP
39 where
40 infohashP :: Parser InfoHash
41 infohashP = argument (maybeReader readMaybe)
42 (metavar "SHA1" <> help "infohash of torrent file")
43
44 torrentP :: Parser FilePath
45 torrentP = argument (maybeReader Just)
46 ( metavar "FILE"
47 <> help "A .torrent file"
48 )
49
50 destDirP :: Parser FilePath
51 destDirP = argument (maybeReader Just)
52 ( metavar "DIR"
53 <> help "Directory to put content"
54 )
55
56argsInfo :: ParserInfo Args
57argsInfo = info (helper <*> argsParser)
58 ( fullDesc
59 <> progDesc "A simple CLI bittorrent client"
60 <> header "foo"
61 )
62
63{-----------------------------------------------------------------------
64-- Client
65-----------------------------------------------------------------------}
66
67run :: Args -> BitTorrent ()
68run (Args (TorrentBox t) dir) = do
69 h <- openHandle dir t
70 start h
71 liftIO $ threadDelay 10000000000
72
73main :: IO ()
74main = execParser argsInfo >>= simpleClient . run
diff --git a/examples/FS.hs b/examples/FS.hs
deleted file mode 100644
index 550d85a7..00000000
--- a/examples/FS.hs
+++ /dev/null
@@ -1,74 +0,0 @@
1{-# LANGUAGE RecordWildCards #-}
2module Main (main) where
3
4import Control.Arrow
5import Data.ByteString.Char8 as BC
6import Data.List as L
7import Data.Map as M
8import Data.Torrent as T
9import Data.Torrent.Tree as T
10import System.Environment
11import System.Fuse
12import System.FilePath
13import System.Posix.Files
14
15
16defStat :: FileStat
17defStat = FileStat
18 { statEntryType = Unknown
19 , statFileMode = ownerReadMode
20 , statLinkCount = 2
21
22 , statFileOwner = 0
23 , statFileGroup = 0
24
25 , statSpecialDeviceID = 0
26
27 , statFileSize = 0
28 , statBlocks = 0
29
30 , statAccessTime = 0
31 , statModificationTime = 0
32 , statStatusChangeTime = 0
33 }
34
35dirStat :: FileStat
36dirStat = defStat {
37 statEntryType = Directory
38 }
39
40type Result a = IO (Either Errno a)
41type Result' = IO Errno
42
43fsGetFileStat :: Torrent -> FilePath -> Result FileStat
44fsGetFileStat _ path = return $ Right dirStat
45
46fsOpenDirectory :: Torrent -> FilePath -> Result'
47fsOpenDirectory _ _ = return eOK
48
49fsReadDirectory :: Torrent -> FilePath -> Result [(FilePath, FileStat)]
50fsReadDirectory Torrent {tInfoDict = InfoDict {..}} path
51 | Just cs <- T.lookupDir (L.tail (splitDirectories path)) tree =
52 return $ Right $ L.map (BC.unpack *** const defStat) cs
53 | otherwise = return $ Left eNOENT
54 where
55 tree = build $ idLayoutInfo
56
57fsReleaseDirectory :: Torrent -> FilePath -> Result'
58fsReleaseDirectory _ _ = return eOK
59
60exfsOps :: Torrent -> FuseOperations ()
61exfsOps t = defaultFuseOps
62 { fuseGetFileStat = fsGetFileStat t
63
64 , fuseOpenDirectory = fsOpenDirectory t
65 , fuseReadDirectory = fsReadDirectory t
66 , fuseReleaseDirectory = fsReleaseDirectory t
67 }
68
69main :: IO ()
70main = do
71 x : xs <- getArgs
72 t <- fromFile x
73 withArgs xs $ do
74 fuseMain (exfsOps t) defaultExceptionHandler \ No newline at end of file
diff --git a/examples/MkTorrent.hs b/examples/MkTorrent.hs
deleted file mode 100644
index 88a84893..00000000
--- a/examples/MkTorrent.hs
+++ /dev/null
@@ -1,500 +0,0 @@
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE StandaloneDeriving #-}
5{-# OPTIONS -fno-warn-orphans #-}
6module Main (main) where
7
8import Prelude as P
9import Control.Concurrent
10import Control.Concurrent.Async.Lifted
11import Control.Concurrent.ParallelIO
12import Control.Exception
13import Control.Lens hiding (argument, (<.>))
14import Control.Monad as M
15import Control.Monad.Trans
16import Data.Conduit as C
17import Data.Conduit.List as C
18import Data.List as L
19import Data.Maybe as L
20import Data.Monoid
21import Data.Text as T
22import qualified Data.Text.IO as T
23import Data.Text.Read as T
24import Data.Version
25import Network
26import Network.URI
27import Options.Applicative
28import System.Exit
29import System.FilePath
30import System.Log
31import System.Log.Logger
32import Text.Read
33import Text.PrettyPrint.HughesPJClass hiding ((<>),($$))
34
35import Paths_bittorrent (version)
36import Data.Torrent hiding (Magnet (Magnet))
37import Network.Address
38import Network.BitTorrent.DHT.Session hiding (Options, options)
39import Network.BitTorrent.DHT as DHT hiding (Options)
40import Network.BitTorrent.Exchange.Bitfield as BF
41import Network.BitTorrent.Exchange.Connection hiding (Options)
42import Network.BitTorrent.Exchange.Message
43import Network.BitTorrent.Exchange.Session
44import System.Torrent.Storage
45
46#if MIN_VERSION_optparse_applicative(0,13,0)
47-- maybeReader imported from Options.Applicative.Builder
48#elif MIN_VERSION_optparse_applicative(0,11,0)
49maybeReader f = eitherReader (maybe (Left ":(") Right . f)
50#else
51maybeReader f = f
52#endif
53
54
55{-----------------------------------------------------------------------
56-- Dialogs
57-----------------------------------------------------------------------}
58
59instance Read URI where
60 readsPrec _ = f . parseURI
61 where
62 f Nothing = []
63 f (Just u) = [(u, "")]
64
65question :: Show a => Text -> Maybe a -> IO ()
66question q defVal = do
67 T.putStrLn q
68 case defVal of
69 Nothing -> return ()
70 Just v -> T.putStrLn $ "[default: " <> T.pack (show v) <> "]"
71
72ask :: Read a => Text -> IO a
73ask q = question q (Just True) >> getReply
74 where
75 getReply = do
76 resp <- P.getLine
77 maybe getReply return $ readMaybe resp
78
79askMaybe :: Read a => Text -> IO (Maybe a)
80askMaybe q = question q (Just False) >> getReply
81 where
82 getReply = do
83 resp <- P.getLine
84 if resp == []
85 then return Nothing
86 else maybe getReply return $ readMaybe resp
87
88askURI :: IO URI
89askURI = do
90 s <- P.getLine
91 case parseURI s of
92 Nothing -> T.putStrLn "incorrect URI" >> askURI
93 Just u -> return u
94
95askFreeform :: IO Text
96askFreeform = do
97 s <- T.getLine
98 if T.null s
99 then askFreeform
100 else return s
101
102askInRange :: Int -> Int -> IO Int
103askInRange a b = do
104 s <- T.getLine
105 case T.decimal s of
106 Left msg -> do
107 P.putStrLn msg
108 askInRange a b
109 Right (i, _)
110 | a <= i && i < b -> return i
111 | otherwise -> do
112 T.putStrLn "not in range "
113 askInRange a b
114
115askChoice :: [(Text, a)] -> IO a
116askChoice kvs = do
117 forM_ (L.zip [1 :: Int ..] $ L.map fst kvs) $ \(i, lbl) -> do
118 T.putStrLn $ " " <> T.pack (show i) <> ") " <> lbl
119 T.putStrLn "Your choice?"
120 n <- askInRange 1 (succ (L.length kvs))
121 return $ snd (kvs !! pred n)
122
123{-----------------------------------------------------------------------
124-- Helpers
125-----------------------------------------------------------------------}
126
127torrentFile :: Parser FilePath
128torrentFile = argument (maybeReader Just)
129 ( metavar "TORRENT_FILE_PATH"
130 <> help "A .torrent file"
131 )
132
133{-----------------------------------------------------------------------
134-- Amend command - edit a field of torrent file
135-----------------------------------------------------------------------}
136
137data AmendOpts = AmendOpts FilePath
138 deriving Show
139
140amendInfo :: ParserInfo AmendOpts
141amendInfo = info (helper <*> parser) modifier
142 where
143 modifier = progDesc "Edit info fields of existing torrent"
144 parser = AmendOpts <$> torrentFile
145
146type Amend = Torrent -> Torrent
147
148fields :: [(Text, IO Amend)]
149fields = [ ("announce", set announce . Just <$> askURI)
150 , ("comment", set comment . Just <$> askFreeform)
151 , ("created by", set createdBy . Just <$> askFreeform)
152 , ("publisher url", set publisherURL . Just <$> askURI)
153 ]
154
155askAmend :: IO Amend
156askAmend = join $ T.putStrLn "Choose a field:" >> askChoice fields
157
158amend :: AmendOpts -> IO ()
159amend (AmendOpts tpath) = do
160 t <- fromFile tpath
161 a <- askAmend
162 toFile tpath $ a t
163
164{-----------------------------------------------------------------------
165-- Check command -- validate content files using torrent file
166-----------------------------------------------------------------------}
167-- TODO progress bar
168
169data CheckOpts = CheckOpts
170 { checkTorrentPath :: FilePath -- ^ validation torrent file
171 , checkContentPath :: FilePath -- ^ root dir for content files
172 } deriving Show
173
174checkInfo :: ParserInfo CheckOpts
175checkInfo = info (helper <*> parser) modifier
176 where
177 modifier = progDesc "Validate integrity of torrent data"
178 <> header "append +RTS -N$NUMBER_OF_CORES -RTS for parallel execution"
179 parser = CheckOpts
180 <$> torrentFile
181 <*> argument (maybeReader Just)
182 ( metavar "CONTENT_DIR_PATH"
183 <> value "."
184 <> help "Content directory or a single file"
185 )
186
187validatePiece :: Storage -> PieceInfo -> PieceIx -> IO (Maybe PieceIx)
188validatePiece s pinfo pix = do
189 valid <- verifyPiece s pinfo pix
190 if valid
191 then do infoM "check" $ "valid piece " ++ show pix
192 return (Just pix)
193 else do infoM "check" $ "invalid piece " ++ show pix
194 return Nothing
195
196validateStorage :: Storage -> PieceInfo -> IO Bitfield
197validateStorage s pinfo = do
198 infoM "check" "start storage validation"
199 let total = totalPieces s
200 pixs <- parallel $ L.map (validatePiece s pinfo) [0 .. total - 1]
201 infoM "check" "storage validation finished"
202 return $ fromList total $ L.catMaybes pixs
203
204-- TODO use local thread pool
205checkContent :: Storage -> PieceInfo -> IO ()
206checkContent s pinfo = do
207 invalids <- BF.complement <$> validateStorage s pinfo
208 if BF.null invalids
209 then noticeM "check" "all files are complete and valid"
210 else do
211 emergencyM "check" $ "there are some invalid pieces" ++ show invalids
212 exitFailure
213
214checkTorrent :: CheckOpts -> IO ()
215checkTorrent CheckOpts {..} = do
216 infoM "check" "openning torrent file..."
217 InfoDict {..} <- tInfoDict <$> fromFile checkTorrentPath
218 let layout = flatLayout checkContentPath idLayoutInfo
219 infoM "check" "mapping content files..."
220 withStorage ReadOnly (piPieceLength idPieceInfo) layout $ \ s -> do
221 infoM "check" "files mapped"
222 checkContent s idPieceInfo
223 infoM "check" "unmapping files"
224
225{-----------------------------------------------------------------------
226-- Create command
227-----------------------------------------------------------------------}
228-- TODO progress bar
229-- TODO multifile torrents
230-- TODO interactive mode
231-- TODO non interactive mode
232-- TODO --ignore-dot-files
233-- TODO --md5
234-- TODO --piece-size
235
236{-
237createFlags :: Parser CreateFlags
238createFlags = CreateFlags
239 <$> optional (option
240 ( long "piece-size"
241 <> short 's'
242 <> metavar "SIZE"
243 <> help "Set size of torrent pieces"
244 ))
245 <*> switch
246 ( long "md5"
247 <> short '5'
248 <> help "Include md5 hash of each file"
249 )
250 <*> switch
251 ( long "ignore-dot-files"
252 <> short 'd'
253 <> help "Do not include .* files"
254 )
255
256
257createOpts :: Parser CreateOpts
258createOpts = CreateOpts
259 <$> argument (maybeReader Just)
260 ( metavar "PATH"
261 <> help "Content directory or a single file"
262 )
263 <*> optional (argument (maybeReader Just)
264 ( metavar "FILE"
265 <> help "Place for the output .torrent file"
266 ))
267 <*> createFlags
268
269createInfo :: ParserInfo CreateOpts
270createInfo = info (helper <*> createOpts) modifier
271 where
272 modifier = progDesc "Make a new .torrent file"
273-}
274
275{-----------------------------------------------------------------------
276-- Magnet command -- print magnet link for given torrent file
277-----------------------------------------------------------------------}
278
279data MagnetOpts = MagnetOpts
280 { magnetFile :: FilePath -- ^ path to torrent file
281 , detailed :: Bool -- ^ whether to append additional uri params
282 } deriving Show
283
284magnetInfo :: ParserInfo MagnetOpts
285magnetInfo = info (helper <*> parser) modifier
286 where
287 modifier = progDesc "Print magnet link"
288 parser = MagnetOpts
289 <$> torrentFile
290 <*> switch ( long "detailed" )
291
292magnet :: MagnetOpts -> IO ()
293magnet MagnetOpts {..} = print . magnetLink =<< fromFile magnetFile
294 where
295 magnetLink = if detailed then detailedMagnet else simpleMagnet
296
297{-----------------------------------------------------------------------
298-- Show command - print torrent file information
299-----------------------------------------------------------------------}
300
301data ShowOpts = ShowOpts
302 { showPath :: FilePath -- ^ torrent file to inspect;
303 , infoHashOnly :: Bool -- ^ omit everything except infohash.
304 } deriving Show
305
306showInfo :: ParserInfo ShowOpts
307showInfo = info (helper <*> parser) modifier
308 where
309 modifier = progDesc "Print .torrent file metadata"
310 parser = ShowOpts
311 <$> torrentFile
312 <*> switch
313 ( long "infohash"
314 <> help "Show only hash of the torrent info part"
315 )
316
317showTorrent :: ShowOpts -> Torrent -> ShowS
318showTorrent ShowOpts {..} torrent
319 | infoHashOnly = shows $ idInfoHash (tInfoDict torrent)
320 | otherwise = shows $ pPrint torrent
321
322putTorrent :: ShowOpts -> IO ()
323putTorrent opts @ ShowOpts {..} = do
324 torrent <- fromFile showPath `onException` putStrLn msg
325 putStrLn $ showTorrent opts torrent []
326 where
327 msg = "Torrent file is either invalid or do not exist"
328
329{-----------------------------------------------------------------------
330-- Get command - fetch torrent by infohash
331-----------------------------------------------------------------------}
332
333data GetOpts = GetOpts
334 { topic :: InfoHash
335 , servPort :: PortNumber
336 , bootNode :: NodeAddr IPv4
337 , buckets :: Int
338 } deriving Show
339
340#if !MIN_VERSION_network(2,6,3)
341instance Read PortNumber where
342 readsPrec i s = [ (toEnum a, t) | (a, t) <- readsPrec i s]
343#endif
344
345paramsParser :: Parser GetOpts
346paramsParser = GetOpts
347 <$> argument (maybeReader readMaybe)
348 (metavar "SHA1" <> help "infohash of torrent file")
349 <*> option auto (long "port" <> short 'p'
350 <> value 7000 <> showDefault
351 <> metavar "NUM" <> help "port number to bind"
352 )
353 <*> option auto (long "boot" <> short 'b'
354 <> metavar "NODE" <> help "bootstrap node address"
355 )
356 <*> option auto (long "bucket" <> short 'n'
357 <> value 2 <> showDefault
358 <> metavar "NUM" <> help "number of buckets to maintain"
359 )
360
361getInfo :: ParserInfo GetOpts
362getInfo = info (helper <*> paramsParser)
363 ( fullDesc
364 <> progDesc "Get torrent file by infohash"
365 <> header "get torrent file by infohash"
366 )
367
368 -- TODO add tNodes, tCreated, etc?
369getTorrent :: GetOpts -> IO ()
370getTorrent GetOpts {..} = do
371 infoM "get" "searching for peers..."
372 s <- newSession (\ _ _ _ _ -> return ()) (PeerAddr Nothing Nothing 7000) "/tmp" (Left topic)
373 dht (def { optBucketCount = buckets }) (NodeAddr "0.0.0.0" servPort) $ do
374 bootstrap [bootNode]
375 infodict <- withAsync (DHT.lookup topic $$ connectSink s)
376 (const (liftIO $ waitMetadata s))
377 liftIO $ toFile (show topic <.> torrentExt) $ nullTorrent infodict
378 infoM "get" "saved torrent file"
379
380{-----------------------------------------------------------------------
381-- Command
382-----------------------------------------------------------------------}
383
384data Command
385 = Amend AmendOpts
386 | Check CheckOpts
387-- | Create CreateOpts
388 | Get GetOpts
389 | Magnet MagnetOpts
390 | Show ShowOpts
391 deriving Show
392
393commandOpts :: Parser Command
394commandOpts = subparser $ mconcat
395 [ command "amend" (Amend <$> amendInfo)
396 , command "check" (Check <$> checkInfo)
397-- , command "create" (Create <$> createInfo)
398 , command "get" (Get <$> getInfo)
399 , command "magnet" (Magnet <$> magnetInfo)
400 , command "show" (Show <$> showInfo)
401 ]
402
403{-----------------------------------------------------------------------
404-- Global Options
405-----------------------------------------------------------------------}
406
407data GlobalOpts = GlobalOpts
408 { verbosity :: Priority
409 } deriving Show
410
411#if !MIN_VERSION_hslogger(1,2,9)
412deriving instance Enum Priority
413deriving instance Bounded Priority
414#endif
415
416priorities :: [Priority]
417priorities = [minBound..maxBound]
418
419defaultPriority :: Priority
420defaultPriority = WARNING
421
422verbosityOpts :: Parser Priority
423verbosityOpts = verbosityP <|> verboseP <|> quietP
424 where
425 verbosityP = option auto
426 ( long "verbosity"
427 <> metavar "LEVEL"
428 <> help ("Set verbosity level\n"
429 ++ "Possible values are " ++ show priorities)
430 )
431
432 verboseP = flag defaultPriority INFO
433 ( long "verbose"
434 <> short 'v'
435 <> help "Verbose mode"
436 )
437
438 quietP = flag defaultPriority CRITICAL
439 ( long "quiet"
440 <> short 'q'
441 <> help "Silent mode"
442 )
443
444
445globalOpts :: Parser GlobalOpts
446globalOpts = GlobalOpts <$> verbosityOpts
447
448data Options = Options
449 { cmdOpts :: Command
450 , globOpts :: GlobalOpts
451 } deriving Show
452
453options :: Parser Options
454options = Options <$> commandOpts <*> globalOpts
455
456versioner :: String -> Version -> Parser (a -> a)
457#if MIN_VERSION_optparse_applicative(0,10,0)
458versioner prog ver = nullOption disabled $ mconcat
459#else
460versioner prog ver = nullOption $ mconcat
461#endif
462 [ long "version"
463 , help "Show program version and exit"
464 , value id
465 , metavar ""
466 , hidden
467 , mempty -- reader $ const $ undefined -- Left $ ErrorMsg versionStr
468 ]
469 where
470 versionStr = prog ++ " version " ++ showVersion ver
471
472parserInfo :: ParserInfo Options
473parserInfo = info parser modifier
474 where
475 parser = helper <*> versioner "mktorrent" version <*> options
476 modifier = header synopsis <> progDesc description <> fullDesc
477 synopsis = "Torrent management utility"
478 description = "" -- TODO
479
480{-----------------------------------------------------------------------
481-- Dispatch
482-----------------------------------------------------------------------}
483
484run :: Command -> IO ()
485run (Amend opts) = amend opts
486run (Check opts) = checkTorrent opts
487--run (Create opts) = createTorrent opts
488run (Get opts) = getTorrent opts
489run (Magnet opts) = magnet opts
490run (Show opts) = putTorrent opts
491
492prepare :: GlobalOpts -> IO ()
493prepare GlobalOpts {..} = do
494 updateGlobalLogger rootLoggerName (setLevel verbosity)
495
496main :: IO ()
497main = do
498 Options {..} <- execParser parserInfo
499 prepare globOpts
500 run cmdOpts
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 14:44:24 +0000