avoid padding in servePut

This means that when the client sends a truncated data to indicate
invalidity, DATA is not passed the full expected data. That leaves the
P2P connection in a state where it cannot be reused. While so far, they
are not reused, they will be later when proxies are supported. So, have
to close the P2P connection in this situation.

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index 7d3d75785d2a15c8342860cd832e21afcbc0b4ea..133204cf4a91e3d1c0b48b023cf2c782425389c4 100644 (file)
--- a/Command/P2PHttp.hs
+++ b/Command/P2PHttp.hs
@@ -186,7 +186,7 @@ testPut = do
                (AssociatedFile (Just "foo"))
                "foocontent"
                30
-               (liftIO (print "validity check") >> return True)
+               (liftIO (print "validity check") >> return False)
        liftIO $ print res
 
 testRemove = do

diff --git a/P2P/Http.hs b/P2P/Http.hs
index 5ad1ac631cf6bf6d38427cdce329815a98b709bb..76a160223bcd778e6a7e00bee3fb2cd8a9bb3756 100644 (file)
--- a/P2P/Http.hs
+++ b/P2P/Http.hs
@@ -544,13 +544,12 @@ servePut st resultmangle su apiver (DataLength len) (B64Key k) cu bypass baf mof
        validityv <- liftIO newEmptyTMVarIO
        let validitycheck = local $ runValidityCheck $
                liftIO $ atomically $ readTMVar validityv
-       content <- liftIO $ S.unSourceT stream (gather validityv)
+       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 ->
-                       liftIO $ inAnnexWorker st $
-                               enteringStage (TransferStage Download) $
-                                       runFullProto (clientRunState conn) (clientP2PConnection conn) $
-                                               protoaction content validitycheck
+                       liftIO (protoaction conn content validitycheck)
+                               `finally` checktooshort conn tooshortv
        case res of
                Right (Right (Just plusuuids)) -> return $ resultmangle $
                        PutResultPlus True (map B64UUID plusuuids)
@@ -561,7 +560,12 @@ servePut st resultmangle su apiver (DataLength len) (B64Key k) cu bypass baf mof
                Left err -> throwError $
                        err500 { errBody = encodeBL (show err) }
   where
-       protoaction content validitycheck = put' k af $ \offset' ->
+       protoaction conn content validitycheck = inAnnexWorker st $
+               enteringStage (TransferStage Download) $
+                       runFullProto (clientRunState conn) (clientP2PConnection conn) $
+                               protoaction' content validitycheck
+       
+       protoaction' content validitycheck = put' k af $ \offset' ->
                let offsetdelta = offset' - offset
                in case compare offset' offset of
                        EQ -> sendContent' nullMeterUpdate (Len len)
@@ -584,36 +588,41 @@ servePut st resultmangle su apiver (DataLength len) (B64Key k) cu bypass baf mof
                Nothing -> Nothing
 
        -- Streams the ByteString from the client. Avoids returning a longer
-       -- or shorter than expected ByteString by truncating or padding;
-       -- in such cases the data is not Valid.
-       gather validityv = unsafeInterleaveIO . go 0
+       -- than expected ByteString by truncating to the expected length. 
+       -- Returns a shorter than expected ByteString when the data is not
+       -- valid.
+       gather validityv tooshortv = unsafeInterleaveIO . go 0
          where
-               go n S.Stop
-                       | n == len = do
-                               atomically $ writeTMVar validityv Valid
-                               return LI.Empty
-                       | otherwise = do
-                               atomically $ writeTMVar validityv Invalid
-                               padout n
+               go n S.Stop = do
+                       atomically $ do
+                               writeTMVar validityv $
+                                       if n == len then Valid else Invalid
+                               writeTMVar tooshortv (n /= len)
+                       return LI.Empty
                go n (S.Error _err) = do
