Work around sqlite's incorrect handling of umask when creating databases.

Refactored some common code into initDb.

This only deals with the problem when creating new databases. If a repo
got bad permissions into it, it's up to the user to deal with it.

This commit was sponsored by Ole-Morten Duesund on Patreon.

Database/Fsck.hs

@@ -22,11 +22,10 @@ module Database.Fsck (
 
 import Database.Types
 import qualified Database.Queue as H
+import Database.Init
 import Annex.Locations
-import Utility.PosixFiles
 import Utility.Exception
 import Annex.Common
-import Annex.Perms
 import Annex.LockFile
 
 import Database.Persist.TH
@@ -61,17 +60,8 @@ openDb u = do
 	dbdir <- fromRepo (gitAnnexFsckDbDir u)
 	let db = dbdir </> "db"
 	unlessM (liftIO $ doesFileExist db) $ do
-		let tmpdbdir = dbdir ++ ".tmp"
-		let tmpdb = tmpdbdir </> "db"
-		liftIO $ do
-			createDirectoryIfMissing True tmpdbdir
-			H.initDb tmpdb $ void $
-				runMigrationSilent migrateFsck
-		setAnnexDirPerm tmpdbdir
-		setAnnexFilePerm tmpdb
-		liftIO $ do
-			void $ tryIO $ removeDirectoryRecursive dbdir
-			rename tmpdbdir dbdir
+		initDb db $ void $
+			runMigrationSilent migrateFsck
 	lockFileCached =<< fromRepo (gitAnnexFsckDbLock u)
 	h <- liftIO $ H.openDbQueue db "fscked"
 	return $ FsckHandle h u

Database/Handle.hs

@@ -9,7 +9,6 @@
 
 module Database.Handle (
 	DbHandle,
-	initDb,
 	openDb,
 	TableName,
 	queryDb,
@@ -38,26 +37,6 @@ import System.IO
  - the database. It has a MVar which Jobs are submitted to. -}
 data DbHandle = DbHandle (Async ()) (MVar Job)
 
-{- Ensures that the database is initialized. Pass the migration action for
- - the database.
- -
- - The database is initialized using WAL mode, to prevent readers
- - from blocking writers, and prevent a writer from blocking readers.
- -}
-initDb :: FilePath -> SqlPersistM () -> IO ()
-initDb f migration = do
-	let db = T.pack f
-	enableWAL db
-	runSqlite db migration
-
-enableWAL :: T.Text -> IO ()
-enableWAL db = do
-	conn <- Sqlite.open db
-	stmt <- Sqlite.prepare conn (T.pack "PRAGMA journal_mode=WAL;")
-	void $ Sqlite.step stmt
-	void $ Sqlite.finalize stmt
-	Sqlite.close conn
-
 {- Name of a table that should exist once the database is initialized. -}
 type TableName = String
 

Database/Init.hs

@@ -0,0 +1,55 @@
+{- Persistent sqlite database initialization
+ -
+ - Copyright 2015-2017 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Database.Init where
+
+import Annex.Common
+import Annex.Perms
+import Utility.FileMode
+
+import Database.Persist.Sqlite
+import qualified Database.Sqlite as Sqlite
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Text as T
+
+{- Ensures that the database is freshly initialized. Deletes any
+ - existing database. Pass the migration action for the database.
+ -
+ - The database is initialized using WAL mode, to prevent readers
+ - from blocking writers, and prevent a writer from blocking readers.
+ -
+ - The permissions of the database are set based on the
+ - core.sharedRepository setting. Setting these permissions on the main db
+ - file causes Sqlite to always use the same permissions for additional
+ - files it writes later on
+ -}
+initDb :: FilePath -> SqlPersistM () -> Annex ()
+initDb db migration = do
+	let dbdir = takeDirectory db
+	let tmpdbdir = dbdir ++ ".tmp"
+	let tmpdb = tmpdbdir </> "db"
+	liftIO $ do
+		createDirectoryIfMissing True tmpdbdir
+		let tdb = T.pack tmpdb
+		enableWAL tdb
+		runSqlite tdb migration
+	setAnnexDirPerm tmpdbdir
+	-- Work around sqlite bug that prevents it from honoring
+	-- less restrictive umasks.
+	liftIO $ setFileMode tmpdb =<< defaultFileMode
+	setAnnexFilePerm tmpdb
+	liftIO $ do
+		void $ tryIO $ removeDirectoryRecursive dbdir
+		rename tmpdbdir dbdir
+
+enableWAL :: T.Text -> IO ()
+enableWAL db = do
+	conn <- Sqlite.open db
+	stmt <- Sqlite.prepare conn (T.pack "PRAGMA journal_mode=WAL;")
+	void $ Sqlite.step stmt
+	void $ Sqlite.finalize stmt
+	Sqlite.close conn

Database/Keys.hs

@@ -25,11 +25,11 @@ import qualified Database.Keys.SQL as SQL
 import Database.Types
 import Database.Keys.Handle
 import qualified Database.Queue as H
+import Database.Init
 import Annex.Locations
 import Annex.Common hiding (delete)
 import Annex.Version (versionUsesKeysDatabase)
 import qualified Annex
-import Annex.Perms
 import Annex.LockFile
 import Utility.InodeCache
 import Annex.InodeSentinal
@@ -120,11 +120,7 @@ openDb createdb _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKe
 	case (dbexists, createdb) of
 		(True, _) -> open db
 		(False, True) -> do
-			liftIO $ do
-				createDirectoryIfMissing True dbdir
-				H.initDb db SQL.createTables
-			setAnnexDirPerm dbdir
-			setAnnexFilePerm db
+			initDb db SQL.createTables
 			open db
 		(False, False) -> return DbUnavailable
   where

Database/Queue.hs

@@ -9,7 +9,6 @@
 
 module Database.Queue (
 	DbQueue,
-	initDb,
 	openDbQueue,
 	queryDbQueue,
 	closeDbQueue,