mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

progress meter for p2phttp storeKey

Browse source
This commit is contained in:
Joey Hess 2024-07-24 12:14:56 -04:00
parent b3915b88ba
commit cfdb80cd05
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 6 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

2
P2P/Http/Client.hs
View file

@ -318,7 +318,7 @@ clientPut meterupdate k moffset af contentfile contentfilesize validitycheck cli
return (Right res) return (Right res)
where where
stream h checkv checkresultv = S.SourceT $ \a -> do stream h checkv checkresultv = S.SourceT $ \a -> do
bl <- L.hGetContents h bl <- hGetContentsMetered h meterupdate
v <- newMVar (0, filter (not . B.null) (L.toChunks bl)) v <- newMVar (0, filter (not . B.null) (L.toChunks bl))
a (go v) a (go v)
where where

6
Remote/Git.hs
View file

@ -57,6 +57,7 @@ import qualified Remote.GCrypt
import qualified Remote.GitLFS import qualified Remote.GitLFS
import qualified Remote.P2P import qualified Remote.P2P
import qualified Remote.Helper.P2P as P2PHelper import qualified Remote.Helper.P2P as P2PHelper
import qualified P2P.Protocol as P2P
import P2P.Address import P2P.Address
import P2P.Http.Url import P2P.Http.Url
import P2P.Http.Client import P2P.Http.Client
@ -667,10 +668,11 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key af o meterupdate
return False return False
Nothing -> return True Nothing -> return True
in p2pHttpClient r (const $ pure $ PutOffsetResultPlus (Offset 0)) (clientPutOffset key) >>= \case in p2pHttpClient r (const $ pure $ PutOffsetResultPlus (Offset 0)) (clientPutOffset key) >>= \case
PutOffsetResultPlus offset -> PutOffsetResultPlus (offset@(Offset (P2P.Offset n))) ->
metered (Just meterupdate) key bwlimit $ \_ p -> do metered (Just meterupdate) key bwlimit $ \_ p -> do
let p' = offsetMeterUpdate p (BytesProcessed n)
res <- p2pHttpClient r giveup $ res <- p2pHttpClient r giveup $
clientPut p key (Just offset) af object sz check' clientPut p' key (Just offset) af object sz check'
case res of case res of
PutResultPlus False _ -> PutResultPlus False _ ->
failedsend failedsend

2
doc/todo/git-annex_proxies.mdwn
View file

@ -28,7 +28,7 @@ Planned schedule of work:
## work notes ## work notes
* Rest of Remote.Git needs implementing: put, drop, lock * Rest of Remote.Git needs implementing: drop, lock
* A Locker should expire the lock on its own after 10 minutes, * A Locker should expire the lock on its own after 10 minutes,
initially. Once keeplocked is called, the expiry should end with the end initially. Once keeplocked is called, the expiry should end with the end