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:
parent
dd8e649f49
commit
dede05171b
7 changed files with 65 additions and 19 deletions
|
@ -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
28
Backend/URL.hs
Normal 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" }
|
|
@ -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
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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
1
debian/changelog
vendored
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue