clientPut seeking to offset

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index 133204cf4a91e3d1c0b48b023cf2c782425389c4..1c2241a33b94011223552621647b589c3dd0f692 100644 (file)
--- 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 76a160223bcd778e6a7e00bee3fb2cd8a9bb3756..8317f896115b805e99cbce13978c7e6b0b5bd74e 100644 (file)
--- 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 b563cee878f92159cf3c02c351d52e3f624ef8b6..ade3b8eedd4b4f19150872bfdc6f5ccd32f085ab 100644 (file)
--- 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.