clientPut seeking to offset

This commit is contained in:
Joey Hess 2024-07-22 12:50:21 -04:00
parent a01426b713
commit b240a11b79
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 19 additions and 15 deletions

View file

@ -177,16 +177,16 @@ testPut = do
burl <- liftIO $ parseBaseUrl "http://localhost:8080/" burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
res <- clientPut (mkClientEnv mgr burl) res <- clientPut (mkClientEnv mgr burl)
(P2P.ProtocolVersion 3) (P2P.ProtocolVersion 3)
(B64Key (fromJust $ deserializeKey ("WORM-s30-m1720547401--foo"))) (B64Key (fromJust $ deserializeKey ("SHA256E-s1048576000--b460ca923520db561d01b99483e9e2fe65ff9dfbdd52c17acba6ac4e874e27d5")))
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String))) (B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
(B64UUID (toUUID ("cu" :: String))) (B64UUID (toUUID ("cu" :: String)))
[] []
Nothing Nothing
Nothing (Just (Offset 584754208))
(AssociatedFile (Just "foo")) (AssociatedFile (Just "foo"))
"foocontent" "bigfile3content"
30 1048576000
(liftIO (print "validity check") >> return False) (liftIO (print "validity check") >> return True)
liftIO $ print res liftIO $ print res
testRemove = do testRemove = do

View file

@ -547,7 +547,7 @@ servePut st resultmangle su apiver (DataLength len) (B64Key k) cu bypass baf mof
tooshortv <- liftIO newEmptyTMVarIO tooshortv <- liftIO newEmptyTMVarIO
content <- liftIO $ S.unSourceT stream (gather validityv tooshortv) content <- liftIO $ S.unSourceT stream (gather validityv tooshortv)
res <- withP2PConnection' apiver st cu su bypass sec auth WriteAction res <- withP2PConnection' apiver st cu su bypass sec auth WriteAction
(\st -> st { connectionWaitVar = False }) $ \conn -> (\cst -> cst { connectionWaitVar = False }) $ \conn ->
liftIO (protoaction conn content validitycheck) liftIO (protoaction conn content validitycheck)
`finally` checktooshort conn tooshortv `finally` checktooshort conn tooshortv
case res of case res of
@ -645,7 +645,11 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
liftIO $ atomically $ takeTMVar checkv liftIO $ atomically $ takeTMVar checkv
validitycheck >>= liftIO . atomically . putTMVar checkresultv validitycheck >>= liftIO . atomically . putTMVar checkresultv
checkerthread <- liftIO . async =<< forkState checker checkerthread <- liftIO . async =<< forkState checker
liftIO (withClientM (cli (stream checkv checkresultv)) clientenv return) >>= \case v <- liftIO $ withBinaryFile contentfile ReadMode $ \h -> do
when (offset /= 0) $
hSeek h AbsoluteSeek offset
withClientM (cli (stream h checkv checkresultv)) clientenv return
case v of
Left err -> do Left err -> do
void $ liftIO $ atomically $ tryPutTMVar checkv () void $ liftIO $ atomically $ tryPutTMVar checkv ()
join $ liftIO (wait checkerthread) join $ liftIO (wait checkerthread)
@ -654,9 +658,8 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
join $ liftIO (wait checkerthread) join $ liftIO (wait checkerthread)
return res return res
where where
stream checkv checkresultv = S.SourceT $ \a -> do stream h checkv checkresultv = S.SourceT $ \a -> do
-- TODO seek to offset when requested bl <- L.hGetContents h
bl <- L.readFile contentfile
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
@ -692,9 +695,12 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
AssociatedFile (Just f) -> Just (B64FilePath f) AssociatedFile (Just f) -> Just (B64FilePath f)
len = DataLength nlen len = DataLength nlen
nlen = case moffset of
Nothing -> contentfilesize nlen = contentfilesize - offset
Just (Offset o) -> contentfilesize - fromIntegral o
offset = case moffset of
Nothing -> 0
Just (Offset o) -> fromIntegral o
cli src = case ver of cli src = case ver of
3 -> v3 su V3 len k cu bypass baf moffset src auth 3 -> v3 su V3 len k cu bypass baf moffset src auth

View file

@ -28,8 +28,6 @@ Planned schedule of work:
## work notes ## work notes
* 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.