aboutsummaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-08-20 16:11:42 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-08-20 16:11:42 -0400
commit737b5d14c91101d46e20999e33461e9059dd9f28 (patch)
tree109fb64986ec03679c8ea3c85362eff19aae1ce3 /Remote
parentec746c511f5666fc214eba1a477d1ababfe9d367 (diff)
moved files around
Diffstat (limited to 'Remote')
-rw-r--r--Remote/Bup.hs2
-rw-r--r--Remote/Git.hs4
-rw-r--r--Remote/Helper/Ssh.hs61
-rw-r--r--Remote/Helper/Url.hs70
-rw-r--r--Remote/Web.hs2
5 files changed, 4 insertions, 135 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index c82f84745..069209792 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -30,7 +30,7 @@ import Locations
import Config
import Utility
import Messages
-import Remote.Helper.Ssh
+import Utility.Ssh
import Remote.Helper.Special
import Remote.Helper.Encryptable
import Crypto
diff --git a/Remote/Git.hs b/Remote/Git.hs
index d8ecd33c4..80ba8a153 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -25,8 +25,8 @@ import qualified Content
import Messages
import Utility.CopyFile
import Utility.RsyncFile
-import Remote.Helper.Ssh
-import qualified Remote.Helper.Url as Url
+import Utility.Ssh
+import qualified Utility.Url as Url
import Config
import Init
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
deleted file mode 100644
index 478b01881..000000000
--- a/Remote/Helper/Ssh.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-{- git-annex remote access with ssh
- -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-module Remote.Helper.Ssh where
-
-import Control.Monad.State (liftIO)
-
-import qualified Git
-import Utility
-import Types
-import Config
-
-{- Generates parameters to ssh to a repository's host and run a command.
- - Caller is responsible for doing any neccessary shellEscaping of the
- - passed command. -}
-sshToRepo :: Git.Repo -> [CommandParam] -> Annex [CommandParam]
-sshToRepo repo sshcmd = do
- s <- getConfig repo "ssh-options" ""
- let sshoptions = map Param (words s)
- let sshport = case Git.urlPort repo of
- Nothing -> []
- Just p -> [Param "-p", Param (show p)]
- let sshhost = Param $ Git.urlHostUser repo
- return $ sshoptions ++ sshport ++ [sshhost] ++ sshcmd
-
-{- Generates parameters to run a git-annex-shell command on a remote
- - repository. -}
-git_annex_shell :: Git.Repo -> String -> [CommandParam] -> Annex (Maybe (FilePath, [CommandParam]))
-git_annex_shell r command params
- | not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts)
- | Git.repoIsSsh r = do
- sshparams <- sshToRepo r [Param sshcmd]
- return $ Just ("ssh", sshparams)
- | otherwise = return Nothing
- where
- dir = Git.workTree r
- shellcmd = "git-annex-shell"
- shellopts = Param command : File dir : params
- sshcmd = shellcmd ++ " " ++
- unwords (map shellEscape $ toCommand shellopts)
-
-{- Uses a supplied function (such as boolSystem) to run a git-annex-shell
- - command on a remote.
- -
- - Or, if the remote does not support running remote commands, returns
- - a specified error value. -}
-onRemote
- :: Git.Repo
- -> (FilePath -> [CommandParam] -> IO a, a)
- -> String
- -> [CommandParam]
- -> Annex a
-onRemote r (with, errorval) command params = do
- s <- git_annex_shell r command params
- case s of
- Just (c, ps) -> liftIO $ with c ps
- Nothing -> return errorval
diff --git a/Remote/Helper/Url.hs b/Remote/Helper/Url.hs
deleted file mode 100644
index af1fee8f0..000000000
--- a/Remote/Helper/Url.hs
+++ /dev/null
@@ -1,70 +0,0 @@
-{- Url downloading for remotes.
- -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-module Remote.Helper.Url (
- exists,
- download,
- get
-) where
-
-import Control.Monad (liftM)
-import Control.Monad.State (liftIO)
-import qualified Network.Browser as Browser
-import Network.HTTP
-import Network.URI
-
-import Types
-import Messages
-import Utility
-
-type URLString = String
-
-{- Checks that an url exists and could be successfully downloaded. -}
-exists :: URLString -> IO Bool
-exists url =
- case parseURI url of
- Nothing -> return False
- Just u -> do
- r <- request u HEAD
- case rspCode r of
- (2,_,_) -> return True
- _ -> return False
-
-{- Used to download large files, such as the contents of keys.
- - Uses curl program for its progress bar. -}
-download :: URLString -> FilePath -> Annex Bool
-download url file = do
- showOutput -- make way for curl progress bar
- -- Uses the -# progress display, because the normal one is very
- -- confusing when resuming, showing the remainder to download
- -- as the whole file, and not indicating how much percent was
- -- downloaded before the resume.
- liftIO $ boolSystem "curl" [Params "-L -C - -# -o", File file, File url]
-
-{- Downloads a small file. -}
-get :: URLString -> IO String
-get url =
- case parseURI url of
- Nothing -> error "url parse error"
- Just u -> do
- r <- request u GET
- case rspCode r of
- (2,_,_) -> return $ rspBody r
- _ -> error $ rspReason r
-
-{- Makes a http request of an url. For example, HEAD can be used to
- - check if the url exists, or GET used to get the url content (best for
- - small urls). -}
-request :: URI -> RequestMethod -> IO (Response String)
-request url requesttype = Browser.browse $ do
- Browser.setErrHandler ignore
- Browser.setOutHandler ignore
- Browser.setAllowRedirects True
- liftM snd $ Browser.request
- (mkRequest requesttype url :: Request_String)
- where
- ignore = const $ return ()
diff --git a/Remote/Web.hs b/Remote/Web.hs
index cc96d5306..5bc6a204b 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -24,7 +24,7 @@ import Config
import PresenceLog
import LocationLog
import Locations
-import qualified Remote.Helper.Url as Url
+import qualified Utility.Url as Url
type URLString = String