diff options
| -rw-r--r-- | Backend.hs | 3 | ||||
| -rw-r--r-- | Backend/URL.hs | 28 | ||||
| -rw-r--r-- | Command/Add.hs | 21 | ||||
| -rw-r--r-- | Command/AddUrl.hs | 27 | ||||
| -rw-r--r-- | Command/Migrate.hs | 2 | ||||
| -rw-r--r-- | debian/changelog | 1 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 2 |
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 |