make serveKeepLocked check auth just to be safe

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index e33e839f7320dfd213ad918c07de892becf454d7..d85c9e559816eb7d5130f227cd57a0a8b8a2887a 100644 (file)
--- a/Command/P2PHttp.hs
+++ b/Command/P2PHttp.hs
@@ -138,7 +138,8 @@ testKeepLocked = do
                (B64UUID (toUUID ("lck" :: String)))
                (B64UUID (toUUID ("cu" :: String)))
                (B64UUID (toUUID ("su" :: String)))
-               [] $ \keeplocked -> do
+               [] 
+               Nothing $ \keeplocked -> do
                        print "running, press enter to drop lock"
                        _ <- getLine
                        atomically $ writeTMVar keeplocked False

diff --git a/P2P/Http.hs b/P2P/Http.hs
index 1faf9ed2dce3d92b444258618ff078723afaceff..2576c0d9b591d9c78a84eec10b6ebfa65ae87824 100644 (file)
--- a/P2P/Http.hs
+++ b/P2P/Http.hs
@@ -832,7 +832,7 @@ serveLockContent st su apiver (B64Key k) cu bypass sec auth = do
                        _ -> return Nothing
        let unlock (annexworker, unlockv) = do
                atomically $ putTMVar unlockv ()
-               wait annexworker
+               void $ wait annexworker
                releaseP2PConnection conn
        liftIO $ mkLocker lock unlock >>= \case
                Just (locker, lockid) -> do
@@ -874,6 +874,8 @@ type KeepLockedAPI
        = LockIDParam
        :> CU Required
        :> BypassUUIDs
+       :> IsSecure
+       :> AuthHeader
        :> Header "Connection" ConnectionKeepAlive
        :> Header "Keep-Alive" KeepAlive
        :> StreamBody NewlineFraming JSON (SourceIO UnlockRequest)
@@ -887,13 +889,16 @@ serveKeepLocked
        -> LockID
        -> B64UUID ClientSide
        -> [B64UUID Bypass]
+       -> IsSecure
+       -> Maybe Auth
        -> Maybe ConnectionKeepAlive
        -> Maybe KeepAlive
        -> S.SourceT IO UnlockRequest
        -> Handler LockResult
-serveKeepLocked st su apiver lckid cu _ _ _ unlockrequeststream = do
-       _ <- liftIO $ S.unSourceT unlockrequeststream go
-       return (LockResult False Nothing)
+serveKeepLocked st _su _apiver lckid _cu _bypass sec auth _ _ unlockrequeststream = do
+       checkAuthActionClass st sec auth WriteAction $ \_ -> do
+               _ <- liftIO $ S.unSourceT unlockrequeststream go
+               return (LockResult False Nothing)
   where
        go S.Stop = dropLock lckid st
        go (S.Error _err) = dropLock lckid st
@@ -909,15 +914,16 @@ clientKeepLocked
        -> B64UUID ClientSide
        -> B64UUID ServerSide
        -> [B64UUID Bypass]
+       -> Maybe Auth
        -> (TMVar Bool -> IO ())
        -- ^ The TMVar can be filled any number of times with True to send
        -- repeated keep locked requests, eg to keep a connection alive.
        -- Once filled with False, the lock will be dropped.
        -> IO ()
-clientKeepLocked clientenv (ProtocolVersion ver) lckid cu su bypass a = do
+clientKeepLocked clientenv (ProtocolVersion ver) lckid cu su bypass auth a = do
        keeplocked <- newEmptyTMVarIO
        tid <- async $ a keeplocked
-       let cli' = cli lckid cu bypass
+       let cli' = cli lckid cu bypass auth
                (Just connectionKeepAlive) (Just keepAlive)
                (S.fromStepT (unlocksender keeplocked))
        withClientM cli' clientenv $ \case

diff --git a/P2P/Http/State.hs b/P2P/Http/State.hs
index b38ceae0f070ce3814e45b8d1e36c7c2af4ba444..aaac3ee51ef3eb60c6b49830325c8feb4f8d2187 100644 (file)
--- a/P2P/Http/State.hs
+++ b/P2P/Http/State.hs
@@ -104,13 +104,7 @@ getP2PConnection
        -> (ConnectionParams -> ConnectionParams)
        -> Handler P2PConnectionPair
 getP2PConnection apiver st cu su bypass sec auth actionclass fconnparams =
-       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
+       checkAuthActionClass st sec auth actionclass go
   where
        go servermode = liftIO (acquireP2PConnection st cp) >>= \case
                Left (ConnectionFailed err) -> 
@@ -128,6 +122,22 @@ getP2PConnection apiver st cu su bypass sec auth actionclass fconnparams =
                        , connectionWaitVar = True
                        }
 
+checkAuthActionClass
+       :: P2PHttpServerState
+       -> IsSecure
+       -> Maybe Auth
+       -> ActionClass
+       -> (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
+
 basicAuthRequired :: ServerError
 basicAuthRequired = err401 { errHeaders = [(h, v)] }
   where

diff --git a/doc/design/p2p_protocol_over_http/draft1.mdwn b/doc/design/p2p_protocol_over_http/draft1.mdwn
index 988b4c9288d329a6d3892712bf1eb71d33dbad63..25108f336ebdaa2b1c627f0fdb453cdf33ade185 100644 (file)
--- a/doc/design/p2p_protocol_over_http/draft1.mdwn
+++ b/doc/design/p2p_protocol_over_http/draft1.mdwn
@@ -234,6 +234,9 @@ If the connection is closed before the client sends `{"unlock": true},
 or even if the web server gets shut down, the content will remain
 locked for 10 minutes from the time it was first locked.
 
+Note that the common parameters bypass and clientuuid, while
+accepted, have no effect.
+
 ### POST /git-annex/$uuid/v2/keeplocked
 
 Identical to v3.

diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn
index 4cecfaf68ff011a9cfb0e193aa30131d62def20e..04718d829e7447a27c1c14467193b9d05273369f 100644 (file)
--- a/doc/todo/git-annex_proxies.mdwn
+++ b/doc/todo/git-annex_proxies.mdwn
@@ -32,9 +32,6 @@ Planned schedule of work:
 
 * A Locker should expire the lock on its own after 10 minutes initially.
 
-* serveKeepLocked should check auth just to be safe, although added
-  security is probably minimal.
-
 * Make Remote.Git use http client when remote.name.annex-url is configured.
 
 * Make http server support proxies and clusters.