From 280b59024768689feed03db4e7069e12f9605825 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 22 May 2015 22:41:36 -0400 Subject: fromkey, registerurl: Allow urls to be specified instead of keys, and generate URL keys. This is especially useful because the caller doesn't need to generate valid url keys, which involves some escaping of characters, and may involve taking a md5sum of the url if it's too long. --- Backend/URL.hs | 4 ++-- Command/AddUrl.hs | 8 ++++---- Command/FromKey.hs | 16 +++++++++++++--- Command/ImportFeed.hs | 2 +- Command/RegisterUrl.hs | 6 +++--- Remote/BitTorrent.hs | 2 +- debian/changelog | 7 +++++++ doc/git-annex-fromkey.mdwn | 6 ++++++ 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 + - Copyright 2010, 2015 Joey Hess - - 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 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) -- cgit v1.2.3