blob: 46584f0d8112b76d9cd986080fa34db6106ea685 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
{- git-annex command
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.AddUrl where
import Network.URI
import Common.Annex
import Command
import qualified Backend
import qualified Command.Add
import qualified Annex
import qualified Backend.URL
import Annex.Content
import Logs.Web
def :: [Command]
def = [command "addurl" (paramRepeating paramUrl) seek "add urls to annex"]
seek :: [CommandSeek]
seek = [withStrings start]
start :: String -> CommandStart
start s = notBareRepo $ go $ parseURI s
where
go Nothing = error $ "bad url " ++ s
go (Just url) = do
file <- liftIO $ url2file url
showStart "addurl" file
next $ perform s file
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
showAction $ "downloading " ++ url ++ " "
let dummykey = Backend.URL.fromUrl url
tmp <- fromRepo $ gitAnnexTmpLocation dummykey
liftIO $ createDirectoryIfMissing True (parentDir tmp)
stopUnless (downloadUrl [url] tmp) $ do
[(backend, _)] <- Backend.chooseBackends [file]
k <- Backend.genKey tmp backend
case k of
Nothing -> stop
Just (key, _) -> do
moveAnnex key tmp
setUrlPresent key url
next $ Command.Add.cleanup file key True
nodownload :: String -> FilePath -> CommandPerform
nodownload url file = do
let key = Backend.URL.fromUrl url
setUrlPresent key url
next $ Command.Add.cleanup file key False
url2file :: URI -> IO FilePath
url2file url = do
whenM (doesFileExist file) $
error $ "already have this url in " ++ file
return file
where
file = escape $ uriRegName auth ++ uriPath url ++ uriQuery url
escape = replace "/" "_" . replace "?" "_"
auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url
|
