diff options
author | Igor Pashev <pashev.igor@gmail.com> | 2016-06-17 13:31:28 +0800 |
---|---|---|
committer | Igor Pashev <pashev.igor@gmail.com> | 2016-06-17 13:40:54 +0800 |
commit | b41849d9cb4ccb856905a26bfc36b6ac7c5b1f32 (patch) | |
tree | 2b1e76de39a5cced6531879f4c28cecc7e7963d6 | |
parent | 2059118ee2778fb8945ae6ccf33aa3aaba5d3417 (diff) | |
download | mywatch-b41849d9cb4ccb856905a26bfc36b6ac7c5b1f32.tar.gz |
Work around buggy mysql package
It uses unsafeUseAsCString for no reason and causes heisenbugs.
See https://github.com/bos/mysql/pull/23
-rw-r--r-- | src/Main.hs | 3 | ||||
-rw-r--r-- | src/Server.hs | 5 |
2 files changed, 5 insertions, 3 deletions
diff --git a/src/Main.hs b/src/Main.hs index 494faba..1f8cc89 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -61,7 +61,8 @@ main = do connectPort = 0, connectSSL = Nothing, connectUser = "", - connectOptions = [ ReadDefaultFile file, ReadDefaultGroup (pack g) ] + -- FIXME: Work aroung buggy mysql: unsafeUseAsCString creates garbage. + connectOptions = [ ReadDefaultFile file, ReadDefaultGroup (pack $ g ++ "\0") ] }) servers listen = maybe (Right socket) (Left . read) port server listen myInfo datadir diff --git a/src/Server.hs b/src/Server.hs index 14ecd9c..6c91a59 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -5,7 +5,6 @@ module Server import Control.Exception.Base (throwIO, catch, bracket) import Data.Bits ((.|.)) -import Data.ByteString.Lazy (fromStrict) import Data.List (find) import Data.Maybe (fromJust) import Data.Pool (createPool, destroyAllResources) @@ -22,6 +21,7 @@ import System.IO (hPutStrLn, stderr) import System.IO.Error (isDoesNotExistError) import System.Posix.Files (removeLink, setFileMode, socketMode, ownerReadMode, ownerWriteMode, groupReadMode, groupWriteMode) +import qualified Data.ByteString.Lazy as LBS import qualified Data.HashMap.Lazy as HM import qualified Database.MySQL.Simple as MySQL @@ -52,7 +52,8 @@ getGroup ci = decodeUtf8 . getName . fromJust . find isGroup . connectOptions $ where isGroup (ReadDefaultGroup _) = True isGroup _ = False - getName (ReadDefaultGroup n) = fromStrict n + -- FIXME: Removing trailing zero added for buggy mysql in Main.hs. + getName (ReadDefaultGroup n) = LBS.takeWhile (0 /=) . LBS.fromStrict $ n getName _ = error "Cannot happen" |