diff options
author | Joey Hess <joey@kitenet.net> | 2011-08-20 16:11:42 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-08-20 16:11:42 -0400 |
commit | 737b5d14c91101d46e20999e33461e9059dd9f28 (patch) | |
tree | 109fb64986ec03679c8ea3c85362eff19aae1ce3 /Remote/Helper | |
parent | ec746c511f5666fc214eba1a477d1ababfe9d367 (diff) |
moved files around
Diffstat (limited to 'Remote/Helper')
-rw-r--r-- | Remote/Helper/Ssh.hs | 61 | ||||
-rw-r--r-- | Remote/Helper/Url.hs | 70 |
2 files changed, 0 insertions, 131 deletions
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 () |