blob: 981af2f7e662cbb6179437982df4cc02b569d4d7 (
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
82
83
84
85
86
87
|
{- 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 qualified Utility.Url as Url
import Annex.Content
import Logs.Web
import qualified Option
import Types.Key
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
liftIO $ createDirectoryIfMissing True (parentDir file)
fast <- Annex.getState Annex.fast
if fast then nodownload url file else download url file
addurl (key, _backend) = do
unlessM (liftIO $ Url.check url (keySize key)) $
error $ "failed to verify url: " ++ url
setUrlPresent key url
next $ return True
download :: String -> FilePath -> CommandPerform
download url file = do
showAction $ "downloading " ++ url ++ " "
let dummykey = Backend.URL.fromUrl url Nothing
tmp <- fromRepo $ gitAnnexTmpLocation dummykey
liftIO $ createDirectoryIfMissing True (parentDir tmp)
stopUnless (downloadUrl [url] tmp) $ do
backend <- Backend.chooseBackend 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
(exists, size) <- liftIO $ Url.exists url
unless exists $
error $ "unable to access url: " ++ url
let key = Backend.URL.fromUrl url size
setUrlPresent key url
next $ Command.Add.cleanup file key False
url2file :: URI -> FilePath
url2file url = take 255 $ escape $ uriRegName auth ++ uriPath url ++ uriQuery url
where
escape = replace "/" "_" . replace "?" "_"
auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url
|