[lmdb facebookincubator#6] Move mksquashfs flags to a config field

Author: simonmar

glean/config/server/server_config.thrift

@@ -320,6 +320,10 @@ struct Config {
   // How much of total memory capacity to use for rocksdb cache.
   // Overrides db_rocksdb_cache_mb if set.
   38: optional float db_rocksdb_cache_to_mem_ratio;
+
+  // Args to pass to mksquashfs when creating a backup of an LMDB
+  39: list<string> db_lmdb_mksquashfs_args =
+    [ "-comp", "zstd", "-Xcompression-level", "8" ];
 }
 
 // The following were automatically generated and may benefit from renaming.

glean/db/Glean/Database/Backup.hs

@@ -236,7 +236,7 @@ doBackup env@Env{..} repo prefix site =
   say log s = log $ inRepo repo $ "backup: " ++ s
 
   backup = loggingAction (runLogRepo "backup" env repo) (const mempty) $ do
-    ServerConfig.Config{..} <- Observed.get envServerConfig
+    cfg@ServerConfig.Config{..} <- Observed.get envServerConfig
     meta <- atomically $ Catalog.readMeta envCatalog repo
     let excluded =
           hasExcludeProperty repo (metaProperties meta) config_retention
@@ -253,7 +253,7 @@ doBackup env@Env{..} repo prefix site =
     withStorageFor env repo meta $ \storage -> do
 
     Backend.Data{..} <- withScratchDirectory storage repo $ \scratch ->
-      Storage.backup odbHandle scratch $ \path Data{dataSize} -> do
+      Storage.backup odbHandle cfg scratch $ \path Data{dataSize} -> do
         say logInfo "uploading"
         let policy = ServerConfig.databaseBackupPolicy_repos config_backup
             ttl = case Map.lookup (repo_name repo) policy of

glean/db/Glean/Database/Storage.hs

@@ -32,6 +32,7 @@ import Glean.RTS.Foreign.Lookup (CanLookup(..), Lookup)
 import Glean.RTS.Foreign.Ownership hiding (computeDerivedOwnership)
 import Glean.RTS.Types (Fid, Pid)
 import Glean.ServerConfig.Types (DBVersion(..))
+import qualified Glean.ServerConfig.Types as ServerConfig
 import Glean.Types (PredicateStats, Repo, SchemaId)
 import Glean.Util.Some
 
@@ -202,6 +203,7 @@ class CanLookup db => DatabaseOps db where
   -- the operation completes.
   backup
     :: db  -- ^ database
+    -> ServerConfig.Config  -- ^ server config
     -> FilePath  -- ^ scratch directory
     -> (FilePath -> Data -> IO a)
           -- ^ function which expects the serialised database

glean/db/Glean/Database/Storage/DB.hs

@@ -23,6 +23,7 @@ import Foreign.ForeignPtr
 import Foreign.Marshal.Array
 import Foreign.Ptr
 import Foreign.Storable
+import System.Directory
 import System.FilePath
 
 import Util.FFI
@@ -156,12 +157,12 @@ instance DatabaseOps DB where
     unsafeWithForeignPtr (dbPtr db) $ \db_ptr ->
       invoke $ glean_rocksdb_prepare_fact_owner_cache db_ptr
 
-  backup db scratch process = do
+  backup db _ scratch process = do
+    let path = scratch </> "backup"
+    createDirectoryIfMissing True path
     withContainer db $ \s_ptr ->
       withCString path $ invoke . glean_rocksdb_container_backup s_ptr
     process path (Data 0)
-    where
-      path = scratch </> "backup"
 
 newtype Container = Container (Ptr Container)
   deriving(Storable)

glean/db/Glean/Database/Storage/LMDB.hs

@@ -13,6 +13,7 @@ module Glean.Database.Storage.LMDB
 
 import Control.Exception
 import Data.Int
+import qualified Data.Text as Text
 import Foreign.C.String
 import Foreign.C.Types
 import Foreign.ForeignPtr
@@ -126,7 +127,6 @@ instance Storage LMDB where
       createDirectoryIfMissing True $ takeDirectory target
       renameDirectory db target
 
-
 containerPath :: LMDB -> Repo -> FilePath
 containerPath LMDB{..} repo = databasePath lmdbRoot repo </> "db"
 
@@ -148,17 +148,16 @@ instance DatabaseOps (Database LMDB) where
   cacheOwnership (Database db) = cacheOwnership db
   prepareFactOwnerCache (Database db) = prepareFactOwnerCache db
 
-  backup (Database db) scratch process = do
-    createDirectoryIfMissing True (scratch </> "backup")
-    backup db scratch $ \_ _ -> do
+  backup (Database db) cfg scratch process =
+    backup db cfg scratch $ \path _ -> do
       withTempDirectory scratch "out" $ \tmpdir -> do
         let out = tmpdir </> "db.squashfs"
-        callProcess "mksquashfs" [
-          scratch </> "backup", out,
-          "-comp", "zstd", "-Xcompression-level", "8" ]
+        callProcess "mksquashfs" $ [ path, out ] <>
+          map Text.unpack (ServerConfig.config_db_lmdb_mksquashfs_args cfg)
         size <- getFileSize out
         process out (Data $ fromIntegral size)
 
+
 foreign import ccall safe glean_lmdb_container_open
   :: CString
   -> CInt

glean/db/Glean/Database/Storage/Memory.hs

@@ -117,4 +117,4 @@ instance DatabaseOps (Database Memory) where
   prepareFactOwnerCache _ = return ()
 
   -- TODO
-  backup db _ _ = dbError (dbRepo db) "unimplemented 'backup'"
+  backup db _ _ _ = dbError (dbRepo db) "unimplemented 'backup'"

glean/db/Glean/Database/Storage/RocksDB.hs

@@ -211,11 +211,11 @@ instance DatabaseOps (Database RocksDB) where
   cacheOwnership (Database db) = cacheOwnership db
   prepareFactOwnerCache (Database db) = prepareFactOwnerCache db
 
-  backup (Database db) scratch process = do
-    createDirectoryIfMissing True (scratch </> "backup")
-    backup db scratch $ \_ _ ->
+  backup (Database db) cfg scratch process = do
+    backup db cfg scratch $ \path _ -> do
+      let (base, dir) = splitFileName path
       withTempFile $ \tarFile -> do
-        tar ["-cf", tarFile, "-C", scratch, "backup"]
+        tar ["-cf", tarFile, "-C", base, dir]
         size <- getFileSize tarFile
         process tarFile (Data $ fromIntegral size)
 

glean/test/tests/DatabaseJanitorTest.hs

@@ -229,7 +229,7 @@ makeFakeCloudDB schema backupDir repo dbtime completeness opts = do
       storeSchema hdl $ toStoredSchema schema
       tmpDir <- getCanonicalTemporaryDirectory
       withTempDirectory tmpDir "scratch" $ \scratch ->
-        Storage.backup hdl scratch $ \file _data ->
+        Storage.backup hdl def scratch $ \file _data ->
           void $ backup (mockSite backupDir) repo props Nothing file
     )
   where