blob: 496b9f2e8be3e9280e86c51d9f395eac8556bb87 (
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
78
79
80
81
|
{- 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
import qualified Option
def :: [Command]
def = [withOptions [fileOption] $
command "addurl" (paramRepeating paramUrl) seek "add urls to annex"]
fileOption :: Option
fileOption = Option.field [] "file" paramFile "specify what file the url is added to"
seek :: [CommandSeek]
seek = [withField fileOption return $ \f ->
withStrings $ start f]
start :: Maybe FilePath -> String -> CommandStart
start optfile s = notBareRepo $ go $ fromMaybe bad $ parseURI s
where
bad = fromMaybe (error $ "bad url " ++ s) $
parseURI $ escapeURIString isUnescapedInURI s
go url = do
let file = fromMaybe (url2file url) optfile
showStart "addurl" file
next $ perform s file
perform :: String -> FilePath -> CommandPerform
perform url file = ifAnnexed file addurl geturl
where
geturl = do
whenM (liftIO $ doesFileExist file) $
error $ "not overwriting existing " ++ file
fast <- Annex.getState Annex.fast
if fast then nodownload url file else download url file
addurl (key, _backend) = do
setUrlPresent key url
next $ return True
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 -> FilePath
url2file url = escape $ uriRegName auth ++ uriPath url ++ uriQuery url
where
escape = replace "/" "_" . replace "?" "_"
auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url
|
