blob: 713a486a5c85a90ccdb19b57c37b69c4cc4494aa (
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
|
{- 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 Messages
import Content
import PresenceLog
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
[(_, backend)] <- Backend.chooseBackends [file]
showNote $ "downloading " ++ url
ok <- Remote.Web.download file [url]
if ok
then do
stored <- Backend.storeFileKey file backend
case stored of
Nothing -> stop
Just (key, _) -> do
moveAnnex key file
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
|
