diff options
| -rw-r--r-- | Backend/URL.hs | 4 | ||||
| -rw-r--r-- | Command/AddUrl.hs | 8 | ||||
| -rw-r--r-- | Command/FromKey.hs | 16 | ||||
| -rw-r--r-- | Command/ImportFeed.hs | 2 | ||||
| -rw-r--r-- | Command/RegisterUrl.hs | 6 | ||||
| -rw-r--r-- | Remote/BitTorrent.hs | 2 | ||||
| -rw-r--r-- | debian/changelog | 7 | ||||
| -rw-r--r-- | doc/git-annex-fromkey.mdwn | 6 | ||||
| -rw-r--r-- | doc/git-annex-registerurl.mdwn | 4 |
9 files changed, 41 insertions, 14 deletions
diff --git a/Backend/URL.hs b/Backend/URL.hs index 8ec270e95..77397bdde 100644 --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -31,8 +31,8 @@ backend = Backend } {- Every unique url has a corresponding key. -} -fromUrl :: String -> Maybe Integer -> Annex Key -fromUrl url size = return $ stubKey +fromUrl :: String -> Maybe Integer -> Key +fromUrl url size = stubKey { keyName = genKeyName url , keyBackendName = "URL" , keySize = size diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 96a966e8d..0de4da78f 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -115,7 +115,7 @@ performRemote r relaxed uri file sz = ifAnnexed file adduri geturi downloadRemoteFile :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key) downloadRemoteFile r relaxed uri file sz = do - urlkey <- Backend.URL.fromUrl uri sz + let urlkey = Backend.URL.fromUrl uri sz liftIO $ createDirectoryIfMissing True (parentDir file) ifM (Annex.getState Annex.fast <||> pure relaxed) ( do @@ -206,7 +206,7 @@ performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl #ifdef WITH_QUVI addUrlFileQuvi :: Bool -> URLString -> URLString -> FilePath -> Annex (Maybe Key) addUrlFileQuvi relaxed quviurl videourl file = do - key <- Backend.URL.fromUrl quviurl Nothing + let key = Backend.URL.fromUrl quviurl Nothing ifM (pure relaxed <||> Annex.getState Annex.fast) ( do cleanup webUUID quviurl file key Nothing @@ -264,7 +264,7 @@ addUrlFile relaxed url urlinfo file = do downloadWeb :: URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key) downloadWeb url urlinfo file = do - dummykey <- addSizeUrlKey urlinfo <$> Backend.URL.fromUrl url Nothing + let dummykey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing let downloader f _ = do showOutput downloadUrl [url] f @@ -321,7 +321,7 @@ cleanup u url file key mtmp = do nodownload :: URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key) nodownload url urlinfo file | Url.urlExists urlinfo = do - key <- Backend.URL.fromUrl url (Url.urlSize urlinfo) + let key = Backend.URL.fromUrl url (Url.urlSize urlinfo) cleanup webUUID url file key Nothing return (Just key) | otherwise = do diff --git a/Command/FromKey.hs b/Command/FromKey.hs index ebc0e6f6e..584d913fc 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess <id@joeyh.name> + - Copyright 2010, 2015 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -15,6 +15,9 @@ import qualified Annex.Queue import Annex.Content import Types.Key import qualified Annex +import qualified Backend.URL + +import Network.URI cmd :: [Command] cmd = [notDirect $ notBareRepo $ @@ -28,7 +31,7 @@ seek ps = do start :: Bool -> [String] -> CommandStart start force (keyname:file:[]) = do - let key = fromMaybe (error "bad key") $ file2key keyname + let key = mkKey keyname unless force $ do inbackend <- inAnnex key unless inbackend $ error $ @@ -45,12 +48,19 @@ massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents where go status [] = next $ return status go status ((keyname,f):rest) | not (null keyname) && not (null f) = do - let key = fromMaybe (error $ "bad key " ++ keyname) $ file2key keyname + let key = mkKey keyname ok <- perform' key f let !status' = status && ok go status' rest go _ _ = error "Expected pairs of key and file on stdin, but got something else." +mkKey :: String -> Key +mkKey s = case file2key s of + Just k -> k + Nothing -> case parseURI s of + Just _u -> Backend.URL.fromUrl s Nothing + Nothing -> error $ "bad key " ++ s + perform :: Key -> FilePath -> CommandPerform perform key file = do ok <- perform' key file diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 6d3a1765b..4bc3f52f4 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -370,4 +370,4 @@ clearFeedProblem :: URLString -> Annex () clearFeedProblem url = void $ liftIO . tryIO . removeFile =<< feedState url feedState :: URLString -> Annex FilePath -feedState url = fromRepo . gitAnnexFeedState =<< fromUrl url Nothing +feedState url = fromRepo $ gitAnnexFeedState $ fromUrl url Nothing diff --git a/Command/RegisterUrl.hs b/Command/RegisterUrl.hs index d0e806597..4282db58a 100644 --- a/Command/RegisterUrl.hs +++ b/Command/RegisterUrl.hs @@ -11,9 +11,9 @@ module Command.RegisterUrl where import Common.Annex import Command -import Types.Key import Logs.Web import Annex.UUID +import Command.FromKey (mkKey) cmd :: [Command] cmd = [notDirect $ notBareRepo $ @@ -25,7 +25,7 @@ seek = withWords start start :: [String] -> CommandStart start (keyname:url:[]) = do - let key = fromMaybe (error "bad key") $ file2key keyname + let key = mkKey keyname showStart "registerurl" url next $ perform key url start [] = do @@ -38,7 +38,7 @@ massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents where go status [] = next $ return status go status ((keyname,u):rest) | not (null keyname) && not (null u) = do - let key = fromMaybe (error $ "bad key " ++ keyname) $ file2key keyname + let key = mkKey keyname ok <- perform' key u let !status' = status && ok go status' rest diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs index 05326e390..a4ec11bf1 100644 --- a/Remote/BitTorrent.hs +++ b/Remote/BitTorrent.hs @@ -155,7 +155,7 @@ torrentUrlNum u {- A Key corresponding to the URL of a torrent file. -} torrentUrlKey :: URLString -> Annex Key -torrentUrlKey u = fromUrl (fst $ torrentUrlNum u) Nothing +torrentUrlKey u = return $ fromUrl (fst $ torrentUrlNum u) Nothing {- Temporary directory used to download a torrent. -} tmpTorrentDir :: URLString -> Annex FilePath diff --git a/debian/changelog b/debian/changelog index 58525853e..e899df2ff 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +git-annex (5.20150523) UNRELEASED; urgency=medium + + * fromkey, registerurl: Allow urls to be specified instead of keys, + and generate URL keys. + + -- Joey Hess <id@joeyh.name> Fri, 22 May 2015 22:23:32 -0400 + git-annex (5.20150522) unstable; urgency=medium * import: Refuse to import files that are within the work tree, as that diff --git a/doc/git-annex-fromkey.mdwn b/doc/git-annex-fromkey.mdwn index 1126e823e..461f42eb6 100644 --- a/doc/git-annex-fromkey.mdwn +++ b/doc/git-annex-fromkey.mdwn @@ -15,6 +15,12 @@ If the key and file are not specified on the command line, they are instead read from stdin. Any number of lines can be provided in this mode, each containing a key and filename, separated by a single space. +Normally the key is a git-annex formatted key. However, to make it easier +to use this to add urls, if the key cannot be parsed as a key, and is a +valid url, an URL key is constructed from the url. Note that this does not +register the url as a location of the key; use [[git-annex-registerurl]](1) +to do that. + # OPTIONS * `--force` diff --git a/doc/git-annex-registerurl.mdwn b/doc/git-annex-registerurl.mdwn index 961fcbba2..05328abbb 100644 --- a/doc/git-annex-registerurl.mdwn +++ b/doc/git-annex-registerurl.mdwn @@ -17,6 +17,10 @@ If the key and url are not specified on the command line, they are instead read from stdin. Any number of lines can be provided in this mode, each containing a key and url, separated by a single space. +Normally the key is a git-annex formatted key. However, to make it easier +to use this to add urls, if the key cannot be parsed as a key, and is a +valid url, an URL key is constructed from the url. + # SEE ALSO [[git-annex]](1) |