椿の日記

たぶんプログラムの話をします

Haskellからmysqlを実行する

Haskellからmysqlを叩きたくなったので調べていたのですが、かなり骨が折れる作業になりました。一筋縄に行かない問題が次から次へと…。しかしなんとか解決できたので、忘れないように覚書を残しておきます。
ビルドするのはThe HDBC-mysql packageです。パッケージ情報を見る限りGHC 7.4でビルド確認されているらしいのですが、恐らくテストされているのはLinux版で、MySQLも5.0.75を対象にしています。自分の環境はWindows Vista(x64)ですしMySQLは5.5.28なので、OS違いやバージョン違いの対応が中心でした。
ひとまず気をつけるべき点を8個ほど書きます。ここには手戻りしないように書いたので、この通りやってけば多分動きますが、またバージョンが変わったりしたらダメになると思います。なお自分の環境は次のような環境です。

HDBC-mysql 0.6.6.1をダウンロード

当然ですが、次のcabalコマンドは失敗します。

> cabal install HDBC-mysql

とりあえずHDBC-mysql 0.6.6.1をダウンロードして修正の準備に入ります。

Connector/C 6.0.2 (32bit版)をダウンロード

MySQLのインストールディレクトリには、libmysql.libとlibmysql.dllがあり、includeも入っています。これを使いたいところなのですが、自分の環境はMySQLが5.5.1の64bit版で、このdllがどうやら64bit版のものらしいです。あいにく現在Windowsで使えるGHCは32bit版です。したがって、このdllではGHCでビルドしたプログラムがlibmysql.dllと動的リンクできなくなります。というわけで、32bit版の接続用SDKを使います。
MySQLの公式サイトで、Connector/C 6.0.2のWindowsの32bit版のSDKを落とします。
もし32bit版を落とさないで作業を進めると、GHCでビルドしたプログラムを実行したときに「libmysql.dllが見つかりません」とか言われます(同じディレクトリにdllを置いてあるのに関わらず)。

mingw向けのインポートライブラリの作成

落としてきたConnector/Cには32bitのlibmysql.dllは含まれています。しかし、GHCがリンクするlibmysql.aがありません。含まれているのはMSVC向けのlibmysql.libです。そこで、これをGHCで利用できるようにするため、Haskellでiconvを参考にlibmysql.aを作成します。

> reimp -c -d libmysql.lib
> dlltool -k -d libmysql.def -l libmysql.a

ここでdlltoolの-kを忘れずにつけておきます。これはmingwがlibmysql.dll内の関数を見つけるために必要になります。まず、.defファイルの中を見ると関数名の後ろに@8だの@12だの色々な数字がついているのが分かります。

libmysql.def
----------
LIBRARY "LIBMYSQL.dll"
EXPORTS
myodbc_remove_escape@8
mysql_affected_rows@4
mysql_autocommit@8
mysql_change_user@16
...(略)...

この@数字はstdcallにすると勝手につくものです。mingwはstdcallな関数を見つけるとこの規約に沿って@数字をつけてコンパイルします。しかしlibmysql.dll内の関数名には@数字の修飾がついていません。このため、この-kを指定しないと、実行時に「mysql_autocommit@8が見つかりません」とか言われてしまいます。この-kというオプションは、この@以降の部分を無視してリンクすることが出来るようにするオプションです。

HDBC-mysql.cabalの修正

libmysql.aを作成したので、これをインストール時に利用することを指示します。これはHDBC-mysql.cabalで指定することができます。

HDBC-mysql.cabal
----------
	library
	  Exposed-modules:  Database.HDBC.MySQL
	  Other-modules:
	    Database.HDBC.MySQL.Connection
	    Database.HDBC.MySQL.RTS
	  Build-Depends:
	    HDBC >= 2.1.0,
	    base >= 2 && < 5,
	    bytestring,
	    time,
	    utf8-string
	  ghc-options:      -Wall
+	  extra-libraries:  mysql
+	  extra-lib-dirs:   C:\usr\work

ここで指定するextra-librariesには、mysqlと書くと、libmysql.aがリンクされるようになります。

追加インクルードディレクトリと利用ライブラリの修正

最初にcabal install HDBC-mysqlしたときに出たエラーメッセージの最後は次のようなものになっているはずです。

...(略)...
setup.exe: The program mysql_config is required but it could not be found
cabal: Error: some packages failed to install:
HDBC-mysql-0.6.6.1 failed during the configure step. The exception was:
ExitFailure 1

この「The program mysql_config is required but it could not be found」で名指しされているmysql_configですが、MySQLの色んな環境情報を取得する際に用いるプログラムです(includeディレクトリの情報など)。この情報はパッケージのビルド中にmysql.hのインクルード先を決めるのに利用されるのですが、mysql_configが見つからずビルドに失敗しています。
何故mysql_configが見つからないのかというと、MySQL 5.5.28のbinディレクトリにあるのはmysql_config.plというperlのスクリプトファイルで、これがWindowsでは検索に引っかからないためです。Linuxなら.plという拡張子もないだろうし、シェルが実行ファイルとみて実行させられるはずです。
というわけで修正します。HDBC-mysql-0.6.6.1/Setup.lhsの次の部分です。

