summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2021-12-01 22:10:39 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2021-12-02 21:25:26 +0100
commitcac8f382588e33c83f533936ba980ed06d4340aa (patch)
treec729ddb5c25b67cf4128c116f7e1978607254055 /src/Main.hs
parentd722b2045d028e80786109947ceef1aaffa569eb (diff)
Network: automatically find broadcast addresses
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs44
1 files changed, 33 insertions, 11 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 54c5714..8d6f8de 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -22,6 +22,7 @@ import Data.Typeable
import Network.Socket
+import System.Console.GetOpt
import System.Console.Haskeline
import System.Environment
@@ -39,6 +40,26 @@ import Storage
import Storage.Merge
import Sync
+data Options = Options
+ { optServer :: ServerOptions
+ }
+
+defaultOptions :: Options
+defaultOptions = Options
+ { optServer = defaultServerOptions
+ }
+
+options :: [OptDescr (Options -> Options)]
+options =
+ [ Option ['p'] ["port"]
+ (ReqArg (\p -> so $ \opts -> opts { serverPort = read p }) "PORT")
+ "local port to bind"
+ , Option ['s'] ["silent"]
+ (NoArg (so $ \opts -> opts { serverLocalDiscovery = False }))
+ "do not send announce packets for local discovery"
+ ]
+ where so f opts = opts { optServer = f $ optServer opts }
+
main :: IO ()
main = do
st <- liftIO $ openStorage . fromMaybe "./.erebos" =<< lookupEnv "EREBOS_DIR"
@@ -88,12 +109,16 @@ main = do
BC.putStrLn . showRefDigest . refDigest . storedRef . idData =<< interactiveIdentityUpdate idt
| otherwise -> error "invalid identity"
- [bhost] -> interactiveLoop st (Just bhost)
- [] -> interactiveLoop st Nothing
- _ -> error "Unrecognized options"
+ args -> do
+ opts <- case getOpt Permute options args of
+ (o, [], []) -> return (foldl (flip id) defaultOptions o)
+ (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
+ where header = "Usage: erebos [OPTION...]"
+ interactiveLoop st opts
-interactiveLoop :: Storage -> Maybe String -> IO ()
-interactiveLoop st bhost = runInputT defaultSettings $ do
+
+interactiveLoop :: Storage -> Options -> IO ()
+interactiveLoop st opts = runInputT defaultSettings $ do
erebosHead <- liftIO $ loadLocalStateHead st
outputStrLn $ T.unpack $ displayIdentity $ headLocalIdentity erebosHead
@@ -103,10 +128,7 @@ interactiveLoop st bhost = runInputT defaultSettings $ do
let extPrintLn str = extPrint $ case reverse str of ('\n':_) -> str
_ -> str ++ "\n";
server <- liftIO $ do
- let sopt = defaultServerOptions
- { serverLocalDiscovery = bhost
- }
- startServer sopt erebosHead extPrintLn
+ startServer (optServer opts) erebosHead extPrintLn
[ SomeService @AttachService Proxy
, SomeService @SyncService Proxy
, SomeService @ContactService Proxy
@@ -312,8 +334,8 @@ cmdDiscoveryInit = void $ do
(hostname, port) <- (words <$> asks ciLine) >>= return . \case
hostname:p:_ -> (hostname, p)
- [hostname] -> (hostname, discoveryPort)
- [] -> ("discovery.erebosprotocol.net", discoveryPort)
+ [hostname] -> (hostname, show discoveryPort)
+ [] -> ("discovery.erebosprotocol.net", show discoveryPort)
addr:_ <- liftIO $ getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just hostname) (Just port)
peer <- liftIO $ serverPeer server (addrAddress addr)
sendToPeer self peer $ DiscoverySelf (T.pack "ICE") 0