king: Add CLI options for NAT traversal.

(Not yet hooked up to anything.)
This commit is contained in:
Elliot Glaysher 2020-08-04 15:10:28 -04:00
parent 11c86df3ce
commit 225d2a288b

View File

@ -13,11 +13,15 @@ import Options.Applicative.Help.Pretty
import Data.Word (Word16) import Data.Word (Word16)
import System.Environment (getProgName) import System.Environment (getProgName)
import Data.IP
import Network.Socket
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
data KingOpts = KingOpts data KingOpts = KingOpts
{ koSharedHttpPort :: Maybe Word16 { koSharedHttpPort :: Maybe Word16
, koSharedHttpsPort :: Maybe Word16 , koSharedHttpsPort :: Maybe Word16
, koIPSource :: Maybe IPSource
} }
deriving (Show) deriving (Show)
@ -55,6 +59,11 @@ data PillSource
| PillSourceURL String | PillSourceURL String
deriving (Show) deriving (Show)
data IPSource
= IPSourceManual HostAddress
| IPSourceNAT
deriving (Show)
data New = New data New = New
{ nPillSource :: PillSource { nPillSource :: PillSource
, nPierPath :: Maybe FilePath -- Derived from ship name if not specified. , nPierPath :: Maybe FilePath -- Derived from ship name if not specified.
@ -195,6 +204,23 @@ pillFromURL = PillSourceURL <$> strOption
<> value defaultPillURL <> value defaultPillURL
<> help "URL to pill file") <> help "URL to pill file")
ipFromNAT :: Parser IPSource
ipFromNAT = flag' IPSourceNAT
( long "ip-from-nat"
<> help "Try to fetch the local IP from the NAT gateway")
ipReader :: ReadM HostAddress
ipReader = eitherReader $ \arg ->
case readMay arg :: Maybe IPv4 of
Nothing -> Left ("Cannot parse ipv4 address: " ++ arg)
Just ipv4 -> Right $ toHostAddress ipv4
ipFromManual :: Parser IPSource
ipFromManual = IPSourceManual <$> option ipReader
( long "ip-manual"
<> metavar "IPv4"
<> help "Manually specify the external IP")
pierPath :: Parser FilePath pierPath :: Parser FilePath
pierPath = strArgument (metavar "PIER" <> help "Path to pier") pierPath = strArgument (metavar "PIER" <> help "Path to pier")
@ -347,6 +373,8 @@ runOneShip = (,,) <$> fmap Run pierPath <*> opts <*> df
kingOpts :: Parser KingOpts kingOpts :: Parser KingOpts
kingOpts = do kingOpts = do
koIPSource <- optional (ipFromManual <|> ipFromNAT)
koSharedHttpPort <- koSharedHttpPort <-
optional optional
$ option auto $ option auto