blob: 459fbc623d5626afbad11315f469ffffaa614ec8 (
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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
{- 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, pathdepthOption] $
command "addurl" (paramRepeating paramUrl) seek "add urls to annex"]
fileOption :: Option
fileOption = Option.field [] "file" paramFile "specify what file the url is added to"
pathdepthOption :: Option
pathdepthOption = Option.field [] "pathdepth" paramNumber "path components to use in filename"
seek :: [CommandSeek]
seek = [withField fileOption return $ \f ->
withField pathdepthOption (return . maybe Nothing readish) $ \d ->
withStrings $ start f d]
start :: Maybe FilePath -> Maybe Int -> String -> CommandStart
start optfile pathdepth 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 pathdepth) optfile
showStart "addurl" file
next $ perform s file pathdepth
perform :: String -> FilePath -> Maybe Int -> CommandPerform
perform url file pathdepth = 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
when (pathdepth /= Nothing) $
error $ file ++ " already exists"
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
if exists
then do
let key = Backend.URL.fromUrl url size
setUrlPresent key url
next $ Command.Add.cleanup file key False
else do
warning $ "unable to access url: " ++ url
stop
url2file :: URI -> Maybe Int -> FilePath
url2file url pathdepth = case pathdepth of
Nothing -> filesize $ escape fullurl
Just depth
| depth > 0 -> frombits $ drop depth
| depth < 0 -> frombits $ reverse . take (negate depth) . reverse
| otherwise -> error "bad --pathdepth"
where
fullurl = uriRegName auth ++ uriPath url ++ uriQuery url
frombits a = join "/" $ a urlbits
urlbits = map (filesize . escape) $ filter (not . null) $ split "/" fullurl
auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url
filesize = take 255
escape = replace "/" "_" . replace "?" "_"
|
