From 8a3beabf350899e369dcd57a72432930581fbc25 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 26 Dec 2023 18:31:52 -0400 Subject: [PATCH] use RawFilePath for opening sqlite databases Fix a crash opening sqlite databases when run in a non-unicode locale, with a remote that uses a non-unicode filepath. In that situation converting to Text fails. The fix needs git-annex to be built with persistent-sqlite 2.13.3. Building against older versions still works, but that version is used when building with stack. Database.RawFilePath is a lot of code copied from persistent-sqlite and lightly modified, since only 1 function in persistent-sqlite was made to support RawFilePath. This is a bit of a pain, and I hope that persistent-sqlite will eventually switch to using OsPath, allowing this module to be removed from git-annex. Sponsored-by: k0ld on Patreon --- CHANGELOG | 2 + COPYRIGHT | 6 ++ Database/ContentIdentifier.hs | 12 ++- Database/Handle.hs | 8 +- Database/Init.hs | 15 ++- Database/RawFilePath.hs | 99 +++++++++++++++++++ ...led_when_copying_to_remote_repository.mdwn | 3 + git-annex.cabal | 1 + 8 files changed, 138 insertions(+), 8 deletions(-) create mode 100644 Database/RawFilePath.hs diff --git a/CHANGELOG b/CHANGELOG index 936d00b61a..66431f04ea 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -25,6 +25,8 @@ git-annex (10.20231130) UNRELEASED; urgency=medium filesystems that have problems with such filenames. * sync, push: Avoid trying to send individual files to special remotes configured with importtree=yes exporttree=no, which would always fail. + * Fix a crash opening sqlite databases when run in a non-unicode locale. + (Needs persistent-sqlite 2.13.3.) -- Joey Hess Thu, 30 Nov 2023 14:48:12 -0400 diff --git a/COPYRIGHT b/COPYRIGHT index d8920f3fd3..c6c683374d 100644 --- a/COPYRIGHT +++ b/COPYRIGHT @@ -64,6 +64,12 @@ License: GPL-2 The full text of version 2 of the GPL is distributed in /usr/share/common-licenses/GPL-2 on Debian systems. +Files: Database/RawFilePath.hs +Copyright: © 2012 Michael Snoyman, http://www.yesodweb.com/ + © 2023 Joey Hess +License: Expat + The text of the Expat license is in the Expat section below. + Files: doc/tips/automatically_adding_metadata/pre-commit-annex Copyright: 2014 Joey Hess 2016 Klaus Ethgen diff --git a/Database/ContentIdentifier.hs b/Database/ContentIdentifier.hs index 324a6e1b14..bbf67dcfb1 100644 --- a/Database/ContentIdentifier.hs +++ b/Database/ContentIdentifier.hs @@ -53,9 +53,14 @@ import qualified Utility.RawFilePath as R import Database.Persist.Sql hiding (Key) import Database.Persist.TH -import Database.Persist.Sqlite (runSqlite) import qualified System.FilePath.ByteString as P + +#if MIN_VERSION_persistent_sqlite(2,13,3) +import Database.RawFilePath +#else +import Database.Persist.Sqlite (runSqlite) import qualified Data.Text as T +#endif data ContentIdentifierHandle = ContentIdentifierHandle H.DbQueue Bool @@ -102,8 +107,13 @@ openDb = do runMigrationSilent migrateContentIdentifier -- Migrate from old versions of database, which had buggy -- and suboptimal uniqueness constraints. +#if MIN_VERSION_persistent_sqlite(2,13,3) + else liftIO $ runSqlite' db $ void $ + runMigrationSilent migrateContentIdentifier +#else else liftIO $ runSqlite (T.pack (fromRawFilePath db)) $ void $ runMigrationSilent migrateContentIdentifier +#endif h <- liftIO $ H.openDbQueue db "content_identifiers" return $ ContentIdentifierHandle h isnew diff --git a/Database/Handle.hs b/Database/Handle.hs index cf17fd3d3e..a7e65e54cb 100644 --- a/Database/Handle.hs +++ b/Database/Handle.hs @@ -193,11 +193,13 @@ runSqliteRobustly tablename db a = do | otherwise -> rethrow $ errmsg "after successful open" ex opensettle retries ic = do - conn <- Sqlite.open tdb +#if MIN_VERSION_persistent_sqlite(2,13,3) + conn <- Sqlite.open' db +#else + conn <- Sqlite.open (T.pack (fromRawFilePath db)) +#endif settle conn retries ic - tdb = T.pack (fromRawFilePath db) - settle conn retries ic = do r <- try $ do stmt <- Sqlite.prepare conn nullselect diff --git a/Database/Init.hs b/Database/Init.hs index ac33fdae03..6f7ba09faf 100644 --- a/Database/Init.hs +++ b/Database/Init.hs @@ -1,11 +1,11 @@ {- Persistent sqlite database initialization - - - Copyright 2015-2020 Joey Hess + - Copyright 2015-2023 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, CPP #-} module Database.Init where @@ -13,6 +13,9 @@ import Annex.Common import Annex.Perms import Utility.FileMode import qualified Utility.RawFilePath as R +#if MIN_VERSION_persistent_sqlite(2,13,3) +import Database.RawFilePath +#endif import Database.Persist.Sqlite import Lens.Micro @@ -32,9 +35,13 @@ initDb db migration = do let dbdir = P.takeDirectory db let tmpdbdir = dbdir <> ".tmp" let tmpdb = tmpdbdir P. "db" - let tdb = T.pack (fromRawFilePath tmpdb) + let tmpdb' = T.pack (fromRawFilePath tmpdb) createAnnexDirectory tmpdbdir - liftIO $ runSqliteInfo (enableWAL tdb) migration +#if MIN_VERSION_persistent_sqlite(2,13,3) + liftIO $ runSqliteInfo' tmpdb (enableWAL tmpdb') migration +#else + liftIO $ runSqliteInfo (enableWAL tmpdb') migration +#endif setAnnexDirPerm tmpdbdir -- Work around sqlite bug that prevents it from honoring -- less restrictive umasks. diff --git a/Database/RawFilePath.hs b/Database/RawFilePath.hs new file mode 100644 index 0000000000..1b17729f95 --- /dev/null +++ b/Database/RawFilePath.hs @@ -0,0 +1,99 @@ +{- Persistent sqlite RawFilePath support + - + - The functions below are copied from persistent-sqlite, but modified to + - take a RawFilePath and ignore the sqlConnectionStr from the + - SqliteConnectionInfo. This avoids encoding problems using Text + - in some situations. + - + - This module is expected to eventually be supersceded by + - persistent-sqlite getting support for OsString. + - + - Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ + - Copyright 2023 Joey Hess + - + - Permission is hereby granted, free of charge, to any person obtaining + - a copy of this software and associated documentation files (the + - "Software"), to deal in the Software without restriction, including + - without limitation the rights to use, copy, modify, merge, publish, + - distribute, sublicense, and/or sell copies of the Software, and to + - permit persons to whom the Software is furnished to do so, subject to + - the following conditions: + - + - The above copyright notice and this permission notice shall be + - included in all copies or substantial portions of the Software. + - + - THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + - EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + - MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + - NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE + - LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION + - OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION + - WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +-} + +{-# LANGUAGE OverloadedStrings, CPP #-} + +module Database.RawFilePath where + +import Database.Persist.Sqlite +import qualified Database.Sqlite as Sqlite +import qualified System.FilePath.ByteString as P +import qualified Control.Exception as E +import Control.Monad.Logger (MonadLoggerIO) +import Control.Monad.IO.Unlift (MonadUnliftIO) +import Control.Monad.Logger (NoLoggingT, runNoLoggingT) +import Control.Monad.Trans.Reader (ReaderT) +import UnliftIO.Resource (ResourceT, runResourceT) + +{- The functions below are copied from persistent-sqlite, but modified to + - take a RawFilePath and ignore the sqlConnectionStr from the + - SqliteConnectionInfo. This avoids encoding problems using Text + - in some situations. -} +#if MIN_VERSION_persistent_sqlite(2,13,3) +openWith' + :: P.RawFilePath + -> (SqlBackend -> Sqlite.Connection -> r) + -> SqliteConnectionInfo + -> LogFunc + -> IO r +openWith' db f connInfo logFunc = do + conn <- Sqlite.open' db + backend <- wrapConnectionInfo connInfo conn logFunc `E.onException` Sqlite.close conn + return $ f backend conn + +runSqlite' :: (MonadUnliftIO m) + => P.RawFilePath + -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a + -> m a +runSqlite' connstr = runResourceT + . runNoLoggingT + . withSqliteConn' connstr + . runSqlConn + +withSqliteConn' + :: (MonadUnliftIO m, MonadLoggerIO m) + => P.RawFilePath + -> (SqlBackend -> m a) + -> m a +withSqliteConn' connstr = withSqliteConnInfo' connstr $ + mkSqliteConnectionInfo mempty + +runSqliteInfo' + :: (MonadUnliftIO m) + => P.RawFilePath + -> SqliteConnectionInfo + -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a + -> m a +runSqliteInfo' db conInfo = runResourceT + . runNoLoggingT + . withSqliteConnInfo' db conInfo + . runSqlConn + +withSqliteConnInfo' + :: (MonadUnliftIO m, MonadLoggerIO m) + => P.RawFilePath + -> SqliteConnectionInfo + -> (SqlBackend -> m a) + -> m a +withSqliteConnInfo' db = withSqlConn . openWith' db const +#endif diff --git a/doc/bugs/SQlite_failed_when_copying_to_remote_repository.mdwn b/doc/bugs/SQlite_failed_when_copying_to_remote_repository.mdwn index 61b56947eb..396c66312a 100644 --- a/doc/bugs/SQlite_failed_when_copying_to_remote_repository.mdwn +++ b/doc/bugs/SQlite_failed_when_copying_to_remote_repository.mdwn @@ -77,3 +77,6 @@ I use git-annex for several years, and I'm very happy with it. I's one of the be [[!meta title="sqlite fails when repository path contains non-unicode"]] + +> [[fixed|done]], when git-annex is built against persistent-sqlite version +> 2.13.3. --[[Joey]] diff --git a/git-annex.cabal b/git-annex.cabal index b2a8a8f720..fe4e5b75bc 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -746,6 +746,7 @@ Executable git-annex Database.Keys.Tables Database.Keys.SQL Database.Queue + Database.RawFilePath Database.Types Database.Utility Git