Setup.lhs
----------
    mysqlConfigProgram = (simpleProgram "mysql_config") {
    programFindLocation = \verbosity -> do
      mysql_config  <- findProgramOnPath "mysql_config"  verbosity
      mysql_config5 <- findProgramOnPath "mysql_config5" verbosity
      return (mysql_config `mplus` mysql_config5)
  }

mysqlBuildInfo :: LocalBuildInfo -> IO BuildInfo
mysqlBuildInfo lbi = do
  let mysqlConfig = rawSystemProgramStdoutConf verbosity mysqlConfigProgram (withPrograms lbi)
      ws = " \n\r\t"

  includeDirs <- return . map (drop 2) . split ws =<< mysqlConfig ["--include"]
  ldOptions   <- return . split ws =<< mysqlConfig ["--libs"]

  return emptyBuildInfo {
    ldOptions   = ldOptions,
    includeDirs = includeDirs
  }
  where
    verbosity = normal -- honestly, this is a hack

少し長いですが、ポイントはfindProgramOnPath "mysql_config"で、ここで"mysql_config.pl"見つからないのでエラーになっています。さて、ここでperlスクリプトを実行できるように書き換えても良いのですが、そんなことをしなくても結果だけ合ってればよいので、直接スクリプトファイルに結果をぶち込みます。
mysqlBuildInfoの戻り値を見ると、重要なのはldOptionsとincludeDirsの結果だけということが分かります。そこで、これを各環境の値に強引に書き換えてしまいます。

Setup.lhs
----------
+  includeDirs <- return ["C:\\bin\\mysql-connector-c-noinstall-6.0.2-win32\\include"]
+  ldOptions   <- return []
-  includeDirs <- return . map (drop 2) . split ws =<< mysqlConfig ["--include"]
-  ldOptions   <- return . split ws =<< mysqlConfig ["--libs"]

パスは自分が利用している場所に書き換えてください。

SOCKETのシンボルエラーを修正。

ここでrughc setup configure/runghc setup buildとすると色々とビルドエラーが出てきますので修正します。まず最初はこちら。

C:\Program Files\MySQL\MySQL Server 5.5\include/mysql_com.h:291:3: error: expected specifier-qualifier-list before 'SOCKET'

SOCKETはWindowsでお馴染みのSOCKETハンドルのことでしょう。msvcの場合はwindows.hをインクルードするとSOCKETが漏れなくついてくるのですが、mingwはついてこないようなので、これを使えるようにします。mingwでSOCKETが定義されているのはwinsock2.hですので、これを追加します。

Connection.hsc
----------
	import qualified Database.HDBC.Types as Types
	import Database.HDBC.ColTypes as ColTypes
	import Database.HDBC (throwSqlError)

+	#include <winsock2.h>
	#include <mysql.h>

シグナルが色々と使えないのを修正

引き続きrunghc setup buildを続けると次のようなエラーが出ます。

Database\HDBC\MySQL\RTS.hsc: In function 'main':
Database\HDBC\MySQL\RTS.hsc:38:5: error: 'SIGALRM' undeclared (first use in this function)
Database\HDBC\MySQL\RTS.hsc:38:5: note: each undeclared identifier is reported only once for each function it appears in
Database\HDBC\MySQL\RTS.hsc:39:5: error: 'SIGVTALRM' undeclared (first use in this function)
Database\HDBC\MySQL\RTS.hsc:40:5: error: 'SIG_BLOCK' undeclared (first use in this function)
Database\HDBC\MySQL\RTS.hsc:41:5: error: 'SIG_UNBLOCK' undeclared (first use inthis function)
Database\HDBC\MySQL\RTS.hsc:46:5: error: 'sigset_t' undeclared (first use in this function)

さて、これらのエラーはRTS.hscのwithRTSSignalsBlockedという関数で利用されています。この関数はアクションを一つ引数に受け取り、SIGALRMやSIGVTALRMなどを無効にした状態でそのアクションを実行する、というアクションラッパーです。RTS.hscのコメントによれば、どうやらmysqlclientの関数はこれらのシグナルの割り込み後の復帰処理が上手く出来てないらしく、これらのシグナルを無効にして実行しないとならない場合があるようです。特に-threaded runtimeを利用したときに特によく発生するとのこと。
で、どうしようか悩んだ末に、とりあえずは無くても動くには動くので、まずはこれらのシグナルを全て無効にしてしまいます。そこで次のように修正。

RTS.hsc
----------
 withRTSSignalsBlocked :: IO a -> IO a
