diff --git a/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs b/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs index b5edbcd2f..8824a7c96 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs @@ -13,11 +13,15 @@ import Options.Applicative.Help.Pretty import Data.Word (Word16) import System.Environment (getProgName) +import Data.IP +import Network.Socket + -------------------------------------------------------------------------------- data KingOpts = KingOpts { koSharedHttpPort :: Maybe Word16 , koSharedHttpsPort :: Maybe Word16 + , koIPSource :: Maybe IPSource } deriving (Show) @@ -55,6 +59,11 @@ data PillSource | PillSourceURL String deriving (Show) +data IPSource + = IPSourceManual HostAddress + | IPSourceNAT + deriving (Show) + data New = New { nPillSource :: PillSource , nPierPath :: Maybe FilePath -- Derived from ship name if not specified. @@ -195,6 +204,23 @@ pillFromURL = PillSourceURL <$> strOption <> value defaultPillURL <> 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 = strArgument (metavar "PIER" <> help "Path to pier") @@ -347,6 +373,8 @@ runOneShip = (,,) <$> fmap Run pierPath <*> opts <*> df kingOpts :: Parser KingOpts kingOpts = do + koIPSource <- optional (ipFromManual <|> ipFromNAT) + koSharedHttpPort <- optional $ option auto