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. - Licensed under the GNU GPL version 3 or higher.
-} -}
module Utility.Ssh where module Annex.Ssh where
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)

View file

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

View file

@ -16,7 +16,7 @@ import qualified Git
import Annex.UUID import Annex.UUID
import Logs.UUID import Logs.UUID
import Logs.Trust import Logs.Trust
import Utility.Ssh import Annex.Ssh
import qualified Utility.Dot as Dot import qualified Utility.Dot as Dot
-- a link from the first repository to the second (its remote) -- 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 one to one.
- ":" is escaped to "&c", because despite it being 2011, people still care - ":" is escaped to "&c", because despite it being 2011, people still care
- about FAT. - about FAT.
- -} -}
keyFile :: Key -> FilePath keyFile :: Key -> FilePath
keyFile key = replace "/" "%" $ replace ":" "&c" $ keyFile key = replace "/" "%" $ replace ":" "&c" $
replace "%" "&s" $ replace "&" "&a" $ show key replace "%" "&s" $ replace "&" "&a" $ show key

View file

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

View file

@ -13,7 +13,7 @@ import qualified Data.Map as M
import Common.Annex import Common.Annex
import Utility.CopyFile import Utility.CopyFile
import Utility.RsyncFile import Utility.RsyncFile
import Utility.Ssh import Annex.Ssh
import Types.Remote import Types.Remote
import qualified Git import qualified Git
import qualified Annex import qualified Annex
@ -164,7 +164,7 @@ copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
copyFromRemote r key file copyFromRemote r key file
| not $ Git.repoIsUrl r = rsyncOrCopyFile r (gitAnnexLocation r key) file | not $ Git.repoIsUrl r = rsyncOrCopyFile r (gitAnnexLocation r key) file
| Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True 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" | otherwise = error "copying from non-ssh, non-http repo not supported"
{- Tries to copy a key's content to a remote's annex. -} {- 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 get [] = do
warning "no known url" warning "no known url"
return False 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 :: Key -> Annex Bool
uploadKey _ = do uploadKey _ = do

View file

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