From 97db2f945a4d1874e711defc3a855bb9ecada6c3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 3 Feb 2012 16:57:07 -0400 Subject: [PATCH 1/7] exception update in test too --- test.hs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/test.hs b/test.hs index 7b25917a11..245dd6706a 100644 --- a/test.hs +++ b/test.hs @@ -11,10 +11,8 @@ import Test.QuickCheck import System.Posix.Directory (changeWorkingDirectory) import System.Posix.Files -import Control.Exception (bracket_, bracket, throw) -import System.IO.Error import System.Posix.Env -import qualified Control.Exception.Extensible as E +import Control.Exception.Extensible import qualified Data.Map as M import System.IO.HVFS (SystemFS(..)) import Text.JSON @@ -695,7 +693,7 @@ test_crypto = "git-annex crypto" ~: intmpclonerepo $ when Build.SysConfig.gpg $ git_annex :: String -> [String] -> IO Bool git_annex command params = do -- catch all errors, including normally fatal errors - r <- E.try (run)::IO (Either E.SomeException ()) + r <- try (run)::IO (Either SomeException ()) case r of Right _ -> return True Left _ -> return False @@ -761,7 +759,7 @@ indir dir a = do -- any type of error and change back to cwd before -- rethrowing. r <- bracket_ (changeToTmpDir dir) (changeWorkingDirectory cwd) - (E.try (a)::IO (Either E.SomeException ())) + (try (a)::IO (Either SomeException ())) case r of Right () -> return () Left e -> throw e @@ -832,14 +830,14 @@ checkunwritable f = do checkwritable :: FilePath -> Assertion checkwritable f = do - r <- try $ writeFile f $ content f + r <- tryIO $ writeFile f $ content f case r of Left _ -> assertFailure $ "unable to modify " ++ f Right _ -> return () checkdangling :: FilePath -> Assertion checkdangling f = do - r <- try $ readFile f + r <- tryIO $ readFile f case r of Left _ -> return () -- expected; dangling link Right _ -> assertFailure $ f ++ " was not a dangling link as expected" From 2385fe3c4cd1a2c33cc27c4e24b6325d5917c1f6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 4 Feb 2012 01:59:53 -0400 Subject: [PATCH 2/7] add news item --- doc/news/Presentation_at_FOSDEM.mdwn | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 doc/news/Presentation_at_FOSDEM.mdwn diff --git a/doc/news/Presentation_at_FOSDEM.mdwn b/doc/news/Presentation_at_FOSDEM.mdwn new file mode 100644 index 0000000000..48daf2678d --- /dev/null +++ b/doc/news/Presentation_at_FOSDEM.mdwn @@ -0,0 +1,4 @@ +git-annex will be briefly presented at FOSDEM, on Sunday February 4th at 15:40. +[Details](http://fosdem.org/2012/schedule/event/gitannex). + +Thanks to Richard Hartmann for making this presentation. From e066fa3884b7085278636b7fe042c84c4b6eeafa Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 6 Feb 2012 14:19:44 -0400 Subject: [PATCH 3/7] use "known" instead of "visible" I think it's clearer, also it's the same length as "local" :) --- Command/Status.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Command/Status.hs b/Command/Status.hs index a1d4eea087..5facaab9be 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -66,8 +66,8 @@ slow_stats = , bad_data_size , local_annex_keys , local_annex_size - , visible_annex_keys - , visible_annex_size + , known_annex_keys + , known_annex_size , backend_usage ] @@ -128,12 +128,12 @@ local_annex_keys :: Stat local_annex_keys = stat "local annex keys" $ json show $ S.size <$> cachedKeysPresent -visible_annex_size :: Stat -visible_annex_size = stat "visible annex size" $ json id $ +known_annex_size :: Stat +known_annex_size = stat "known annex size" $ json id $ keySizeSum <$> cachedKeysReferenced -visible_annex_keys :: Stat -visible_annex_keys = stat "visible annex keys" $ json show $ +known_annex_keys :: Stat +known_annex_keys = stat "known annex keys" $ json show $ S.size <$> cachedKeysReferenced tmp_size :: Stat From 5e59440533eb36074d4cc6500b4f51e7722af9a0 Mon Sep 17 00:00:00 2001 From: "http://jefferai.org/" Date: Tue, 7 Feb 2012 00:18:24 +0000 Subject: [PATCH 4/7] --- doc/bugs/show_version_without_having_to_be_in_a_git_repo.mdwn | 1 + 1 file changed, 1 insertion(+) create mode 100644 doc/bugs/show_version_without_having_to_be_in_a_git_repo.mdwn diff --git a/doc/bugs/show_version_without_having_to_be_in_a_git_repo.mdwn b/doc/bugs/show_version_without_having_to_be_in_a_git_repo.mdwn new file mode 100644 index 0000000000..8dc075474e --- /dev/null +++ b/doc/bugs/show_version_without_having_to_be_in_a_git_repo.mdwn @@ -0,0 +1 @@ +It'd be nice to be able to run "git annex version" -- and maybe some other commands, like "git annex" itself for the help text, without having to be inside a git repo. Right now it requires you to be in a git repo even if it's not a git-annex repo. From e2bcf1717e4cf7f49dba82b27fc99ea70dc6a885 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 6 Feb 2012 20:34:07 -0400 Subject: [PATCH 5/7] already done --- ...w_version_without_having_to_be_in_a_git_repo.mdwn | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/doc/bugs/show_version_without_having_to_be_in_a_git_repo.mdwn b/doc/bugs/show_version_without_having_to_be_in_a_git_repo.mdwn index 8dc075474e..98b9ced228 100644 --- a/doc/bugs/show_version_without_having_to_be_in_a_git_repo.mdwn +++ b/doc/bugs/show_version_without_having_to_be_in_a_git_repo.mdwn @@ -1 +1,11 @@ -It'd be nice to be able to run "git annex version" -- and maybe some other commands, like "git annex" itself for the help text, without having to be inside a git repo. Right now it requires you to be in a git repo even if it's not a git-annex repo. +It'd be nice to be able to run "git annex version" -- and maybe some other +commands, like "git annex" itself for the help text, without having to be +inside a git repo. Right now it requires you to be in a git repo even if +it's not a git-annex repo. + +> You need a newer verison of git-annex. --[[Joey]] + + joey@gnu:/>git annex version + git-annex version: 3.20120124 + +[[done]] From 0ad5d8168f59561827dfe42020ef952d6e0cd309 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 6 Feb 2012 21:37:44 -0400 Subject: [PATCH 6/7] add a bug template --- doc/bugs.mdwn | 2 ++ doc/templates/bugtemplate.mdwn | 12 ++++++++++++ 2 files changed, 14 insertions(+) create mode 100644 doc/templates/bugtemplate.mdwn diff --git a/doc/bugs.mdwn b/doc/bugs.mdwn index 2786e5bf74..b0837eb10b 100644 --- a/doc/bugs.mdwn +++ b/doc/bugs.mdwn @@ -2,3 +2,5 @@ This is git-annex's bug list. Link bugs to [[bugs/done]] when done. [[!inline pages="./bugs/* and !./bugs/done and !link(done) and !*/Discussion" actions=yes postform=yes show=0 archive=yes]] + +[[!edittemplate template=templates/bugtemplate match="bugs/*" silent=yes]] diff --git a/doc/templates/bugtemplate.mdwn b/doc/templates/bugtemplate.mdwn new file mode 100644 index 0000000000..2d35c8f6fb --- /dev/null +++ b/doc/templates/bugtemplate.mdwn @@ -0,0 +1,12 @@ +What steps will reproduce the problem? + + +What is the expected output? What do you see instead? + + +What version of git-annex are you using? On what operating system? + + +Please provide any additional information below. + + From b9b72d22a9036fddbb34f70b85136f00cfe94b10 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 7 Feb 2012 01:40:14 -0400 Subject: [PATCH 7/7] refactor Wow, triple monadic lift! --- Remote/S3.hs | 37 ++++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/Remote/S3.hs b/Remote/S3.hs index 1d23b7d6f0..2ef96dbdaf 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -272,26 +272,29 @@ s3Connection c = do {- S3 creds come from the environment if set. - Otherwise, might be stored encrypted in the remote's config. -} s3GetCreds :: RemoteConfig -> Annex (Maybe (String, String)) -s3GetCreds c = do - ak <- getEnvKey s3AccessKey - sk <- getEnvKey s3SecretKey - if null ak || null sk - then do +s3GetCreds c = maybe fromconfig (return . Just) =<< liftIO getenv + where + getenv = liftM2 (,) + <$> get s3AccessKey + <*> get s3SecretKey + where + get = catchMaybeIO . getEnv + setenv (ak, sk) = do + setEnv s3AccessKey ak True + setEnv s3SecretKey sk True + fromconfig = do mcipher <- remoteCipher c case (M.lookup "s3creds" c, mcipher) of - (Just encrypted, Just cipher) -> do - s <- liftIO $ withDecryptedContent cipher - (return $ L.pack $ fromB64 encrypted) - (return . L.unpack) - let [ak', sk', _rest] = lines s - liftIO $ do - setEnv s3AccessKey ak True - setEnv s3SecretKey sk True - return $ Just (ak', sk') + (Just s3creds, Just cipher) -> + liftIO $ decrypt s3creds cipher _ -> return Nothing - else return $ Just (ak, sk) - where - getEnvKey s = liftIO $ catchDefaultIO (getEnv s) "" + decrypt s3creds cipher = do + [ak, sk, _rest] <- lines <$> + withDecryptedContent cipher + (return $ L.pack $ fromB64 s3creds) + (return . L.unpack) + setenv (ak, sk) + return $ Just (ak, sk) {- Stores S3 creds encrypted in the remote's config if possible. -} s3SetCreds :: RemoteConfig -> Annex RemoteConfig