summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-08-06 14:57:22 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-08-06 14:57:22 -0400
commitdede05171bc9431778da72e5e1235c69db9fa38e (patch)
treea9bc1f6fce6e16af835b9d3ff7d647ad0d82583e
parentdd8e649f49212c46df23f329299c64e13a3c90e1 (diff)
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.
-rw-r--r--Backend.hs3
-rw-r--r--Backend/URL.hs28
-rw-r--r--Command/Add.hs21
-rw-r--r--Command/AddUrl.hs27
-rw-r--r--Command/Migrate.hs2
-rw-r--r--debian/changelog1
-rw-r--r--doc/git-annex.mdwn2
7 files changed, 65 insertions, 19 deletions
diff --git a/Backend.hs b/Backend.hs
index 6942692e8..0bb9f4b57 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -32,9 +32,10 @@ import Messages
-- When adding a new backend, import it here and add it to the list.
import qualified Backend.WORM
import qualified Backend.SHA
+import qualified Backend.URL
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. -}
orderedList :: Annex [Backend Annex]
diff --git a/Backend/URL.hs b/Backend/URL.hs
new file mode 100644
index 000000000..f20aa1f95
--- /dev/null
+++ b/Backend/URL.hs
@@ -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" }
diff --git a/Command/Add.hs b/Command/Add.hs
index 58c0143dd..d8947fb07 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -8,6 +8,7 @@
module Command.Add where
import Control.Monad.State (liftIO)
+import Control.Monad (when)
import System.Posix.Files
import System.Directory
import Control.Exception.Control (handle)
@@ -52,7 +53,7 @@ perform (file, backend) = do
Nothing -> stop
Just (key, _) -> do
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.
- This can be called before or after the symlink is in place. -}
@@ -72,18 +73,20 @@ undo file key e = do
g <- Annex.gitRepo
liftIO $ renameFile (gitAnnexLocation g key) file
-cleanup :: FilePath -> Key -> CommandCleanup
-cleanup file key = do
+cleanup :: FilePath -> Key -> Bool -> CommandCleanup
+cleanup file key hascontent = do
handle (undo file key) $ do
link <- calcGitLink file key
liftIO $ createSymbolicLink link file
- logStatus key InfoPresent
+
+ when hascontent $ do
+ logStatus key InfoPresent
- -- touch the symlink to have the same mtime as the
- -- file it points to
- s <- liftIO $ getFileStatus file
- let mtime = modificationTime s
- liftIO $ touch file (TimeSpec mtime) False
+ -- touch the symlink to have the same mtime as the
+ -- file it points to
+ s <- liftIO $ getFileStatus file
+ let mtime = modificationTime s
+ liftIO $ touch file (TimeSpec mtime) False
force <- Annex.getState Annex.force
if force
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 1b12362e9..e87de384b 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -17,10 +17,10 @@ import qualified Backend
import qualified Remote.Web
import qualified Command.Add
import qualified Annex
+import qualified Backend.URL
import Messages
import Content
import PresenceLog
-import Types.Key
import Locations
import Utility
@@ -42,9 +42,14 @@ start s = do
perform :: String -> FilePath -> CommandPerform
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
showAction $ "downloading " ++ url ++ " "
- let dummykey = stubKey { keyName = url, keyBackendName = "URL" }
+ let dummykey = Backend.URL.fromUrl url
let tmp = gitAnnexTmpLocation g dummykey
liftIO $ createDirectoryIfMissing True (parentDir tmp)
ok <- Remote.Web.download [url] tmp
@@ -57,9 +62,16 @@ perform url file = do
Just (key, _) -> do
moveAnnex key tmp
Remote.Web.setUrl key url InfoPresent
- next $ Command.Add.cleanup file key
+ next $ Command.Add.cleanup file key True
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 url = do
let parts = filter safe $ split "/" $ uriPath url
@@ -75,8 +87,7 @@ url2file url = do
e <- doesFileExist file
when e $ error "already have this url"
return file
- safe s
- | null s = False
- | s == "." = False
- | s == ".." = False
- | otherwise = True
+ safe "" = False
+ safe "." = False
+ safe ".." = False
+ safe _ = True
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index 495bf9fb6..5ae835440 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -72,7 +72,7 @@ perform file oldkey newbackend = do
then do
-- Update symlink to use the new key.
liftIO $ removeFile file
- next $ Command.Add.cleanup file newkey
+ next $ Command.Add.cleanup file newkey True
else stop
where
cleantmp t = whenM (doesFileExist t) $ removeFile t
diff --git a/debian/changelog b/debian/changelog
index 748a945d7..fcc0b58b8 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,6 +1,7 @@
git-annex (3.20110720) UNRELEASED; urgency=low
* 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
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 11f617f1b..2865c8af5 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -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.
+ To avoid immediately downloading the url, specify --fast
+
* fromkey file
This plumbing-level command can be used to manually set up a file