9f1577f746
The only remaining vestiage of backends is different types of keys. These are still called "backends", mostly to avoid needing to change user interface and configuration. But everything to do with storing keys in different backends was gone; instead different types of remotes are used. In the refactoring, lots of code was moved out of odd corners like Backend.File, to closer to where it's used, like Command.Drop and Command.Fsck. Quite a lot of dead code was removed. Several data structures became simpler, which may result in better runtime efficiency. There should be no user-visible changes.
82 lines
1.9 KiB
Haskell
82 lines
1.9 KiB
Haskell
{- 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
|
|
showNote $ "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
|