blob: 1b12362e9fef48392acf6306ee497f792338b138 (
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
|
{- git-annex command
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.AddUrl where
import Control.Monad.State (liftIO, when)
import Network.URI
import Data.String.Utils
import System.Directory
import Command
import qualified Backend
import qualified Remote.Web
import qualified Command.Add
import qualified Annex
import Messages
import Content
import PresenceLog
import Types.Key
import Locations
import Utility
command :: [Command]
command = [repoCommand "addurl" paramPath seek "add urls to annex"]
seek :: [CommandSeek]
seek = [withStrings start]
start :: CommandStartString
start s = do
let u = parseURI s
case u of
Nothing -> error $ "bad url " ++ s
Just url -> do
file <- liftIO $ url2file url
showStart "addurl" file
next $ perform s file
perform :: String -> FilePath -> CommandPerform
perform url file = do
g <- Annex.gitRepo
showAction $ "downloading " ++ url ++ " "
let dummykey = stubKey { keyName = url, keyBackendName = "URL" }
let tmp = gitAnnexTmpLocation g dummykey
liftIO $ createDirectoryIfMissing True (parentDir tmp)
ok <- Remote.Web.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
Remote.Web.setUrl key url InfoPresent
next $ Command.Add.cleanup file key
else stop
url2file :: URI -> IO FilePath
url2file url = do
let parts = filter safe $ split "/" $ uriPath url
if null parts
then fallback
else do
let file = last parts
e <- doesFileExist file
if e then fallback else return file
where
fallback = do
let file = replace "/" "_" $ show url
e <- doesFileExist file
when e $ error "already have this url"
return file
safe s
| null s = False
| s == "." = False
| s == ".." = False
| otherwise = True
|
