blob: b717e271d1bcbeb1443e372655995bbfc0eddce4 (
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
72
73
74
75
76
77
|
{- 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 Utility.Url as Url
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
g <- gitRepo
showAction $ "downloading " ++ url ++ " "
let dummykey = Backend.URL.fromUrl url
let tmp = gitAnnexTmpLocation g dummykey
liftIO $ createDirectoryIfMissing True (parentDir tmp)
ok <- liftIO $ Url.download url tmp
if ok
then 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
else stop
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
liftIO $ print file
return file
where
file = escape $ uriRegName auth ++ uriPath url ++ uriQuery url
escape = replace "/" "_" . replace "?" "_"
auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url
|
