clean Annex stuff out of Utility/

This commit is contained in:
Joey Hess 2011-10-16 00:04:26 -04:00
parent 52c8244219
commit 91366c896d
8 changed files with 14 additions and 16 deletions

View file

@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher.
-}
module Utility.Ssh where
module Annex.Ssh where
import Control.Monad.State (liftIO)

View file

@ -48,7 +48,7 @@ download url file = do
let dummykey = Backend.URL.fromUrl url
let tmp = gitAnnexTmpLocation g dummykey
liftIO $ createDirectoryIfMissing True (parentDir tmp)
ok <- Url.download url tmp
ok <- liftIO $ Url.download url tmp
if ok
then do
[(backend, _)] <- Backend.chooseBackends [file]

View file

@ -16,7 +16,7 @@ import qualified Git
import Annex.UUID
import Logs.UUID
import Logs.Trust
import Utility.Ssh
import Annex.Ssh
import qualified Utility.Dot as Dot
-- a link from the first repository to the second (its remote)

View file

@ -127,7 +127,7 @@ isLinkToAnnex s = ("/.git/" ++ objectDir) `isInfixOf` s
- is one to one.
- ":" is escaped to "&c", because despite it being 2011, people still care
- about FAT.
- -}
-}
keyFile :: Key -> FilePath
keyFile key = replace "/" "%" $ replace ":" "&c" $
replace "%" "&s" $ replace "&" "&a" $ show key

View file

@ -16,7 +16,7 @@ import Common.Annex
import Types.Remote
import qualified Git
import Config
import Utility.Ssh
import Annex.Ssh
import Remote.Helper.Special
import Remote.Helper.Encryptable
import Crypto

View file

@ -13,7 +13,7 @@ import qualified Data.Map as M
import Common.Annex
import Utility.CopyFile
import Utility.RsyncFile
import Utility.Ssh
import Annex.Ssh
import Types.Remote
import qualified Git
import qualified Annex
@ -164,7 +164,7 @@ copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
copyFromRemote r key file
| not $ Git.repoIsUrl r = rsyncOrCopyFile r (gitAnnexLocation r key) file
| Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key file
| Git.repoIsHttp r = Url.download (keyUrl r key) file
| Git.repoIsHttp r = liftIO $ Url.download (keyUrl r key) file
| otherwise = error "copying from non-ssh, non-http repo not supported"
{- Tries to copy a key's content to a remote's annex. -}

View file

@ -49,7 +49,9 @@ downloadKey key file = get =<< getUrls key
get [] = do
warning "no known url"
return False
get urls = anyM (`Url.download` file) urls
get urls = do
showOutput -- make way for download progress bar
liftIO $ anyM (`Url.download` file) urls
uploadKey :: Key -> Annex Bool
uploadKey _ = do

View file

@ -12,13 +12,10 @@ module Utility.Url (
) where
import Control.Applicative
import Control.Monad.State (liftIO)
import qualified Network.Browser as Browser
import Network.HTTP
import Network.URI
import Types
import Messages
import Utility.SafeCommand
import Utility
@ -38,13 +35,12 @@ exists url =
{- Used to download large files, such as the contents of keys.
- Uses wget or curl program for its progress bar. (Wget has a better one,
- so is preferred.) -}
download :: URLString -> FilePath -> Annex Bool
download :: URLString -> FilePath -> IO Bool
download url file = do
showOutput -- make way for program's progress bar
e <- liftIO $ inPath "wget"
e <- inPath "wget"
if e
then
liftIO $ boolSystem "wget"
boolSystem "wget"
[Params "-c -O", File file, File url]
else
-- Uses the -# progress display, because the normal
@ -52,7 +48,7 @@ download url file = do
-- the remainder to download as the whole file,
-- and not indicating how much percent was
-- downloaded before the resume.
liftIO $ boolSystem "curl"
boolSystem "curl"
[Params "-L -C - -# -o", File file, File url]
{- Downloads a small file. -}