-                       atomically $ writeTMVar validityv Invalid
-                       padout n
+                       atomically $ do
+                               writeTMVar validityv Invalid
+                               writeTMVar tooshortv (n /= len)
+                       return LI.Empty
                go n (S.Skip s) = go n s
                go n (S.Effect ms) = ms >>= go n
                go n (S.Yield v s) =
                        let !n' = n + fromIntegral (B.length v)
                        in if n' > len
                                then do
-                                       atomically $ writeTMVar validityv Invalid
+                                       atomically $ do
+                                               writeTMVar validityv Invalid
+                                               writeTMVar tooshortv True
                                        return $ LI.Chunk
                                                (B.take (fromIntegral (len - n')) v)
                                                LI.Empty
                                else LI.Chunk v <$> unsafeInterleaveIO (go n' s)
-               
-               padout n =return $ LI.Chunk
-                       (B.replicate (fromIntegral (len-n))
-                               (fromIntegral (ord 'X')))
-                       LI.Empty
+                       
+       -- The connection can no longer be used when too short a DATA has
+       -- been written to it.
+       checktooshort conn tooshortv =
+               liftIO $ whenM (atomically $ fromMaybe True <$> tryTakeTMVar tooshortv) $
+                       closeP2PConnection conn
 
 clientPut
        :: ClientEnv
@@ -655,7 +664,7 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
                        modifyMVar v $ \case
                                (n, (b:[])) -> do
                                        let !n' = n + B.length b
-                                       ifM (checkvalid n)
+                                       ifM (checkvalid n')
                                                ( return ((n', []), b)
                                                -- The key's content is invalid, but
                                                -- the amount of data is the same as the

diff --git a/P2P/Http/State.hs b/P2P/Http/State.hs
index 559a9048d9fac965ceb84126f20fb305dc6310b2..534a46ed88ace56fbc9b8111c155f8d0800b9039 100644 (file)
--- a/P2P/Http/State.hs
+++ b/P2P/Http/State.hs
@@ -154,6 +154,11 @@ data P2PConnectionPair = P2PConnectionPair
        , clientP2PConnection :: P2PConnection
        , serverP2PConnection :: P2PConnection
        , releaseP2PConnection :: IO ()
+       -- ^ Releases a P2P connection, which can be reused for other
+       -- requests.
+       , closeP2PConnection :: IO ()
+       -- ^ Closes a P2P connection, which is in a state where it is no
+       -- longer usable.
        }
 
 proxyClientNetProto :: P2PConnectionPair -> P2P.Proto a -> IO (Either P2P.ProtoFailure a)
@@ -229,7 +234,7 @@ mkP2PConnectionPair connparams relv startworker = do
        serverrunst <- mkserverrunst
        asyncworker <- async $
                startworker serverrunst serverconn
-       let releaseconn = atomically $ putTMVar relv $
+       let releaseconn = atomically $ void $ tryPutTMVar relv $
                liftIO $ wait asyncworker
                        >>= either throwM return
        return $ Right $ P2PConnectionPair
@@ -237,6 +242,7 @@ mkP2PConnectionPair connparams relv startworker = do
                , clientP2PConnection = clientconn
                , serverP2PConnection = serverconn
                , releaseP2PConnection = releaseconn
+               , closeP2PConnection = releaseconn
                }
   where
        mkserverrunst = do

diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn
index d21ad3061d3f67cb81eb73fc721d1dfe83a8879b..b563cee878f92159cf3c02c351d52e3f624ef8b6 100644 (file)
--- a/doc/todo/git-annex_proxies.mdwn
+++ b/doc/todo/git-annex_proxies.mdwn
@@ -28,10 +28,6 @@ Planned schedule of work:
 
 ## work notes
 
-* servePut and clientPut pad the data to indicate when it's not valid.
-  That should not be necessary, they should always be able to truncate the
-  data. 
-
 * clientPut needs to seek to the requested offset in the file.
 
 * Implement: servePutOffset, serveLockContent