From 2d408c6b1a0dc5f45567db8c57b84c7c576ec80f Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 9 Apr 2013 15:18:05 -0400
Subject: allow --listen to have a port specified as well as the address

---
 Utility/WebApp.hs  | 25 ++++++++++++++++++-------
 doc/git-annex.mdwn |  4 ++--
 2 files changed, 20 insertions(+), 9 deletions(-)

diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs
index 029fa25de..97a6879ec 100644
--- a/Utility/WebApp.hs
+++ b/Utility/WebApp.hs
@@ -20,7 +20,6 @@ import Network.Wai.Logger
 import Control.Monad.IO.Class
 import Network.HTTP.Types
 import System.Log.Logger
-import Data.ByteString.Lazy.UTF8
 import qualified Data.CaseInsensitive as CI
 import Network.Socket
 import Control.Exception
@@ -28,6 +27,7 @@ import Crypto.Random
 import Data.Digest.Pure.SHA
 import qualified Web.ClientSession as CS
 import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy.UTF8 as L8
 import qualified Data.ByteString as B
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
@@ -67,22 +67,21 @@ webAppSettings = defaultSettings
 	}
 
 {- Binds to a local socket, or if specified, to a socket on the specified
- - hostname or address. Selets any free port.
+ - hostname or address. Selets any free port, unless the hostname ends with
+ - ":port"
  -
  - 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
-	addrs <- getAddrInfo (Just hints) hostname Nothing
+	addrs <- getAddrInfo (Just hints) (Just hostname) port
 	case (partition (\a -> addrFamily a == AF_INET) addrs) of
 		(v4addr:_, _) -> go v4addr
 		(_, v6addr:_) -> go v6addr
 		_ -> error "unable to bind to a local socket"
   where
-	hostname
-		| isJust h = h
-		| otherwise = Just localhost
+	(hostname, port) = maybe (localhost, Nothing) splitHostPort h
 	hints = defaultHints
 		{ addrFlags = [AI_ADDRCONFIG]
 		, addrSocketType = Stream
@@ -102,6 +101,18 @@ getSocket h = do
 		listen sock maxListenQueue
 		return sock
 
+{- Splits address:port. For IPv6, use [address]:port. The port is optional. -}
+splitHostPort :: String -> (HostName, Maybe ServiceName)
+splitHostPort s
+	| "[" `isPrefixOf` s = let (h, p) = break (== ']') (drop 1 s)
+		in if "]:" `isPrefixOf` p
+			then (h, Just $ drop 2 p)
+			else (h, Nothing)
+	| otherwise = let (h, p) = separate (== ':') s
+		in if null p
+			then (h, Nothing)
+			else (h, Just p)
+
 {- Checks if debugging is actually enabled. -}
 debugEnabled :: IO Bool
 debugEnabled = do
@@ -129,7 +140,7 @@ logRequest req = do
 		, frombs $ lookupRequestField "user-agent" req
 		]
   where
-	frombs v = toString $ L.fromChunks [v]
+	frombs v = L8.toString $ L.fromChunks [v]
 
 lookupRequestField :: CI.CI B.ByteString -> Wai.Request -> B.ByteString
 lookupRequestField k req = fromMaybe "" . lookup k $ Wai.requestHeaders req
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 933163133..60ce3a9ae 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -204,8 +204,8 @@ subdirectories).
   By default, the webapp can only be accessed from localhost, and running
   it opens a browser window.
 
-  With the --listen= option, the webapp can be made to listen for
-  connections on the specified address. This disables running a
+  With the --listen=address[:port] option, the webapp can be made to listen
+  for connections on the specified address. This disables running a
   local web browser, and outputs the url you can use to open the webapp
   from a remote computer.
   Note that this does not yet use HTTPS for security, so use with caution!
-- 
cgit v1.2.3