blob: add71c820970e5c4fd3b7c0208876636d0d7bdfc (
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
|
{- 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.Helper.Url
import qualified Remote.Web
import qualified Command.Add
import qualified Annex
import qualified Backend.URL
import Messages
import Content
import PresenceLog
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
fast <- Annex.getState Annex.fast
if fast then nodownload url file else download url file
download :: String -> FilePath -> CommandPerform
download url file = do
g <- Annex.gitRepo
showAction $ "downloading " ++ url ++ " "
let dummykey = Backend.URL.fromUrl url
let tmp = gitAnnexTmpLocation g dummykey
liftIO $ createDirectoryIfMissing True (parentDir tmp)
ok <- Remote.Helper.Url.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 True
else stop
nodownload :: String -> FilePath -> CommandPerform
nodownload url file = do
let key = Backend.URL.fromUrl url
Remote.Web.setUrl key url InfoPresent
next $ Command.Add.cleanup file key False
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 "" = False
safe "." = False
safe ".." = False
safe _ = True
|
