implemented serveLockContent (untested)

This commit is contained in:
Joey Hess 2024-07-22 17:36:56 -04:00
parent d5eaf0f567
commit f5dd7a8bc0
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 48 additions and 19 deletions

View file

@ -798,6 +798,8 @@ type LockContentAPI
= KeyParam = KeyParam
:> CU Required :> CU Required
:> BypassUUIDs :> BypassUUIDs
:> IsSecure
:> AuthHeader
:> Post '[JSON] LockResult :> Post '[JSON] LockResult
serveLockContent serveLockContent
@ -808,8 +810,35 @@ serveLockContent
-> B64Key -> B64Key
-> B64UUID ClientSide -> B64UUID ClientSide
-> [B64UUID Bypass] -> [B64UUID Bypass]
-> IsSecure
-> Maybe Auth
-> Handler LockResult -> Handler LockResult
serveLockContent = undefined -- TODO serveLockContent st su apiver (B64Key k) cu bypass sec auth = do
conn <- getP2PConnection apiver st cu su bypass sec auth WriteAction id
let lock = do
lockresv <- newEmptyTMVarIO
unlockv <- newEmptyTMVarIO
annexworker <- async $ inAnnexWorker st $ do
lockres <- runFullProto (clientRunState conn) (clientP2PConnection conn) $ 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
atomically (takeTMVar lockresv) >>= \case
Right True -> return (Just (annexworker, unlockv))
_ -> return Nothing
let unlock (annexworker, unlockv) = do
atomically $ putTMVar unlockv ()
wait annexworker
releaseP2PConnection conn
liftIO $ mkLocker lock unlock >>= \case
Just (locker, lockid) -> do
liftIO $ storeLock lockid locker st
return $ LockResult True (Just lockid)
Nothing -> return $ LockResult False Nothing
clientLockContent clientLockContent
:: B64UUID ServerSide :: B64UUID ServerSide
@ -817,6 +846,7 @@ clientLockContent
-> B64Key -> B64Key
-> B64UUID ClientSide -> B64UUID ClientSide
-> [B64UUID Bypass] -> [B64UUID Bypass]
-> Maybe Auth
-> ClientM LockResult -> ClientM LockResult
clientLockContent su (ProtocolVersion ver) = case ver of clientLockContent su (ProtocolVersion ver) = case ver of
3 -> v3 su V3 3 -> v3 su V3

View file

@ -264,23 +264,21 @@ data Locker = Locker
-- and setting to False causes the lock to be released. -- and setting to False causes the lock to be released.
} }
mkLocker :: IO () -> IO () -> IO (Maybe (Locker, LockID)) mkLocker :: IO (Maybe a) -> (a -> IO ()) -> IO (Maybe (Locker, LockID))
mkLocker lock unlock = do mkLocker lock unlock = do
lv <- newEmptyTMVarIO lv <- newEmptyTMVarIO
let setlocked = putTMVar lv let setlocked = putTMVar lv
tid <- async $ tid <- async $ lock >>= \case
tryNonAsync lock >>= \case Nothing ->
Left _ -> do atomically $ setlocked False
atomically $ setlocked False Just st -> do
unlock atomically $ setlocked True
Right () -> do atomically $ do
atomically $ setlocked True v <- takeTMVar lv
atomically $ do if v
v <- takeTMVar lv then retry
if v else setlocked False
then retry unlock st
else setlocked False
unlock
locksuccess <- atomically $ readTMVar lv locksuccess <- atomically $ readTMVar lv
if locksuccess if locksuccess
then do then do
@ -305,7 +303,8 @@ dropLock lckid st = do
putTMVar (openLocks st) m' putTMVar (openLocks st) m'
case mlocker of case mlocker of
Nothing -> return Nothing Nothing -> return Nothing
-- Signal to the locker's thread that it can release the lock. -- Signal to the locker's thread that it can
-- release the lock.
Just locker -> do Just locker -> do
_ <- swapTMVar (lockerVar locker) False _ <- swapTMVar (lockerVar locker) False
return (Just locker) return (Just locker)

View file

@ -28,12 +28,12 @@ Planned schedule of work:
## work notes ## work notes
* Implement serveLockContent * Test serveLockContent
* A Locker should expire the lock on its own after 10 minutes initially. * A Locker should expire the lock on its own after 10 minutes initially.
* Since each held lock needs a connection to a proxy, the Locker * serveKeepLocked should check auth just to be safe, although added
could reference count, and avoid holding more than one lock per key. security is probably minimal.
* Make Remote.Git use http client when remote.name.annex-url is configured. * Make Remote.Git use http client when remote.name.annex-url is configured.