diff --git a/P2P/Http/Server.hs b/P2P/Http/Server.hs
index 626e87465c..bc19ced1da 100644
--- a/P2P/Http/Server.hs
+++ b/P2P/Http/Server.hs
@@ -428,7 +428,6 @@ serveLockContent st su apiver (B64Key k) cu bypass sec auth = do
 				net $ sendMessage (LOCKCONTENT k)
 				checkSuccess
 			liftIO $ atomically $ putTMVar lockresv lockres
-			-- TODO timeout
 			liftIO $ atomically $ takeTMVar unlockv
 			void $ runFullProto (clientRunState conn) (clientP2PConnection conn) $ do
 				net $ sendMessage UNLOCKCONTENT
@@ -461,6 +460,7 @@ serveKeepLocked
 	-> Handler LockResult
 serveKeepLocked st _su _apiver lckid _cu _bypass sec auth _ _ unlockrequeststream = do
 	checkAuthActionClass st sec auth WriteAction $ \_ -> do
+		liftIO $ keepingLocked lckid st
 		_ <- liftIO $ S.unSourceT unlockrequeststream go
 		return (LockResult False Nothing)
   where
diff --git a/P2P/Http/State.hs b/P2P/Http/State.hs
index f0d1b8e8bc..067b86bfbb 100644
--- a/P2P/Http/State.hs
+++ b/P2P/Http/State.hs
@@ -21,9 +21,12 @@ import qualified P2P.IO as P2P
 import P2P.IO
 import P2P.Annex
 import Annex.UUID
+import Types.NumCopies
 import Types.WorkerPool
 import Annex.WorkerPool
 import CmdLine.Action (startConcurrency)
+import Utility.ThreadScheduler
+import Utility.HumanTime
 
 import Servant
 import qualified Data.Map as M
@@ -281,13 +284,17 @@ data Locker = Locker
 	-- ^ Left empty until the thread has taken the lock
 	-- (or failed to do so), then True while the lock is held,
 	-- and setting to False causes the lock to be released.
+	, lockerTimeoutDisable :: TMVar ()
+	-- ^ Until this is filled, the lock will be subject to timeout.
+	-- Once filled the lock will remain held until explicitly dropped.
 	}
 
-mkLocker :: IO (Maybe a) -> (a -> IO ()) -> IO (Maybe (Locker, LockID))
+mkLocker :: (IO (Maybe a)) -> (a -> IO ()) -> IO (Maybe (Locker, LockID))
 mkLocker lock unlock = do
 	lv <- newEmptyTMVarIO
+	timeoutdisablev <- newEmptyTMVarIO
 	let setlocked = putTMVar lv
-	tid <- async $ lock >>= \case
+	locktid <- async $ lock >>= \case
 		Nothing ->
 			atomically $ setlocked False
 		Just st -> do
@@ -301,10 +308,20 @@ mkLocker lock unlock = do
 	locksuccess <- atomically $ readTMVar lv
 	if locksuccess
 		then do
+			timeouttid <- async $ do
+				threadDelaySeconds $ Seconds $ fromIntegral $
+					durationSeconds p2pDefaultLockContentRetentionDuration
+				atomically (tryReadTMVar timeoutdisablev) >>= \case
+					Nothing -> void $ atomically $
+						writeTMVar lv False
+					Just () -> noop
+			tid <- async $ do
+				wait locktid
+				cancel timeouttid
 			lckid <- B64UUID <$> genUUID
-			return (Just (Locker tid lv, lckid))
+			return (Just (Locker tid lv timeoutdisablev, lckid))
 		else do
-			wait tid
+			wait locktid
 			return Nothing
 
 storeLock :: LockID -> Locker -> P2PHttpServerState -> IO ()
@@ -313,6 +330,15 @@ storeLock lckid locker st = atomically $ do
 	let !m' = M.insert lckid locker m
 	putTMVar (openLocks st) m'
 
+keepingLocked :: LockID -> P2PHttpServerState -> IO ()
+keepingLocked lckid st = do
+	m <- atomically $ readTMVar (openLocks st)
+	case M.lookup lckid m of
+		Nothing -> return ()
+		Just locker ->
+			atomically $ void $ 
+				tryPutTMVar (lockerTimeoutDisable locker) ()
+
 dropLock :: LockID -> P2PHttpServerState -> IO ()
 dropLock lckid st = do
 	v <- atomically $ do
diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn
index 905fe2c431..2efee45a75 100644
--- a/doc/todo/git-annex_proxies.mdwn
+++ b/doc/todo/git-annex_proxies.mdwn
@@ -30,11 +30,6 @@ Planned schedule of work:
 
 * Drop needs to check the proof and use timestamps.
 
-* A Locker should expire the lock on its own after 10 minutes,
-  initially. Once keeplocked is called, the lock will expire at the end 
-  of that call. But if keeplocked never gets called, the lock currently
-  persists forever.
-
 * Make http server support proxies and clusters.
 
 * Support proxying to git remotes using annex+http urls.