aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIgor Pashev <pashev.igor@gmail.com>2016-06-17 13:31:28 +0800
committerIgor Pashev <pashev.igor@gmail.com>2016-06-17 13:40:54 +0800
commitb41849d9cb4ccb856905a26bfc36b6ac7c5b1f32 (patch)
tree2b1e76de39a5cced6531879f4c28cecc7e7963d6
parent2059118ee2778fb8945ae6ccf33aa3aaba5d3417 (diff)
downloadmywatch-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.hs3
-rw-r--r--src/Server.hs5
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"