+withRTSSignalsBlocked act = act
-withRTSSignalsBlocked act = runInBoundThread . alloca $ \set -> do
-  sigemptyset set
-  sigaddset set (#const SIGALRM)
-  sigaddset set (#const SIGVTALRM)
-  pthread_sigmask (#const SIG_BLOCK) set nullPtr
-  act `finally` pthread_sigmask (#const SIG_UNBLOCK) set nullPtr

sigset_tが使えないのを修正(追記)

さらに、mingwではsigset_tがsys/types.hに定義されているので、これを追加します。

RTS.hsc
----------
#include <signal.h>
#include <sys/types.h>

mysql_real_connectの関数定義の修正

ここまでくるとbuild/installまで実行できるのですが、サンプルプログラムのビルドは通らないので修正はまだまだ続きます。

mysql_real_connectという関数がありますが、現在のConnector/Cのバージョンでは関数引数が変更されています。マニュアルを参考に修正していきます。

Connection.hsc
----------
  foreign import stdcall unsafe mysql_real_connect
   :: Ptr MYSQL -- the context
   -> CString   -- hostname
   -> CString   -- username
   -> CString   -- password
   -> CString   -- database
   -> CInt      -- port
   -> CString   -- unix socket
+  -> CInt      -- clientflag
   -> IO (Ptr MYSQL)

対応する呼び出し部分には適当にデフォルト値の0でも突っ込んでおきます。

Connection.hsc
----------
connectMySQL info = do
  mysql_ <- mysql_init nullPtr
  when (mysql_ == nullPtr) (error "mysql_init failed")
  case mysqlGroup info of
    Just group -> withCString group $ \group_ -> do
                      _ <- mysql_options mysql_ #{const MYSQL_READ_DEFAULT_GROUP} (castPtr group_)
                      return ()
    Nothing -> return ()
  withCString (mysqlHost info) $ \host_ ->
      withCString (mysqlUser info) $ \user_ ->
          withCString (mysqlPassword info) $ \passwd_ ->
              withCString (mysqlDatabase info) $ \db_ ->
                  withCString (mysqlUnixSocket info) $ \unixSocket_ ->
                      do rv <- mysql_real_connect mysql_ host_ user_ passwd_ db_
                                                  (fromIntegral $ mysqlPort info)
+                                                 unixSocket_ 0
-                                                 unixSocket_
                         when (rv == nullPtr) (connectionError mysql_)
                         wrap mysql_

関数定義をccallからstdcallにする

libmysql.dllの関数はstdcallです。ところがHDBC-mysqlは次のように書かれています。

Connection.hsc
----------
foreign import ccall unsafe mysql_get_client_info
    :: IO CString

foreign import ccall unsafe mysql_get_server_info
    :: Ptr MYSQL -> IO CString

foreign import ccall unsafe mysql_get_proto_info
    :: Ptr MYSQL -> IO CUInt
...(略)...

てなわけで、ccallを置換してstdcallに変換します。但し、一番最後にC標準関数のmemsetがあります。

foreign import ccall unsafe memset
    :: Ptr () -> CInt -> CSize -> IO ()

この関数はC呼び出し規約なので、これは変えてはいけません。

Foreign.newForeignPtrをForeign.Concurrent.newForeignPtrに変更する

これでいよいよリンクも通り実行できるようになるのですが、プログラムの終了時にSegmentation faultで死にます。原因を把握仕切れていないのですが、どうもForeign.newForeignPtrの周辺が怪しいようです。mysql_closeを直接に叩くと成功するのにForeign.newForeignPtrの自動解放に任せると死ぬようなので次のように変更します。

Connection.hsc
----------
-        mysql__ <- newForeignPtr mysql_close mysql_
+        mysql__ <- Foreign.Concurrent.newForeignPtr mysql_ (mysql_close mysql_)
Connection.hsc
----------
-	foreign import ccall unsafe "&mysql_close" mysql_close
-	    :: FunPtr (Ptr MYSQL -> IO ())
+	foreign import stdcall unsafe mysql_close
+	    :: Ptr MYSQL -> IO ()

明示的にdisconnectしない限り、mysql_closeが呼ばれないことに注意してください。

test.hsをビルド

自分が修正した点は以上です。これでテストプログラムを書いて試してみましょう。

test.hs
----------
import Control.Monad
import Database.HDBC
import Database.HDBC.MySQL
main = do conn <- connectMySQL defaultMySQLConnectInfo {
                     mysqlHost     = "127.0.0.1",
                     mysqlUser     = "testuser",
                     mysqlPassword = "password",
                     mysqlDatabase = "testdb"
                  }

          rows <- quickQuery' conn "SELECT 1 + 1" []
          forM_ rows $ \row -> putStrLn $ show row

実行します。

c:\usr\work> test
[SqlInt64 2]