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

diff --git a/Assistant.hs b/Assistant.hs
index 3bfaaaa7f981665380f2975e36f0e6e9920b731e..2e50a79ff13c6102c38b0f1e8007eaf96b5b84d0 100644 (file)
--- a/Assistant.hs
+++ b/Assistant.hs
@@ -59,7 +59,7 @@ import System.Environment (getArgs)
 #endif
 import qualified Utility.Debug as Debug
 
-import Network.Socket (HostName)
+import Network.Socket (HostName, PortNumber)
 
 stopDaemon :: Annex ()
 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
  - stdout and stderr descriptors. -}
-startDaemon :: Bool -> Bool -> Maybe Duration -> Maybe String -> Maybe HostName ->  Maybe (Maybe Handle -> Maybe Handle -> String -> FilePath -> IO ()) -> Annex ()
-startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = do
+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 listenport startbrowser = do
        Annex.changeState $ \s -> s { Annex.daemon = True }
        enableInteractiveBranchAccess
        pidfile <- fromRepo gitAnnexPidFile
@@ -141,7 +141,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
 #endif
                urlrenderer <- liftIO newUrlRenderer
 #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
                let webappthread = []
 #endif

diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index f8b3a2b41e466fb5e86cd8b4f664e7ad6b102150..3fdd12d05fee0b0cb92f1547be980783ae07714f 100644 (file)
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -45,7 +45,7 @@ import Git
 import qualified Annex
 
 import Yesod
-import Network.Socket (SockAddr, HostName)
+import Network.Socket (SockAddr, HostName, PortNumber)
 import Data.Text (pack, unpack)
 import qualified Network.Wai.Handler.WarpTLS as TLS
 import Network.Wai.Middleware.RequestLogger
@@ -61,12 +61,16 @@ webAppThread
        -> Maybe String
        -> Maybe (IO Url)
        -> Maybe HostName
+       -> Maybe PortNumber
        -> Maybe (Url -> FilePath -> IO ())
        -> 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
                then pure listenhost
                else getAnnex $ annexListen <$> Annex.getGitConfig
+       listenport' <- if isJust listenport
+               then pure listenport
+               else getAnnex $ annexPort <$> Annex.getGitConfig
        tlssettings <- getAnnex getTlsSettings
        webapp <- WebApp
                <$> pure assistantdata
@@ -84,7 +88,7 @@ webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost
                ( return $ logStdout 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
                        hClose h
                        go tlssettings addr webapp tmpfile Nothing

diff --git a/CHANGELOG b/CHANGELOG
index c832cc32363ef40090b2920b07e147dec69f7a58..464da37a44654a8d363c449e4891a7aa0c763686 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -22,6 +22,7 @@ git-annex (10.20231228) UNRELEASED; urgency=medium
     annex.bwlimit-download, annex.bwlimit-upload,
     and similar per-remote configs.
   * 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
 

diff --git a/Command/Watch.hs b/Command/Watch.hs
index 340559d2b64f86dcc34cbaadde39f252aae23fc7..45289f269e03c72e6635985809aa45aeb5794e24 100644 (file)
--- a/Command/Watch.hs
+++ b/Command/Watch.hs
@@ -24,5 +24,12 @@ start :: Bool -> DaemonOptions -> Maybe Duration -> CommandStart
 start assistant o startdelay = do
        if stopDaemonOption o
                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

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

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

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

diff --git a/doc/bugs/webapp_--listen_port_is_not_used__63__.mdwn b/doc/bugs/webapp_--listen_port_is_not_used__63__.mdwn
index 56d76c95188603257104824b18fbf06fe889f520..bf9f80a68d87170c033fcd4d2253e72dacda3ac2 100644 (file)
--- a/doc/bugs/webapp_--listen_port_is_not_used__63__.mdwn
+++ b/doc/bugs/webapp_--listen_port_is_not_used__63__.mdwn
@@ -19,3 +19,5 @@ git-annex version: 10.20230126
 
 [[!meta author=yoh]]
 [[!tag projects/repronim]]
+
+> [[done]] --[[Joey]]

diff --git a/doc/bugs/webapp_--listen_port_is_not_used__63__/comment_4_ba217465bfa738b77ea9417a33810d75._comment b/doc/bugs/webapp_--listen_port_is_not_used__63__/comment_4_ba217465bfa738b77ea9417a33810d75._comment
new file mode 100644 (file)
index 0000000..74c0a7b
--- /dev/null
+++ b/doc/bugs/webapp_--listen_port_is_not_used__63__/comment_4_ba217465bfa738b77ea9417a33810d75._comment
@@ -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.
+"""]]

diff --git a/doc/bugs/webapp_--listen_port_is_not_used__63__/comment_5_99a6933f30649bc33ee5c74b33fc7046._comment b/doc/bugs/webapp_--listen_port_is_not_used__63__/comment_5_99a6933f30649bc33ee5c74b33fc7046._comment
new file mode 100644 (file)
index 0000000..cdd59cf
--- /dev/null
+++ b/doc/bugs/webapp_--listen_port_is_not_used__63__/comment_5_99a6933f30649bc33ee5c74b33fc7046._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 5"""
+ date="2024-01-25T18:06:15Z"
+ content="""
+Implemented --port.
+"""]]

diff --git a/doc/git-annex-webapp.mdwn b/doc/git-annex-webapp.mdwn
index 21ae9fff54b53aeed4e9815adb97ee948439cb14..d53e76f8cbfcb227f14170b397a815f227e5ca07 100644 (file)
--- a/doc/git-annex-webapp.mdwn
+++ b/doc/git-annex-webapp.mdwn
@@ -21,7 +21,8 @@ it opens a browser window.
 * `--listen=address`
 
   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
   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
   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.
 
 # USING HTTPS

diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 7b895701e479eaeab03a4da54e4a22eb8d72e1bd..c4bd2b8df32231bd7da74bc1d32d54a0c46c103d 100644 (file)
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -2040,6 +2040,11 @@ Remotes are configured using these settings in `.git/config`.
   The default is localhost. Can be either an IP 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
 
 The key-value backend used when adding a new file to the annex can be

diff --git a/doc/todo/Make_webapp_port_configurable.mdwn b/doc/todo/Make_webapp_port_configurable.mdwn
index 81613442727cf6cb8e3fe6ab85b57b6bb152f314..2c94690293dba86f51dcbe4fb64dbabfd8d6de5e 100644 (file)
--- a/doc/todo/Make_webapp_port_configurable.mdwn
+++ b/doc/todo/Make_webapp_port_configurable.mdwn
@@ -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)
 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
-> 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]]
+> [[done]] via --port option --[[Joey]]