record transfer information on local git remotes
In order to record a semi-useful filename associated with the key, this required plumbing the filename all the way through to the remotes' storeKey and retrieveKeyFile. Note that there is potential for deadlock here, narrowly avoided. Suppose the repos are A and B. A sends file foo to B, and at the same time, B gets file foo from A. So, A locks its upload transfer info file, and then locks B's download transfer info file. At the same time, B is taking the two locks in the opposite order. This is only not a deadlock because the lock code does not wait, and aborts. So one of A or B's transfers will be aborted and the other transfer will continue. Whew!
This commit is contained in:
parent
8c10f37714
commit
7225c2bfc0
16 changed files with 107 additions and 76 deletions
|
@ -31,6 +31,7 @@ import Logs.Trust
|
|||
import Remote
|
||||
import Config
|
||||
import Utility.Percentage
|
||||
import Logs.Transfer
|
||||
|
||||
-- a named computation that produces a statistic
|
||||
type Stat = StatState (Maybe (String, StatState String))
|
||||
|
@ -70,6 +71,7 @@ fast_stats =
|
|||
, remote_list SemiTrusted "semitrusted"
|
||||
, remote_list UnTrusted "untrusted"
|
||||
, remote_list DeadTrusted "dead"
|
||||
, transfer_list
|
||||
, disk_size
|
||||
]
|
||||
slow_stats :: [Stat]
|
||||
|
@ -170,6 +172,24 @@ bloom_info = stat "bloom filter size" $ json id $ do
|
|||
|
||||
return $ size ++ note
|
||||
|
||||
transfer_list :: Stat
|
||||
transfer_list = stat "transfers in progress" $ nojson $ lift $ do
|
||||
uuidmap <- Remote.remoteMap id
|
||||
ts <- getTransfers
|
||||
if null ts
|
||||
then return "none"
|
||||
else return $ pp uuidmap "" $ sort ts
|
||||
where
|
||||
pp _ c [] = c
|
||||
pp uuidmap c ((t, i):xs) = "\n\t" ++ line uuidmap t i ++ pp uuidmap c xs
|
||||
line uuidmap t i = unwords
|
||||
[ show (transferDirection t) ++ "ing"
|
||||
, fromMaybe (show $ transferKey t) (associatedFile i)
|
||||
, if transferDirection t == Upload then "to" else "from"
|
||||
, maybe (fromUUID $ transferRemote t) Remote.name $
|
||||
M.lookup (transferRemote t) uuidmap
|
||||
]
|
||||
|
||||
disk_size :: Stat
|
||||
disk_size = stat "available local disk space" $ json id $ lift $
|
||||
calcfree
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue