p2phttp combining unauth and auth options

p2phttp: Support serving unauthenticated users while requesting
authentication for operations that need it. Eg, --unauth-readonly can be
combined with --authenv.

Drop locking currently needs authentication so it will prompt for that.
That still needs to be addressed somehow.

CHANGELOG

@@ -1,3 +1,11 @@
+git-annex (10.20240928) UNRELEASED; urgency=medium
+
+  * p2phttp: Support serving unauthenticated users while requesting
+    authentication for operations that need it. Eg, --unauth-readonly
+    can be combined with --authenv.
+
+ -- Joey Hess <id@joeyh.name>  Thu, 17 Oct 2024 11:02:17 -0400
+
 git-annex (10.20240927) upstream; urgency=medium
 
   * Detect when a preferred content expression contains "not present",

Command/P2PHttp.hs

@@ -128,10 +128,15 @@ seek o = getAnnexWorkerPool $ \workerpool ->
 
 mkGetServerMode :: M.Map Auth P2P.ServerMode -> Options -> GetServerMode
 mkGetServerMode _ o _ Nothing
-	| wideOpenOption o = Just P2P.ServeReadWrite
-	| unauthAppendOnlyOption o = Just P2P.ServeAppendOnly
-	| unauthReadOnlyOption o = Just P2P.ServeReadOnly
-	| otherwise = Nothing
+	| wideOpenOption o =
+		ServerMode P2P.ServeReadWrite False
+	| unauthAppendOnlyOption o =
+		ServerMode P2P.ServeAppendOnly canauth
+	| unauthReadOnlyOption o =
+		ServerMode P2P.ServeReadOnly canauth
+	| otherwise = CannotServeRequests
+  where
+	canauth = authEnvOption o || authEnvHttpOption o
 mkGetServerMode authenv o issecure (Just auth) =
 	case (issecure, authEnvOption o, authEnvHttpOption o) of
 		(Secure, True, _) -> checkauth
@@ -139,9 +144,10 @@ mkGetServerMode authenv o issecure (Just auth) =
 		_ -> noauth
   where
 	checkauth = case M.lookup auth authenv of
-		Just servermode -> Just servermode
+		Just servermode -> ServerMode servermode False
 		Nothing -> noauth
-	noauth = mkGetServerMode authenv o issecure Nothing
+	noauth = mkGetServerMode authenv noautho issecure Nothing
+	noautho = o { authEnvOption = False, authEnvHttpOption = False }
 
 getAuthEnv :: IO (M.Map Auth P2P.ServerMode)
 getAuthEnv = do

P2P/Http/State.hs

@@ -52,8 +52,14 @@ data P2PHttpServerState = P2PHttpServerState
 
 type AnnexWorkerPool = TMVar (WorkerPool (Annex.AnnexState, Annex.AnnexRead))
 
--- Nothing when the server is not allowed to serve any requests.
-type GetServerMode = IsSecure -> Maybe Auth -> Maybe P2P.ServerMode
+type GetServerMode = IsSecure -> Maybe Auth -> ServerMode
+
+data ServerMode
+	= ServerMode
+		{ serverMode :: P2P.ServerMode
+		, authenticationAllowed :: Bool
+		}
+	| CannotServeRequests
 
 mkP2PHttpServerState :: AcquireP2PConnection -> AnnexWorkerPool -> GetServerMode -> IO P2PHttpServerState
 mkP2PHttpServerState acquireconn annexworkerpool getservermode = P2PHttpServerState
@@ -143,13 +149,23 @@ checkAuthActionClass
 	-> (P2P.ServerMode -> Handler a)
 	-> Handler a
 checkAuthActionClass st sec auth actionclass go =
-	case (getServerMode st sec auth, actionclass) of
-		(Just P2P.ServeReadWrite, _) -> go P2P.ServeReadWrite
-		(Just P2P.ServeAppendOnly, RemoveAction) -> throwError err403
-		(Just P2P.ServeAppendOnly, _) -> go P2P.ServeAppendOnly
-		(Just P2P.ServeReadOnly, ReadAction) -> go P2P.ServeReadOnly
-		(Just P2P.ServeReadOnly, _) -> throwError err403
-		(Nothing, _) -> throwError basicAuthRequired
+	case (sm, actionclass) of
+		(ServerMode { serverMode = P2P.ServeReadWrite }, _) ->
+			go P2P.ServeReadWrite
+		(ServerMode { serverMode = P2P.ServeAppendOnly }, RemoveAction) -> 
+			throwError $ forbiddenWithoutAuth sm
+		(ServerMode { serverMode = P2P.ServeAppendOnly }, _) ->
+			go P2P.ServeAppendOnly
+		(ServerMode { serverMode = P2P.ServeReadOnly }, ReadAction) ->
+			go P2P.ServeReadOnly
+		(ServerMode { serverMode = P2P.ServeReadOnly }, _) -> 
+			throwError $ forbiddenWithoutAuth sm
+		(CannotServeRequests, _) -> throwError basicAuthRequired
+  where
+	sm = getServerMode st sec auth
+
+forbiddenAction :: ServerError
+forbiddenAction = err403
 
 basicAuthRequired :: ServerError
 basicAuthRequired = err401 { errHeaders = [(h, v)] }
@@ -157,6 +173,11 @@ basicAuthRequired = err401 { errHeaders = [(h, v)] }
 	h = "WWW-Authenticate"
 	v = "Basic realm=\"git-annex\", charset=\"UTF-8\""
 
+forbiddenWithoutAuth :: ServerMode -> ServerError
+forbiddenWithoutAuth sm
+	| authenticationAllowed sm = basicAuthRequired
+	| otherwise = forbiddenAction
+
 data ConnectionParams = ConnectionParams
 	{ connectionProtocolVersion :: P2P.ProtocolVersion
 	, connectionServerUUID :: UUID

doc/bugs/p2phttp__58___drop_difference_wideopen_unauth-readonly/comment_6_f883c505182b6b740081beaa0871b9a9._comment

@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2024-10-17T15:07:12Z"
+ content="""
+I've implemented combining --unauth-readonly (or --unauth-appendonly) with
+--authenv/--authenv-http.
+
+Read-only drop locking in that configuration still needs to be addressed, it
+does prompt for authentication currently.
+"""]]

doc/git-annex-p2phttp.mdwn

@@ -116,10 +116,16 @@ convenient way to download the content of any key, by using the path
   Allows unauthenticated users to read the repository, but not make
   modifications to it.
 
+  This can be combined with `--authenv` or `--authenv-http` to allow
+  anonymous readonly access, and authenticated write access.
+
 * `--unauth-appendonly`
 
   Allows unauthenticated users to read the repository, and store data in
   it, but not remove data from it.
+  
+  This can be combined with `--authenv` or `--authenv-http` to allow
+  anonymous appendonly access, and authenticated remove access.
 
 * `--wideopen`