if keys database cannot be opened due to permissions, ignore

This lets readonly repos be used. If a repo is readonly, we can ignore the
keys database, because nothing that we can do will change the state of the
repo anyway.

5 files changed, 33 insertions, 7 deletions

diff --git a/Database/Keys.hs b/Database/Keys.hs
index fe796e206..f3d349dc0 100644
--- a/Database/Keys.hs
+++ b/Database/Keys.hs
@@ -56,7 +56,7 @@ runReader a = do
 	h <- getDbHandle
 	withDbState h go
   where
-	go DbEmpty = return (mempty, DbEmpty)
+	go DbUnavailable = return (mempty, DbUnavailable)
 	go st@(DbOpen qh) = do
 		liftIO $ H.flushDbQueue qh
 		v <- a (SQL.ReadHandle qh)
@@ -114,8 +114,8 @@ getDbHandle = go =<< Annex.getState Annex.keysdbhandle
  -}
 openDb :: Bool -> DbState -> Annex DbState
 openDb _ st@(DbOpen _) = return st
-openDb False DbEmpty = return DbEmpty
-openDb createdb _ = withExclusiveLock gitAnnexKeysDbLock $ do
+openDb False DbUnavailable = return DbUnavailable
+openDb createdb _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKeysDbLock $ do
 	dbdir <- fromRepo gitAnnexKeysDb
 	let db = dbdir </> "db"
 	dbexists <- liftIO $ doesFileExist db
@@ -128,9 +128,14 @@ openDb createdb _ = withExclusiveLock gitAnnexKeysDbLock $ do
 			setAnnexDirPerm dbdir
 			setAnnexFilePerm db
 			open db
-		(False, False) -> return DbEmpty
+		(False, False) -> return DbUnavailable
   where
 	open db = liftIO $ DbOpen <$> H.openDbQueue db SQL.containedTable
+	-- If permissions don't allow opening the database, treat it as if
+	-- it does not exist.
+	permerr e = case createdb of
+		False -> return DbUnavailable
+		True -> throwM e
 
 addAssociatedFile :: Key -> TopFilePath -> Annex ()
 addAssociatedFile k f = runWriterIO $ SQL.addAssociatedFile (toIKey k) f
diff --git a/Database/Keys/Handle.hs b/Database/Keys/Handle.hs
index 8a3f2b407..51de58fa8 100644
--- a/Database/Keys/Handle.hs
+++ b/Database/Keys/Handle.hs
@@ -26,8 +26,8 @@ import Prelude
 newtype DbHandle = DbHandle (MVar DbState)
 
 -- The database can be closed or open, but it also may have been
--- tried to open (for read) and didn't exist yet.
-data DbState = DbClosed | DbOpen H.DbQueue | DbEmpty
+-- tried to open (for read) and didn't exist yet or is not readable.
+data DbState = DbClosed | DbOpen H.DbQueue | DbUnavailable
 
 newDbHandle :: IO DbHandle
 newDbHandle = DbHandle <$> newMVar DbClosed
diff --git a/Utility/Exception.hs b/Utility/Exception.hs
index 8b110ae6d..e691f13b6 100644
--- a/Utility/Exception.hs
+++ b/Utility/Exception.hs
@@ -21,7 +21,8 @@ module Utility.Exception (
 	tryNonAsync,
 	tryWhenExists,
 	catchIOErrorType,
-	IOErrorType(..)
+	IOErrorType(..),
+	catchPermissionDenied,
 ) where
 
 import Control.Monad.Catch as X hiding (Handler)
@@ -97,3 +98,6 @@ catchIOErrorType errtype onmatchingerr a = catchIO a onlymatching
 	onlymatching e
 		| ioeGetErrorType e == errtype = onmatchingerr e
 		| otherwise = throwM e
+
+catchPermissionDenied :: MonadCatch m => (IOException -> m a) -> m a -> m a
+catchPermissionDenied = catchIOErrorType PermissionDenied
diff --git a/debian/changelog b/debian/changelog
index ef03b41ad..88732b611 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+git-annex (6.20160212) UNRELEASED; urgency=medium
+
+  * Support getting files from read-only repositories.
+
+ -- Joey Hess <id@joeyh.name>  Fri, 12 Feb 2016 14:03:46 -0400
+
 git-annex (6.20160211) unstable; urgency=medium
 
   * annex.addsmallfiles: New option controlling what is done when
diff --git a/doc/todo/read-only_removable_drives/comment_8_a802e0617c9ef72eb8d3842de99e44ae._comment b/doc/todo/read-only_removable_drives/comment_8_a802e0617c9ef72eb8d3842de99e44ae._comment
new file mode 100644
index 000000000..f19865889
--- /dev/null
+++ b/doc/todo/read-only_removable_drives/comment_8_a802e0617c9ef72eb8d3842de99e44ae._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 8"""
+ date="2016-02-12T18:08:18Z"
+ content="""
+I've made some changes today, which let files be downloaded from readonly
+repositories (both on local drives and remote, as long as git-annex-shell
+is updated to a version with the changes).
+
+The issues with the webapp probably remain.
+"""]]