diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs index 133204cf4a..1c2241a33b 100644 --- a/Command/P2PHttp.hs +++ b/Command/P2PHttp.hs @@ -177,16 +177,16 @@ testPut = do burl <- liftIO $ parseBaseUrl "http://localhost:8080/" res <- clientPut (mkClientEnv mgr burl) (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 ("cu" :: String))) [] Nothing - Nothing + (Just (Offset 584754208)) (AssociatedFile (Just "foo")) - "foocontent" - 30 - (liftIO (print "validity check") >> return False) + "bigfile3content" + 1048576000 + (liftIO (print "validity check") >> return True) liftIO $ print res testRemove = do diff --git a/P2P/Http.hs b/P2P/Http.hs index 76a160223b..8317f89611 100644 --- a/P2P/Http.hs +++ b/P2P/Http.hs @@ -547,7 +547,7 @@ servePut st resultmangle su apiver (DataLength len) (B64Key k) cu bypass baf mof tooshortv <- liftIO newEmptyTMVarIO content <- liftIO $ S.unSourceT stream (gather validityv tooshortv) 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) `finally` checktooshort conn tooshortv case res of @@ -645,7 +645,11 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content liftIO $ atomically $ takeTMVar checkv validitycheck >>= liftIO . atomically . putTMVar checkresultv 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 void $ liftIO $ atomically $ tryPutTMVar checkv () join $ liftIO (wait checkerthread) @@ -654,9 +658,8 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content join $ liftIO (wait checkerthread) return res where - stream checkv checkresultv = S.SourceT $ \a -> do - -- TODO seek to offset when requested - bl <- L.readFile contentfile + stream h checkv checkresultv = S.SourceT $ \a -> do + bl <- L.hGetContents h v <- newMVar (0, filter (not . B.null) (L.toChunks bl)) a (go v) where @@ -692,9 +695,12 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content AssociatedFile (Just f) -> Just (B64FilePath f) len = DataLength nlen - nlen = case moffset of - Nothing -> contentfilesize - Just (Offset o) -> contentfilesize - fromIntegral o + + nlen = contentfilesize - offset + + offset = case moffset of + Nothing -> 0 + Just (Offset o) -> fromIntegral o cli src = case ver of 3 -> v3 su V3 len k cu bypass baf moffset src auth diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn index b563cee878..ade3b8eedd 100644 --- a/doc/todo/git-annex_proxies.mdwn +++ b/doc/todo/git-annex_proxies.mdwn @@ -28,8 +28,6 @@ Planned schedule of work: ## work notes -* clientPut needs to seek to the requested offset in the file. - * Implement: servePutOffset, serveLockContent * A Locker should expire the lock on its own after 10 minutes initially.