From 2dcce5a8bb1fcc2be5f844b782158406dc419221 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 7 Feb 2012 14:15:37 -0400 Subject: [PATCH 1/7] merged ghc 7.4 support into master --- doc/bugs/problems_with_utf8_names.mdwn | 5 ++--- doc/download.mdwn | 3 ++- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/bugs/problems_with_utf8_names.mdwn b/doc/bugs/problems_with_utf8_names.mdwn index fbdca41cd1..aeeb16be65 100644 --- a/doc/bugs/problems_with_utf8_names.mdwn +++ b/doc/bugs/problems_with_utf8_names.mdwn @@ -3,10 +3,9 @@ This bug is reopened to track some new UTF-8 filename issues caused by GHC encoding no longer works. Even unicode filenames fail to work when git-annex is built with 7.4. --[[Joey]] -I now have a `ghc7.4` branch in git that seems to solve this, +This bug is now fixed in current master. Once again, git-annex will work for all filename encodings, and all system encodings. It will -only build with the new GHC. If you have this problem, give it a try! ---[[Joey]] +only build with the new GHC. [[done]] --[[Joey]] ---- diff --git a/doc/download.mdwn b/doc/download.mdwn index bfde849f80..120e0a517d 100644 --- a/doc/download.mdwn +++ b/doc/download.mdwn @@ -28,7 +28,8 @@ The git repository has some branches: library. * `tweak-fetch` adds support for the git tweak-fetch hook, which has been proposed and implemented but not yet accepted into git. -* `ghc7.4` is for use this that version of ghc. +* `ghc7.0` supports versions of ghc older than 7.4, which + had a major change to filename encoding. * `setup` contains configuration for this website * `pristine-tar` contains [pristine-tar](http://kitenet.net/~joey/code/pristine-tar) data to create tarballs of any past git-annex release. From 995bf51e10161c26ac6b0716080d3a0a75657314 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 7 Feb 2012 16:52:39 -0400 Subject: [PATCH 2/7] correction --- debian/changelog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/debian/changelog b/debian/changelog index 30b7090bea..7165092a65 100644 --- a/debian/changelog +++ b/debian/changelog @@ -8,7 +8,7 @@ git-annex (3.20120124) UNRELEASED; urgency=low used by git-annex-shell and other places where changes are made to a remote's location log. * Modifications to support ghc 7.4's handling of filenames. - This version can only be built with ghc 7.4. + This version can only be built with ghc 7.4 or newer. -- Joey Hess Tue, 24 Jan 2012 16:21:55 -0400 From 57a747d0819d587d8f7fb301c3c6c589c80c556f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 8 Feb 2012 11:41:15 -0400 Subject: [PATCH 3/7] S3: Fix irrefutable pattern failure when accessing encrypted S3 credentials. --- Remote/S3.hs | 9 ++++++--- debian/changelog | 2 ++ 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/Remote/S3.hs b/Remote/S3.hs index 2ef96dbdaf..c9527ba67a 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -289,12 +289,15 @@ s3GetCreds c = maybe fromconfig (return . Just) =<< liftIO getenv liftIO $ decrypt s3creds cipher _ -> return Nothing decrypt s3creds cipher = do - [ak, sk, _rest] <- lines <$> + creds <- lines <$> withDecryptedContent cipher (return $ L.pack $ fromB64 s3creds) (return . L.unpack) - setenv (ak, sk) - return $ Just (ak, sk) + case creds of + [ak, sk] -> do + setenv (ak, sk) + return $ Just (ak, sk) + _ -> do error "bad s3creds" {- Stores S3 creds encrypted in the remote's config if possible. -} s3SetCreds :: RemoteConfig -> Annex RemoteConfig diff --git a/debian/changelog b/debian/changelog index 7165092a65..ad7121da24 100644 --- a/debian/changelog +++ b/debian/changelog @@ -9,6 +9,8 @@ git-annex (3.20120124) UNRELEASED; urgency=low a remote's location log. * Modifications to support ghc 7.4's handling of filenames. This version can only be built with ghc 7.4 or newer. + * S3: Fix irrefutable pattern failure when accessing encrypted S3 + credentials. -- Joey Hess Tue, 24 Jan 2012 16:21:55 -0400 From ef013506cb8c82d547160195b66572b5774db14f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 8 Feb 2012 15:35:18 -0400 Subject: [PATCH 4/7] addurl: Added a --file option Can be used to specify what file the url is added to. This can be used to override the default filename that is used when adding an url, which is based on the url. Or, when the file already exists, the url is recorded as another location of the file. --- Command/AddUrl.hs | 37 +++++++++++++++++++++++-------------- Usage.hs | 2 ++ debian/changelog | 5 +++++ doc/git-annex.mdwn | 9 +++++++-- 4 files changed, 37 insertions(+), 16 deletions(-) diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 46584f0d81..600a6169d8 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -17,26 +17,39 @@ import qualified Annex import qualified Backend.URL import Annex.Content import Logs.Web +import qualified Option def :: [Command] -def = [command "addurl" (paramRepeating paramUrl) seek "add urls to annex"] +def = [withOptions [fileOption] $ + command "addurl" (paramRepeating paramUrl) seek "add urls to annex"] + +fileOption :: Option +fileOption = Option.field [] "file" paramFile "specify what file the url is added to" seek :: [CommandSeek] -seek = [withStrings start] +seek = [withField fileOption return $ \f -> + withStrings $ start f] -start :: String -> CommandStart -start s = notBareRepo $ go $ parseURI s +start :: Maybe FilePath -> String -> CommandStart +start optfile s = notBareRepo $ go $ parseURI s where go Nothing = error $ "bad url " ++ s go (Just url) = do - file <- liftIO $ url2file url + let file = fromMaybe (url2file url) optfile 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 +perform url file = ifAnnexed file addurl geturl + where + geturl = do + whenM (liftIO $ doesFileExist file) $ + error $ "already have this url in " ++ file + fast <- Annex.getState Annex.fast + if fast then nodownload url file else download url file + addurl (key, _backend) = do + setUrlPresent key url + next $ return True download :: String -> FilePath -> CommandPerform download url file = do @@ -60,12 +73,8 @@ nodownload url file = do setUrlPresent key url next $ Command.Add.cleanup file key False -url2file :: URI -> IO FilePath -url2file url = do - whenM (doesFileExist file) $ - error $ "already have this url in " ++ file - return file +url2file :: URI -> FilePath +url2file url = escape $ uriRegName auth ++ uriPath url ++ uriQuery url where - file = escape $ uriRegName auth ++ uriPath url ++ uriQuery url escape = replace "/" "_" . replace "?" "_" auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url diff --git a/Usage.hs b/Usage.hs index 34c344b183..a33f6f311b 100644 --- a/Usage.hs +++ b/Usage.hs @@ -76,6 +76,8 @@ paramDate :: String paramDate = "DATE" paramFormat :: String paramFormat = "FORMAT" +paramFile :: String +paramFile = "FILE" paramKeyValue :: String paramKeyValue = "K=V" paramNothing :: String diff --git a/debian/changelog b/debian/changelog index ad7121da24..2f9d79939d 100644 --- a/debian/changelog +++ b/debian/changelog @@ -11,6 +11,11 @@ git-annex (3.20120124) UNRELEASED; urgency=low This version can only be built with ghc 7.4 or newer. * S3: Fix irrefutable pattern failure when accessing encrypted S3 credentials. + * addurl: Added a --file option, which can be used to specify what + file the url is added to. This can be used to override the default + filename that is used when adding an url, which is based on the url. + Or, when the file already exists, the url is recorded as another + location of the file. -- Joey Hess Tue, 24 Jan 2012 16:21:55 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 148b6336de..9232bf0208 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -145,9 +145,14 @@ subdirectories). * addurl [url ...] - Downloads each url to a file, which is added to the annex. + Downloads each url to its own file, which is added to the annex. - To avoid immediately downloading the url, specify --fast + To avoid immediately downloading the url, specify --fast. + + To specify what file the url is added to, specify --file. This changes + the behavior; now all the specified urls are recorded as alternate + locations from which the file can be downloaded. In this mode, addurl + can be used both to add new files, or to add urls to existing files. # REPOSITORY SETUP COMMANDS From ac9745465954d77d7215e4d7411a3c218203643d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 8 Feb 2012 15:49:42 -0400 Subject: [PATCH 5/7] improve error message --- Command/AddUrl.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 600a6169d8..2f157c7fdd 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -44,7 +44,7 @@ perform url file = ifAnnexed file addurl geturl where geturl = do whenM (liftIO $ doesFileExist file) $ - error $ "already have this url in " ++ file + error $ "not overwriting existing " ++ file fast <- Annex.getState Annex.fast if fast then nodownload url file else download url file addurl (key, _backend) = do From 1c0bd81ba6aa6bd081042c81fcb6dca21ece0eec Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 9 Feb 2012 14:19:58 -0400 Subject: [PATCH 6/7] addurl: Normalize badly encoded urls. --- Command/AddUrl.hs | 7 ++++--- debian/changelog | 1 + 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 2f157c7fdd..496b9f2e8b 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -31,10 +31,11 @@ seek = [withField fileOption return $ \f -> withStrings $ start f] start :: Maybe FilePath -> String -> CommandStart -start optfile s = notBareRepo $ go $ parseURI s +start optfile s = notBareRepo $ go $ fromMaybe bad $ parseURI s where - go Nothing = error $ "bad url " ++ s - go (Just url) = do + bad = fromMaybe (error $ "bad url " ++ s) $ + parseURI $ escapeURIString isUnescapedInURI s + go url = do let file = fromMaybe (url2file url) optfile showStart "addurl" file next $ perform s file diff --git a/debian/changelog b/debian/changelog index 2f9d79939d..ad1fe1945a 100644 --- a/debian/changelog +++ b/debian/changelog @@ -16,6 +16,7 @@ git-annex (3.20120124) UNRELEASED; urgency=low filename that is used when adding an url, which is based on the url. Or, when the file already exists, the url is recorded as another location of the file. + * addurl: Normalize badly encoded urls. -- Joey Hess Tue, 24 Jan 2012 16:21:55 -0400 From e4d09235446e13134e28aa4519c54ec14061d126 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 9 Feb 2012 17:35:36 -0400 Subject: [PATCH 7/7] wording --- Git/UnionMerge.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs index be8eb10d99..90bbf5c4cc 100644 --- a/Git/UnionMerge.hs +++ b/Git/UnionMerge.hs @@ -85,13 +85,14 @@ merge_trees (Ref x) (Ref y) h = calc_merge h $ "diff-tree":diff_opts ++ [x, y] {- For merging a single tree into the index. -} merge_tree_index :: Ref -> CatFileHandle -> Repo -> Streamer -merge_tree_index (Ref x) h = calc_merge h $ "diff-index":diff_opts ++ ["--cached", x] +merge_tree_index (Ref x) h = calc_merge h $ + "diff-index" : diff_opts ++ ["--cached", x] diff_opts :: [String] diff_opts = ["--raw", "-z", "-r", "--no-renames", "-l0"] {- Calculates how to perform a merge, using git to get a raw diff, - - and returning a list suitable for update_index. -} + - and generating update-index input. -} calc_merge :: CatFileHandle -> [String] -> Repo -> Streamer calc_merge ch differ repo streamer = gendiff >>= go where @@ -102,7 +103,7 @@ calc_merge ch differ repo streamer = gendiff >>= go go (_:[]) = error "calc_merge parse error" {- Given an info line from a git raw diff, and the filename, generates - - a line suitable for update_index that union merges the two sides of the + - a line suitable for update-index that union merges the two sides of the - diff. -} mergeFile :: String -> FilePath -> CatFileHandle -> Repo -> IO (Maybe String) mergeFile info file h repo = case filter (/= nullSha) [Ref asha, Ref bsha] of