avoid padding in clientPut
Instead truncate when necessary to indicate invalid content was sent. Very similar to how serveGet handles it.
This commit is contained in:
parent
726c815a7f
commit
efa0efdc44
2 changed files with 31 additions and 22 deletions
47
P2P/Http.hs
47
P2P/Http.hs
|
@ -646,37 +646,44 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
|
||||||
return res
|
return res
|
||||||
where
|
where
|
||||||
stream checkv checkresultv = S.SourceT $ \a -> do
|
stream checkv checkresultv = S.SourceT $ \a -> do
|
||||||
|
-- TODO seek to offset when requested
|
||||||
bl <- L.readFile contentfile
|
bl <- L.readFile contentfile
|
||||||
v <- newMVar (0, L.toChunks bl)
|
v <- newMVar (0, filter (not . B.null) (L.toChunks bl))
|
||||||
a (go v)
|
a (go v)
|
||||||
where
|
where
|
||||||
go v = S.fromActionStep B.null $ do
|
go v = S.fromActionStep B.null $
|
||||||
res <- modifyMVar v $ pure . \case
|
modifyMVar v $ \case
|
||||||
(n, []) -> ((n, []), (n, Nothing))
|
(n, (b:[])) -> do
|
||||||
|
let !n' = n + B.length b
|
||||||
|
ifM (checkvalid n)
|
||||||
|
( return ((n', []), b)
|
||||||
|
-- The key's content is invalid, but
|
||||||
|
-- the amount of data is the same as the
|
||||||
|
-- DataLengthHeader indicates. Truncate
|
||||||
|
-- the stream by one byte to indicate
|
||||||
|
-- to the server that it's not valid.
|
||||||
|
, return ((n' - 1, []), B.take (B.length b - 1) b)
|
||||||
|
)
|
||||||
|
(n, []) -> do
|
||||||
|
void $ checkvalid n
|
||||||
|
return ((n, []), mempty)
|
||||||
(n, (b:bs)) ->
|
(n, (b:bs)) ->
|
||||||
let !n' = n + B.length b
|
let !n' = n + B.length b
|
||||||
in ((n', bs), (n, Just b))
|
in return ((n', bs), b)
|
||||||
case res of
|
|
||||||
(_, Just b) -> return b
|
checkvalid n = do
|
||||||
(n, Nothing) -> do
|
void $ liftIO $ atomically $ tryPutTMVar checkv ()
|
||||||
void $ liftIO $ atomically $
|
valid <- liftIO $ atomically $ readTMVar checkresultv
|
||||||
tryPutTMVar checkv ()
|
|
||||||
valid <- liftIO $ atomically $
|
|
||||||
readTMVar checkresultv
|
|
||||||
if not valid
|
if not valid
|
||||||
then if n == fromIntegral contentfilesize
|
then return (n /= fromIntegral nlen)
|
||||||
then do
|
else return True
|
||||||
modifyMVar_ v $ \(_n, l) ->
|
|
||||||
pure (n+1, l)
|
|
||||||
return "X"
|
|
||||||
else return B.empty
|
|
||||||
else return B.empty
|
|
||||||
|
|
||||||
baf = case af of
|
baf = case af of
|
||||||
AssociatedFile Nothing -> Nothing
|
AssociatedFile Nothing -> Nothing
|
||||||
AssociatedFile (Just f) -> Just (B64FilePath f)
|
AssociatedFile (Just f) -> Just (B64FilePath f)
|
||||||
|
|
||||||
len = DataLength $ case moffset of
|
len = DataLength nlen
|
||||||
|
nlen = case moffset of
|
||||||
Nothing -> contentfilesize
|
Nothing -> contentfilesize
|
||||||
Just (Offset o) -> contentfilesize - fromIntegral o
|
Just (Offset o) -> contentfilesize - fromIntegral o
|
||||||
|
|
||||||
|
|
|
@ -32,6 +32,8 @@ Planned schedule of work:
|
||||||
That should not be necessary, they should always be able to truncate the
|
That should not be necessary, they should always be able to truncate the
|
||||||
data.
|
data.
|
||||||
|
|
||||||
|
* clientPut needs to seek to the requested offset in the file.
|
||||||
|
|
||||||
* Implement: servePutOffset, serveLockContent
|
* Implement: servePutOffset, 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.
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue