webapp: Added --port option, and annex.port config

The getSocket comment that mentioned using ":port"
in the hostname seems to have been incorrect or be out of date.
After all, the bug report came when the user first tried doing that,
and it didn't work.

Sponsored-by: the NIH-funded NICEMAN (ReproNim TR&D3) project
This commit is contained in:
Joey Hess 2024-01-25 14:08:36 -04:00
parent d54f2ccae1
commit 8e9ee31621
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
13 changed files with 90 additions and 29 deletions

View file

@ -59,7 +59,7 @@ import System.Environment (getArgs)
#endif #endif
import qualified Utility.Debug as Debug import qualified Utility.Debug as Debug
import Network.Socket (HostName) import Network.Socket (HostName, PortNumber)
stopDaemon :: Annex () stopDaemon :: Annex ()
stopDaemon = liftIO . Utility.Daemon.stopDaemon . fromRawFilePath stopDaemon = liftIO . Utility.Daemon.stopDaemon . fromRawFilePath
@ -70,8 +70,8 @@ stopDaemon = liftIO . Utility.Daemon.stopDaemon . fromRawFilePath
- -
- startbrowser is passed the url and html shim file, as well as the original - startbrowser is passed the url and html shim file, as well as the original
- stdout and stderr descriptors. -} - stdout and stderr descriptors. -}
startDaemon :: Bool -> Bool -> Maybe Duration -> Maybe String -> Maybe HostName -> Maybe (Maybe Handle -> Maybe Handle -> String -> FilePath -> IO ()) -> Annex () startDaemon :: Bool -> Bool -> Maybe Duration -> Maybe String -> Maybe HostName -> Maybe PortNumber -> Maybe (Maybe Handle -> Maybe Handle -> String -> FilePath -> IO ()) -> Annex ()
startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = do startDaemon assistant foreground startdelay cannotrun listenhost listenport startbrowser = do
Annex.changeState $ \s -> s { Annex.daemon = True } Annex.changeState $ \s -> s { Annex.daemon = True }
enableInteractiveBranchAccess enableInteractiveBranchAccess
pidfile <- fromRepo gitAnnexPidFile pidfile <- fromRepo gitAnnexPidFile
@ -141,7 +141,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
#endif #endif
urlrenderer <- liftIO newUrlRenderer urlrenderer <- liftIO newUrlRenderer
#ifdef WITH_WEBAPP #ifdef WITH_WEBAPP
let webappthread = [ assist $ webAppThread d urlrenderer False cannotrun Nothing listenhost webappwaiter ] let webappthread = [ assist $ webAppThread d urlrenderer False cannotrun Nothing listenhost listenport webappwaiter ]
#else #else
let webappthread = [] let webappthread = []
#endif #endif

View file

@ -45,7 +45,7 @@ import Git
import qualified Annex import qualified Annex
import Yesod import Yesod
import Network.Socket (SockAddr, HostName) import Network.Socket (SockAddr, HostName, PortNumber)
import Data.Text (pack, unpack) import Data.Text (pack, unpack)
import qualified Network.Wai.Handler.WarpTLS as TLS import qualified Network.Wai.Handler.WarpTLS as TLS
import Network.Wai.Middleware.RequestLogger import Network.Wai.Middleware.RequestLogger
@ -61,12 +61,16 @@ webAppThread
-> Maybe String -> Maybe String
-> Maybe (IO Url) -> Maybe (IO Url)
-> Maybe HostName -> Maybe HostName
-> Maybe PortNumber
-> Maybe (Url -> FilePath -> IO ()) -> Maybe (Url -> FilePath -> IO ())
-> NamedThread -> NamedThread
webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost onstartup = thread $ liftIO $ do webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost listenport onstartup = thread $ liftIO $ do
listenhost' <- if isJust listenhost listenhost' <- if isJust listenhost
then pure listenhost then pure listenhost
else getAnnex $ annexListen <$> Annex.getGitConfig else getAnnex $ annexListen <$> Annex.getGitConfig
listenport' <- if isJust listenport
then pure listenport
else getAnnex $ annexPort <$> Annex.getGitConfig
tlssettings <- getAnnex getTlsSettings tlssettings <- getAnnex getTlsSettings
webapp <- WebApp webapp <- WebApp
<$> pure assistantdata <$> pure assistantdata
@ -84,7 +88,7 @@ webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost
( return $ logStdout app ( return $ logStdout app
, return app , return app
) )
runWebApp tlssettings listenhost' app' $ \addr -> if noannex runWebApp tlssettings listenhost' listenport' app' $ \addr -> if noannex
then withTmpFile "webapp.html" $ \tmpfile h -> do then withTmpFile "webapp.html" $ \tmpfile h -> do
hClose h hClose h
go tlssettings addr webapp tmpfile Nothing go tlssettings addr webapp tmpfile Nothing

View file

@ -22,6 +22,7 @@ git-annex (10.20231228) UNRELEASED; urgency=medium
annex.bwlimit-download, annex.bwlimit-upload, annex.bwlimit-download, annex.bwlimit-upload,
and similar per-remote configs. and similar per-remote configs.
* Added --expected-present file matching option. * Added --expected-present file matching option.
* webapp: Added --port option, and annex.port config.
-- Joey Hess <id@joeyh.name> Fri, 29 Dec 2023 11:52:06 -0400 -- Joey Hess <id@joeyh.name> Fri, 29 Dec 2023 11:52:06 -0400

View file

@ -24,5 +24,12 @@ start :: Bool -> DaemonOptions -> Maybe Duration -> CommandStart
start assistant o startdelay = do start assistant o startdelay = do
if stopDaemonOption o if stopDaemonOption o
then stopDaemon then stopDaemon
else startDaemon assistant (foregroundDaemonOption o) startdelay Nothing Nothing Nothing -- does not return else startDaemon assistant
(foregroundDaemonOption o)
startdelay
Nothing
Nothing
Nothing
Nothing
-- does not return
stop stop

View file

@ -36,6 +36,7 @@ import Utility.Android
import Control.Concurrent import Control.Concurrent
import Control.Concurrent.STM import Control.Concurrent.STM
import Network.Socket (PortNumber)
cmd :: Command cmd :: Command
cmd = noCommit $ dontCheck repoExists $ notBareRepo $ cmd = noCommit $ dontCheck repoExists $ notBareRepo $
@ -45,6 +46,7 @@ cmd = noCommit $ dontCheck repoExists $ notBareRepo $
data WebAppOptions = WebAppOptions data WebAppOptions = WebAppOptions
{ listenAddress :: Maybe String { listenAddress :: Maybe String
, listenPort :: Maybe PortNumber
} }
optParser :: CmdParamsDesc -> Parser WebAppOptions optParser :: CmdParamsDesc -> Parser WebAppOptions
@ -53,6 +55,10 @@ optParser _ = WebAppOptions
( long "listen" <> metavar paramAddress ( long "listen" <> metavar paramAddress
<> help "accept connections to this address" <> help "accept connections to this address"
)) ))
<*> optional (option auto
( long "port" <> metavar paramNumber
<> help "specify port to listen on"
))
seek :: WebAppOptions -> CommandSeek seek :: WebAppOptions -> CommandSeek
seek = commandAction . start seek = commandAction . start
@ -77,9 +83,12 @@ start' allowauto o = do
listenAddress' <- if isJust (listenAddress o) listenAddress' <- if isJust (listenAddress o)
then pure (listenAddress o) then pure (listenAddress o)
else annexListen <$> Annex.getGitConfig else annexListen <$> Annex.getGitConfig
listenPort' <- if isJust (listenPort o)
then pure (listenPort o)
else annexPort <$> Annex.getGitConfig
ifM (checkpid <&&> checkshim (fromRawFilePath f)) ifM (checkpid <&&> checkshim (fromRawFilePath f))
( if isJust (listenAddress o) ( if isJust (listenAddress o) || isJust (listenPort o)
then giveup "The assistant is already running, so --listen cannot be used." then giveup "The assistant is already running, so --listen and --port cannot be used."
else do else do
url <- liftIO . readFile . fromRawFilePath url <- liftIO . readFile . fromRawFilePath
=<< fromRepo gitAnnexUrlFile =<< fromRepo gitAnnexUrlFile
@ -87,7 +96,7 @@ start' allowauto o = do
then putStrLn url then putStrLn url
else liftIO $ openBrowser browser (fromRawFilePath f) url Nothing Nothing else liftIO $ openBrowser browser (fromRawFilePath f) url Nothing Nothing
, do , do
startDaemon True True Nothing cannotrun listenAddress' $ Just $ startDaemon True True Nothing cannotrun listenAddress' listenPort' $ Just $
\origout origerr url htmlshim -> \origout origerr url htmlshim ->
if isJust listenAddress' if isJust listenAddress'
then maybe noop (`hPutStrLn` url) origout then maybe noop (`hPutStrLn` url) origout
@ -168,6 +177,7 @@ firstRun o = do
webAppThread d urlrenderer True Nothing webAppThread d urlrenderer True Nothing
(callback signaler) (callback signaler)
(listenAddress o) (listenAddress o)
(listenPort o)
(callback mainthread) (callback mainthread)
waitNamedThreads waitNamedThreads
where where
@ -189,8 +199,8 @@ firstRun o = do
_wait <- takeMVar v _wait <- takeMVar v
state <- Annex.new =<< Git.CurrentRepo.get state <- Annex.new =<< Git.CurrentRepo.get
Annex.eval state $ Annex.eval state $
startDaemon True True Nothing Nothing (listenAddress o) $ Just $ startDaemon True True Nothing Nothing (listenAddress o) (listenPort o)
sendurlback v (Just $ sendurlback v)
sendurlback v _origout _origerr url _htmlshim = putMVar v url sendurlback v _origout _origerr url _htmlshim = putMVar v url
openBrowser :: Maybe FilePath -> FilePath -> String -> Maybe Handle -> Maybe Handle -> IO () openBrowser :: Maybe FilePath -> FilePath -> String -> Maybe Handle -> Maybe Handle -> IO ()

View file

@ -50,6 +50,7 @@ import Utility.Gpg (GpgCmd, mkGpgCmd)
import Utility.StatelessOpenPGP (SOPCmd(..), SOPProfile(..)) import Utility.StatelessOpenPGP (SOPCmd(..), SOPProfile(..))
import Utility.ThreadScheduler (Seconds(..)) import Utility.ThreadScheduler (Seconds(..))
import Utility.Url (Scheme, mkScheme) import Utility.Url (Scheme, mkScheme)
import Network.Socket (PortNumber)
import Control.Concurrent.STM import Control.Concurrent.STM
import qualified Data.Set as S import qualified Data.Set as S
@ -115,6 +116,7 @@ data GitConfig = GitConfig
, annexSecureEraseCommand :: Maybe String , annexSecureEraseCommand :: Maybe String
, annexGenMetaData :: Bool , annexGenMetaData :: Bool
, annexListen :: Maybe String , annexListen :: Maybe String
, annexPort :: Maybe PortNumber
, annexStartupScan :: Bool , annexStartupScan :: Bool
, annexHardLink :: Bool , annexHardLink :: Bool
, annexThin :: Bool , annexThin :: Bool
@ -210,6 +212,7 @@ extractGitConfig configsource r = GitConfig
, annexSecureEraseCommand = getmaybe (annexConfig "secure-erase-command") , annexSecureEraseCommand = getmaybe (annexConfig "secure-erase-command")
, annexGenMetaData = getbool (annexConfig "genmetadata") False , annexGenMetaData = getbool (annexConfig "genmetadata") False
, annexListen = getmaybe (annexConfig "listen") , annexListen = getmaybe (annexConfig "listen")
, annexPort = getmayberead (annexConfig "port")
, annexStartupScan = getbool (annexConfig "startupscan") True , annexStartupScan = getbool (annexConfig "startupscan") True
, annexHardLink = getbool (annexConfig "hardlink") False , annexHardLink = getbool (annexConfig "hardlink") False
, annexThin = getbool (annexConfig "thin") False , annexThin = getbool (annexConfig "thin") False

View file

@ -58,9 +58,9 @@ browserProc url = proc "xdg-open" [url]
- An IO action can also be run, to do something with the address, - An IO action can also be run, to do something with the address,
- such as start a web browser to view the webapp. - such as start a web browser to view the webapp.
-} -}
runWebApp :: Maybe TLSSettings -> Maybe HostName -> Wai.Application -> (SockAddr -> IO ()) -> IO () runWebApp :: Maybe TLSSettings -> Maybe HostName -> Maybe PortNumber -> Wai.Application -> (SockAddr -> IO ()) -> IO ()
runWebApp tlssettings h app observer = withSocketsDo $ do runWebApp tlssettings h p app observer = withSocketsDo $ do
sock <- getSocket h sock <- getSocket h p
void $ forkIO $ go webAppSettings sock app void $ forkIO $ go webAppSettings sock app
sockaddr <- getSocketName sock sockaddr <- getSocketName sock
observer sockaddr observer sockaddr
@ -74,14 +74,13 @@ webAppSettings = setTimeout halfhour defaultSettings
halfhour = 30 * 60 halfhour = 30 * 60
{- Binds to a local socket, or if specified, to a socket on the specified {- Binds to a local socket, or if specified, to a socket on the specified
- hostname or address. Selects any free port, unless the hostname ends with - hostname or address. Selects any free port, unless a port is specified.
- ":port"
- -
- Prefers to bind to the ipv4 address rather than the ipv6 address - Prefers to bind to the ipv4 address rather than the ipv6 address
- of localhost, if it's available. - of localhost, if it's available.
-} -}
getSocket :: Maybe HostName -> IO Socket getSocket :: Maybe HostName -> Maybe PortNumber -> IO Socket
getSocket h = do getSocket h p = do
#if defined (mingw32_HOST_OS) #if defined (mingw32_HOST_OS)
-- The HostName is ignored by this code. -- The HostName is ignored by this code.
-- getAddrInfo didn't used to work on windows; current status -- getAddrInfo didn't used to work on windows; current status
@ -91,11 +90,11 @@ getSocket h = do
let addr = tupleToHostAddress (127,0,0,1) let addr = tupleToHostAddress (127,0,0,1)
sock <- socket AF_INET Stream defaultProtocol sock <- socket AF_INET Stream defaultProtocol
preparesocket sock preparesocket sock
bind sock (SockAddrInet defaultPort addr) bind sock (SockAddrInet (fromMaybe defaultPort p) addr)
use sock use sock
where where
#else #else
addrs <- getAddrInfo (Just hints) (Just hostname) Nothing addrs <- getAddrInfo (Just hints) (Just hostname) (fmap show p)
case (partition (\a -> addrFamily a == AF_INET) addrs) of case (partition (\a -> addrFamily a == AF_INET) addrs) of
(v4addr:_, _) -> go v4addr (v4addr:_, _) -> go v4addr
(_, v6addr:_) -> go v6addr (_, v6addr:_) -> go v6addr

