GET from proxied special remote

Working, but lots of room for improvement...

Without streaming, so there is a delay before download begins as the
file is retreived from the special remote.

And when resuming it retrieves the whole file from the special remote
*again*.

Also, if the special remote throws an exception, currently it
shows as "protocol error".

diff --git a/Annex/Proxy.hs b/Annex/Proxy.hs
index 21e950dd8b824234db76a089920950a6818fe4a6..cbbbffadd5d9c35e43cf534a008e4d8d82b5aaf1 100644 (file)
--- a/Annex/Proxy.hs
+++ b/Annex/Proxy.hs
@@ -16,10 +16,15 @@ import qualified Types.Remote as Remote
 import qualified Remote.Git
 import Remote.Helper.Ssh (openP2PShellConnection', closeP2PShellConnection)
 import Annex.Concurrent
+import Annex.Verify
+import Annex.Tmp
+import Utility.Tmp.Dir
+import Utility.Metered
 
 import Control.Concurrent.STM
 import Control.Concurrent.Async
 import qualified Data.ByteString.Lazy as L
+import qualified System.FilePath.ByteString as P
 
 proxyRemoteSide :: ProtocolVersion -> Bypass -> Remote -> Annex RemoteSide
 proxyRemoteSide clientmaxversion bypass r
@@ -75,30 +80,34 @@ proxySpecialRemote
        -> Annex ()
 proxySpecialRemote protoversion r ihdl ohdl endv = go
   where
-       go = receivemessage >>= \case
+       go :: Annex ()
+       go = liftIO receivemessage >>= \case
                Just (CHECKPRESENT k) -> do
                        tryNonAsync (Remote.checkPresent r k) >>= \case
-                               Right True -> sendmessage SUCCESS
-                               Right False -> sendmessage FAILURE
-                               Left err -> propagateerror err
+                               Right True -> liftIO $ sendmessage SUCCESS
+                               Right False -> liftIO $ sendmessage FAILURE
+                               Left err -> liftIO $ propagateerror err
                        go
                Just (LOCKCONTENT _) -> do
                        -- Special remotes do not support locking content.
-                       sendmessage FAILURE
+                       liftIO $ sendmessage FAILURE
                        go
                Just (REMOVE k) -> do
                        tryNonAsync (Remote.removeKey r k) >>= \case
-                               Right () -> sendmessage SUCCESS
-                               Left err -> propagateerror err
+                               Right () -> liftIO $ sendmessage SUCCESS
+                               Left err -> liftIO $ propagateerror err
                        go
                Just (PUT af k) -> giveup "TODO PUT" -- XXX
-               Just (GET offset af k) -> giveup "TODO GET" -- XXX
+               Just (GET offset (ProtoAssociatedFile af) k) -> do
+                       proxyget offset af k
+                       go
                Just (BYPASS _) -> go
                Just (CONNECT _) -> 
                        -- Not supported and the protocol ends here.
-                       sendmessage $ CONNECTDONE (ExitFailure 1)       
+                       liftIO $ sendmessage $ CONNECTDONE (ExitFailure 1)      
                Just NOTIFYCHANGE -> do
-                       sendmessage (ERROR "NOTIFYCHANGE unsupported for a special remote")
+                       liftIO $ sendmessage $
+                               ERROR "NOTIFYCHANGE unsupported for a special remote"
                        go
                Just _ -> giveup "protocol error"
                Nothing -> return ()
@@ -107,7 +116,7 @@ proxySpecialRemote protoversion r ihdl ohdl endv = go
                liftIO $ atomically $ 
                        (Right <$> takeTMVar ohdl)
                                `orElse`
-                       (Left <$> takeTMVar endv)
+                       (Left <$> readTMVar endv)
 
        receivemessage = getnextmessageorend >>= \case
                Right (Right m) -> return (Just m)
@@ -117,8 +126,57 @@ proxySpecialRemote protoversion r ihdl ohdl endv = go
        --      Left b -> return b
        --      Right _m -> giveup "did not receive ByteString from P2P MVar"
 
-       sendmessage m = liftIO $ atomically $ putTMVar ihdl (Right m)
-       sendbytestring b = liftIO $ atomically $ putTMVar ihdl (Left b)
+       sendmessage m = atomically $ putTMVar ihdl (Right m)
+       
+       sendbytestring b = atomically $ putTMVar ihdl (Left b)
 
        propagateerror err = sendmessage $ ERROR $
                "proxied special remote reports: " ++ show err
+
+       -- Not using gitAnnexTmpObjectLocation because there might be
+       -- several concurrent GET and PUTs of the same key being proxied
+       -- from this special remote or others, and each needs to happen
+       -- independently. Also, this key is not getting added into the
+       -- local annex objects.
+       withproxytmpfile k a = withOtherTmp $ \othertmpdir ->
+               withTmpDirIn (fromRawFilePath othertmpdir) "proxy" $ \tmpdir ->
+                       a (toRawFilePath tmpdir P.</> keyFile k)
+
+       proxyget offset af k = withproxytmpfile k $ \tmpfile -> do
+               -- Don't verify the content from the remote,
+               -- because the client will do its own verification.
+               let vc = Remote.NoVerify
+               tryNonAsync (Remote.retrieveKeyFile r k af (fromRawFilePath tmpfile) nullMeterUpdate vc) >>= \case
+                       Right v ->
+                               ifM (verifyKeyContentPostRetrieval Remote.RetrievalAllKeysSecure vc v k tmpfile)
+                                       ( liftIO $ senddata offset tmpfile
+                                       , liftIO $ sendmessage $
+                                               ERROR "verification of content failed"
+                                       )
+                       Left err -> liftIO $ propagateerror err
+       
+       senddata (Offset offset) f = do
+               size <- fromIntegral <$> getFileSize f
+               let n = max 0 (size - offset)
+               sendmessage $ DATA (Len n)
+               withBinaryFile (fromRawFilePath f) ReadMode $ \h -> do
+                       hSeek h AbsoluteSeek offset
+                       sendbs =<< L.hGetContents h
+                       -- Important to keep the handle open until
+                       -- the client responds. The bytestring
+                       -- could still be lazily streaming out to
+                       -- the client.
+                       waitclientresponse
+         where
+               sendbs bs = do
+                       sendbytestring bs
+                       when (protoversion > ProtocolVersion 0) $
+                               sendmessage (VALIDITY Valid)
+                       
+               waitclientresponse = 
+                       receivemessage >>= \case
+                               Just SUCCESS -> return ()
+                               Just FAILURE -> return ()
+                               Just _ -> giveup "protocol error"
+                               Nothing -> return ()
+                                               

diff --git a/P2P/IO.hs b/P2P/IO.hs
index 643aafc4ec6b37efbf2bf165b93d6570cd10eecf..52a9b0a81285d23501cc62e65c1db647265b2521 100644 (file)
--- a/P2P/IO.hs
+++ b/P2P/IO.hs
@@ -241,10 +241,10 @@ runNet runst conn runner f = case f of
                                        Right b -> runner (next b)
                                        Left e -> return $ Left $
                                                ProtoFailureException e
-                       P2PHandleTMVar mv -> 
+                       P2PHandleTMVar mv ->
                                liftIO (atomically (takeTMVar mv)) >>= \case
                                        Left b -> runner (next b)
-                                       Right _m -> return $ Left $
+                                       Right _ -> return $ Left $
                                                ProtoFailureMessage "protocol error"
        CheckAuthToken _u t next -> do
                let authed = connCheckAuth conn t

diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn
index 73538cec422d3d1f087e83ab3a446a904647825f..de2960ad21837f428e34d535c76b8f422f14c81b 100644 (file)
--- a/doc/todo/git-annex_proxies.mdwn
+++ b/doc/todo/git-annex_proxies.mdwn
@@ -24,13 +24,18 @@ Planned schedule of work:
 
 For June's work on [[design/passthrough_proxy]], remaining todos:
 
-* Since proxying to special remotes is not supported yet, and won't be for
-  the first release, make it fail in a reasonable way.
+* Resuming an interrupted download from proxied special remote makes the proxy
+  re-download the whole content. It could instead keep some of the 
+  object files around when the client does not send SUCCESS. This would
+  use more disk, but without streaming, proxying a special remote already
+  needs some disk. And it could minimize to eg, the last 2 or so.
 
-- or -
+* If GET from a proxied special remote sends an ERROR with a message
+  from the special remote, currently the user sees "protocol error".
 
-* Proxying for special remotes.
-  Including encryption and chunking. See design for issues.
+* Implement PUT to proxied special remotes.
+
+* Streaming download from proxied special remotes. See design.
 
 # items deferred until later for [[design/passthrough_proxy]]
 
@@ -124,3 +129,6 @@ For June's work on [[design/passthrough_proxy]], remaining todos:
 
 * Proxied cluster nodes should have slightly higher cost than the cluster
   gateway. (done)
+
+* Basic support for proxying special remotes. (But not exporttree=yes ones
+  yet.) (done)