From b7149e897b2e9fb6a7b78bae6f04e0f96fe2c0d6 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 23 Jul 2024 15:19:56 -0400
Subject: [PATCH] add --bind option and listen to both ipv4 and ipv6 by default

---
 Command/P2PHttp.hs         | 19 +++++++++++++++++--
 doc/git-annex-p2phttp.mdwn |  4 ++++
 2 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index 515cdae4b2..8c34ee2660 100644
--- a/Command/P2PHttp.hs
+++ b/Command/P2PHttp.hs
@@ -21,11 +21,13 @@ import Utility.Env
 import Utility.MonotonicClock
 
 import qualified Network.Wai.Handler.Warp as Warp
+import qualified Network.Wai.Handler.WarpTLS as Warp
 import Servant
 import Servant.Client.Streaming
 import Control.Concurrent.STM
 import Network.Socket (PortNumber)
 import qualified Data.Map as M
+import Data.String
 
 cmd :: Command
 cmd = withAnnexOptions [jobsOption] $ command "p2phttp" SectionPlumbing
@@ -34,6 +36,7 @@ cmd = withAnnexOptions [jobsOption] $ command "p2phttp" SectionPlumbing
 
 data Options = Options
 	{ portOption :: Maybe PortNumber
+	, bindOption :: Maybe String
 	, authEnvOption :: Bool
 	, authEnvHttpOption :: Bool
 	, unauthReadOnlyOption :: Bool
@@ -47,6 +50,10 @@ optParser _ = Options
 		( long "port" <> metavar paramNumber
 		<> help "specify port to listen on"
 		))
+	<*> optional (strOption
+		( long "bind" <> metavar paramAddress
+		<> help "specify address to bind to"
+		))
 	<*> switch
 		( long "authenv"
 		<> help "authenticate users from environment (https only)"
@@ -74,11 +81,19 @@ seek o = getAnnexWorkerPool $ \workerpool ->
 		authenv <- getAuthEnv
 		st <- mkP2PHttpServerState acquireconn workerpool $
 			mkGetServerMode authenv o
-		Warp.run (fromIntegral port) (p2pHttpApp st)
+		let settings = Warp.setPort port $ Warp.setHost host $
+			Warp.defaultSettings
+		Warp.runSettings settings (p2pHttpApp st)
+		--Warp.runTLS settings (p2pHttpApp st)
   where
-	port = fromMaybe
+	port = maybe
 		(fromIntegral defaultP2PHttpProtocolPort)
+		fromIntegral
 		(portOption o)
+	host = maybe
+		(fromString "*") -- both ipv4 and ipv6
+		fromString
+		(bindOption o)
 
 mkGetServerMode :: M.Map Auth P2P.ServerMode -> Options -> GetServerMode
 mkGetServerMode _ o _ Nothing
diff --git a/doc/git-annex-p2phttp.mdwn b/doc/git-annex-p2phttp.mdwn
index 9102af2d4a..f9dcd52c96 100644
--- a/doc/git-annex-p2phttp.mdwn
+++ b/doc/git-annex-p2phttp.mdwn
@@ -48,6 +48,10 @@ convenient way to download the content of any key, by using the path
   use a low port like port 80. It will not drop permissions when run as
   root.
 
+* `--bind=address`
+
+  What address to bind to. The default is to bind to all addresses.
+
 * `--authenv`
 
   Allows users to be authenticated with a username and password.
-- 
2.30.2