View file

@ -19,3 +19,5 @@ git-annex version: 10.20230126
[[!meta author=yoh]] [[!meta author=yoh]]
[[!tag projects/repronim]] [[!tag projects/repronim]]
> [[done]] --[[Joey]]

View file

@ -0,0 +1,22 @@
[[!comment format=mdwn
username="joey"
subject="""comment 4"""
date="2024-01-25T17:29:08Z"
content="""
I found an old todo about the same thing,
[[todo/Make_webapp_port_configurable]].
The idea there was, they were using docker and wanted to open only a
specific port selected for the webapp. So basically the same kind of thing.
I think that this should be a separate --port option, to avoid needing to
try to parse something that may be an ipv6 address or hostname, or
whatever.
I don't think that using --port should prevent the webapp from needing
the `?auth=' part of the url, as output when using --listen.
Probably it does not make sense to use --port without also using --listen,
but if the user does use it, I don't think --port needs to output the url
the way --listen does.
"""]]

View file

@ -0,0 +1,7 @@
[[!comment format=mdwn
username="joey"
subject="""comment 5"""
date="2024-01-25T18:06:15Z"
content="""
Implemented --port.
"""]]

View file

@ -21,7 +21,8 @@ it opens a browser window.
* `--listen=address` * `--listen=address`
Useful for using the webapp on a remote computer. This makes the webapp Useful for using the webapp on a remote computer. This makes the webapp
listen on the specified IP address. listen on the specified IP address. (Or on the address that a specified
hostname resolves to.)
This disables running a local web browser, and outputs the url you This disables running a local web browser, and outputs the url you
can use to open the webapp. can use to open the webapp.
@ -29,6 +30,11 @@ it opens a browser window.
Set annex.listen in the git config to make the webapp always Set annex.listen in the git config to make the webapp always
listen on an IP address. listen on an IP address.
* `--port=number`
Use this option to specify a port for the webapp.
By default, the webapp picks an unused port.
* Also the [[git-annex-common-options]](1) can be used. * Also the [[git-annex-common-options]](1) can be used.
# USING HTTPS # USING HTTPS

View file

@ -2040,6 +2040,11 @@ Remotes are configured using these settings in `.git/config`.
The default is localhost. Can be either an IP address, The default is localhost. Can be either an IP address,
or a hostname that resolves to the desired address. or a hostname that resolves to the desired address.
* `annex.port`
Configures which port address the webapp listens on.
The default is to pick an unused port.
# CONFIGURATION VIA .gitattributes # CONFIGURATION VIA .gitattributes
The key-value backend used when adding a new file to the annex can be The key-value backend used when adding a new file to the annex can be

View file

@ -39,9 +39,4 @@ dependency versions: aws-0.20 bloomfilter-2.0.1.0 cryptonite-0.25 DAV-1.3.3 feed
### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders) ### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)
git annex seems awesome with the little bit of testing I've done. It seems like the perfect tool for what I want to accomplish. Thanks! git annex seems awesome with the little bit of testing I've done. It seems like the perfect tool for what I want to accomplish. Thanks!
> I don't think this necessarily makes sense, but there is an active bug > [[done]] via --port option --[[Joey]]
> report about the same thing at
> [[bugs/webapp_--listen_port_is_not_used__63__]]
>
> So, closing this old todo to keep discussion in one place. [[done]]
> --[[Joey]]