addurl: --fast can be used to avoid immediately downloading the url.

The tricky part about this is that to generate a key, the file must be
present already. Worked around by adding (back) an URL key type, which
is used for addurl --fast.
This commit is contained in:
Joey Hess 2011-08-06 14:57:22 -04:00
parent dd8e649f49
commit dede05171b
7 changed files with 65 additions and 19 deletions

View file

@ -32,9 +32,10 @@ import Messages
-- When adding a new backend, import it here and add it to the list. -- When adding a new backend, import it here and add it to the list.
import qualified Backend.WORM import qualified Backend.WORM
import qualified Backend.SHA import qualified Backend.SHA
import qualified Backend.URL
list :: [Backend Annex] list :: [Backend Annex]
list = Backend.WORM.backends ++ Backend.SHA.backends list = Backend.WORM.backends ++ Backend.SHA.backends ++ Backend.URL.backends
{- List of backends in the order to try them when storing a new key. -} {- List of backends in the order to try them when storing a new key. -}
orderedList :: Annex [Backend Annex] orderedList :: Annex [Backend Annex]

28
Backend/URL.hs Normal file
View file

@ -0,0 +1,28 @@
{- git-annex "URL" backend -- keys whose content is available from urls.
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Backend.URL (
backends,
fromUrl
) where
import Types.Backend
import Types.Key
import Types
backends :: [Backend Annex]
backends = [backend]
backend :: Backend Annex
backend = Types.Backend.Backend {
name = "URL",
getKey = const (return Nothing),
fsckKey = const (return True)
}
fromUrl :: String -> Key
fromUrl url = stubKey { keyName = url, keyBackendName = "URL" }

View file

@ -8,6 +8,7 @@
module Command.Add where module Command.Add where
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import Control.Monad (when)
import System.Posix.Files import System.Posix.Files
import System.Directory import System.Directory
import Control.Exception.Control (handle) import Control.Exception.Control (handle)
@ -52,7 +53,7 @@ perform (file, backend) = do
Nothing -> stop Nothing -> stop
Just (key, _) -> do Just (key, _) -> do
handle (undo file key) $ moveAnnex key file handle (undo file key) $ moveAnnex key file
next $ cleanup file key next $ cleanup file key True
{- On error, put the file back so it doesn't seem to have vanished. {- On error, put the file back so it doesn't seem to have vanished.
- This can be called before or after the symlink is in place. -} - This can be called before or after the symlink is in place. -}
@ -72,11 +73,13 @@ undo file key e = do
g <- Annex.gitRepo g <- Annex.gitRepo
liftIO $ renameFile (gitAnnexLocation g key) file liftIO $ renameFile (gitAnnexLocation g key) file
cleanup :: FilePath -> Key -> CommandCleanup cleanup :: FilePath -> Key -> Bool -> CommandCleanup
cleanup file key = do cleanup file key hascontent = do
handle (undo file key) $ do handle (undo file key) $ do
link <- calcGitLink file key link <- calcGitLink file key
liftIO $ createSymbolicLink link file liftIO $ createSymbolicLink link file
when hascontent $ do
logStatus key InfoPresent logStatus key InfoPresent
-- touch the symlink to have the same mtime as the -- touch the symlink to have the same mtime as the

View file

@ -17,10 +17,10 @@ import qualified Backend
import qualified Remote.Web import qualified Remote.Web
import qualified Command.Add import qualified Command.Add
import qualified Annex import qualified Annex
import qualified Backend.URL
import Messages import Messages
import Content import Content
import PresenceLog import PresenceLog
import Types.Key
import Locations import Locations
import Utility import Utility
@ -42,9 +42,14 @@ start s = do
perform :: String -> FilePath -> CommandPerform perform :: String -> FilePath -> CommandPerform
perform url file = do perform url file = do
fast <- Annex.getState Annex.fast
if fast then nodownload url file else download url file
download :: String -> FilePath -> CommandPerform
download url file = do
g <- Annex.gitRepo g <- Annex.gitRepo
showAction $ "downloading " ++ url ++ " " showAction $ "downloading " ++ url ++ " "
let dummykey = stubKey { keyName = url, keyBackendName = "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 <- Remote.Web.download [url] tmp ok <- Remote.Web.download [url] tmp
@ -57,9 +62,16 @@ perform url file = do
Just (key, _) -> do Just (key, _) -> do
moveAnnex key tmp moveAnnex key tmp
Remote.Web.setUrl key url InfoPresent Remote.Web.setUrl key url InfoPresent
next $ Command.Add.cleanup file key next $ Command.Add.cleanup file key True
else stop else stop
nodownload :: String -> FilePath -> CommandPerform
nodownload url file = do
let key = Backend.URL.fromUrl url
Remote.Web.setUrl key url InfoPresent
next $ Command.Add.cleanup file key False
url2file :: URI -> IO FilePath url2file :: URI -> IO FilePath
url2file url = do url2file url = do
let parts = filter safe $ split "/" $ uriPath url let parts = filter safe $ split "/" $ uriPath url
@ -75,8 +87,7 @@ url2file url = do
e <- doesFileExist file e <- doesFileExist file
when e $ error "already have this url" when e $ error "already have this url"
return file return file
safe s safe "" = False
| null s = False safe "." = False
| s == "." = False safe ".." = False
| s == ".." = False safe _ = True
| otherwise = True

View file

@ -72,7 +72,7 @@ perform file oldkey newbackend = do
then do then do
-- Update symlink to use the new key. -- Update symlink to use the new key.
liftIO $ removeFile file liftIO $ removeFile file
next $ Command.Add.cleanup file newkey next $ Command.Add.cleanup file newkey True
else stop else stop
where where
cleantmp t = whenM (doesFileExist t) $ removeFile t cleantmp t = whenM (doesFileExist t) $ removeFile t

1
debian/changelog vendored
View file

@ -1,6 +1,7 @@
git-annex (3.20110720) UNRELEASED; urgency=low git-annex (3.20110720) UNRELEASED; urgency=low
* Fix shell escaping in rsync special remote. * Fix shell escaping in rsync special remote.
* addurl: --fast can be used to avoid immediately downloading the url.
-- Joey Hess <joeyh@debian.org> Fri, 29 Jul 2011 15:27:30 +0200 -- Joey Hess <joeyh@debian.org> Fri, 29 Jul 2011 15:27:30 +0200

View file

@ -282,6 +282,8 @@ Many git-annex commands will stage changes for later `git commit` by you.
Downloads each url to a file, which is added to the annex. Downloads each url to a file, which is added to the annex.
To avoid immediately downloading the url, specify --fast
* fromkey file * fromkey file
This plumbing-level command can be used to manually set up a file This plumbing-level command can be used to manually set up a file