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

@ -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

View file

@ -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

View file

@ -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