mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

add --bind option and listen to both ipv4 and ipv6 by default

Browse source
This commit is contained in:
Joey Hess 2024-07-23 15:19:56 -04:00
parent b7454f1eeb
commit b7149e897b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 21 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
Command/P2PHttp.hs
View file

@ -21,11 +21,13 @@ import Utility.Env
import Utility.MonotonicClock import Utility.MonotonicClock
import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Handler.WarpTLS as Warp
import Servant import Servant
import Servant.Client.Streaming import Servant.Client.Streaming
import Control.Concurrent.STM import Control.Concurrent.STM
import Network.Socket (PortNumber) import Network.Socket (PortNumber)
import qualified Data.Map as M import qualified Data.Map as M
import Data.String
cmd :: Command cmd :: Command
cmd = withAnnexOptions [jobsOption] $ command "p2phttp" SectionPlumbing cmd = withAnnexOptions [jobsOption] $ command "p2phttp" SectionPlumbing
@ -34,6 +36,7 @@ cmd = withAnnexOptions [jobsOption] $ command "p2phttp" SectionPlumbing
data Options = Options data Options = Options
{ portOption :: Maybe PortNumber { portOption :: Maybe PortNumber
, bindOption :: Maybe String
, authEnvOption :: Bool , authEnvOption :: Bool
, authEnvHttpOption :: Bool , authEnvHttpOption :: Bool
, unauthReadOnlyOption :: Bool , unauthReadOnlyOption :: Bool
@ -47,6 +50,10 @@ optParser _ = Options
( long "port" <> metavar paramNumber ( long "port" <> metavar paramNumber
<> help "specify port to listen on" <> help "specify port to listen on"
)) ))
<*> optional (strOption
( long "bind" <> metavar paramAddress
<> help "specify address to bind to"
))
<*> switch <*> switch
( long "authenv" ( long "authenv"
<> help "authenticate users from environment (https only)" <> help "authenticate users from environment (https only)"
@ -74,11 +81,19 @@ seek o = getAnnexWorkerPool $ \workerpool ->
authenv <- getAuthEnv authenv <- getAuthEnv
st <- mkP2PHttpServerState acquireconn workerpool $ st <- mkP2PHttpServerState acquireconn workerpool $
mkGetServerMode authenv o 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 where
port = fromMaybe port = maybe
(fromIntegral defaultP2PHttpProtocolPort) (fromIntegral defaultP2PHttpProtocolPort)
fromIntegral
(portOption o) (portOption o)
host = maybe
(fromString "*") -- both ipv4 and ipv6
fromString
(bindOption o)
mkGetServerMode :: M.Map Auth P2P.ServerMode -> Options -> GetServerMode mkGetServerMode :: M.Map Auth P2P.ServerMode -> Options -> GetServerMode
mkGetServerMode _ o _ Nothing mkGetServerMode _ o _ Nothing

4
doc/git-annex-p2phttp.mdwn
View file

@ -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 use a low port like port 80. It will not drop permissions when run as
root. root.
* `--bind=address`
What address to bind to. The default is to bind to all addresses.
* `--authenv` * `--authenv`
Allows users to be authenticated with a username and password. Allows users to be authenticated with a username and password.