├── .travis-ocaml.sh ├── .travis.yml ├── CHANGES.md ├── COPYING.txt ├── LICENSE ├── README.md ├── benchmarks ├── bench.ml ├── bench_config.ml ├── bench_mysql_libc.ml ├── bench_mysql_protocol.ml └── dune ├── dune ├── dune-project ├── examples ├── client.ml ├── dune └── run.ml ├── mysql_protocol.opam ├── src ├── dune ├── mp_auth_switch_request.ml ├── mp_authentication.ml ├── mp_binary.ml ├── mp_bitstring.ml ├── mp_capabilities.ml ├── mp_change_user.ml ├── mp_charset.ml ├── mp_charset.mli ├── mp_client.ml ├── mp_client.mli ├── mp_com.ml ├── mp_data.ml ├── mp_data.mli ├── mp_data_binary.ml ├── mp_data_process.ml ├── mp_data_simple.ml ├── mp_eof_packet.ml ├── mp_error_packet.ml ├── mp_execute.ml ├── mp_fetch.ml ├── mp_field.ml ├── mp_field_packet.ml ├── mp_handshake.ml ├── mp_ok_packet.ml ├── mp_ok_prepare_packet.ml ├── mp_packet.ml ├── mp_protocol.ml ├── mp_raw_data.ml ├── mp_result_packet.ml ├── mp_result_set_packet.ml ├── mp_string.ml └── mysql_protocol.mlpack ├── test ├── caml-inria-fr.128x58.gif ├── dune ├── fixture.mli ├── fixture_config.ml ├── fixture_latin1.ml ├── fixture_utf8.ml ├── logo-full-thumb.png ├── ocaml-3.12-refman.pdf ├── test.ml ├── test_benchmark.ml ├── test_change_user.ml ├── test_client.ml ├── test_connect.ml ├── test_ping.ml ├── test_query.ml ├── test_query_auto_increment.ml ├── test_query_bad.ml ├── test_query_close_statement.ml ├── test_query_delete.ml ├── test_query_execute.ml ├── test_query_fetch.ml ├── test_query_grant.ml ├── test_query_insert.ml ├── test_query_prepare.ml ├── test_query_select.ml ├── test_query_transaction.ml ├── test_query_update.ml ├── test_reset_connection.ml ├── test_reset_session.ml ├── test_types.ml └── twomega.bin └── tutorials ├── tutorial.pdf └── tutorial.tex /.travis-ocaml.sh: -------------------------------------------------------------------------------- 1 | ## basic OCaml and opam installation 2 | 3 | full_apt_version () { 4 | package=$1 5 | version=$2 6 | case "${version}" in 7 | latest) echo -n "${package}" ;; 8 | *) echo -n "${package}=" 9 | apt-cache show "$package" \ 10 | | sed -n "s/^Version: \(${version}\)/\1/p" \ 11 | | head -1 12 | esac 13 | } 14 | 15 | set -uex 16 | 17 | if [ "$TRAVIS_OS_NAME" = freebsd -a "${OPAM_VERSION+x}" = x ]; then 18 | echo OPAM_VERSION not permitted for FreeBSD targets 19 | exit 1 20 | fi 21 | 22 | OCAML_VERSION=${OCAML_VERSION:-latest} 23 | SYS_OCAML_VERSION=4.05 24 | # Default opam is the latest release of opam 2 25 | OPAM_VERSION=${OPAM_VERSION:-2} 26 | OPAM_INIT=${OPAM_INIT:-true} 27 | OCAML_BETA=${OCAML_BETA:-disable} 28 | 29 | OPAM_LATEST_RELEASE=2.0.7 30 | 31 | case ${TRAVIS_CPU_ARCH:-amd64} in 32 | amd64|notset) OPAM_ARCH=x86_64;; 33 | arm64) OPAM_ARCH=arm64;; 34 | *) echo "'$TRAVIS_CPU_ARCH' architecture not currently supported"; exit 1;; 35 | esac 36 | 37 | case $OPAM_VERSION in 38 | 2|2.0) OPAM_VERSION=$OPAM_LATEST_RELEASE;; 39 | 1.*) echo "Opam version '$OPAM_VERSION' is not supported"; exit 1;; 40 | esac 41 | 42 | if [ "$TRAVIS_OS_NAME" = "osx" ] ; then 43 | brew update &> /dev/null & 44 | while sleep 60; do echo "brew update is still running..."; done & 45 | wait %1 46 | kill %2 47 | BREW_OPAM_VERSION=$(brew info opam --json=v1 | sed -e 's/.*"versions":{[^}]*"stable":"//' -e 's/".*//') 48 | if [ "$OPAM_VERSION" != "$BREW_OPAM_VERSION" ] ; then 49 | set +x 50 | echo -e "[\e[0;31mWARNING\e[0m] Ignored OPAM_VERSION=$OPAM_VERSION; interpreted as \"$BREW_OPAM_VERSION\"" >&2 51 | echo -e "[\e[0;31mWARNING\e[0m] opam 2 is installed via Homebrew" >&2 52 | set -x 53 | fi 54 | OPAM_VERSION="$BREW_OPAM_VERSION" 55 | fi 56 | 57 | if [ "$OPAM_VERSION" != "$OPAM_LATEST_RELEASE" ] ; then 58 | set +x 59 | echo -e "[\e[0;31mWARNING\e[0m] Out-of-date opam $OPAM_VERSION requested" >&2 60 | echo -e "[\e[0;31mWARNING\e[0m] Latest release is $OPAM_LATEST_RELEASE" >&2 61 | set -x 62 | fi 63 | 64 | if [ "${INSTALL_LOCAL+x}" = x ] ; then 65 | if [ "$TRAVIS_OS_NAME" = osx -o "$TRAVIS_OS_NAME" = freebsd ] ; then 66 | echo INSTALL_LOCAL not permitted for macOS and FreeBSD targets 67 | exit 1 68 | fi 69 | 70 | if [ "${OPAM_SWITCH:=ocaml-system}" != ocaml-system ] ; then 71 | echo "INSTALL_LOCAL requires OPAM_SWITCH=ocaml-system (or unset/null)" 72 | exit 1 73 | fi 74 | fi 75 | 76 | # the base opam repository to use for bootstrapping and catch-all namespace 77 | BASE_REMOTE=${BASE_REMOTE:-git://github.com/ocaml/opam-repository} 78 | 79 | # whether we need a new gcc and binutils 80 | UPDATE_GCC_BINUTILS=${UPDATE_GCC_BINUTILS:-"0"} 81 | 82 | # Install Xenial remotes 83 | UBUNTU_XENIAL=${UBUNTU_XENIAL:-"0"} 84 | 85 | # Install XQuartz on OSX 86 | INSTALL_XQUARTZ=${INSTALL_XQUARTZ:-"false"} 87 | 88 | APT_UPDATED=0 89 | 90 | add_ppa () { 91 | if [ "$TRAVIS_OS_NAME" = "linux" ] ; then 92 | APT_UPDATED=0 93 | sudo add-apt-repository --yes ppa:$1 94 | fi 95 | } 96 | 97 | apt_install () { 98 | if [ "$TRAVIS_OS_NAME" = "linux" ] ; then 99 | if [ "$APT_UPDATED" -eq 0 ] ; then 100 | APT_UPDATED=1 101 | sudo apt-get update -qq 102 | fi 103 | sudo apt-get install --no-install-recommends -y "$@" 104 | fi 105 | } 106 | 107 | install_ocaml () { 108 | apt_install \ 109 | ocaml ocaml-base ocaml-native-compilers ocaml-compiler-libs \ 110 | ocaml-interp ocaml-base-nox ocaml-nox 111 | } 112 | 113 | install_opam2 () { 114 | case $TRAVIS_OS_NAME in 115 | freebsd) 116 | # Opam does not have any ready to use binaries for FreeBSD 117 | sudo pkg install -qy ocaml-opam ;; 118 | linux) 119 | case $TRAVIS_DIST in 120 | precise|trusty|xenial) 121 | # Required for bubblewrap (supports arm64 & amd64) 122 | add_ppa avsm/ppa ;; 123 | esac 124 | if [ "${INSTALL_LOCAL:=0}" = 0 ] ; then 125 | install_ocaml 126 | fi 127 | apt_install bubblewrap 128 | sudo wget https://github.com/ocaml/opam/releases/download/$OPAM_VERSION/opam-$OPAM_VERSION-$OPAM_ARCH-linux -O /usr/local/bin/opam 129 | sudo chmod +x /usr/local/bin/opam ;; 130 | osx) 131 | if [ "${INSTALL_LOCAL:=0}" = 0 ] ; then 132 | brew install ocaml 133 | fi 134 | sudo curl -fsSL https://github.com/ocaml/opam/releases/download/$OPAM_VERSION/opam-$OPAM_VERSION-$OPAM_ARCH-macos -o /usr/local/bin/opam 135 | sudo chmod +x /usr/local/bin/opam ;; 136 | esac 137 | } 138 | 139 | install_ppa () { 140 | add_ppa $1 141 | if [ "${INSTALL_LOCAL:=0}" = 0 ] ; then 142 | sudo apt-get -qq update 143 | APT_UPDATED=1 144 | apt_install \ 145 | "$(full_apt_version ocaml $SYS_OCAML_VERSION)" \ 146 | "$(full_apt_version ocaml-base $SYS_OCAML_VERSION)" \ 147 | "$(full_apt_version ocaml-native-compilers $SYS_OCAML_VERSION)" \ 148 | "$(full_apt_version ocaml-compiler-libs $SYS_OCAML_VERSION)" \ 149 | "$(full_apt_version ocaml-interp $SYS_OCAML_VERSION)" \ 150 | "$(full_apt_version ocaml-base-nox $SYS_OCAML_VERSION)" \ 151 | "$(full_apt_version ocaml-nox $SYS_OCAML_VERSION)" 152 | fi 153 | apt_install opam 154 | } 155 | 156 | install_on_freebsd () { 157 | case "$OCAML_VERSION" in 158 | 3.12) OCAML_FULL_VERSION=3.12.1; install_opam2 ;; 159 | 4.00) OCAML_FULL_VERSION=4.00.1; install_opam2 ;; 160 | 4.01) OCAML_FULL_VERSION=4.01.0; install_opam2 ;; 161 | 4.02) OCAML_FULL_VERSION=4.02.3; install_opam2 ;; 162 | 4.03) OCAML_FULL_VERSION=4.03.0; install_opam2 ;; 163 | 4.04) OCAML_FULL_VERSION=4.04.2; install_opam2 ;; 164 | 4.05) OCAML_FULL_VERSION=4.05.0; install_opam2 ;; 165 | 4.06) OCAML_FULL_VERSION=4.06.1; install_opam2 ;; 166 | 4.07) OCAML_FULL_VERSION=4.07.1; install_opam2 ;; 167 | 4.08) OCAML_FULL_VERSION=4.08.1; install_opam2 ;; 168 | 4.09) OCAML_FULL_VERSION=4.09.1; install_opam2 ;; 169 | 4.10) OCAML_FULL_VERSION=4.10.1; install_opam2 ;; 170 | 4.11) OCAML_FULL_VERSION=4.11.0; install_opam2 ;; 171 | 4.12) OCAML_FULL_VERSION=4.12.0+trunk; OCAML_BETA=enable; install_opam2 ;; 172 | *) 173 | if [ "$OCAML_BETA" != "enable" ]; then 174 | echo "Unknown OCAML_VERSION=$OCAML_VERSION" 175 | echo "(An unset OCAML_VERSION used to default to \"latest\", but you must now specify it." 176 | echo "Try something like \"OCAML_VERSION=3.12\", \"OCAML_VERSION=4.10\", or see README-travis.md at https://github.com/ocaml/ocaml-ci-scripts )" 177 | exit 1 178 | fi 179 | OCAML_FULL_VERSION="${OCAML_VERSION}" 180 | install_opam2 ;; 181 | esac 182 | } 183 | 184 | install_on_linux () { 185 | case "$OCAML_VERSION" in 186 | 3.12) OCAML_FULL_VERSION=3.12.1; install_opam2 ;; 187 | 4.00) OCAML_FULL_VERSION=4.00.1; install_opam2 ;; 188 | 4.01) OCAML_FULL_VERSION=4.01.0; install_opam2 ;; 189 | 4.02) OCAML_FULL_VERSION=4.02.3; install_opam2 ;; 190 | 4.03) OCAML_FULL_VERSION=4.03.0; install_opam2 ;; 191 | 4.04) OCAML_FULL_VERSION=4.04.2; install_opam2 ;; 192 | 4.05) OCAML_FULL_VERSION=4.05.0; install_opam2 ;; 193 | 4.06) OCAML_FULL_VERSION=4.06.1; install_opam2 ;; 194 | 4.07) OCAML_FULL_VERSION=4.07.1; install_opam2 ;; 195 | 4.08) OCAML_FULL_VERSION=4.08.1; install_opam2 ;; 196 | 4.09) OCAML_FULL_VERSION=4.09.1; install_opam2 ;; 197 | 4.10) OCAML_FULL_VERSION=4.10.1; install_opam2 ;; 198 | 4.11) OCAML_FULL_VERSION=4.11.1; install_opam2 ;; 199 | 4.12) OCAML_FULL_VERSION=4.12.0+trunk; OCAML_BETA=enable; install_opam2 ;; 200 | *) 201 | if [ "$OCAML_BETA" != "enable" ]; then 202 | echo "Unknown OCAML_VERSION=$OCAML_VERSION" 203 | echo "(An unset OCAML_VERSION used to default to \"latest\", but you must now specify it." 204 | echo "Try something like \"OCAML_VERSION=3.12\", \"OCAML_VERSION=4.10\", or see README-travis.md at https://github.com/ocaml/ocaml-ci-scripts )" 205 | exit 1 206 | fi 207 | OCAML_FULL_VERSION="${OCAML_VERSION}" 208 | install_opam2 ;; 209 | esac 210 | 211 | XENIAL="deb mirror://mirrors.ubuntu.com/mirrors.txt xenial main restricted universe" 212 | 213 | if [ "$UPDATE_GCC_BINUTILS" != "0" ] ; then 214 | echo "installing a recent gcc and binutils (mainly to get mirage-entropy-xen working!)" 215 | sudo add-apt-repository "${XENIAL}" 216 | sudo add-apt-repository --yes ppa:ubuntu-toolchain-r/test 217 | sudo apt-get -qq update 218 | sudo apt-get install -y gcc-5 219 | sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-5 90 220 | sudo add-apt-repository -r "${XENIAL}" 221 | fi 222 | 223 | if [ "$UBUNTU_XENIAL" != "0" ] ; then 224 | echo "Adding Ubuntu Xenial mirrors" 225 | sudo add-apt-repository "${XENIAL}" 226 | sudo apt-get -qq update 227 | APT_UPDATED=1 228 | fi 229 | 230 | if [ "${INSTALL_LOCAL:=0}" != 0 ] ; then 231 | ( set +x; echo -en "travis_fold:start:build.ocaml\r" ) 2>/dev/null 232 | echo "Building a local OCaml; this may take a few minutes..." 233 | wget "http://caml.inria.fr/pub/distrib/ocaml-${OCAML_FULL_VERSION%.*}/ocaml-$OCAML_FULL_VERSION.tar.gz" 234 | tar -xzf "ocaml-$OCAML_FULL_VERSION.tar.gz" 235 | cd "ocaml-$OCAML_FULL_VERSION" 236 | ./configure -prefix /usr/local ${OCAML_CONFIGURE_ARGS:=--with-debug-runtime} 237 | make world.opt 238 | sudo make install 239 | cd .. 240 | rm -rf "ocaml-$OCAML_FULL_VERSION" 241 | ( set +x; echo -en "travis_fold:end:build.ocaml\r" ) 2>/dev/null 242 | fi 243 | } 244 | 245 | install_on_osx () { 246 | case $INSTALL_XQUARTZ in 247 | true) 248 | curl -OL "http://xquartz.macosforge.org/downloads/SL/XQuartz-2.7.6.dmg" 249 | sudo hdiutil attach XQuartz-2.7.6.dmg 250 | sudo installer -verbose -pkg /Volumes/XQuartz-2.7.6/XQuartz.pkg -target / 251 | ;; 252 | esac 253 | case "$OCAML_VERSION" in 254 | 3.12) OCAML_FULL_VERSION=3.12.1; install_opam2 ;; 255 | 4.00) OCAML_FULL_VERSION=4.00.1; install_opam2 ;; 256 | 4.01) OCAML_FULL_VERSION=4.01.0; install_opam2 ;; 257 | 4.02) OCAML_FULL_VERSION=4.02.3; install_opam2 ;; 258 | 4.03) OCAML_FULL_VERSION=4.03.0; install_opam2 ;; 259 | 4.04) OCAML_FULL_VERSION=4.04.2; install_opam2 ;; 260 | 4.05) OCAML_FULL_VERSION=4.05.0; install_opam2 ;; 261 | 4.06) OCAML_FULL_VERSION=4.06.1; install_opam2 ;; 262 | 4.07) OCAML_FULL_VERSION=4.07.1; install_opam2 ;; 263 | 4.08) OCAML_FULL_VERSION=4.08.1; install_opam2 ;; 264 | 4.09) OCAML_FULL_VERSION=4.09.1; install_opam2 ;; 265 | 4.10) OCAML_FULL_VERSION=4.10.0; 266 | OPAM_SWITCH=${OPAM_SWITCH:-ocaml-system}; 267 | brew install ocaml; 268 | install_opam2 ;; 269 | 4.11) OCAML_FULL_VERSION=4.11.1; install_opam2 ;; 270 | 4.12) OCAML_FULL_VERSION=4.12.0+trunk; OCAML_BETA=enable; install_opam2 ;; 271 | *) 272 | if [ "$OCAML_BETA" != "enable" ]; then 273 | echo "Unknown OCAML_VERSION=$OCAML_VERSION" 274 | exit 1 275 | fi 276 | OCAML_FULL_VERSION="${OCAML_VERSION}" 277 | install_opam2 ;; 278 | esac 279 | } 280 | 281 | case $TRAVIS_OS_NAME in 282 | freebsd) install_on_freebsd ;; 283 | osx) install_on_osx ;; 284 | linux) install_on_linux ;; 285 | esac 286 | 287 | ocaml_package=ocaml-base-compiler 288 | if [ "$OCAML_BETA" = "enable" ]; then 289 | ocaml_package=ocaml-variants 290 | fi 291 | 292 | OPAM_SWITCH=${OPAM_SWITCH:-$ocaml_package.$OCAML_FULL_VERSION} 293 | 294 | PACKAGES="$OPAM_SWITCH" 295 | case "$OCAML_VERSION" in 296 | 3.12|4.00|4.01|4.02|4.03|4.04|4.05|4.06|4.07) 297 | PACKAGES="$PACKAGES,ocaml-secondary-compiler";; 298 | esac 299 | 300 | export OPAMYES=1 301 | 302 | case $OPAM_INIT in 303 | true) 304 | opam init -a --bare "$BASE_REMOTE" 305 | opam_repo_selection= 306 | if [ "$OCAML_BETA" = "enable" ]; then 307 | opam repo add --dont-select beta git://github.com/ocaml/ocaml-beta-repository.git 308 | opam_repo_selection="--repo=default,beta" 309 | fi 310 | opam switch "$OPAM_SWITCH" || opam switch create $opam_repo_selection "$OPAM_SWITCH" --packages="$PACKAGES" 311 | eval $(opam config env) 312 | ;; 313 | esac 314 | 315 | echo OCAML_VERSION=$OCAML_VERSION > .travis-ocaml.env 316 | echo OPAM_SWITCH=$OPAM_SWITCH >> .travis-ocaml.env 317 | 318 | # Temporary fix an issue with opam-depext < 1.1.4 on FreeBSD. 319 | # See https://github.com/ocaml/opam-depext/pull/123 320 | echo export ASSUME_ALWAYS_YES=YES >> .travis-ocaml.env 321 | 322 | if [ -x "$(command -v ocaml)" ]; then 323 | # "|| true" is a temp fix for OCaml 4.12: https://github.com/ocaml/ocaml/pull/9798 324 | ocaml -version || true 325 | else 326 | echo "OCaml is not yet installed" 327 | fi 328 | 329 | opam --version 330 | opam --git-version -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | install: test -e .travis-opam.sh || wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh 3 | script: bash -ex .travis-opam.sh 4 | env: 5 | - OCAML_VERSION=4.09 6 | - OCAML_VERSION=4.10 7 | - OCAML_VERSION=4.11 8 | os: 9 | - freebsd 10 | - linux 11 | - osx 12 | arch: 13 | - amd64 14 | - arm64 -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## v3.0.3 (2022-04-12) 2 | - Avoid error with UNIX socket 3 | 4 | ## v3.0.2 (2022-04-03) 5 | - Update charsets and collations 6 | - Unbreak benchmark build 7 | 8 | ## v3.0.1 (2020-11-22) 9 | - OPAM linting 10 | 11 | ## v3.0 (2020-11-22) 12 | - MariaDB compatibility 13 | - Dunification 14 | - PPX Bitstring 15 | - Implements reset connection 16 | 17 | ## v2.0 (2016-02-10) 18 | This new release introduces backward incompatible changes: 19 | - the old `native_data` type is now private, you have to use the new `data_*` and `to_ocaml_*` functions to convert the data between OCaml world and MySQL world. 20 | - `get_result_set` function has a new signature: `val get_result_set : result -> Mp_result_set_packet.result_select` 21 | - `insert_id` is now a tuple of type `(Int64.t * Big_int.big_int)`. The `Int64` value must be used when the `auto_increment` field is not a `BIGINT UNSIGNED`, otherwise the `Big_int` value must be used. 22 | 23 | ## v1.1 (2015-10-28) 24 | - Add opam file 25 | 26 | ## v1.0 (2014-10-18) 27 | - Initial version 28 | -------------------------------------------------------------------------------- /COPYING.txt: -------------------------------------------------------------------------------- 1 | See LICENSE 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | 9 | This version of the GNU Lesser General Public License incorporates 10 | the terms and conditions of version 3 of the GNU General Public 11 | License, supplemented by the additional permissions listed below. 12 | 13 | 0. Additional Definitions. 14 | 15 | As used herein, "this License" refers to version 3 of the GNU Lesser 16 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 17 | General Public License. 18 | 19 | "The Library" refers to a covered work governed by this License, 20 | other than an Application or a Combined Work as defined below. 21 | 22 | An "Application" is any work that makes use of an interface provided 23 | by the Library, but which is not otherwise based on the Library. 24 | Defining a subclass of a class defined by the Library is deemed a mode 25 | of using an interface provided by the Library. 26 | 27 | A "Combined Work" is a work produced by combining or linking an 28 | Application with the Library. The particular version of the Library 29 | with which the Combined Work was made is also called the "Linked 30 | Version". 31 | 32 | The "Minimal Corresponding Source" for a Combined Work means the 33 | Corresponding Source for the Combined Work, excluding any source code 34 | for portions of the Combined Work that, considered in isolation, are 35 | based on the Application, and not on the Linked Version. 36 | 37 | The "Corresponding Application Code" for a Combined Work means the 38 | object code and/or source code for the Application, including any data 39 | and utility programs needed for reproducing the Combined Work from the 40 | Application, but excluding the System Libraries of the Combined Work. 41 | 42 | 1. Exception to Section 3 of the GNU GPL. 43 | 44 | You may convey a covered work under sections 3 and 4 of this License 45 | without being bound by section 3 of the GNU GPL. 46 | 47 | 2. Conveying Modified Versions. 48 | 49 | If you modify a copy of the Library, and, in your modifications, a 50 | facility refers to a function or data to be supplied by an Application 51 | that uses the facility (other than as an argument passed when the 52 | facility is invoked), then you may convey a copy of the modified 53 | version: 54 | 55 | a) under this License, provided that you make a good faith effort to 56 | ensure that, in the event an Application does not supply the 57 | function or data, the facility still operates, and performs 58 | whatever part of its purpose remains meaningful, or 59 | 60 | b) under the GNU GPL, with none of the additional permissions of 61 | this License applicable to that copy. 62 | 63 | 3. Object Code Incorporating Material from Library Header Files. 64 | 65 | The object code form of an Application may incorporate material from 66 | a header file that is part of the Library. You may convey such object 67 | code under terms of your choice, provided that, if the incorporated 68 | material is not limited to numerical parameters, data structure 69 | layouts and accessors, or small macros, inline functions and templates 70 | (ten or fewer lines in length), you do both of the following: 71 | 72 | a) Give prominent notice with each copy of the object code that the 73 | Library is used in it and that the Library and its use are 74 | covered by this License. 75 | 76 | b) Accompany the object code with a copy of the GNU GPL and this license 77 | document. 78 | 79 | 4. Combined Works. 80 | 81 | You may convey a Combined Work under terms of your choice that, 82 | taken together, effectively do not restrict modification of the 83 | portions of the Library contained in the Combined Work and reverse 84 | engineering for debugging such modifications, if you also do each of 85 | the following: 86 | 87 | a) Give prominent notice with each copy of the Combined Work that 88 | the Library is used in it and that the Library and its use are 89 | covered by this License. 90 | 91 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 92 | document. 93 | 94 | c) For a Combined Work that displays copyright notices during 95 | execution, include the copyright notice for the Library among 96 | these notices, as well as a reference directing the user to the 97 | copies of the GNU GPL and this license document. 98 | 99 | d) Do one of the following: 100 | 101 | 0) Convey the Minimal Corresponding Source under the terms of this 102 | License, and the Corresponding Application Code in a form 103 | suitable for, and under terms that permit, the user to 104 | recombine or relink the Application with a modified version of 105 | the Linked Version to produce a modified Combined Work, in the 106 | manner specified by section 6 of the GNU GPL for conveying 107 | Corresponding Source. 108 | 109 | 1) Use a suitable shared library mechanism for linking with the 110 | Library. A suitable mechanism is one that (a) uses at run time 111 | a copy of the Library already present on the user's computer 112 | system, and (b) will operate properly with a modified version 113 | of the Library that is interface-compatible with the Linked 114 | Version. 115 | 116 | e) Provide Installation Information, but only if you would otherwise 117 | be required to provide such information under section 6 of the 118 | GNU GPL, and only to the extent that such information is 119 | necessary to install and execute a modified version of the 120 | Combined Work produced by recombining or relinking the 121 | Application with a modified version of the Linked Version. (If 122 | you use option 4d0, the Installation Information must accompany 123 | the Minimal Corresponding Source and Corresponding Application 124 | Code. If you use option 4d1, you must provide the Installation 125 | Information in the manner specified by section 6 of the GNU GPL 126 | for conveying Corresponding Source.) 127 | 128 | 5. Combined Libraries. 129 | 130 | You may place library facilities that are a work based on the 131 | Library side by side in a single library together with other library 132 | facilities that are not Applications and are not covered by this 133 | License, and convey such a combined library under terms of your 134 | choice, if you do both of the following: 135 | 136 | a) Accompany the combined library with a copy of the same work based 137 | on the Library, uncombined with any other library facilities, 138 | conveyed under the terms of this License. 139 | 140 | b) Give prominent notice with the combined library that part of it 141 | is a work based on the Library, and explaining where to find the 142 | accompanying uncombined form of the same work. 143 | 144 | 6. Revised Versions of the GNU Lesser General Public License. 145 | 146 | The Free Software Foundation may publish revised and/or new versions 147 | of the GNU Lesser General Public License from time to time. Such new 148 | versions will be similar in spirit to the present version, but may 149 | differ in detail to address new problems or concerns. 150 | 151 | Each version is given a distinguishing version number. If the 152 | Library as you received it specifies that a certain numbered version 153 | of the GNU Lesser General Public License "or any later version" 154 | applies to it, you have the option of following the terms and 155 | conditions either of that published version or of any later version 156 | published by the Free Software Foundation. If the Library as you 157 | received it does not specify a version number of the GNU Lesser 158 | General Public License, you may choose any version of the GNU Lesser 159 | General Public License ever published by the Free Software Foundation. 160 | 161 | If the Library as you received it specifies that a proxy can decide 162 | whether future versions of the GNU Lesser General Public License shall 163 | apply, that proxy's public statement of acceptance of any version is 164 | permanent authorization for you to choose that version for the 165 | Library. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # OCaml mysql_protocol library 2 | 3 | [![Build Status](https://travis-ci.org/slegrand45/mysql_protocol.svg?branch=master)](https://travis-ci.org/slegrand45/mysql_protocol) 4 | 5 | OCaml implementation of the native MySQL Protocol with the Bitstring library. 6 | 7 | ## How to install 8 | ``` 9 | opam install mysql_protocol 10 | ``` 11 | 12 | ## Documentation 13 | 14 | - [Examples][examples]. 15 | 16 | [examples]: https://github.com/slegrand45/mysql_protocol/tree/master/examples/ 17 | 18 | - [Tutorial][tutorial]. 19 | 20 | [tutorial]: https://github.com/slegrand45/mysql_protocol/blob/master/tutorials/tutorial.pdf?raw=true 21 | 22 | - [OCamldoc generated documentation][ocamldoc]. 23 | 24 | [ocamldoc]: http://slegrand45.github.io/mysql_protocol.site/mysql_protocol/Mysql_protocol/Mp_client/ 25 | 26 | - Interfaces: [client][client], [data conversion][data], [charsets][charset]. 27 | 28 | [charset]: https://github.com/slegrand45/mysql_protocol/blob/master/src/mp_charset.mli 29 | [client]: https://github.com/slegrand45/mysql_protocol/blob/master/src/mp_client.mli 30 | [data]: https://github.com/slegrand45/mysql_protocol/blob/master/src/mp_data.mli 31 | 32 | ## How to build 33 | 34 | ### Building the project 35 | ``` 36 | dune build 37 | ``` 38 | 39 | ### Building the documentation 40 | ``` 41 | dune build @doc 42 | ``` 43 | 44 | ## Copyright 45 | 46 | Copyright (C) 2011-2022, Stephane Legrand. 47 | -------------------------------------------------------------------------------- /benchmarks/bench.ml: -------------------------------------------------------------------------------- 1 | 2 | let standard_deviation l = 3 | let calc_sum acc e = acc +. e in 4 | let sum = List.fold_left calc_sum 0. l in 5 | let mean = sum /. (float_of_int (List.length l)) in 6 | let calc_sub acc e = (e -. mean) :: acc in 7 | let ldev = List.fold_left calc_sub [] l in 8 | let calc_square acc e = (e *. e) :: acc in 9 | let ldev = List.fold_left calc_square [] ldev in 10 | let sum_ldev = List.fold_left calc_sum 0. ldev in 11 | let r = sum_ldev /. (float_of_int ((List.length l) - 1)) in 12 | sqrt r 13 | 14 | let bench f n = 15 | let total_time = ref 0.0 in 16 | let min = ref max_float in 17 | let max = ref 0.0 in 18 | let avg = ref 0.0 in 19 | let () = 20 | for _ = 1 to n do 21 | let start = Unix.gettimeofday () in 22 | let () = f () in 23 | let stop = Unix.gettimeofday () in 24 | let time = stop -. start in 25 | let () = 26 | if (time < !min) then min := time 27 | in 28 | let () = 29 | if (time > !max) then max := time 30 | in 31 | total_time := !total_time +. time 32 | done 33 | in 34 | let () = 35 | avg := !total_time /. (float_of_int n) 36 | in 37 | (!total_time, !min, !max, !avg) 38 | 39 | let () = 40 | 41 | let time_mp = ref 0.0 in 42 | let min_mp = ref max_float in 43 | let max_mp = ref 0.0 in 44 | let avg_mp = ref 0.0 in 45 | 46 | let time_mc = ref 0.0 in 47 | let min_mc = ref max_float in 48 | let max_mc = ref 0.0 in 49 | let avg_mc = ref 0.0 in 50 | 51 | let nb_run = 5 in 52 | let nb_iter = 500 in 53 | 54 | let list_times_mp = ref [] in 55 | let list_times_mc = ref [] in 56 | 57 | let () = 58 | for i = 1 to nb_run do 59 | let () = print_newline () in 60 | let () = print_endline (Printf.sprintf "Run %u (one run = %u iter):" i nb_iter) in 61 | 62 | let (time, min, max, avg) = bench Bench_mysql_protocol.run nb_iter in 63 | let () = if (time < !min_mp) then min_mp := time in 64 | let () = if (time > !max_mp) then max_mp := time in 65 | let () = time_mp := !time_mp +. time in 66 | let () = print_endline (Printf.sprintf " MySQL Protocol (sec.): Total=%f Avg (total time / %u)=%f Min (1 iter)=%f Max (1 iter)=%f" time nb_iter avg min max) in 67 | let () = list_times_mp := time :: !list_times_mp in 68 | 69 | let (time, min, max, avg) = bench Bench_mysql_libc.run nb_iter in 70 | let () = if (time < !min_mc) then min_mc := time in 71 | let () = if (time > !max_mc) then max_mc := time in 72 | let () = time_mc := !time_mc +. time in 73 | let () = print_endline (Printf.sprintf " MySQL C library (sec.): Total=%f Avg (total time / %u)=%f Min (1 iter)=%f Max (1 iter)=%f" time nb_iter avg min max) in 74 | let () = list_times_mc := time :: !list_times_mc in 75 | 76 | let () = print_newline () in 77 | () 78 | done 79 | in 80 | let () = avg_mp := !time_mp /. (float_of_int nb_run) in 81 | let () = avg_mc := !time_mc /. (float_of_int nb_run) in 82 | 83 | let sd_mp = standard_deviation !list_times_mp in 84 | let sd_mc = standard_deviation !list_times_mc in 85 | 86 | let () = print_newline () in 87 | let () = print_endline (Printf.sprintf "Results for %u runs of %u iter:" nb_run nb_iter) in 88 | let () = print_endline (Printf.sprintf " MySQL Protocol (seconds): Total=%f Avg (total time / %u)=%f Std deviation=%f Min (1 run)=%f Max (1 run)=%f" !time_mp nb_run !avg_mp sd_mp !min_mp !max_mp) in 89 | let () = print_endline (Printf.sprintf " MySQL C library (seconds): Total=%f Avg (total time / %u)=%f Std deviation=%f Min (1 run)=%f Max (1 run)=%f" !time_mc nb_run !avg_mc sd_mc !min_mc !max_mc) in 90 | () 91 | -------------------------------------------------------------------------------- /benchmarks/bench_config.ml: -------------------------------------------------------------------------------- 1 | (* let host = "192.168.1.20" 2 | let addr = Unix.inet_addr_of_string host 3 | let port = 3306 *) 4 | let sockaddr = "/usr/jails/mariadb/var/run/mysql/mysql.sock" 5 | let db_user = "user_ocaml_ocmp" 6 | let db_password = "ocmp" 7 | let db_name = "test_ocaml_ocmp_utf8" 8 | -------------------------------------------------------------------------------- /benchmarks/bench_mysql_libc.ml: -------------------------------------------------------------------------------- 1 | 2 | let print_set sql r = 3 | let print_row e = 4 | let (id, col1, col2) = e in 5 | let s = Printf.sprintf " id: %Lu\n col1: %s\n col2: %s\n -- --" id col1 col2 in 6 | print_endline (s ^ "\n") 7 | in 8 | let () = print_endline ("Result set for the SQL statement \"" ^ sql ^ "\":\n") in 9 | List.iter print_row r 10 | 11 | let build_set r = 12 | let col = Mysql.column r in 13 | let row x = ( Mysql.not_null Mysql.int642ml (col ~key:"id" ~row:x), 14 | Mysql.not_null Mysql.str2ml (col ~key:"col1" ~row:x), 15 | Mysql.not_null Mysql.decimal2ml (col ~key:"col2" ~row:x) 16 | ) in 17 | let rec loop = function 18 | | None -> [] 19 | | Some x -> row x :: loop (Mysql.fetch r) 20 | in 21 | loop (Mysql.fetch r) 22 | 23 | let build_set_from_prepare r = 24 | let row x = 25 | ( Mysql.not_null Mysql.int642ml x.(0), 26 | Mysql.not_null Mysql.str2ml x.(1), 27 | Mysql.not_null Mysql.decimal2ml x.(2) 28 | ) 29 | in 30 | let rec loop = function 31 | | None -> [] 32 | | Some x -> row x :: loop (Mysql.Prepared.fetch r) 33 | in 34 | loop (Mysql.Prepared.fetch r) 35 | 36 | let run() = 37 | 38 | let conf = { 39 | Mysql.dbhost = None; 40 | Mysql.dbname = None; 41 | Mysql.dbport = None; 42 | Mysql.dbpwd = Some Bench_config.db_password; 43 | Mysql.dbuser = Some Bench_config.db_user; 44 | Mysql.dbsocket = Some Bench_config.sockaddr; 45 | } in 46 | 47 | let db = Mysql.connect ~options:[] conf in 48 | 49 | let _ = Mysql.exec db "DROP TABLE IF EXISTS ocmp_table" in 50 | 51 | let _ = Mysql.exec db "CREATE TABLE IF NOT EXISTS ocmp_table (id BIGINT AUTO_INCREMENT, col1 VARCHAR(255), col2 DECIMAL(30,10), PRIMARY KEY(id))" in 52 | 53 | let _ = Mysql.exec db "INSERT INTO ocmp_table (col1, col2) VALUES ('col1', 123.45)" in 54 | 55 | let stmt = Mysql.Prepared.create db "INSERT INTO ocmp_table (col1, col2) VALUES (?, ?)" in 56 | let params = Array.make 2 "" in 57 | let () = params.(0) <- "col2" in 58 | let () = params.(1) <- Mysql.ml2decimal "98765/100" in 59 | let _ = Mysql.Prepared.execute stmt params in 60 | let () = Mysql.Prepared.close stmt in 61 | 62 | let sql = "SELECT * FROM ocmp_table ORDER BY col1" in 63 | let r = Mysql.exec db sql in 64 | let _ = build_set r in 65 | (* let () = print_set sql r in *) 66 | 67 | let sql = "SELECT * FROM ocmp_table WHERE col1=?" in 68 | let stmt = Mysql.Prepared.create db sql in 69 | let params = Array.make 1 "" in 70 | let () = params.(0) <- "col1" in 71 | let r = Mysql.Prepared.execute stmt params in 72 | let _ = build_set_from_prepare r in 73 | (* let () = print_set sql r in *) 74 | let () = Mysql.Prepared.close stmt in 75 | 76 | let () = Mysql.disconnect db in 77 | 78 | () 79 | -------------------------------------------------------------------------------- /benchmarks/bench_mysql_protocol.ml: -------------------------------------------------------------------------------- 1 | 2 | module Mp_client = Mysql_protocol.Mp_client;; 3 | module Mp_data = Mysql_protocol.Mp_data;; 4 | module Mp_execute = Mysql_protocol.Mp_execute;; 5 | module Mp_result_set_packet = Mysql_protocol.Mp_result_set_packet;; 6 | 7 | let print_result sql r = 8 | print_endline ("Result of the SQL statement \"" ^ sql ^ "\": \n " ^ (Mp_client.dml_dcl_result_to_string r) ^ "\n") 9 | 10 | let print_row fields row = 11 | let print_data f = 12 | let (field_name, field_pos) = f in 13 | let data = List.nth row field_pos in 14 | print_endline (" " ^ field_name ^ ": " ^ (Option.value (Mp_data.to_string data) ~default:"")) 15 | in 16 | let () = List.iter print_data fields in 17 | print_endline " -- -- " 18 | 19 | let print_set sql r = 20 | let (fields, rows) = r.Mp_result_set_packet.rows in 21 | let () = print_endline ("Result set for the SQL statement \"" ^ sql ^ "\": \n") in 22 | let print_rows = 23 | let () = List.iter (print_row fields) rows in 24 | print_newline () 25 | in 26 | print_rows 27 | 28 | let run() = 29 | try 30 | (* let addr = Bench_config.addr in 31 | let port = Bench_config.port in *) 32 | let sockaddr = Unix.ADDR_UNIX Bench_config.sockaddr in 33 | let db_user = Bench_config.db_user in 34 | let db_password = Bench_config.db_password in 35 | let db_name = Bench_config.db_name in 36 | 37 | let config = Mp_client.configuration ~user:db_user ~password:db_password ~sockaddr:sockaddr ~databasename:db_name () in 38 | 39 | let connection = Mp_client.connect ~configuration:config () in 40 | 41 | let () = Mp_client.use_database ~connection:connection ~databasename:db_name in 42 | 43 | let sql = "DROP TABLE IF EXISTS ocmp_table" in 44 | let stmt = Mp_client.create_statement_from_string sql in 45 | let r = Mp_client.execute ~connection:connection ~statement:stmt () in 46 | let r = Mp_client.get_result r in 47 | let _ = Mp_client.get_result_ok r in 48 | (* let () = print_result sql r in *) 49 | 50 | let sql = "CREATE TABLE IF NOT EXISTS ocmp_table (id BIGINT AUTO_INCREMENT, col1 VARCHAR(255), col2 DECIMAL(30,10), PRIMARY KEY(id))" in 51 | let stmt = Mp_client.create_statement_from_string sql in 52 | let r = Mp_client.execute ~connection:connection ~statement:stmt () in 53 | let r = Mp_client.get_result r in 54 | let _ = Mp_client.get_result_ok r in 55 | (* let () = print_result sql r in *) 56 | 57 | let sql = "INSERT INTO ocmp_table (col1, col2) VALUES ('col1', 123.45)" in 58 | let stmt = Mp_client.create_statement_from_string sql in 59 | let r = Mp_client.execute ~connection:connection ~statement:stmt () in 60 | let r = Mp_client.get_result r in 61 | let _ = Mp_client.get_result_ok r in 62 | (* let () = print_result sql r in *) 63 | 64 | let params = [Mp_data.data_varstring "col2"; Mp_data.data_decimal (Num.num_of_string "98765/100")] in 65 | let sql = "INSERT INTO ocmp_table (col1, col2) VALUES (?, ?)" in 66 | let stmt = Mp_client.create_statement_from_string sql in 67 | let prep = Mp_client.prepare ~connection:connection ~statement:stmt in 68 | let r = Mp_client.execute ~connection:connection ~statement:prep ~params:params () in 69 | let () = Mp_client.close_statement ~connection:connection ~statement:prep in 70 | let r = Mp_client.get_result r in 71 | let _ = Mp_client.get_result_ok r in 72 | (* let () = print_result sql r in *) 73 | 74 | let sql = "SELECT * FROM ocmp_table ORDER BY col1" in 75 | let stmt = Mp_client.create_statement_from_string sql in 76 | let r = Mp_client.execute ~connection:connection ~statement:stmt () in 77 | let r = Mp_client.get_result r in 78 | let _ = Mp_client.get_result_set r in 79 | (* let () = print_set sql r in *) 80 | 81 | let params = [Mp_data.data_varstring "col1"] in 82 | let sql = "SELECT * FROM ocmp_table WHERE col1=?" in 83 | let stmt = Mp_client.create_statement_from_string sql in 84 | let prep = Mp_client.prepare ~connection:connection ~statement:stmt in 85 | let stmt = Mp_client.execute ~connection:connection ~statement:prep ~params:params ~flag:Mp_execute.Cursor_type_read_only () in 86 | let () = 87 | try 88 | while true do 89 | let rows = Mp_client.fetch ~connection:connection ~statement:stmt () in 90 | let _ = Mp_client.get_fetch_result_set rows in 91 | () (* print_set sql rows *) 92 | done 93 | with 94 | | Mp_client.Fetch_no_more_rows -> () (* no more rows in the result *) 95 | in 96 | let () = Mp_client.close_statement ~connection:connection ~statement:prep in 97 | 98 | let () = Mp_client.disconnect ~connection:connection in 99 | () 100 | with 101 | | Mp_client.Error error -> ( 102 | print_newline (); 103 | print_endline ("Exception: " ^ (Mp_client.error_exception_to_string error)) 104 | ) 105 | -------------------------------------------------------------------------------- /benchmarks/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name bench) 3 | (libraries mysql_protocol mysql)) -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev 3 | (flags (:standard -w -8)))) 4 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.7) 2 | 3 | (name mysql_protocol) 4 | 5 | (version 3.0.3) 6 | 7 | (generate_opam_files true) 8 | 9 | (source (github slegrand45/mysql_protocol)) 10 | (license LGPL-3.0-or-later) 11 | (authors "Stéphane Legrand") 12 | (maintainers "Stéphane Legrand") 13 | 14 | (package 15 | (name mysql_protocol) 16 | (synopsis "OCaml implementation of the native MySQL/MariaDB Protocol with the Bitstring library") 17 | (description "This library allows you to access the functionality provided by MySQL or MariaDB") 18 | (depends 19 | num 20 | (ocaml (>= 4.09.0)) 21 | cryptokit 22 | (ounit2 :with-test) 23 | (bitstring (>= 4.0.1)) 24 | (ppx_bitstring (>= 4.0.1)) 25 | )) 26 | -------------------------------------------------------------------------------- /examples/client.ml: -------------------------------------------------------------------------------- 1 | 2 | (** 3 | A client session example. 4 | *) 5 | 6 | module Mp_client = Mysql_protocol.Mp_client 7 | module Mp_data = Mysql_protocol.Mp_data 8 | module Mp_execute = Mysql_protocol.Mp_execute 9 | module Mp_result_set_packet = Mysql_protocol.Mp_result_set_packet 10 | module Mp_capabilities = Mysql_protocol.Mp_capabilities 11 | 12 | let run() = 13 | (* helper function to display ok result (INSERT, UPDATE... result) *) 14 | let print_result sql r = 15 | print_endline ("Result of the SQL statement \"" ^ sql ^ "\": \n " ^ (Mp_client.dml_dcl_result_to_string r) ^ "\n") 16 | in 17 | 18 | (* helper functions to display set result (SELECT result) *) 19 | let print_row fields row = 20 | let print_data f = 21 | let (field_name, field_pos) = f in 22 | let data = List.nth row field_pos in 23 | print_endline (" " ^ field_name ^ ": " ^ (Option.value (Mp_data.to_string data) ~default:"")) 24 | in 25 | let () = List.iter print_data fields in 26 | print_endline " -- -- " 27 | in 28 | let print_set sql r = 29 | let (fields, rows) = r.Mp_result_set_packet.rows in 30 | let () = print_endline ("Result set for the SQL statement \"" ^ sql ^ "\": \n") in 31 | let print_rows = 32 | let () = List.iter (print_row fields) rows in 33 | print_newline () 34 | in 35 | print_rows 36 | in 37 | 38 | (* server address *) 39 | (* let addr = Unix.inet_addr_of_string "192.168.1.20" in *) 40 | 41 | (* server port *) 42 | (* let port = 3306 in *) 43 | 44 | (* let sockaddr = Unix.ADDR_INET(addr, port) in *) 45 | let sockaddr = Unix.ADDR_UNIX "/usr/jails/mariadb/var/run/mysql/mysql.sock" in 46 | 47 | (* MySQL user login *) 48 | let db_user = "user_ocaml_ocmp" in 49 | let db_user_2 = "u_ocmp_npauth" in 50 | 51 | (* MySQL user password *) 52 | let db_password = "ocmp" in 53 | let db_password_2 = "ocmpnpauth" in 54 | 55 | (* database name *) 56 | let db_name = "test_ocaml_ocmp_utf8" in 57 | 58 | (* configuration *) 59 | let config = Mp_client.configuration ~user:db_user ~password:db_password ~sockaddr:sockaddr ~databasename:db_name () in 60 | 61 | (* connection *) 62 | let connection = Mp_client.connect ~configuration:config () in 63 | 64 | (* use database *) 65 | let () = Mp_client.use_database ~connection:connection ~databasename:db_name in 66 | 67 | (* delete table with a non prepared statement to have a clean database *) 68 | let sql = "DROP TABLE IF EXISTS ocmp_table" in 69 | let stmt = Mp_client.create_statement_from_string sql in 70 | let r = Mp_client.execute ~connection:connection ~statement:stmt () in 71 | let r = Mp_client.get_result r in 72 | let r = Mp_client.get_result_ok r in 73 | let () = print_result sql r in 74 | 75 | (* create table with a non prepared statement *) 76 | let sql = "CREATE TABLE IF NOT EXISTS ocmp_table (id BIGINT AUTO_INCREMENT, col1 VARCHAR(255), col2 DECIMAL(30,10), PRIMARY KEY(id))" in 77 | let stmt = Mp_client.create_statement_from_string sql in 78 | let r = Mp_client.execute ~connection:connection ~statement:stmt () in 79 | let r = Mp_client.get_result r in 80 | let r = Mp_client.get_result_ok r in 81 | let () = print_result sql r in 82 | 83 | (* send non prepared SQL statement *) 84 | let sql = "INSERT INTO ocmp_table (col1, col2) VALUES ('col1', 123.45)" in 85 | let stmt = Mp_client.create_statement_from_string sql in 86 | let r = Mp_client.execute ~connection:connection ~statement:stmt () in 87 | let r = Mp_client.get_result r in 88 | let r = Mp_client.get_result_ok r in 89 | let () = print_result sql r in 90 | 91 | (* send prepared SQL statement with params *) 92 | let params = [Mp_data.data_varstring "col2"; Mp_data.data_decimal (Num.num_of_string "98765/100")] in 93 | let sql = "INSERT INTO ocmp_table (col1, col2) VALUES (?, ?)" in 94 | let stmt = Mp_client.create_statement_from_string sql in 95 | let prep = Mp_client.prepare ~connection:connection ~statement:stmt in 96 | let r = Mp_client.execute ~connection:connection ~statement:prep ~params:params () in 97 | let () = Mp_client.close_statement ~connection:connection ~statement:prep in 98 | let r = Mp_client.get_result r in 99 | let r = Mp_client.get_result_ok r in 100 | let () = print_result sql r in 101 | 102 | (* send non prepared SELECT statement *) 103 | let sql = "SELECT * FROM ocmp_table ORDER BY col1" in 104 | let stmt = Mp_client.create_statement_from_string sql in 105 | let r = Mp_client.execute ~connection:connection ~statement:stmt () in 106 | let r = Mp_client.get_result r in 107 | let r = Mp_client.get_result_set r in 108 | let () = print_set sql r in 109 | 110 | (* send prepared SELECT statement with params but no fetch *) 111 | let params = [Mp_data.data_decimal (Num.num_of_string "98765/100")] in 112 | let sql = "SELECT * FROM ocmp_table WHERE col2=?" in 113 | let stmt = Mp_client.create_statement_from_string sql in 114 | let prep = Mp_client.prepare ~connection:connection ~statement:stmt in 115 | let r = Mp_client.execute ~connection:connection ~statement:prep ~params:params () in 116 | let () = Mp_client.close_statement ~connection:connection ~statement:prep in 117 | let r = Mp_client.get_result r in 118 | let r = Mp_client.get_result_set r in 119 | let () = print_set sql r in 120 | 121 | (* send prepared SELECT statement with params and fetch the result *) 122 | let params = [Mp_data.data_varstring "col1"] in 123 | let sql = "SELECT * FROM ocmp_table WHERE col1=?" in 124 | let stmt = Mp_client.create_statement_from_string sql in 125 | let prep = Mp_client.prepare ~connection:connection ~statement:stmt in 126 | let stmt = Mp_client.execute ~connection:connection ~statement:prep ~params:params ~flag:Mp_execute.Cursor_type_read_only () in 127 | let () = 128 | try 129 | while true do 130 | let rows = Mp_client.fetch ~connection:connection ~statement:stmt () in 131 | let rows = Mp_client.get_fetch_result_set rows in 132 | print_set sql rows 133 | done 134 | with 135 | | Mp_client.Fetch_no_more_rows -> () (* no more rows in the result *) 136 | in 137 | let () = Mp_client.close_statement ~connection:connection ~statement:prep in 138 | 139 | (* send non prepared SELECT statement and embed the print function *) 140 | let sql = "SELECT * FROM ocmp_table ORDER BY col1" in 141 | let stmt = Mp_client.create_statement_from_string sql in 142 | let () = print_endline ("Result set for the SQL statement \"" ^ sql ^ "\" (print function embedded): \n") in 143 | let _ = Mp_client.execute ~connection:connection ~statement:stmt ~iter:(Some print_row) () in 144 | 145 | (* PING server *) 146 | let () = Mp_client.ping ~connection:connection in 147 | 148 | (* change user *) 149 | let _ = Mp_client.change_user ~connection:connection ~user:db_user_2 ~password:db_password_2 ~databasename:db_name () in 150 | 151 | (* reset session (equivalent to a disconnect and reconnect) *) 152 | let () = Mp_client.reset_session ~connection:connection in 153 | 154 | (* reset connection without re-authentication *) 155 | let () = Mp_client.reset_connection ~connection:connection in 156 | 157 | (* catch MySQL error *) 158 | let stmt = Mp_client.create_statement_from_string ("BAD SQL QUERY") in 159 | let () = 160 | try 161 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 162 | () 163 | with 164 | | Mp_client.Error error -> 165 | print_newline (); 166 | print_endline ("This is a test to show how to catch a MySQL error, the exception is: " ^ (Mp_client.error_exception_to_string error)); 167 | print_newline (); 168 | in 169 | 170 | (* create and call a procedure *) 171 | let sql = "DROP PROCEDURE IF EXISTS ocmp_proc" in 172 | let stmt = Mp_client.create_statement_from_string sql in 173 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 174 | let sql = "CREATE PROCEDURE ocmp_proc() BEGIN SELECT * FROM ocmp_table; END" in 175 | let stmt = Mp_client.create_statement_from_string sql in 176 | let r = Mp_client.execute ~connection:connection ~statement:stmt () in 177 | let r = Mp_client.get_result r in 178 | let r = Mp_client.get_result_ok r in 179 | let () = print_result sql r in 180 | let sql = "CALL ocmp_proc()" in 181 | let stmt = Mp_client.create_statement_from_string sql in 182 | let r = Mp_client.execute ~connection:connection ~statement:stmt () in 183 | let r = Mp_client.get_result_multiple r in 184 | let f e = 185 | try 186 | let rs = Mp_client.get_result_set e in 187 | print_set sql rs 188 | with 189 | | Failure _ -> 190 | let rs = Mp_client.get_result_ok e in 191 | let affected_rows = rs.Mp_client.affected_rows in 192 | print_endline (Printf.sprintf "Result OK: affected rows=%Ld" affected_rows) 193 | in 194 | let () = List.iter f r in 195 | 196 | (* disconnect *) 197 | let () = Mp_client.disconnect ~connection:connection in 198 | () 199 | -------------------------------------------------------------------------------- /examples/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name run) 3 | (libraries mysql_protocol)) -------------------------------------------------------------------------------- /examples/run.ml: -------------------------------------------------------------------------------- 1 | Client.run() 2 | -------------------------------------------------------------------------------- /mysql_protocol.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "3.0.3" 4 | synopsis: 5 | "OCaml implementation of the native MySQL/MariaDB Protocol with the Bitstring library" 6 | description: 7 | "This library allows you to access the functionality provided by MySQL or MariaDB" 8 | maintainer: ["Stéphane Legrand"] 9 | authors: ["Stéphane Legrand"] 10 | license: "LGPL-3.0-or-later" 11 | homepage: "https://github.com/slegrand45/mysql_protocol" 12 | bug-reports: "https://github.com/slegrand45/mysql_protocol/issues" 13 | depends: [ 14 | "dune" {>= "2.7"} 15 | "num" 16 | "ocaml" {>= "4.09.0"} 17 | "cryptokit" 18 | "ounit2" {with-test} 19 | "bitstring" {>= "4.0.1"} 20 | "ppx_bitstring" {>= "4.0.1"} 21 | "odoc" {with-doc} 22 | ] 23 | build: [ 24 | ["dune" "subst"] {dev} 25 | [ 26 | "dune" 27 | "build" 28 | "-p" 29 | name 30 | "-j" 31 | jobs 32 | "@install" 33 | "@runtest" {with-test} 34 | "@doc" {with-doc} 35 | ] 36 | ] 37 | dev-repo: "git+https://github.com/slegrand45/mysql_protocol.git" 38 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name mysql_protocol) 3 | (public_name mysql_protocol) 4 | (libraries num cryptokit bitstring) 5 | (preprocess 6 | (pps ppx_bitstring))) 7 | -------------------------------------------------------------------------------- /src/mp_auth_switch_request.ml: -------------------------------------------------------------------------------- 1 | 2 | type auth_switch_request_packet = { 3 | plugin_name : string; 4 | plugin_data : Bitstring.t 5 | } 6 | 7 | let auth_switch_request_packet_to_string p = 8 | Printf.sprintf "plugin_name : %s\nplugin_data : %s\n" 9 | p.plugin_name (Bitstring.string_of_bitstring p.plugin_data) 10 | 11 | let auth_switch_request_packet_bits_without_0xFE_prefix bits = 12 | let length = Bitstring.bitstring_length bits in 13 | match%bitstring bits with 14 | | {| "mysql_native_password" : 21*8 : string; 15 | 0x00 : 8 : int; 16 | plugin_data : length - ((21+1+1)*8) : bitstring; 17 | 0x00 : 8 : int |} -> 18 | { plugin_name = "mysql_native_password"; plugin_data } 19 | -------------------------------------------------------------------------------- /src/mp_authentication.ml: -------------------------------------------------------------------------------- 1 | let xor_string s1 s2 = 2 | (* s1 and s2 must have the same length *) 3 | let s = ref "" in 4 | let i = ref 0 in 5 | let f c1 = 6 | let c2 = String.get s2 !i in 7 | let c = (Char.code c1) lxor (Char.code c2) in 8 | let c = Char.chr c in 9 | s := !s ^ (String.make 1 c); 10 | i := !i + 1 11 | in 12 | let () = String.iter f s1 in 13 | !s 14 | 15 | let encode_client_password scramble password = 16 | let hash s = Cryptokit.hash_string (Cryptokit.Hash.sha1()) s in 17 | let hash_stage1 = hash password in 18 | let hash_stage2 = hash hash_stage1 in 19 | let hash_stage3 = hash (scramble ^ hash_stage2) in 20 | let reply = xor_string hash_stage1 hash_stage3 in 21 | reply 22 | 23 | (* 24 | /!\ : bad capabilities can prevent right authentication 25 | This list works : 26 | Client_long_password; Client_long_flag; Client_protocol_41; 27 | Client_transactions; Client_secure_connection; 28 | *) 29 | let client_authentication_packet ~handshake ~capabilities ~max_packet_size ~charset_number ~user ~password ~databasename ~auth_plugin_name = 30 | let client_flags = Int64.of_int (Mp_capabilities.encode_client_capabilities capabilities) in 31 | let filler = Bitstring.make_bitstring (23*8) '\x00' in 32 | let user = Mp_string.make_null_terminated_string user in 33 | let length_user = String.length user in 34 | 35 | let scramble_buff = Bitstring.concat [handshake.Mp_handshake.scramble_buff_1; handshake.Mp_handshake.scramble_buff_2] in 36 | let scramble_buff = Bitstring.string_of_bitstring scramble_buff in 37 | let credential = 38 | if (String.length password > 0) then ( 39 | (* /!\ : length coded binary <= 250 bytes ?? *) 40 | let encoded_password = encode_client_password scramble_buff password in 41 | let length_encoded_password = String.length encoded_password in 42 | let c = Char.chr length_encoded_password in 43 | (String.make 1 c) ^ encoded_password 44 | ) 45 | else ( 46 | String.make 1 '\x00' 47 | ) 48 | in 49 | let length_credential = String.length credential in 50 | 51 | (* TODO (?): check CLIENT_CONNECT_WITH_DB is set in flags *) 52 | let db = Bitstring.bitstring_of_string (Mp_string.make_null_terminated_string databasename) in 53 | let length_db = Bitstring.bitstring_length db in 54 | 55 | (* TODO (?): check CLIENT_PLUGIN_AUTH is set in flags *) 56 | let plugin = Mp_string.make_null_terminated_string auth_plugin_name in 57 | let length_plugin = String.length plugin in 58 | 59 | let%bitstring bits = {| 60 | client_flags : Mp_bitstring.compute32 : int, unsigned, littleendian; 61 | max_packet_size : Mp_bitstring.compute32 : int, unsigned, bigendian; 62 | charset_number : 1*8 : int, unsigned, bigendian; 63 | filler : 23*8 : bitstring; 64 | user : length_user*8 : string; 65 | credential : length_credential*8 : string; 66 | db : length_db : bitstring; 67 | plugin : length_plugin*8 : string 68 | |} 69 | in 70 | let bits = Bitstring.concat [bits; db] in 71 | let bits = Mp_packet.make_packet handshake.Mp_handshake.packet_number bits in 72 | bits 73 | -------------------------------------------------------------------------------- /src/mp_binary.ml: -------------------------------------------------------------------------------- 1 | let length_coded_binary bits = 2 | let length_rest = (Bitstring.bitstring_length bits) - 8 in 3 | match%bitstring bits with 4 | | {| byte1 : 1*8 : int, unsigned, bigendian; 5 | rest : length_rest : bitstring |} -> ( 6 | let length = Bitstring.bitstring_length rest in 7 | if byte1 <= 250 then (* one byte integer *) 8 | (Int64.of_int byte1, rest) 9 | (* 251 : NULL value and only in a row data packet 10 | this special value is handled in the row data packet function *) 11 | else if byte1 = 251 then (* NULL value *) 12 | (Int64.of_int byte1, rest) 13 | else if byte1 = 252 then (* two bytes integer *) 14 | let () = 15 | if (length < 2*8) then ( 16 | failwith (Printf.sprintf "Bad length (2 bytes expected but %u bits available) in length coded binary" length) 17 | ) 18 | in 19 | let length_rest = (Bitstring.bitstring_length rest) - (2*8) in 20 | match%bitstring rest with 21 | | {| i : 2*8 : int, unsigned, littleendian; 22 | rest : length_rest : bitstring |} -> 23 | (Int64.of_int i, rest) 24 | else if byte1 = 253 then (* three bytes integer *) 25 | let () = 26 | if (length < 3*8) then ( 27 | failwith (Printf.sprintf "Bad length (3 bytes expected but %u bits available) in length coded binary" length) 28 | ) 29 | in 30 | let length_rest = (Bitstring.bitstring_length rest) - (3*8) in 31 | match%bitstring rest with 32 | | {| i : 3*8 : int, unsigned, littleendian; 33 | rest : length_rest : bitstring |} -> 34 | (Int64.of_int i, rest) 35 | else if byte1 = 254 then (* height bytes integer *) 36 | let () = 37 | if (length < 8*8) then ( 38 | failwith (Printf.sprintf "Bad length (8 bytes expected but %u bits available) in length coded binary" length) 39 | ) 40 | in 41 | let length_rest = (Bitstring.bitstring_length rest) - (8*8) in 42 | match%bitstring rest with 43 | | {| i : 8*8 : int, unsigned, littleendian; (* /!\ unsigned 64 bits *) 44 | rest : length_rest : bitstring |} -> 45 | (i, rest) 46 | else ( 47 | failwith (Printf.sprintf "Unknown byte1 = %u in length coded binary" byte1) 48 | ) 49 | ) 50 | 51 | let build_length_coded_binary length = 52 | if (length <= 250) then 53 | let%bitstring v = 54 | {| length : 1*8 : int, unsigned, littleendian |} 55 | in v 56 | else if (length <= 65536) then 57 | let%bitstring v = 58 | {| 252 : 1*8 : int, unsigned, littleendian; 59 | length : 2*8 : int, unsigned, littleendian |} 60 | in v 61 | else if (length <= 16777216) then 62 | let%bitstring v = 63 | {| 253 : 1*8 : int, unsigned, littleendian; 64 | length : 3*8 : int, unsigned, littleendian |} 65 | in v 66 | else 67 | let length = Int64.of_int length in 68 | let%bitstring v = 69 | {| 254 : 1*8 : int, unsigned, littleendian; 70 | length : 8*8 : int, unsigned, littleendian |} 71 | in v 72 | -------------------------------------------------------------------------------- /src/mp_bitstring.ml: -------------------------------------------------------------------------------- 1 | 2 | (* to have a 4*8 computed expression in order to force a Int64 type for length *) 3 | let compute32 = 4 * 8 4 | -------------------------------------------------------------------------------- /src/mp_capabilities.ml: -------------------------------------------------------------------------------- 1 | type capabilities = 2 | Client_long_password 3 | | Client_found_rows 4 | | Client_long_flag 5 | | Client_connect_with_db 6 | | Client_no_schema 7 | | Client_compress 8 | | Client_odbc 9 | | Client_local_files 10 | | Client_ignore_space 11 | | Client_protocol_41 12 | | Client_interactive 13 | | Client_ssl 14 | | Client_ignore_sigpipe 15 | | Client_transactions 16 | | Client_reserved 17 | | Client_secure_connection 18 | | Client_multi_statements 19 | | Client_multi_results 20 | 21 | let capabilities_to_string capabilities = 22 | let build_string acc capability = 23 | match capability with 24 | Client_long_password -> acc ^ "CLIENT_LONG_PASSWORD," 25 | | Client_found_rows -> acc ^ "CLIENT_FOUND_ROWS," 26 | | Client_long_flag -> acc ^ "CLIENT_LONG_FLAG," 27 | | Client_connect_with_db -> acc ^ "CLIENT_CONNECT_WITH_DB," 28 | | Client_no_schema -> acc ^ "CLIENT_NO_SCHEMA," 29 | | Client_compress -> acc ^ "CLIENT_COMPRESS," 30 | | Client_odbc -> acc ^ "CLIENT_ODBC," 31 | | Client_local_files -> acc ^ "CLIENT_LOCAL_FILES," 32 | | Client_ignore_space -> acc ^ "CLIENT_IGNORE_SPACE," 33 | | Client_protocol_41 -> acc ^ "CLIENT_PROTOCOL_41," 34 | | Client_interactive -> acc ^ "CLIENT_INTERACTIVE," 35 | | Client_ssl -> acc ^ "CLIENT_SSL," 36 | | Client_ignore_sigpipe -> acc ^ "CLIENT_IGNORE_SIGPIPE," 37 | | Client_transactions -> acc ^ "CLIENT_TRANSACTIONS," 38 | | Client_reserved -> acc ^ "CLIENT_RESERVED," 39 | | Client_secure_connection -> acc ^ "CLIENT_SECURE_CONNECTION," 40 | | Client_multi_statements -> acc ^ "CLIENT_MULTI_STATEMENTS," 41 | | Client_multi_results -> acc ^ "CLIENT_MULTI_RESULTS" 42 | in 43 | let s = List.fold_left build_string "" capabilities in 44 | if String.length s > 0 then String.sub s 0 ((String.length s) - 1) else s 45 | 46 | (* /!\ : NEED CHECK !!!!!! *) 47 | let decode_server_capabilities bits = 48 | match%bitstring bits with 49 | (* 50 | | { 51 | long_password : 1; 52 | found_rows : 1; 53 | long_flag : 1; 54 | connect_with_db : 1; 55 | no_schema : 1; 56 | compress : 1; 57 | odbc : 1; 58 | local_files : 1; 59 | ignore_space : 1; 60 | protocol_41 : 1; 61 | interactive : 1; 62 | ssl : 1; 63 | ignore_sigpipe : 1; 64 | transactions : 1; 65 | reserved : 1; 66 | secure_connection : 1 67 | } 68 | *) 69 | | {| 70 | secure_connection : 1; 71 | reserved : 1; 72 | transactions : 1; 73 | ignore_sigpipe : 1; 74 | ssl : 1; 75 | interactive : 1; 76 | protocol_41 : 1; 77 | ignore_space : 1; 78 | local_files : 1; 79 | odbc : 1; 80 | compress : 1; 81 | no_schema : 1; 82 | connect_with_db : 1; 83 | long_flag : 1; 84 | found_rows : 1; 85 | long_password : 1 |} -> 86 | let l = [] in 87 | let l = if long_password then Client_long_password::l else l in 88 | let l = if found_rows then Client_found_rows::l else l in 89 | let l = if long_flag then Client_long_flag::l else l in 90 | let l = if connect_with_db then Client_connect_with_db::l else l in 91 | let l = if no_schema then Client_no_schema::l else l in 92 | let l = if compress then Client_compress::l else l in 93 | let l = if odbc then Client_odbc::l else l in 94 | let l = if local_files then Client_local_files::l else l in 95 | let l = if ignore_space then Client_ignore_space::l else l in 96 | let l = if protocol_41 then Client_protocol_41::l else l in 97 | let l = if interactive then Client_interactive::l else l in 98 | let l = if ssl then Client_ssl::l else l in 99 | let l = if ignore_sigpipe then Client_ignore_sigpipe::l else l in 100 | let l = if transactions then Client_transactions::l else l in 101 | let l = if reserved then Client_reserved::l else l in 102 | let l = if secure_connection then Client_secure_connection::l else l in 103 | l 104 | 105 | (* 106 | /!\ : WARNING : the wiki doc includes several other constants 107 | greater than a 16 bits value !! 108 | 109 | Anyway, it seems ok : 110 | 111 | http://bugs.mysql.com/bug.php?id=42268 112 | 113 | CLIENT_MULTI_STATEMENTS 65536 /* Enable/disable multi-stmt support */ 114 | CLIENT_MULTI_RESULTS 131072 /* Enable/disable multi-results */ 115 | ... 116 | 117 | *) 118 | let encode_client_capabilities capabilities_list = 119 | let sum_capability sum c = 120 | match c with 121 | | Client_long_password -> sum + 1 122 | | Client_found_rows -> sum + 2 123 | | Client_long_flag -> sum + 4 124 | | Client_connect_with_db -> sum + 8 125 | | Client_no_schema -> sum + 16 126 | | Client_compress -> sum + 32 127 | | Client_odbc -> sum + 64 128 | | Client_local_files -> sum + 128 129 | | Client_ignore_space -> sum + 256 130 | | Client_protocol_41 -> sum + 512 131 | | Client_interactive -> sum + 1024 132 | | Client_ssl -> sum + 2048 133 | | Client_ignore_sigpipe -> sum + 4096 134 | | Client_transactions -> sum + 8192 135 | | Client_reserved -> sum + 16384 136 | | Client_secure_connection -> sum + 32768 137 | | Client_multi_statements -> sum + 65536 138 | | Client_multi_results -> sum + 131072 139 | in 140 | List.fold_left sum_capability 0 capabilities_list 141 | -------------------------------------------------------------------------------- /src/mp_change_user.ml: -------------------------------------------------------------------------------- 1 | 2 | let build_change_user ~handshake ~user ~password ~databasename ~charset_number ~auth_plugin_name = 3 | let user = Mp_string.make_null_terminated_string user in 4 | let length_user = String.length user in 5 | 6 | let scramble_buff = Bitstring.concat [handshake.Mp_handshake.scramble_buff_1; handshake.Mp_handshake.scramble_buff_2] in 7 | let scramble_buff = Bitstring.string_of_bitstring scramble_buff in 8 | let credential = 9 | if (String.length password > 0) then ( 10 | (* /!\ : length coded binary <= 250 bytes ?? *) 11 | let encoded_password = Mp_authentication.encode_client_password scramble_buff password in 12 | let length_encoded_password = String.length encoded_password in 13 | let c = Char.chr length_encoded_password in 14 | (String.make 1 c) ^ encoded_password 15 | ) 16 | else ( 17 | String.make 1 '\x00' 18 | ) 19 | in 20 | let length_credential = String.length credential in 21 | let db = Bitstring.bitstring_of_string (Mp_string.make_null_terminated_string databasename) in 22 | let length_db = Bitstring.bitstring_length db in 23 | let plugin = Mp_string.make_null_terminated_string auth_plugin_name in 24 | let length_plugin = String.length plugin in 25 | let%bitstring bits = {| 26 | user : length_user*8 : string; 27 | credential : length_credential*8 : string; 28 | db : length_db : bitstring; 29 | charset_number : 2*8 : int, unsigned, bigendian; 30 | plugin : length_plugin*8 : string 31 | |} 32 | in 33 | bits 34 | -------------------------------------------------------------------------------- /src/mp_charset.mli: -------------------------------------------------------------------------------- 1 | (** 2 | Available charset and collation. 3 | *) 4 | 5 | type charset_name = 6 | Armscii8 7 | | Ascii 8 | | Big5 9 | | Binary_charset (* /!\ : renamed to avoid conflict with binary collation *) 10 | | Cp1250 11 | | Cp1251 12 | | Cp1256 13 | | Cp1257 14 | | Cp850 15 | | Cp852 16 | | Cp866 17 | | Cp932 18 | | Dec8 19 | | Eucjpms 20 | | Euckr 21 | | Gb2312 22 | | Gbk 23 | | Geostd8 24 | | Greek 25 | | Hebrew 26 | | Hp8 27 | | Keybcs2 28 | | Koi8r 29 | | Koi8u 30 | | Latin1 31 | | Latin2 32 | | Latin5 33 | | Latin7 34 | | Macce 35 | | Macroman 36 | | Sjis 37 | | Swe7 38 | | Tis620 39 | | Ucs2 40 | | Ujis 41 | | Utf16 42 | | Utf16le 43 | | Utf32 44 | | Utf8 45 | | Utf8mb4 46 | 47 | type collation_name = 48 | Armscii8_bin 49 | | Armscii8_general_ci 50 | | Armscii8_general_nopad_ci 51 | | Armscii8_nopad_bin 52 | | Ascii_bin 53 | | Ascii_general_ci 54 | | Ascii_general_nopad_ci 55 | | Ascii_nopad_bin 56 | | Big5_bin 57 | | Big5_chinese_ci 58 | | Big5_chinese_nopad_ci 59 | | Big5_nopad_bin 60 | | Binary_collation (* /!\ : renamed to avoid conflict with binary charset *) 61 | | Cp1250_bin 62 | | Cp1250_croatian_ci 63 | | Cp1250_czech_cs 64 | | Cp1250_general_ci 65 | | Cp1250_general_nopad_ci 66 | | Cp1250_nopad_bin 67 | | Cp1250_polish_ci 68 | | Cp1251_bin 69 | | Cp1251_bulgarian_ci 70 | | Cp1251_general_ci 71 | | Cp1251_general_cs 72 | | Cp1251_general_nopad_ci 73 | | Cp1251_nopad_bin 74 | | Cp1251_ukrainian_ci 75 | | Cp1256_bin 76 | | Cp1256_general_ci 77 | | Cp1256_general_nopad_ci 78 | | Cp1256_nopad_bin 79 | | Cp1257_bin 80 | | Cp1257_general_ci 81 | | Cp1257_general_nopad_ci 82 | | Cp1257_lithuanian_ci 83 | | Cp1257_nopad_bin 84 | | Cp850_bin 85 | | Cp850_general_ci 86 | | Cp850_general_nopad_ci 87 | | Cp850_nopad_bin 88 | | Cp852_bin 89 | | Cp852_general_ci 90 | | Cp852_general_nopad_ci 91 | | Cp852_nopad_bin 92 | | Cp866_bin 93 | | Cp866_general_ci 94 | | Cp866_general_nopad_ci 95 | | Cp866_nopad_bin 96 | | Cp932_bin 97 | | Cp932_japanese_ci 98 | | Cp932_japanese_nopad_ci 99 | | Cp932_nopad_bin 100 | | Dec8_bin 101 | | Dec8_nopad_bin 102 | | Dec8_swedish_ci 103 | | Dec8_swedish_nopad_ci 104 | | Eucjpms_bin 105 | | Eucjpms_japanese_ci 106 | | Eucjpms_japanese_nopad_ci 107 | | Eucjpms_nopad_bin 108 | | Euckr_bin 109 | | Euckr_korean_ci 110 | | Euckr_korean_nopad_ci 111 | | Euckr_nopad_bin 112 | | Gb2312_bin 113 | | Gb2312_chinese_ci 114 | | Gb2312_chinese_nopad_ci 115 | | Gb2312_nopad_bin 116 | | Gbk_bin 117 | | Gbk_chinese_ci 118 | | Gbk_chinese_nopad_ci 119 | | Gbk_nopad_bin 120 | | Geostd8_bin 121 | | Geostd8_general_ci 122 | | Geostd8_general_nopad_ci 123 | | Geostd8_nopad_bin 124 | | Greek_bin 125 | | Greek_general_ci 126 | | Greek_general_nopad_ci 127 | | Greek_nopad_bin 128 | | Hebrew_bin 129 | | Hebrew_general_ci 130 | | Hebrew_general_nopad_ci 131 | | Hebrew_nopad_bin 132 | | Hp8_bin 133 | | Hp8_english_ci 134 | | Hp8_english_nopad_ci 135 | | Hp8_nopad_bin 136 | | Keybcs2_bin 137 | | Keybcs2_general_ci 138 | | Keybcs2_general_nopad_ci 139 | | Keybcs2_nopad_bin 140 | | Koi8r_bin 141 | | Koi8r_general_ci 142 | | Koi8r_general_nopad_ci 143 | | Koi8r_nopad_bin 144 | | Koi8u_bin 145 | | Koi8u_general_ci 146 | | Koi8u_general_nopad_ci 147 | | Koi8u_nopad_bin 148 | | Latin1_bin 149 | | Latin1_danish_ci 150 | | Latin1_general_ci 151 | | Latin1_general_cs 152 | | Latin1_german1_ci 153 | | Latin1_german2_ci 154 | | Latin1_nopad_bin 155 | | Latin1_spanish_ci 156 | | Latin1_swedish_ci 157 | | Latin1_swedish_nopad_ci 158 | | Latin2_bin 159 | | Latin2_croatian_ci 160 | | Latin2_czech_cs 161 | | Latin2_general_ci 162 | | Latin2_general_nopad_ci 163 | | Latin2_hungarian_ci 164 | | Latin2_nopad_bin 165 | | Latin5_bin 166 | | Latin5_nopad_bin 167 | | Latin5_turkish_ci 168 | | Latin5_turkish_nopad_ci 169 | | Latin7_bin 170 | | Latin7_estonian_cs 171 | | Latin7_general_ci 172 | | Latin7_general_cs 173 | | Latin7_general_nopad_ci 174 | | Latin7_nopad_bin 175 | | Macce_bin 176 | | Macce_general_ci 177 | | Macce_general_nopad_ci 178 | | Macce_nopad_bin 179 | | Macroman_bin 180 | | Macroman_general_ci 181 | | Macroman_general_nopad_ci 182 | | Macroman_nopad_bin 183 | | Sjis_bin 184 | | Sjis_japanese_ci 185 | | Sjis_japanese_nopad_ci 186 | | Sjis_nopad_bin 187 | | Swe7_bin 188 | | Swe7_nopad_bin 189 | | Swe7_swedish_ci 190 | | Swe7_swedish_nopad_ci 191 | | Tis620_bin 192 | | Tis620_nopad_bin 193 | | Tis620_thai_ci 194 | | Tis620_thai_nopad_ci 195 | | Ucs2_bin 196 | | Ucs2_croatian_ci 197 | | Ucs2_croatian_mysql561_ci 198 | | Ucs2_czech_ci 199 | | Ucs2_danish_ci 200 | | Ucs2_esperanto_ci 201 | | Ucs2_estonian_ci 202 | | Ucs2_general_ci 203 | | Ucs2_general_mysql500_ci 204 | | Ucs2_general_nopad_ci 205 | | Ucs2_german2_ci 206 | | Ucs2_hungarian_ci 207 | | Ucs2_icelandic_ci 208 | | Ucs2_latvian_ci 209 | | Ucs2_lithuanian_ci 210 | | Ucs2_myanmar_ci 211 | | Ucs2_nopad_bin 212 | | Ucs2_persian_ci 213 | | Ucs2_polish_ci 214 | | Ucs2_romanian_ci 215 | | Ucs2_roman_ci 216 | | Ucs2_sinhala_ci 217 | | Ucs2_slovak_ci 218 | | Ucs2_slovenian_ci 219 | | Ucs2_spanish2_ci 220 | | Ucs2_spanish_ci 221 | | Ucs2_swedish_ci 222 | | Ucs2_thai_520_w2 223 | | Ucs2_turkish_ci 224 | | Ucs2_unicode_520_ci 225 | | Ucs2_unicode_520_nopad_ci 226 | | Ucs2_unicode_ci 227 | | Ucs2_unicode_nopad_ci 228 | | Ucs2_vietnamese_ci 229 | | Ujis_bin 230 | | Ujis_japanese_ci 231 | | Ujis_japanese_nopad_ci 232 | | Ujis_nopad_bin 233 | | Utf16le_bin 234 | | Utf16le_general_ci 235 | | Utf16le_general_nopad_ci 236 | | Utf16le_nopad_bin 237 | | Utf16_bin 238 | | Utf16_croatian_ci 239 | | Utf16_croatian_mysql561_ci 240 | | Utf16_czech_ci 241 | | Utf16_danish_ci 242 | | Utf16_esperanto_ci 243 | | Utf16_estonian_ci 244 | | Utf16_general_ci 245 | | Utf16_general_nopad_ci 246 | | Utf16_german2_ci 247 | | Utf16_hungarian_ci 248 | | Utf16_icelandic_ci 249 | | Utf16_latvian_ci 250 | | Utf16_lithuanian_ci 251 | | Utf16_myanmar_ci 252 | | Utf16_nopad_bin 253 | | Utf16_persian_ci 254 | | Utf16_polish_ci 255 | | Utf16_romanian_ci 256 | | Utf16_roman_ci 257 | | Utf16_sinhala_ci 258 | | Utf16_slovak_ci 259 | | Utf16_slovenian_ci 260 | | Utf16_spanish2_ci 261 | | Utf16_spanish_ci 262 | | Utf16_swedish_ci 263 | | Utf16_thai_520_w2 264 | | Utf16_turkish_ci 265 | | Utf16_unicode_520_ci 266 | | Utf16_unicode_520_nopad_ci 267 | | Utf16_unicode_ci 268 | | Utf16_unicode_nopad_ci 269 | | Utf16_vietnamese_ci 270 | | Utf32_bin 271 | | Utf32_croatian_ci 272 | | Utf32_croatian_mysql561_ci 273 | | Utf32_czech_ci 274 | | Utf32_danish_ci 275 | | Utf32_esperanto_ci 276 | | Utf32_estonian_ci 277 | | Utf32_general_ci 278 | | Utf32_general_nopad_ci 279 | | Utf32_german2_ci 280 | | Utf32_hungarian_ci 281 | | Utf32_icelandic_ci 282 | | Utf32_latvian_ci 283 | | Utf32_lithuanian_ci 284 | | Utf32_myanmar_ci 285 | | Utf32_nopad_bin 286 | | Utf32_persian_ci 287 | | Utf32_polish_ci 288 | | Utf32_romanian_ci 289 | | Utf32_roman_ci 290 | | Utf32_sinhala_ci 291 | | Utf32_slovak_ci 292 | | Utf32_slovenian_ci 293 | | Utf32_spanish2_ci 294 | | Utf32_spanish_ci 295 | | Utf32_swedish_ci 296 | | Utf32_thai_520_w2 297 | | Utf32_turkish_ci 298 | | Utf32_unicode_520_ci 299 | | Utf32_unicode_520_nopad_ci 300 | | Utf32_unicode_ci 301 | | Utf32_unicode_nopad_ci 302 | | Utf32_vietnamese_ci 303 | | Utf8mb4_bin 304 | | Utf8mb4_croatian_ci 305 | | Utf8mb4_croatian_mysql561_ci 306 | | Utf8mb4_czech_ci 307 | | Utf8mb4_danish_ci 308 | | Utf8mb4_esperanto_ci 309 | | Utf8mb4_estonian_ci 310 | | Utf8mb4_general_ci 311 | | Utf8mb4_general_nopad_ci 312 | | Utf8mb4_german2_ci 313 | | Utf8mb4_hungarian_ci 314 | | Utf8mb4_icelandic_ci 315 | | Utf8mb4_latvian_ci 316 | | Utf8mb4_lithuanian_ci 317 | | Utf8mb4_myanmar_ci 318 | | Utf8mb4_nopad_bin 319 | | Utf8mb4_persian_ci 320 | | Utf8mb4_polish_ci 321 | | Utf8mb4_romanian_ci 322 | | Utf8mb4_roman_ci 323 | | Utf8mb4_sinhala_ci 324 | | Utf8mb4_slovak_ci 325 | | Utf8mb4_slovenian_ci 326 | | Utf8mb4_spanish2_ci 327 | | Utf8mb4_spanish_ci 328 | | Utf8mb4_swedish_ci 329 | | Utf8mb4_thai_520_w2 330 | | Utf8mb4_turkish_ci 331 | | Utf8mb4_unicode_520_ci 332 | | Utf8mb4_unicode_520_nopad_ci 333 | | Utf8mb4_unicode_ci 334 | | Utf8mb4_unicode_nopad_ci 335 | | Utf8mb4_vietnamese_ci 336 | | Utf8_bin 337 | | Utf8_croatian_ci 338 | | Utf8_croatian_mysql561_ci 339 | | Utf8_czech_ci 340 | | Utf8_danish_ci 341 | | Utf8_esperanto_ci 342 | | Utf8_estonian_ci 343 | | Utf8_general_ci 344 | | Utf8_general_mysql500_ci 345 | | Utf8_general_nopad_ci 346 | | Utf8_german2_ci 347 | | Utf8_hungarian_ci 348 | | Utf8_icelandic_ci 349 | | Utf8_latvian_ci 350 | | Utf8_lithuanian_ci 351 | | Utf8_myanmar_ci 352 | | Utf8_nopad_bin 353 | | Utf8_persian_ci 354 | | Utf8_polish_ci 355 | | Utf8_romanian_ci 356 | | Utf8_roman_ci 357 | | Utf8_sinhala_ci 358 | | Utf8_slovak_ci 359 | | Utf8_slovenian_ci 360 | | Utf8_spanish2_ci 361 | | Utf8_spanish_ci 362 | | Utf8_swedish_ci 363 | | Utf8_thai_520_w2 364 | | Utf8_turkish_ci 365 | | Utf8_unicode_520_ci 366 | | Utf8_unicode_520_nopad_ci 367 | | Utf8_unicode_ci 368 | | Utf8_unicode_nopad_ci 369 | | Utf8_vietnamese_ci 370 | 371 | type charset = (charset_name * collation_name);; 372 | 373 | val charset_name_to_string : charset_name -> string 374 | val collation_name_to_string : collation_name -> string 375 | val charset_to_string : (charset_name * collation_name) -> string 376 | val charset_number : (charset_name * collation_name) -> int 377 | val number_charset : int -> (charset_name * collation_name) 378 | -------------------------------------------------------------------------------- /src/mp_client.mli: -------------------------------------------------------------------------------- 1 | (** MySQL Protocol natively implements the MySQL client protocol 2 | (ie without any binding to C library). 3 | 4 | License: 5 | - The MySQL Protocol library uses the 6 | {{:http://www.gnu.org/licenses/lgpl.html} LGPL license version 3}. 7 | 8 | External dependencies: 9 | - {{:https://github.com/xguerin/bitstring/} Bitstring}. 10 | - {{:https://github.com/xavierleroy/cryptokit/} Cryptokit}. 11 | - optional: {{:https://github.com/gildor478/ounit/} oUnit } (to run the tests suite). 12 | 13 | Tested configurations: 14 | - MySQL 5.1.69 server (64 bits) - FreeBSD -stable. 15 | - MySQL 5.5.31 server (64 bits) - FreeBSD -stable. 16 | - MySQL 5.6.26 server (64 bits) - FreeBSD -stable. 17 | - MariaDB 10.5.6 server (64 bits) - FreeBSD -stable. 18 | 19 | The following functionalities are not implemented: 20 | - Master/slave. 21 | - Long data packet. 22 | - Compression. 23 | - Encryption. 24 | 25 | Known limitations: 26 | - On 32 bits platforms, the data retrieved from the server cannot exceed 16777211 bytes 27 | (the OCaml Sys.max_string_length value). So, for instance, you cannot retrieve a column 28 | with a binary BLOB data greater than this max size. And if you have a TEXT column encoded 29 | in UTF-8, as a character will take 3 to 4 bytes, you will only be able to retrieve between 30 | 16777211/3=5592403 and 16777211/4=4194302 characters. On 64 bits platforms, the limit is 31 | so high that this limitation can be ignored. 32 | 33 | Usage examples: 34 | - See "examples" directory. 35 | 36 | *) 37 | 38 | (** 39 | MySQL error. 40 | *) 41 | type client_error = { 42 | client_error_errno : int; (** error number *) 43 | client_error_sqlstate : string; (** state *) 44 | client_error_message : string; (** error message *) 45 | } 46 | 47 | (** 48 | Raise if the MySQL server returns an error. 49 | *) 50 | exception Error of client_error 51 | 52 | (** 53 | Raise if fetch is called and the server has no more rows to return. 54 | *) 55 | exception Fetch_no_more_rows 56 | 57 | (** 58 | Client configuration. 59 | *) 60 | type configuration = { 61 | sockaddr : Unix.sockaddr; (** socket *) 62 | capabilities : Mp_capabilities.capabilities list; (** capabilities *) 63 | max_packet_size : Int64.t; (** max packet size *) 64 | charset_number : int; (** charset *) 65 | user : string; (** login *) 66 | password : string; (** password *) 67 | databasename : string; (** database name (can be empty) *) 68 | } 69 | 70 | (** 71 | Client connection. 72 | *) 73 | type connection = { 74 | configuration : configuration; (** configuration *) 75 | mutable channel : (in_channel * out_channel) option; (** channel between client and server *) 76 | mutable handshake : Mp_handshake.handshake option; (** handshake answer from the server *) 77 | } 78 | 79 | (** 80 | DML (Data Manipulation Language) and DCL (Data Control Language) result. 81 | Result of INSERT, UPDATE, GRANT... statements. 82 | 83 | insert_id can be negative in two cases: 84 | - the auto_increment value is indeed negative (SIGNED field). 85 | - the returned value overflows Int64 maximum (BIGINT UNSIGNED field). 86 | 87 | Unfortunately, the protocol gives no way to differentiate these two 88 | cases (see {{:https://bugs.mysql.com/bug.php?id=69228} this bug report}). 89 | So we return two values: 90 | - the first one is a Int64 and must be used when the 91 | auto_increment is {b _not_} a BIGINT UNSIGNED field. 92 | - the second one is a Big_int and must be used when the 93 | auto_increment is a BIGINT UNSIGNED field. 94 | *) 95 | type dml_dcl_result = { 96 | affected_rows : Int64.t; (** number of affected rows *) 97 | insert_id : (Int64.t * Big_int.big_int); (** auto_increment id after an INSERT statement *) 98 | server_status : int; (** status *) 99 | warning_count : int; (** warning *) 100 | message : string; (** warning message *) 101 | } 102 | 103 | (** 104 | Result for a prepare command. 105 | *) 106 | type prepare_result = { 107 | prepare_handler : Int64.t; 108 | prepare_nb_columns : int; 109 | prepare_nb_parameters : int; 110 | prepare_warning_count : int; 111 | prepare_parameters_fields : Mp_field_packet.field_packet list; 112 | prepare_parameters_names : Mp_field.field_name list; 113 | prepare_columns_fields : Mp_field_packet.field_packet list; 114 | prepare_columns_names : Mp_field.field_name list; 115 | } 116 | 117 | type executable_statement 118 | 119 | type execute_result 120 | 121 | type result 122 | 123 | (** 124 | Convert MySQL exception to string. 125 | *) 126 | val error_exception_to_string : client_error -> string 127 | 128 | (** 129 | Convert DML (Data Manipulation Language) and DCL (Data Control Language) result to string. 130 | *) 131 | val dml_dcl_result_to_string : dml_dcl_result -> string 132 | 133 | (** 134 | Build client configuration. 135 | @param user Login. 136 | @param password Password. 137 | @param sockaddr Socket for the connection to the server. 138 | @param databasename Database name. 139 | @param max_packet_size Max client/server packet size. 140 | @param charset Charset and collation name. 141 | @param capabilities Client capabilities. 142 | *) 143 | val configuration : 144 | user:string 145 | -> password:string 146 | -> sockaddr:Unix.sockaddr 147 | -> ?databasename:string 148 | -> ?max_packet_size:Int64.t 149 | -> ?charset:Mp_charset.charset_name * Mp_charset.collation_name 150 | -> ?capabilities:Mp_capabilities.capabilities list 151 | -> unit 152 | -> configuration 153 | 154 | (** 155 | Connection to the server. 156 | @param configuration Client configuration. 157 | @param force If true, the connection is immediately opened. 158 | Otherwise, the connection is opened only the first time it is needed. 159 | *) 160 | val connect : 161 | configuration:configuration 162 | -> ?force:bool 163 | -> unit 164 | -> connection 165 | 166 | (** 167 | Change user / databasename / charset 168 | @param connection Connection. 169 | @param user Login. 170 | @param password Password. 171 | @param databasename Database name. 172 | @param charset Charset and collation name. 173 | *) 174 | val change_user : 175 | connection:connection 176 | -> user:string 177 | -> password:string 178 | -> ?databasename:string 179 | -> ?charset:Mp_charset.charset_name * Mp_charset.collation_name 180 | -> unit 181 | -> configuration 182 | 183 | (** 184 | Reset the session : equivalent to a disconnect/reconnect with the same configuration. 185 | @param connection Connection. 186 | *) 187 | val reset_session : 188 | connection:connection 189 | -> unit 190 | 191 | (** 192 | Reset the connection without re-authentication. 193 | From {{:https://mariadb.com/kb/en/com_reset_connection/} documentation}), this will: 194 | - rollback any open transaction 195 | - reset transaction isolation level 196 | - reset session variables 197 | - delete user variables 198 | - remove temporary tables 199 | - remove all PREPARE statement 200 | 201 | Database will NOT be reset to initial value. 202 | @param connection Connection. 203 | *) 204 | val reset_connection : 205 | connection:connection 206 | -> unit 207 | 208 | (** 209 | Change current database. 210 | @param connection Connection. 211 | @param databasename Database name. 212 | *) 213 | val use_database : 214 | connection:connection 215 | -> databasename:string 216 | -> unit 217 | 218 | (** 219 | Send a PING to the server. 220 | @param connection Connection. 221 | *) 222 | val ping : 223 | connection:connection 224 | -> unit 225 | 226 | (** 227 | Create a new statement from a SQL string. 228 | *) 229 | val create_statement_from_string : 230 | string 231 | -> executable_statement 232 | 233 | (** 234 | Prepare a statement. 235 | @param connection Connection. 236 | @param statement Executable statement. 237 | *) 238 | val prepare : 239 | connection:connection 240 | -> statement:executable_statement 241 | -> executable_statement 242 | 243 | (** 244 | Extract the statement from an executable statement. 245 | *) 246 | val get_created_statement : 247 | executable_statement 248 | -> string 249 | 250 | (** 251 | Extract the prepared statement from an executable statement. 252 | *) 253 | val get_prepared_statement : 254 | executable_statement 255 | -> (string * prepare_result) 256 | 257 | (** 258 | Execute a statement (prepared or not prepared) and return the result. 259 | @param connection Client connection. 260 | @param statement Executable statement. 261 | @param filter Optional function applied to each row of the result. If it returns true, the row is kept in the return result. Otherwise, the row is discarded from the result. 262 | @param iter Optional function applied to each row of the result. If there is also a filter function, this filter is applied _before_ the iter function. So a row will be processed by the iter function only if this row has passed the filter function. 263 | @param return_all_raw_mysql_data If true, the returned result will include MySQL raw data. It's useful if you need for instance to get the MySQL columns types and options. The default is false. 264 | @param params List of params for prepared statement. Must be in the same order than in the prepared statement. 265 | @param bind Specify if the params must be bound into the prepared statement. The default is to bind. A statement must be at least executed once with bind. After that, if you need to execute again the same statement with the same params, you can use No_bind. 266 | @param flag Cursor options. To use fetch to get the statement results, you must specify the Cursor_type_read_only option. 267 | *) 268 | val execute : 269 | connection:connection 270 | -> statement:executable_statement 271 | -> ?filter:((string * int) list 272 | -> Mp_data.t list -> bool) option 273 | -> ?iter:((string * int) list 274 | -> Mp_data.t list -> unit) option 275 | -> ?return_all_raw_mysql_data:bool 276 | -> ?params:Mp_data.t list 277 | -> ?bind:Mp_execute.bind 278 | -> ?flag:Mp_execute.flag 279 | -> unit 280 | -> execute_result 281 | 282 | (** 283 | Extract the result part from an executed result. 284 | *) 285 | val get_result : 286 | execute_result 287 | -> result 288 | 289 | (** 290 | Extract the multiple part from an executed result (for CALL result). 291 | *) 292 | val get_result_multiple : 293 | execute_result 294 | -> result list 295 | 296 | (** 297 | Extract the set part from a result (for SELECT result). 298 | *) 299 | val get_result_set : 300 | result 301 | -> Mp_result_set_packet.result_select 302 | 303 | (** 304 | Extract the ok part from a result (for INSERT, UPDATE, GRANT... result). 305 | *) 306 | val get_result_ok : 307 | result 308 | -> dml_dcl_result 309 | 310 | (** 311 | Fetch row(s) from an executed result. It must be a prepared statement executed with a cursor. 312 | @param connection Client connection. 313 | @param statement Executable statement. 314 | @param nb_rows Number of row(s) to fetch. Default is 1. 315 | @param filter Optional function applied to each fetched rows. If it returns true, the row is kept. Otherwise, the row is discarded. 316 | @param iter Optional function applied to each fetched rows. If there is also a filter function, this filter is applied _before_ the iter function. So a row will be processed by the iter function only if this row has passed the filter function. 317 | @param return_all_raw_mysql_data If true, the fetch will include MySQL raw data. It's useful if you need for instance to get the MySQL columns types and options. The default is false. 318 | *) 319 | val fetch : 320 | connection:connection 321 | -> statement:execute_result 322 | -> ?nb_rows:int64 323 | -> ?filter:((string * int) list 324 | -> Mp_data.t list -> bool) option 325 | -> ?iter:((string * int) list 326 | -> Mp_data.t list -> unit) option 327 | -> ?return_all_raw_mysql_data:bool 328 | -> unit 329 | -> result 330 | 331 | (** 332 | Extract the set part from a fetch. 333 | *) 334 | val get_fetch_result_set : 335 | result 336 | -> Mp_result_set_packet.result_select 337 | 338 | (** 339 | Close and destroy the prepared statement. It will be unusable. 340 | @param connection Client connection. 341 | @param statement Executable statement. 342 | *) 343 | val close_statement : 344 | connection:connection 345 | -> statement:executable_statement 346 | -> unit 347 | 348 | (** 349 | Close the connection to the server. 350 | @param connection Client connection. 351 | *) 352 | val disconnect : 353 | connection:connection 354 | -> unit 355 | -------------------------------------------------------------------------------- /src/mp_com.ml: -------------------------------------------------------------------------------- 1 | 2 | type com_type = 3 | Authentication (* see Mp_authentication *) 4 | | Init_db 5 | | Change_user 6 | | Reset_connection 7 | | Query 8 | | Prepare 9 | | Execute 10 | | Fetch 11 | | Close_statement 12 | | Ping 13 | | Quit 14 | | Client_response_auth_switch_request_plugin_mysql_native_password 15 | 16 | let com_string statement code = 17 | let length = String.length statement in 18 | let%bitstring bits = {| 19 | code : 1*8 : int, unsigned; 20 | statement : length*8 : string 21 | |} 22 | in 23 | let bits = Mp_packet.make_packet (-1) bits in 24 | bits 25 | 26 | let com_bitstring bits code = 27 | let length_bits = Bitstring.bitstring_length bits in 28 | let%bitstring bits = {| 29 | code : 1*8 : int, unsigned; 30 | bits : length_bits : bitstring 31 | |} 32 | in 33 | let bits = Mp_packet.make_packet (-1) bits in 34 | bits 35 | 36 | let com_code code = 37 | let%bitstring bits = {| 38 | code : 1*8 : int, unsigned 39 | |} 40 | in 41 | let bits = Mp_packet.make_packet (-1) bits in 42 | bits 43 | 44 | let com_init_db database = 45 | com_string database 0x02 46 | 47 | let com_change_user bits = 48 | com_bitstring bits 0x11 49 | 50 | let com_reset_connection = 51 | com_code 0x1f 52 | 53 | let com_query query = 54 | com_string query 0x03 55 | 56 | let com_prepare statement = 57 | com_string statement 0x16 58 | 59 | let com_execute bits = 60 | com_bitstring bits 0x17 61 | 62 | let com_fetch bits = 63 | com_bitstring bits 0x1c 64 | 65 | let com_close_statement bits = 66 | com_bitstring bits 0x19 67 | 68 | let com_quit = 69 | com_code 0x01 70 | 71 | let com_ping = 72 | com_code 0x0e 73 | -------------------------------------------------------------------------------- /src/mp_data.mli: -------------------------------------------------------------------------------- 1 | (** 2 | SQL columns data types. 3 | *) 4 | type sign = Positive | Negative 5 | 6 | type sql = private 7 | | Null 8 | | Tinyint of int 9 | | Smallint of int 10 | | Int of int 11 | | Longint of Int64.t 12 | | Longlongint of Big_int.big_int 13 | | Decimal of Num.num 14 | | Date of (int * int * int) (* year, month, day *) 15 | | Time of (sign * int * int * int * Int64.t) (* sign * hour, min, sec, microsec *) 16 | | Datetime of ((int * int * int) * (int * int * int * Int64.t)) (* (year, month, day), (hour, min, sec, microsec) *) 17 | | Timestamp of ((int * int * int) * (int * int * int * Int64.t)) (* (year, month, day), (hour, min, sec, microsec) *) 18 | | Float of float 19 | | Double of float 20 | | Int24 of int 21 | | Year of int 22 | | Varchar of string 23 | | String of string 24 | | Varstring of string 25 | | Blob of Buffer.t (* TODO : add a Text type ? *) 26 | | Binary of Buffer.t 27 | | Varbinary of Buffer.t 28 | | Enum of string 29 | | Set of string 30 | | Bit of Bitstring.t 31 | | Geometry of Bitstring.t 32 | 33 | type t = sql 34 | 35 | exception Wrong_type of string 36 | 37 | (** Build MySQL NULL value *) 38 | val data_null : t 39 | 40 | (** Build MySQL TINYINT value *) 41 | val data_tinyint : int -> t 42 | 43 | (** Build MySQL SMALLINT value *) 44 | val data_smallint : int -> t 45 | 46 | (** Build MySQL INT value *) 47 | val data_int : int -> t 48 | 49 | (** Build MySQL INT value *) 50 | val data_longint : Int64.t -> t 51 | 52 | (** Build MySQL BIGINT value *) 53 | val data_longlongint : Big_int.big_int -> t 54 | 55 | (** Build MySQL DECIMAL value *) 56 | val data_decimal : Num.num -> t 57 | 58 | (** Build MySQL DATE (year, month, day) value *) 59 | val data_date : (int * int * int) -> t 60 | 61 | (** Build MySQL TIME (sign, hour, min, sec, microsec) value *) 62 | val data_time : (sign * int * int * int * Int64.t) -> t 63 | 64 | (** Build MySQL DATETIME ((year, month, day), (hour, min, sec, microsec)) value *) 65 | val data_datetime : ((int * int * int) * (int * int * int * Int64.t)) -> t 66 | 67 | (** Build MySQL TIMESTAMP ((year, month, day), (hour, min, sec, microsec)) value *) 68 | val data_timestamp : ((int * int * int) * (int * int * int * Int64.t)) -> t 69 | 70 | (** Build MySQL FLOAT value *) 71 | val data_float : float -> t 72 | 73 | (** Build MySQL DOUBLE value *) 74 | val data_double : float -> t 75 | 76 | (** Build MySQL MEDIUM INT value *) 77 | val data_int24 : int -> t 78 | 79 | (** Build MySQL YEAR value *) 80 | val data_year : int -> t 81 | 82 | (** Build MySQL VARCHAR value *) 83 | val data_varchar : string -> t 84 | 85 | (** Build MySQL CHAR value *) 86 | val data_string : string -> t 87 | 88 | (** Build MySQL VARCHAR value *) 89 | val data_varstring : string -> t 90 | 91 | (** Build MySQL BLOB value *) (* TODO : add a Text type ? *) 92 | val data_blob : Buffer.t -> t 93 | 94 | (** Build MySQL BINARY value *) 95 | val data_binary : Buffer.t -> t 96 | 97 | (** Build MySQL VARBINARY value *) 98 | val data_varbinary : Buffer.t -> t 99 | 100 | (** Build MySQL ENUM value *) 101 | val data_enum : string -> t 102 | 103 | (** Build MySQL SET value *) 104 | val data_set : string -> t 105 | 106 | (** Build MySQL BIT value *) 107 | val data_bit : Bitstring.t -> t 108 | 109 | (** Build MySQL GEOMETRY value *) 110 | val data_geometry : Bitstring.t -> t 111 | 112 | (** 113 | Convert column data to OCaml value (int). NULL is converted into None. 114 | @raise Wrong_type if the column data is not of int type. 115 | *) 116 | val to_ocaml_int: t -> int option 117 | 118 | (** 119 | Convert column data to OCaml value (Int64). NULL is converted into None. 120 | @raise Wrong_type if the column data is not of Int64 type. 121 | *) 122 | val to_ocaml_int64: t -> Int64.t option 123 | 124 | (** 125 | Convert column data to OCaml value (Big_int). NULL is converted into None. 126 | @raise Wrong_type if the column data is not of Big_int type. 127 | *) 128 | val to_ocaml_big_int: t -> Big_int.big_int option 129 | 130 | (** 131 | Convert column data to OCaml value (Num). NULL is converted into None. 132 | @raise Wrong_type if the column data is not of Num type. 133 | *) 134 | val to_ocaml_num: t -> Num.num option 135 | 136 | (** 137 | Convert column data to OCaml value (date). NULL is converted into None. 138 | @raise Wrong_type if the column data is not of date type. 139 | *) 140 | val to_ocaml_date: t -> (int * int * int) option 141 | 142 | (** 143 | Convert column data to OCaml value (time). NULL is converted into None. 144 | @raise Wrong_type if the column data is not of time type. 145 | *) 146 | val to_ocaml_time: t -> (sign * int * int * int * Int64.t) option 147 | 148 | (** 149 | Convert column data to OCaml value (datetime/timestamp). NULL is converted into None. 150 | @raise Wrong_type if the column data is not of datetime/timestamp type. 151 | *) 152 | val to_ocaml_dt_ts: t -> ((int * int * int) * (int * int * int * Int64.t)) option 153 | 154 | (** 155 | Convert column data to OCaml value (float). NULL is converted into None. 156 | @raise Wrong_type if the column data is not of float type. 157 | *) 158 | val to_ocaml_float: t -> float option 159 | 160 | (** 161 | Convert column data to OCaml value (string). NULL is converted into None. 162 | @raise Wrong_type if the column data is not of string type. 163 | *) 164 | val to_ocaml_string: t -> string option 165 | 166 | (** 167 | Convert column data to OCaml value (Buffer). NULL is converted into None. 168 | @raise Wrong_type if the column data is not of Buffer type. 169 | *) 170 | val to_ocaml_buffer: t -> Buffer.t option 171 | 172 | (** 173 | Convert column data to OCaml value (Bitstring). NULL is converted into None. 174 | @raise Wrong_type if the column data is not of Bitstring type. 175 | *) 176 | val to_ocaml_bitstring: t -> Bitstring.t option 177 | 178 | (** 179 | eq v1 v2 tests for structural equality of v1 and v2 180 | *) 181 | val eq : t -> t -> bool 182 | 183 | (** 184 | Convert column type to string 185 | *) 186 | val type_to_string : t -> string 187 | 188 | (** 189 | Convert column data to string 190 | *) 191 | val to_string : t -> string option 192 | -------------------------------------------------------------------------------- /src/mp_data_binary.ml: -------------------------------------------------------------------------------- 1 | let case_datetime_timestamp_date field_type v = 2 | let length = Bitstring.bitstring_length v in 3 | let parts = 4 | if (length = 0) then 5 | ((0, 0, 0), (0, 0, 0, Int64.zero)) 6 | else 7 | match%bitstring v with 8 | | {| year : 2 * 8 : int, unsigned, littleendian; 9 | rest : length - (2*8) : bitstring |} -> ( 10 | if (Bitstring.bitstring_length rest > 0) then 11 | let length_rest = (Bitstring.bitstring_length rest) - (2*8) in 12 | match%bitstring rest with 13 | | {| month : 1 * 8 : int, unsigned, littleendian; 14 | day : 1 * 8 : int, unsigned, littleendian; 15 | rest : length_rest : bitstring |} -> ( 16 | if (Bitstring.bitstring_length rest > 0) then 17 | let length_rest = (Bitstring.bitstring_length rest) - (3*8) in 18 | match%bitstring rest with 19 | | {| hour : 1 * 8 : int, unsigned, littleendian; 20 | min : 1 * 8 : int, unsigned, littleendian; 21 | sec : 1 * 8 : int, unsigned, littleendian; 22 | rest : length_rest : bitstring |} -> ( 23 | if (Bitstring.bitstring_length rest > 0) then 24 | match%bitstring rest with 25 | | {| subsecond : Mp_bitstring.compute32 : int, unsigned, littleendian |} -> ( 26 | ((year, month, day), (hour, min, sec, subsecond)) 27 | ) 28 | else 29 | ((year, month, day), (hour, min, sec, Int64.zero)) 30 | ) 31 | else 32 | ((year, month, day), (0, 0, 0, Int64.zero)) 33 | ) 34 | else 35 | ((year, 0, 0), (0, 0, 0, Int64.zero)) 36 | ) 37 | in 38 | let ((year, month, day), (hour, min, sec, subsec)) = parts in 39 | match field_type with 40 | | Mp_field_packet.Field_type_datetime -> Mp_data.data_datetime ((year, month, day), (hour, min, sec, subsec)) 41 | | Mp_field_packet.Field_type_timestamp -> Mp_data.data_timestamp ((year, month, day), (hour, min, sec, subsec)) 42 | | Mp_field_packet.Field_type_date -> Mp_data.data_date (year, month, day) 43 | | _ -> assert false 44 | 45 | let data_value_to_sql_value_date_time_types field_type v = 46 | match field_type with 47 | | Mp_field_packet.Field_type_datetime -> case_datetime_timestamp_date field_type v 48 | | Mp_field_packet.Field_type_timestamp -> case_datetime_timestamp_date field_type v 49 | | Mp_field_packet.Field_type_date -> case_datetime_timestamp_date field_type v 50 | | Mp_field_packet.Field_type_time -> ( 51 | let length = Bitstring.bitstring_length v in 52 | if (length = 0) then 53 | Mp_data.data_time (Mp_data.Positive, 0, 0, 0, Int64.zero) 54 | else 55 | match%bitstring v with 56 | | {| sign : 1 * 8 : int, unsigned, littleendian; 57 | rest : length - 8 : bitstring |} -> ( 58 | let pos_or_neg = 59 | match sign with 60 | | 1 -> Mp_data.Negative 61 | | 0 -> Mp_data.Positive 62 | | _ -> assert false 63 | in 64 | if (Bitstring.bitstring_length rest > 0) then 65 | let length_rest = (Bitstring.bitstring_length rest) - Mp_bitstring.compute32 in 66 | match%bitstring rest with 67 | | {| day : Mp_bitstring.compute32 : int, unsigned, littleendian; 68 | rest : length_rest : bitstring |} -> ( 69 | let hour_day = Int64.mul day (Int64.of_int 24) in 70 | (* cast should be ok, documentation says : 71 | "TIME values may range from '-838:59:59' to '838:59:59'" *) 72 | let hour_day = Int64.to_int hour_day in 73 | if (Bitstring.bitstring_length rest > 0) then 74 | let length_rest = (Bitstring.bitstring_length rest) - (3*8) in 75 | match%bitstring rest with 76 | | {| hour : 1 * 8 : int, unsigned, littleendian; 77 | min : 1 * 8 : int, unsigned, littleendian; 78 | sec : 1 * 8 : int, unsigned, littleendian; 79 | rest : length_rest : bitstring |} -> ( 80 | if (Bitstring.bitstring_length rest > 0) then 81 | match%bitstring rest with 82 | | {| subsecond : Mp_bitstring.compute32 : int, unsigned, littleendian |} -> ( 83 | Mp_data.data_time (pos_or_neg, hour + hour_day, min, sec, subsecond) 84 | ) 85 | else 86 | Mp_data.data_time (pos_or_neg, hour + hour_day, min, sec, Int64.zero) 87 | ) 88 | else 89 | Mp_data.data_time (pos_or_neg, 0 + hour_day, 0, 0, Int64.zero) 90 | ) 91 | else 92 | Mp_data.data_time (pos_or_neg, 0, 0, 0, Int64.zero) 93 | ) 94 | ) 95 | | _ -> assert false 96 | 97 | let data_value_to_sql_value v field = 98 | let field_type = field.Mp_field_packet.field_type in 99 | match field_type with 100 | (* /!\ : should not happen because null values are sent with the null bitfield *) 101 | | Mp_field_packet.Field_type_null -> Mp_data.data_null 102 | | Mp_field_packet.Field_type_longlong -> ( 103 | match%bitstring v with 104 | | {| d : 8 * 8 : int, littleendian |} -> 105 | let field_flags = field.Mp_field_packet.field_flags in 106 | let bi = Big_int.big_int_of_int64 d in 107 | let bi = 108 | if ( (List.mem Mp_field_packet.Field_flag_unsigned field_flags) 109 | && (Big_int.sign_big_int bi = -1) ) then 110 | Big_int.add_big_int (Big_int.power_int_positive_int 2 64) bi 111 | else 112 | bi 113 | in 114 | Mp_data.data_longlongint bi 115 | ) 116 | | Mp_field_packet.Field_type_long -> ( 117 | let field_flags = field.Mp_field_packet.field_flags in 118 | match%bitstring v with 119 | | {| d : Mp_bitstring.compute32 : int, littleendian |} -> 120 | if (List.mem Mp_field_packet.Field_flag_unsigned field_flags) then 121 | Mp_data.data_longint d 122 | else 123 | if (Int64.compare d (Int64.of_string "2147483647") > 0) then 124 | Mp_data.data_longint (Int64.sub d (Int64.of_string "4294967296")) 125 | else 126 | Mp_data.data_longint d 127 | ) 128 | | Mp_field_packet.Field_type_short -> ( 129 | let field_flags = field.Mp_field_packet.field_flags in 130 | match%bitstring v with 131 | | {| d : 2 * 8 : int, littleendian |} -> 132 | if (List.mem Mp_field_packet.Field_flag_unsigned field_flags) then 133 | Mp_data.data_smallint d 134 | else 135 | if (d > 32767) then 136 | Mp_data.data_smallint (d - 65536) 137 | else 138 | Mp_data.data_smallint d 139 | ) 140 | | Mp_field_packet.Field_type_tiny -> ( 141 | let field_flags = field.Mp_field_packet.field_flags in 142 | match%bitstring v with 143 | | {| d : 1 * 8 : int, littleendian |} -> 144 | if (List.mem Mp_field_packet.Field_flag_unsigned field_flags) then 145 | Mp_data.data_tinyint d 146 | else 147 | if (d > 127) then 148 | Mp_data.data_tinyint (d - 256) 149 | else 150 | Mp_data.data_tinyint d 151 | ) 152 | | Mp_field_packet.Field_type_float -> ( 153 | match%bitstring v with 154 | | {| d : 4 * 8 : int, littleendian |} -> 155 | Mp_data.data_float (Int32.float_of_bits d) 156 | ) 157 | | Mp_field_packet.Field_type_double -> ( 158 | match%bitstring v with 159 | | {| d : 8 * 8 : int, littleendian |} -> 160 | Mp_data.data_double (Int64.float_of_bits d) 161 | ) 162 | | Mp_field_packet.Field_type_int24 -> ( 163 | let field_flags = field.Mp_field_packet.field_flags in 164 | (* 4 bytes with 0x00 or 0xff for the last one 165 | so we only need the first 3 bytes 166 | *) 167 | match%bitstring v with 168 | | {| d : 3 * 8 : int, littleendian |} -> 169 | if (List.mem Mp_field_packet.Field_flag_unsigned field_flags) then 170 | Mp_data.data_int24 d 171 | else 172 | if (d > 8388607) then 173 | Mp_data.data_int24 (d - 16777216) 174 | else 175 | Mp_data.data_int24 d 176 | ) 177 | | Mp_field_packet.Field_type_year -> ( 178 | match%bitstring v with 179 | | {| d : 2 * 8 : int, littleendian |} -> 180 | Mp_data.data_year d 181 | ) 182 | | Mp_field_packet.Field_type_newdecimal -> ( 183 | let length = Bitstring.bitstring_length v in 184 | let nb_bytes = length / 8 in 185 | match%bitstring v with 186 | | {| d : length : string |} -> 187 | let decimals = field.Mp_field_packet.field_decimals in 188 | let part_i_s = String.sub d 0 (nb_bytes - 1 - decimals) in 189 | let part_d_s = String.sub d (nb_bytes - decimals) decimals in 190 | let i = part_i_s ^ part_d_s in 191 | let i = Big_int.big_int_of_string i in 192 | let i = Num.num_of_big_int i in 193 | let div = Big_int.power_int_positive_int 10 decimals in 194 | let div = Num.num_of_big_int div in 195 | Mp_data.data_decimal (Num.div_num i div) 196 | ) 197 | | Mp_field_packet.Field_type_string -> ( 198 | let length = Bitstring.bitstring_length v in 199 | match%bitstring v with 200 | | {| d : length : string |} -> ( 201 | let field_flags = field.Mp_field_packet.field_flags in 202 | if (List.mem Mp_field_packet.Field_flag_enum field_flags) then 203 | Mp_data.data_enum d 204 | else if (List.mem Mp_field_packet.Field_flag_set field_flags) then 205 | Mp_data.data_set d 206 | else if (List.mem Mp_field_packet.Field_flag_binary field_flags) then 207 | let b = Buffer.create (String.length d) in 208 | let () = Buffer.add_string b d in 209 | Mp_data.data_binary b 210 | else 211 | Mp_data.data_string d 212 | ) 213 | ) 214 | (* /!\ : should not happen because set is sent as a string *) 215 | | Mp_field_packet.Field_type_set -> ( 216 | let length = Bitstring.bitstring_length v in 217 | match%bitstring v with 218 | | {| d : length : string |} -> 219 | Mp_data.data_set d 220 | ) 221 | (* /!\ : should not happen because enum is sent as a string *) 222 | | Mp_field_packet.Field_type_enum -> ( 223 | let length = Bitstring.bitstring_length v in 224 | match%bitstring v with 225 | | {| d : length : string |} -> 226 | Mp_data.data_enum d 227 | ) 228 | | Mp_field_packet.Field_type_var_string -> ( 229 | let length = Bitstring.bitstring_length v in 230 | match%bitstring v with 231 | | {| d : length : string |} -> 232 | let field_flags = field.Mp_field_packet.field_flags in 233 | if (List.mem Mp_field_packet.Field_flag_binary field_flags) then 234 | let b = Buffer.create (String.length d) in 235 | let () = Buffer.add_string b d in 236 | Mp_data.data_varbinary b 237 | else 238 | Mp_data.data_varstring d 239 | ) 240 | | Mp_field_packet.Field_type_varchar -> ( 241 | (* TODO: add varchar to tests *) 242 | let length = Bitstring.bitstring_length v in 243 | match%bitstring v with 244 | | {| d : length : string |} -> Mp_data.data_varchar d 245 | ) 246 | | Mp_field_packet.Field_type_bit -> ( 247 | let length = Bitstring.bitstring_length v in 248 | match%bitstring v with 249 | | {| d : length : bitstring |} -> Mp_data.data_bit d 250 | ) 251 | | Mp_field_packet.Field_type_tiny_blob 252 | | Mp_field_packet.Field_type_medium_blob 253 | | Mp_field_packet.Field_type_long_blob 254 | | Mp_field_packet.Field_type_blob -> ( 255 | let length = Bitstring.bitstring_length v in 256 | match%bitstring v with 257 | | {| d : length : string |} -> 258 | let b = Buffer.create length in 259 | let () = Buffer.add_string b d in 260 | Mp_data.data_blob b 261 | ) 262 | | Mp_field_packet.Field_type_geometry -> (* opaque type *) 263 | Mp_data.data_geometry v 264 | | Mp_field_packet.Field_type_datetime 265 | | Mp_field_packet.Field_type_timestamp 266 | | Mp_field_packet.Field_type_date 267 | | Mp_field_packet.Field_type_time -> 268 | data_value_to_sql_value_date_time_types field_type v 269 | -------------------------------------------------------------------------------- /src/mp_data_simple.ml: -------------------------------------------------------------------------------- 1 | 2 | let split_date_string v = 3 | let t = Array.make 3 "" in 4 | let i = ref 0 in 5 | let f c = 6 | match c with 7 | | '0'..'9' -> 8 | t.(!i) <- t.(!i) ^ (String.make 1 c) 9 | | '-' -> 10 | incr i 11 | | _ -> 12 | assert false 13 | in 14 | let () = String.iter f v in 15 | (* if empty, default to 0 *) 16 | let default i e = 17 | if (e = "") then t.(i) <- "0" 18 | in 19 | let () = Array.iteri default t in 20 | t 21 | 22 | let split_time_string v = 23 | let t = Array.make 4 "" in 24 | let i = ref 0 in 25 | let sign = ref Mp_data.Positive in 26 | let f c = 27 | match c with 28 | | '-' -> 29 | sign := Mp_data.Negative 30 | | '0'..'9' -> 31 | t.(!i) <- t.(!i) ^ (String.make 1 c) 32 | | ':' | '.' -> 33 | incr i 34 | | _ -> 35 | assert false 36 | in 37 | let () = String.iter f v in 38 | (* if empty, default to 0 *) 39 | let default i e = 40 | if (e = "") then t.(i) <- "0" 41 | in 42 | let () = Array.iteri default t in 43 | (!sign, t) 44 | 45 | let split_datetime_string v = 46 | let sep = String.index v ' ' in 47 | let part_date = String.sub v 0 sep in 48 | let part_time = String.sub v (sep + 1) ((String.length v) - (String.length part_date) - 1) in 49 | let split_date = split_date_string part_date in 50 | (* sign time is not used for datetime/timestamp *) 51 | let (_, split_time) = split_time_string part_time in 52 | (split_date, split_time) 53 | 54 | let data_value_to_sql_value v field = 55 | let field_type = field.Mp_field_packet.field_type in 56 | let field_flags = field.Mp_field_packet.field_flags in 57 | match field_type with 58 | | Mp_field_packet.Field_type_decimal -> ( 59 | Mp_data.data_decimal (Num.num_of_string v) 60 | ) 61 | | Mp_field_packet.Field_type_tiny -> ( 62 | Mp_data.data_tinyint (int_of_string v) 63 | ) 64 | | Mp_field_packet.Field_type_short -> ( 65 | Mp_data.data_smallint (int_of_string v) 66 | ) 67 | | Mp_field_packet.Field_type_long -> ( 68 | Mp_data.data_longint (Int64.of_string v) 69 | ) 70 | | Mp_field_packet.Field_type_float -> ( 71 | Mp_data.data_float (float_of_string v) 72 | ) 73 | | Mp_field_packet.Field_type_double -> ( 74 | Mp_data.data_double (float_of_string v) 75 | ) 76 | | Mp_field_packet.Field_type_null -> ( 77 | Mp_data.data_null 78 | ) 79 | | Mp_field_packet.Field_type_longlong -> ( 80 | Mp_data.data_longlongint (Big_int.big_int_of_string v) 81 | ) 82 | | Mp_field_packet.Field_type_int24 -> ( 83 | Mp_data.data_int24 (int_of_string v) 84 | ) 85 | | Mp_field_packet.Field_type_date 86 | | Mp_field_packet.Field_type_newdate -> (* TODO : newdate : add to tests *) ( 87 | let split = split_date_string v in 88 | let part_year = int_of_string (split.(0)) in 89 | let part_month = int_of_string (split.(1)) in 90 | let part_day = int_of_string (split.(2)) in 91 | Mp_data.data_date (part_year, part_month, part_day) 92 | ) 93 | | Mp_field_packet.Field_type_time -> ( 94 | let (sign, split) = split_time_string v in 95 | let part_hour = int_of_string(split.(0)) in 96 | let part_min = int_of_string(split.(1)) in 97 | let part_sec = int_of_string(split.(2)) in 98 | let part_subsec = Int64.of_string (split.(3)) in 99 | Mp_data.data_time (sign, part_hour, part_min, part_sec, part_subsec) 100 | ) 101 | | Mp_field_packet.Field_type_datetime 102 | | Mp_field_packet.Field_type_timestamp -> ( 103 | let (split_date, split_time) = split_datetime_string v in 104 | let part_year = int_of_string (split_date.(0)) in 105 | let part_month = int_of_string (split_date.(1)) in 106 | let part_day = int_of_string (split_date.(2)) in 107 | let part_hour = int_of_string (split_time.(0)) in 108 | let part_min = int_of_string (split_time.(1)) in 109 | let part_sec = int_of_string (split_time.(2)) in 110 | let part_subsec = Int64.of_string (split_time.(3)) in 111 | match field_type with 112 | | Mp_field_packet.Field_type_datetime -> ( 113 | Mp_data.data_datetime ((part_year, part_month, part_day), (part_hour, part_min, part_sec, part_subsec)) 114 | ) 115 | | Mp_field_packet.Field_type_timestamp -> ( 116 | Mp_data.data_timestamp ((part_year, part_month, part_day), (part_hour, part_min, part_sec, part_subsec)) 117 | ) 118 | | _ -> assert false 119 | ) 120 | | Mp_field_packet.Field_type_year -> ( 121 | Mp_data.data_year (int_of_string v) 122 | ) 123 | | Mp_field_packet.Field_type_varchar -> ( 124 | Mp_data.data_varchar v (* TODO : add to tests *) 125 | ) 126 | | Mp_field_packet.Field_type_bit -> ( 127 | Mp_data.data_bit (Bitstring.bitstring_of_string v) 128 | ) 129 | | Mp_field_packet.Field_type_newdecimal -> ( 130 | (* TODO : keep also the original data (as string or two integer parts) 131 | because a round is automatically made *) 132 | let decimals = field.Mp_field_packet.field_decimals in 133 | let length = String.length v in 134 | let part_i_s = String.sub v 0 (length - 1 - decimals) in 135 | let part_d_s = String.sub v (length - decimals) decimals in 136 | let i = part_i_s ^ part_d_s in 137 | let i = Big_int.big_int_of_string i in 138 | let i = Num.num_of_big_int i in 139 | let div = Big_int.power_int_positive_int 10 decimals in 140 | let div = Num.num_of_big_int div in 141 | Mp_data.data_decimal (Num.div_num i div) 142 | ) 143 | | Mp_field_packet.Field_type_enum -> Mp_data.data_enum v 144 | | Mp_field_packet.Field_type_set -> Mp_data.data_set v 145 | | Mp_field_packet.Field_type_tiny_blob 146 | | Mp_field_packet.Field_type_medium_blob 147 | | Mp_field_packet.Field_type_long_blob 148 | | Mp_field_packet.Field_type_blob -> ( 149 | let b = Buffer.create (String.length v) in 150 | let () = Buffer.add_string b v in 151 | Mp_data.data_blob b 152 | ) 153 | | Mp_field_packet.Field_type_var_string -> ( 154 | if (List.mem Mp_field_packet.Field_flag_binary field_flags) then 155 | let b = Buffer.create (String.length v) in 156 | let () = Buffer.add_string b v in 157 | Mp_data.data_varbinary b 158 | else 159 | Mp_data.data_varstring v 160 | ) 161 | | Mp_field_packet.Field_type_string -> ( 162 | if (List.mem Mp_field_packet.Field_flag_enum field_flags) then 163 | Mp_data.data_enum v 164 | else if (List.mem Mp_field_packet.Field_flag_set field_flags) then 165 | Mp_data.data_set v 166 | else if (List.mem Mp_field_packet.Field_flag_binary field_flags) then 167 | let b = Buffer.create (String.length v) in 168 | let () = Buffer.add_string b v in 169 | Mp_data.data_binary b 170 | else 171 | Mp_data.data_string v 172 | ) 173 | | Mp_field_packet.Field_type_geometry -> ( 174 | Mp_data.data_geometry (Bitstring.bitstring_of_string v) 175 | ) 176 | -------------------------------------------------------------------------------- /src/mp_eof_packet.ml: -------------------------------------------------------------------------------- 1 | 2 | exception Bad_EOF_packet of Bitstring.bitstring 3 | 4 | type eof_packet = { 5 | eof_field_count : int; 6 | eof_warning_count : int; 7 | eof_status_flags : int 8 | } 9 | 10 | let eof_packet_empty = { 11 | eof_field_count = 0xfe; 12 | eof_warning_count = 0; 13 | eof_status_flags = 0 14 | } 15 | 16 | let eof_packet_to_string p = 17 | Printf.sprintf "eof_field_count : %u\neof_warning_count : %u\neof_status_flags : %u\n" 18 | p.eof_field_count p.eof_warning_count p.eof_status_flags 19 | 20 | type flag_server = 21 | Server_status_in_trans 22 | | Server_status_autocommit 23 | | Server_more_results_exists 24 | | Server_status_no_good_index_used 25 | | Server_status_no_index_used 26 | | Server_status_cursor_exists 27 | | Server_status_last_row_sent 28 | | Server_status_db_dropped 29 | | Server_status_no_backslash_escapes 30 | | Server_status_metadata_changed 31 | | Server_query_was_slow 32 | | Server_ps_out_params 33 | 34 | let flag_server_to_int f = 35 | match f with 36 | Server_status_in_trans -> 0x0001 37 | | Server_status_autocommit -> 0x0002 38 | | Server_more_results_exists -> 0x0008 39 | | Server_status_no_good_index_used -> 0x0010 40 | | Server_status_no_index_used -> 0x0020 41 | | Server_status_cursor_exists -> 0x0040 42 | | Server_status_last_row_sent -> 0x0080 43 | | Server_status_db_dropped -> 0x0100 44 | | Server_status_no_backslash_escapes -> 0x0200 45 | | Server_status_metadata_changed -> 0x0400 46 | | Server_query_was_slow -> 0x0800 47 | | Server_ps_out_params -> 0x1000 48 | 49 | let status_has_flag status flag = 50 | let code = flag_server_to_int flag in 51 | (status land code) <> 0 52 | 53 | let eof_packet_bits bits = 54 | (* field_count is always 0xfe *) 55 | let length = Bitstring.bitstring_length bits in 56 | if (length = 0) then 57 | (* the first byte 0xfe has already been eat *) 58 | { eof_field_count = 0xfe; eof_warning_count = 0; eof_status_flags = 0 } 59 | else if (length = 8) then ( 60 | (* we only have the first byte 0xfe *) 61 | match%bitstring bits with 62 | | {| 0xfe : 1*8 : int, unsigned, littleendian |} -> 63 | { eof_field_count = 0xfe; eof_warning_count = 0; eof_status_flags = 0 } 64 | ) 65 | else if (length = 32) then ( 66 | (* complete EOF packet but the first byte 0xfe has already been eat *) 67 | match%bitstring bits with 68 | | {| warning_count : 2*8 : int, unsigned, littleendian; 69 | status_flags : 2*8 : int, unsigned, littleendian |} -> 70 | { eof_field_count = 0xfe; eof_warning_count = warning_count; eof_status_flags = status_flags } 71 | ) 72 | else if (length = 40) then ( 73 | (* complete EOF packet including the first byte 0xfe *) 74 | match%bitstring bits with 75 | | {| 0xfe : 1*8 : int, unsigned, littleendian; 76 | warning_count : 2*8 : int, unsigned, littleendian; 77 | status_flags : 2*8 : int, unsigned, littleendian |} -> 78 | { eof_field_count = 0xfe; eof_warning_count = warning_count; eof_status_flags = status_flags } 79 | ) 80 | else ( 81 | raise (Bad_EOF_packet bits) 82 | ) 83 | 84 | let eof_packet_chan ic oc = 85 | let (_, _, bits) = Mp_packet.extract_packet ic oc in 86 | eof_packet_bits bits 87 | -------------------------------------------------------------------------------- /src/mp_error_packet.ml: -------------------------------------------------------------------------------- 1 | 2 | type error_packet = { 3 | error_errno : int; 4 | error_sqlstate : string; 5 | error_message : string; 6 | } 7 | 8 | let error_packet_to_string p = 9 | Printf.sprintf "error_errno : %u\nerror_sqlstate : %s\nerror_message : %s\n" 10 | p.error_errno p.error_sqlstate p.error_message 11 | 12 | let error_packet bits = 13 | let length_message = (Bitstring.bitstring_length bits) - ((2+1+5)*8) in 14 | match%bitstring bits with 15 | | {| errno : 2*8 : int, unsigned, littleendian; 16 | "#" : 1*8 : string; 17 | state : 5*8 : string; 18 | message : length_message : string |} -> ( 19 | { 20 | error_errno = errno; 21 | error_sqlstate = state; 22 | error_message = message; 23 | } 24 | ) -------------------------------------------------------------------------------- /src/mp_execute.ml: -------------------------------------------------------------------------------- 1 | type flag = 2 | Cursor_type_no_cursor 3 | | Cursor_type_read_only 4 | | Cursor_type_for_update 5 | | Cursor_type_scrollable 6 | 7 | type bind = 8 | Bind 9 | | No_bind 10 | 11 | let flag_to_int f = 12 | match f with 13 | | Cursor_type_no_cursor -> 0 14 | | Cursor_type_read_only -> 1 15 | | Cursor_type_for_update -> 2 16 | | Cursor_type_scrollable -> 4 17 | 18 | let bind_to_int b = 19 | match b with 20 | | Bind -> 1 21 | | No_bind -> 0 22 | 23 | let build_params_part_null params = 24 | match params with 25 | | [] -> Bitstring.empty_bitstring 26 | | p -> ( 27 | let nb_params = List.length p in 28 | let nb_null_bytes = (nb_params + 7) / 8 in 29 | let nb_null_bits = nb_null_bytes * 8 in 30 | let bitstring_null = Bitstring.create_bitstring nb_null_bits in 31 | let () = 32 | let count_param = ref 0 in 33 | let set_null_bit e = 34 | let bloc_num = !count_param / 8 in 35 | let pos_bit = (bloc_num * 8) + 7 - (!count_param mod 8) in 36 | match e with 37 | | Mp_data.Null -> ( 38 | let () = Bitstring.set bitstring_null pos_bit in 39 | incr count_param 40 | ) 41 | | _ -> incr count_param 42 | in 43 | List.iter set_null_bit p 44 | in 45 | bitstring_null 46 | ) 47 | 48 | let build_params_part_data bind params fields = 49 | match params with 50 | | [] -> ([], []) 51 | | _ -> 52 | let f acc param _ = 53 | let type_number = 54 | match bind with 55 | | Bind -> Mp_data_process.to_type_number param 56 | | No_bind -> Bitstring.empty_bitstring 57 | in 58 | let data = Mp_data_process.to_bitstring param in 59 | let (lt, ld) = acc in 60 | (type_number::lt, data::ld) 61 | in 62 | List.fold_left2 f ([], []) params fields 63 | 64 | let build_params_part bind params fields = 65 | let flag_bind = bind_to_int bind in 66 | let bitstring_null = build_params_part_null params in 67 | let (bitstring_type, bitstring_data) = build_params_part_data bind params fields in 68 | let bitstring_type = List.rev bitstring_type in 69 | let bitstring_type = Bitstring.concat bitstring_type in 70 | let bitstring_data = List.rev bitstring_data in 71 | let bitstring_data = Bitstring.concat bitstring_data in 72 | let nb_null_bits = Bitstring.bitstring_length bitstring_null in 73 | let nb_bitstring_type = Bitstring.bitstring_length bitstring_type in 74 | let nb_bitstring_data = Bitstring.bitstring_length bitstring_data in 75 | let%bitstring bits = 76 | {| 77 | bitstring_null : nb_null_bits : bitstring; 78 | flag_bind : 1*8 : int, unsigned; 79 | bitstring_type : nb_bitstring_type : bitstring; 80 | bitstring_data : nb_bitstring_data : bitstring 81 | |} 82 | in 83 | bits 84 | 85 | let build_execute ~handler ?(flag = Cursor_type_no_cursor) ?(params = []) ?(fields = []) ?(bind = Bind) () = 86 | let flag = flag_to_int flag in 87 | let iteration_count = Int64.one in 88 | let part_params = build_params_part bind params fields in 89 | let%bitstring bits = 90 | {| 91 | handler : Mp_bitstring.compute32 : int, unsigned, littleendian; 92 | flag : 1*8 : int, unsigned; 93 | iteration_count : Mp_bitstring.compute32 : int, unsigned, littleendian 94 | |} 95 | in 96 | Bitstring.concat [bits; part_params] 97 | -------------------------------------------------------------------------------- /src/mp_fetch.ml: -------------------------------------------------------------------------------- 1 | 2 | let build_fetch ~handler ?(nb_rows = Int64.one) () = 3 | let%bitstring v = 4 | {| 5 | handler : Mp_bitstring.compute32 : int, unsigned, littleendian; 6 | nb_rows : Mp_bitstring.compute32 : int, unsigned, littleendian 7 | |} 8 | in v 9 | -------------------------------------------------------------------------------- /src/mp_field.ml: -------------------------------------------------------------------------------- 1 | 2 | type field_name = (string * int) 3 | 4 | let field_name_to_string f = 5 | let (name, count) = f in 6 | "(" ^ name ^ ", " ^ (string_of_int count) ^ ")" 7 | 8 | let real_field_names field_packets = 9 | let one_packet acc p = 10 | let (l, count) = acc in 11 | let name = p.Mp_field_packet.field_name in 12 | ((name, count) :: l, count + 1) 13 | in 14 | let (l, _) = List.fold_left one_packet ([], 0) field_packets in 15 | List.rev l 16 | -------------------------------------------------------------------------------- /src/mp_handshake.ml: -------------------------------------------------------------------------------- 1 | 2 | type handshake = { 3 | packet_length : int; 4 | packet_number : int; 5 | protocol_version : int; 6 | server_version : string; 7 | thread_id : Int64.t; 8 | scramble_buff_1 : Bitstring.t; 9 | server_capabilities : Mp_capabilities.capabilities list; 10 | server_language : Mp_charset.charset; 11 | server_status : int; 12 | length_scramble : int; 13 | scramble_buff_2 : Bitstring.t 14 | } 15 | 16 | let handshake_to_string handshake = 17 | let fmt = format_of_string "packet_length : %u\n" 18 | ^^ format_of_string "packet_number : %u\n" 19 | ^^ format_of_string "protocol_version : %u\n" 20 | ^^ format_of_string "server_version : %s\n" 21 | ^^ format_of_string "thread_id : %Lu\n" 22 | ^^ format_of_string "scramble_buff_1 : %s\n" 23 | ^^ format_of_string "server_capabilities : %s\n" 24 | ^^ format_of_string "server_language : %s\n" 25 | ^^ format_of_string "server_status : %u\n" 26 | ^^ format_of_string "length_scramble : %u\n" 27 | ^^ format_of_string "scramble_buff_2 : %s\n" 28 | in 29 | Printf.sprintf fmt handshake.packet_length 30 | handshake.packet_number 31 | handshake.protocol_version 32 | handshake.server_version 33 | handshake.thread_id 34 | (Bitstring.string_of_bitstring handshake.scramble_buff_1) 35 | (Mp_capabilities.capabilities_to_string handshake.server_capabilities) 36 | (Mp_charset.charset_to_string handshake.server_language) 37 | handshake.server_status 38 | handshake.length_scramble 39 | (Bitstring.string_of_bitstring handshake.scramble_buff_2) 40 | 41 | let handshake_initialisation ic oc = 42 | let (packet_length, packet_number, bits) = Mp_packet.extract_packet ic oc in 43 | let length_bits = (Bitstring.bitstring_length bits) - 8 in 44 | match%bitstring bits with 45 | | {| protocol_version : 1*8 : int, unsigned, bigendian; (* always = 10 ?? (see send_server_handshake_packet function in sql_acl.cc) *) 46 | rest : length_bits : bitstring |} -> ( 47 | let (rest, server_version) = Mp_string.null_terminated_string rest "" in 48 | let length_rest = (Bitstring.bitstring_length rest) - (31*8) in 49 | match%bitstring rest with 50 | | {| thread_id : 4*8 : int, unsigned, littleendian; 51 | scramble_buff_1 : 8*8 : bitstring; 52 | 0x00 : 1*8 : int, unsigned, bigendian; 53 | server_capabilities : 2*8 : bitstring; 54 | server_language : 1*8 : int, unsigned, bigendian; 55 | server_status : 2*8 : int, unsigned, bigendian; 56 | server_capabilities_upper : 2 * 8 : bitstring; (* server capabilities (two upper bytes) *) 57 | length_scramble : 1 * 8 : int, unsigned, bigendian; (* length of the scramble *) 58 | _ : 1 * 8 : int, unsigned, bigendian; 59 | _ : 1 * 8 : int, unsigned, bigendian; 60 | _ : 1 * 8 : int, unsigned, bigendian; 61 | _ : 1 * 8 : int, unsigned, bigendian; 62 | _ : 1 * 8 : int, unsigned, bigendian; 63 | _ : 1 * 8 : int, unsigned, bigendian; 64 | _ : 1 * 8 : int, unsigned, bigendian; 65 | _ : 1 * 8 : int, unsigned, bigendian; 66 | _ : 1 * 8 : int, unsigned, bigendian; 67 | _ : 1 * 8 : int, unsigned, bigendian; 68 | rest : length_rest : bitstring |} -> 69 | (* thread_id is a 4 bytes unsigned integer (AND NOT a length coded binary) *) 70 | let thread_id = Int64.of_int32 thread_id in 71 | let server_language = Mp_charset.number_charset server_language in 72 | let server_capabilities = Mp_capabilities.decode_server_capabilities 73 | (Bitstring.concat [server_capabilities; server_capabilities_upper]) in 74 | (* scramble_buff_2 = rest of the plugin provided data (at least 12 bytes) 75 | \0 byte, terminating the second part of a scramble *) 76 | let (_, scramble_buff_2) = Mp_string.null_terminated_string rest "" in 77 | let scramble_buff_2 = Bitstring.bitstring_of_string scramble_buff_2 in 78 | let handshake = 79 | { packet_length = packet_length; 80 | packet_number = packet_number; 81 | protocol_version = protocol_version; 82 | server_version = server_version; 83 | thread_id = thread_id; 84 | scramble_buff_1 = scramble_buff_1; 85 | server_capabilities = server_capabilities; 86 | server_language = server_language; 87 | server_status = server_status; 88 | length_scramble = length_scramble; 89 | scramble_buff_2 = scramble_buff_2; 90 | } 91 | in 92 | handshake 93 | ) 94 | -------------------------------------------------------------------------------- /src/mp_ok_packet.ml: -------------------------------------------------------------------------------- 1 | 2 | type ok_packet = { 3 | ok_affected_rows : Int64.t; 4 | ok_insert_id : (Int64.t * Big_int.big_int); 5 | ok_server_status : int; 6 | ok_warning_count : int; 7 | ok_message : string; 8 | } 9 | 10 | let ok_packet_to_string p = 11 | let (insert_id_int64, insert_id_big_int) = p.ok_insert_id in 12 | let fmt = format_of_string "ok_affected_rows : %Lu\n" 13 | ^^ format_of_string "ok_insert_id : (%Lu, %s)\n" 14 | ^^ format_of_string "ok_server_status : %u\n" 15 | ^^ format_of_string "ok_warning_count : %u\n" 16 | ^^ format_of_string "ok_message : %s\n" 17 | in 18 | Printf.sprintf fmt p.ok_affected_rows 19 | insert_id_int64 (Big_int.string_of_big_int insert_id_big_int) 20 | p.ok_server_status 21 | p.ok_warning_count 22 | p.ok_message 23 | 24 | let ok_packet bits = 25 | let (affected_rows, rest) = Mp_binary.length_coded_binary bits in 26 | let (insert_id, rest) = Mp_binary.length_coded_binary rest in 27 | (* insert_id can be negative in two cases: 28 | - the auto_increment value is indeed negative (SIGNED field). 29 | - the returned value overflows Int64 maximum (BIGINT UNSIGNED field). 30 | Unfortunately, the protocol gives no way to differentiate these two 31 | cases (see https://bugs.mysql.com/bug.php?id=69228). 32 | So we return two values: 33 | - the first one is a Int64 and must be used when the 34 | auto_increment is _not_ a BIGINT UNSIGNED field. 35 | - the second one is a Big_int and must be used when the 36 | auto_increment is a BIGINT UNSIGNED field.*) 37 | let (insert_id_int64, insert_id_big_int) = 38 | if (Int64.compare insert_id Int64.zero >= 0) then 39 | (insert_id, Big_int.big_int_of_int64 insert_id) 40 | else 41 | let bi = Big_int.add_big_int (Big_int.power_int_positive_int 2 64) 42 | (Big_int.big_int_of_int64 insert_id) 43 | in 44 | (insert_id, bi) 45 | in 46 | if (Bitstring.bitstring_length rest > 0) then ( 47 | let length_msg = (Bitstring.bitstring_length rest) - (4*8) in 48 | match%bitstring rest with 49 | | {| server_status : 2*8 : int, unsigned, bigendian; 50 | warning_count : 2*8 : int, unsigned, bigendian; 51 | message : length_msg : string |} -> ( 52 | { 53 | ok_affected_rows = affected_rows; 54 | ok_insert_id = (insert_id_int64, insert_id_big_int); 55 | ok_server_status = server_status; 56 | ok_warning_count = warning_count; 57 | ok_message = message; 58 | } 59 | ) 60 | ) 61 | else ( 62 | { 63 | ok_affected_rows = affected_rows; 64 | ok_insert_id = (insert_id_int64, insert_id_big_int); 65 | ok_server_status = 0; 66 | ok_warning_count = 0; 67 | ok_message = ""; 68 | } 69 | ) 70 | -------------------------------------------------------------------------------- /src/mp_ok_prepare_packet.ml: -------------------------------------------------------------------------------- 1 | 2 | type ok_prepare_packet = { 3 | ok_prepare_handler : Int64.t; 4 | ok_prepare_nb_columns : int; 5 | ok_prepare_nb_parameters : int; 6 | ok_prepare_warning_count : int; 7 | ok_prepare_parameters_fields : Mp_field_packet.field_packet list; 8 | ok_prepare_parameters_names : Mp_field.field_name list; 9 | ok_prepare_columns_fields : Mp_field_packet.field_packet list; 10 | ok_prepare_columns_names : Mp_field.field_name list; 11 | } 12 | 13 | let ok_prepare_packet_to_string p = 14 | let f_packet acc p = 15 | acc ^ "\n" ^ (Mp_field_packet.field_packet_to_string p) 16 | in 17 | let f_name acc e = 18 | acc ^ "\n" ^ (Mp_field.field_name_to_string e) 19 | in 20 | let fmt = format_of_string "ok_prepare_handler : %Lu\n" 21 | ^^ format_of_string "ok_prepare_nb_columns : %u\n" 22 | ^^ format_of_string "ok_prepare_nb_parameters : %u\n" 23 | ^^ format_of_string "ok_prepare_warning_count : %u\n" 24 | ^^ format_of_string "PARAMETERS FIELDS: \n" 25 | ^^ format_of_string "\nFields: \n%s" 26 | ^^ format_of_string "\nNames: \n%s" 27 | ^^ format_of_string "\n\nCOLUMNS FIELDS: \n" 28 | ^^ format_of_string "\nFields: \n%s" 29 | ^^ format_of_string "\nNames: \n%s" 30 | in 31 | Printf.sprintf fmt p.ok_prepare_handler 32 | p.ok_prepare_nb_columns 33 | p.ok_prepare_nb_parameters 34 | p.ok_prepare_warning_count 35 | (List.fold_left f_packet "" p.ok_prepare_parameters_fields) 36 | (List.fold_left f_name "" p.ok_prepare_parameters_names) 37 | (List.fold_left f_packet "" p.ok_prepare_columns_fields) 38 | (List.fold_left f_name "" p.ok_prepare_columns_names) 39 | 40 | let ok_prepare_packet bits ic oc = 41 | match%bitstring bits with 42 | | {| handler : Mp_bitstring.compute32 : int, unsigned, littleendian; 43 | nb_columns : 2*8 : int, unsigned, littleendian; 44 | nb_parameters : 2*8 : int, unsigned, littleendian; 45 | 0x0 : 8 : int; 46 | warning_count : 2*8 : int, unsigned, littleendian |} -> 47 | let (list_field_parameters, list_name_parameters) = 48 | if (nb_parameters > 0) then ( 49 | let list_field_packets = ref [] in 50 | let () = 51 | for _ = 1 to nb_parameters do 52 | Mp_field_packet.field_packet list_field_packets ic oc 53 | done 54 | in 55 | let list_field_packets = List.rev !list_field_packets in 56 | let list_field_names = Mp_field.real_field_names list_field_packets in 57 | let _ = Mp_eof_packet.eof_packet_chan ic oc in 58 | (list_field_packets, list_field_names) 59 | ) 60 | else ( 61 | ([], []) 62 | ) 63 | in 64 | let (list_field_columns, list_name_columns) = 65 | if (nb_columns > 0) then ( 66 | let list_field_packets = ref [] in 67 | let () = 68 | for _ = 1 to nb_columns do 69 | Mp_field_packet.field_packet list_field_packets ic oc 70 | done 71 | in 72 | let list_field_packets = List.rev !list_field_packets in 73 | let list_field_names = Mp_field.real_field_names list_field_packets in 74 | let _ = Mp_eof_packet.eof_packet_chan ic oc in 75 | (list_field_packets, list_field_names) 76 | ) 77 | else ( 78 | ([], []) 79 | ) 80 | in 81 | { 82 | ok_prepare_handler = handler; 83 | ok_prepare_nb_columns = nb_columns; 84 | ok_prepare_nb_parameters = nb_parameters; 85 | ok_prepare_warning_count = warning_count; 86 | ok_prepare_parameters_fields = list_field_parameters; 87 | ok_prepare_parameters_names = list_name_parameters; 88 | ok_prepare_columns_fields = list_field_columns; 89 | ok_prepare_columns_names = list_name_columns; 90 | } 91 | -------------------------------------------------------------------------------- /src/mp_packet.ml: -------------------------------------------------------------------------------- 1 | 2 | let extract_extra_packets ic _ = 3 | let length_current = ref 16777215 in 4 | let length = ref 0 in 5 | let number = ref 0 in 6 | let acc_bits = ref Bitstring.empty_bitstring in 7 | let f () = 8 | let bits = Bitstring.bitstring_of_chan_max ic 4 in 9 | match%bitstring bits with 10 | | {| packet_length : 3*8 : int, unsigned, littleendian; 11 | packet_number : 1*8 : int, unsigned, bigendian |} -> 12 | let bits = Bitstring.bitstring_of_chan_max ic packet_length in 13 | let () = length_current := packet_length in 14 | let () = length := !length + packet_length in 15 | let () = number := packet_number in 16 | let () = acc_bits := Bitstring.concat [! acc_bits; bits] in 17 | () 18 | in 19 | try 20 | let () = 21 | while (!length_current = 16777215) do 22 | f (); 23 | done 24 | in 25 | (! length, ! number, ! acc_bits) 26 | with 27 | | _ -> (! length, ! number, ! acc_bits) 28 | 29 | let extract_packet ic oc = 30 | let bits = Bitstring.bitstring_of_chan_max ic 4 in 31 | match%bitstring bits with 32 | | {| packet_length : 3*8 : int, unsigned, littleendian; 33 | packet_number : 1*8 : int, unsigned, bigendian |} -> 34 | let () = 35 | if (packet_length > Sys.max_string_length) then 36 | failwith "Packet length > max_string_length" 37 | in 38 | let bits = Bitstring.bitstring_of_chan_max ic packet_length in 39 | if (packet_length >= 16777215) then 40 | (* we may have more than 1 packet *) 41 | let (packet_length_extra, packet_number_extra, bits_extra) = extract_extra_packets ic oc in 42 | (packet_length + packet_length_extra, packet_number_extra, Bitstring.concat [bits; bits_extra]) 43 | else 44 | (packet_length, packet_number, bits) 45 | 46 | let make_packet current_num_packet bits = 47 | let num = current_num_packet + 1 in 48 | let length = Bitstring.bitstring_length bits / 8 in 49 | let bits_length = 50 | if (length <= 16777215) then ( 51 | let%bitstring v = 52 | {| 53 | length : 3*8 : int, unsigned, littleendian 54 | |} 55 | in v 56 | ) 57 | else ( 58 | failwith "Send packet length too big ( > 0xffffff )" 59 | ) 60 | in 61 | let%bitstring packet = {| 62 | bits_length : Bitstring.bitstring_length bits_length : bitstring; 63 | num : 1*8 : int, unsigned, bigendian; 64 | bits : Bitstring.bitstring_length bits : bitstring 65 | |} 66 | in 67 | packet 68 | -------------------------------------------------------------------------------- /src/mp_protocol.ml: -------------------------------------------------------------------------------- 1 | type protocol_version = 2 | Protocol_version_40 3 | | Protocol_version_41 4 | 5 | let protocol_version_to_string v = 6 | let version = 7 | match v with 8 | | Protocol_version_40 -> "4.0" 9 | | Protocol_version_41 -> "4.1" 10 | in 11 | version 12 | -------------------------------------------------------------------------------- /src/mp_raw_data.ml: -------------------------------------------------------------------------------- 1 | 2 | type row_data = 3 | | Row_data_data of string 4 | | Row_data_null 5 | | Row_data_binary of Bitstring.t 6 | 7 | let row_data_to_string p = 8 | let v = 9 | match p with 10 | | Row_data_data d -> d 11 | | Row_data_null -> "NULL" 12 | | Row_data_binary b -> Bitstring.string_of_bitstring b 13 | in 14 | Printf.sprintf "row_data : %s\n" v 15 | 16 | let binary data field_packet = 17 | let field_type = field_packet.Mp_field_packet.field_type in 18 | let (length_bits, data) = 19 | match field_type with 20 | | Mp_field_packet.Field_type_tiny -> (Int64.of_int (1 * 8), data) 21 | | Mp_field_packet.Field_type_short 22 | | Mp_field_packet.Field_type_year -> (Int64.of_int (2 * 8), data) 23 | | Mp_field_packet.Field_type_float 24 | | Mp_field_packet.Field_type_long -> (Int64.of_int (4 * 8), data) 25 | | Mp_field_packet.Field_type_int24 -> (Int64.of_int (4 * 8), data) (* 4 bytes with 0x00 or 0xff for the last one *) 26 | | Mp_field_packet.Field_type_double 27 | | Mp_field_packet.Field_type_longlong -> (Int64.of_int (8 * 8), data) 28 | | Mp_field_packet.Field_type_newdecimal 29 | | Mp_field_packet.Field_type_datetime 30 | | Mp_field_packet.Field_type_time 31 | | Mp_field_packet.Field_type_date 32 | | Mp_field_packet.Field_type_timestamp 33 | | Mp_field_packet.Field_type_string 34 | | Mp_field_packet.Field_type_var_string 35 | | Mp_field_packet.Field_type_blob 36 | | Mp_field_packet.Field_type_long_blob 37 | | Mp_field_packet.Field_type_medium_blob 38 | | Mp_field_packet.Field_type_tiny_blob 39 | | Mp_field_packet.Field_type_bit 40 | | Mp_field_packet.Field_type_geometry -> ( 41 | let (l, d) = Mp_binary.length_coded_binary data in 42 | (Int64.mul l (Int64.of_int 8), d) 43 | ) 44 | | _ -> assert false 45 | in 46 | let length_rest = (Bitstring.bitstring_length data) - (Int64.to_int length_bits) in 47 | match%bitstring data with 48 | | {| value : (Int64.to_int length_bits) : bitstring; 49 | rest : length_rest : bitstring |} -> (value, rest) 50 | 51 | let raw_data_packet_binary list_field_packet list_null_fields bits = 52 | let nb_columns = List.length list_field_packet in 53 | let count_columns = ref 0 in 54 | let data = ref bits in 55 | let l = ref [] in 56 | let () = 57 | while (Bitstring.bitstring_length !data > 0 || !count_columns < nb_columns) do 58 | let (v, rest) = 59 | if (List.length list_null_fields > 0) then 60 | if (List.nth list_null_fields !count_columns) then 61 | let () = incr count_columns in 62 | (Row_data_null, !data) 63 | else 64 | let (v, rest) = binary !data (List.nth list_field_packet !count_columns) in 65 | let () = incr count_columns in 66 | (Row_data_binary v, rest) 67 | else 68 | let (v, rest) = binary !data (List.nth list_field_packet !count_columns) in 69 | let () = incr count_columns in 70 | (Row_data_binary v, rest) 71 | in 72 | let () = l := v :: !l in 73 | data := rest 74 | done 75 | in 76 | List.rev !l 77 | 78 | let null_bytes bits = 79 | let nb_bytes = (Bitstring.bitstring_length bits) / 8 in 80 | if (nb_bytes > 0) then ( 81 | let byte b l = 82 | match%bitstring b with 83 | | {| bit0 : 1 : int; 84 | bit1 : 1 : int; 85 | bit2 : 1 : int; 86 | bit3 : 1 : int; 87 | bit4 : 1 : int; 88 | bit5 : 1 : int; 89 | bit6 : 1 : int; 90 | bit7 : 1 : int |} -> ( 91 | l := bit7 :: !l; 92 | l := bit6 :: !l; 93 | l := bit5 :: !l; 94 | l := bit4 :: !l; 95 | l := bit3 :: !l; 96 | l := bit2 :: !l; 97 | l := bit1 :: !l; 98 | l := bit0 :: !l; 99 | ) 100 | in 101 | let l = ref [] in 102 | let () = 103 | for i = 0 to (nb_bytes - 1) do 104 | byte (Bitstring.subbitstring bits (i * 8) 8) l 105 | done 106 | in 107 | List.rev !l 108 | ) 109 | else ( 110 | [] 111 | ) 112 | 113 | let raw_data_packet list_field_packet type_sent count_rows bits = 114 | let binary_encoding = ref false in 115 | let bits = 116 | match type_sent with 117 | | Mp_com.Fetch -> 118 | if (count_rows > 0) then 119 | if (Bitstring.bitstring_length bits > 0) then ( 120 | let length_rest = (Bitstring.bitstring_length bits) - 8 in 121 | match%bitstring bits with 122 | | {| test : 1*8 : int, unsigned; 123 | rest : length_rest : bitstring |} -> ( 124 | if (test = 0) then 125 | let () = binary_encoding := true in 126 | rest 127 | else 128 | bits 129 | ) 130 | ) else 131 | bits 132 | else 133 | let () = binary_encoding := true in 134 | bits 135 | | _ -> 136 | if (Bitstring.bitstring_length bits > 0) then ( 137 | let length_rest = (Bitstring.bitstring_length bits) - 8 in 138 | match%bitstring bits with 139 | | {| test : 1*8 : int, unsigned; 140 | rest : length_rest : bitstring |} -> ( 141 | if (test = 0) then 142 | let () = binary_encoding := true in 143 | rest 144 | else 145 | bits 146 | ) 147 | ) else 148 | bits 149 | in 150 | if (!binary_encoding) then ( 151 | let nb_null_bits = ((((List.length list_field_packet) + 7 + 2) / 8) * 8) in 152 | let length_rest = (Bitstring.bitstring_length bits) - nb_null_bits in 153 | match%bitstring bits with 154 | | {| null_bits : nb_null_bits : bitstring; 155 | rest : length_rest : bitstring |} -> ( 156 | let list_null_fields = null_bytes null_bits in 157 | (* the first two bits are reserved *) 158 | let list_null_fields = 159 | match list_null_fields with 160 | | [] -> [] 161 | | _ :: _ :: l -> l 162 | | _ -> assert false 163 | in 164 | raw_data_packet_binary list_field_packet list_null_fields rest 165 | ) 166 | ) else ( 167 | let data = ref bits in 168 | let l = ref [] in 169 | let () = 170 | while (Bitstring.bitstring_length !data > 0) do 171 | let null_value = ref false in 172 | let () = 173 | if (Bitstring.bitstring_length !data >= 8) then ( 174 | match%bitstring !data with 175 | | {| test : 1*8 : int, unsigned, bigendian |} -> ( 176 | if (test = 251) then 177 | null_value := true 178 | ) 179 | ) 180 | in 181 | let (v, rest) = 182 | if !null_value then ( 183 | let length_rest = (Bitstring.bitstring_length !data) - 8 in 184 | match%bitstring !data with 185 | | {| _ : 1*8 : int, unsigned, bigendian; 186 | rest : length_rest : bitstring |} -> (Row_data_null, rest) 187 | ) else ( 188 | let (v, rest) = Mp_string.length_coded_string !data in 189 | (Row_data_data v, rest) 190 | ) 191 | in 192 | let () = l := v :: !l in 193 | data := rest 194 | done 195 | in 196 | List.rev !l 197 | ) 198 | -------------------------------------------------------------------------------- /src/mp_result_packet.ml: -------------------------------------------------------------------------------- 1 | 2 | type result_packet = 3 | Result_packet_ok of Mp_ok_packet.ok_packet 4 | | Result_packet_prepare_ok of Mp_ok_prepare_packet.ok_prepare_packet 5 | | Result_packet_result_set of Mp_result_set_packet.result_select 6 | | Result_packet_eof of Mp_eof_packet.eof_packet 7 | | Result_packet_error of Mp_error_packet.error_packet 8 | 9 | let result_packet_to_string p = 10 | match p with 11 | | Result_packet_ok r -> Mp_ok_packet.ok_packet_to_string r 12 | | Result_packet_prepare_ok r -> Mp_ok_prepare_packet.ok_prepare_packet_to_string r 13 | | Result_packet_result_set r -> Mp_result_set_packet.result_select_to_string r 14 | | Result_packet_eof r -> Mp_eof_packet.eof_packet_to_string r 15 | | Result_packet_error r -> Mp_error_packet.error_packet_to_string r 16 | 17 | let rec result_packet ic oc filter iter return_all_raw_mysql_data type_sent fields acc = 18 | let (_, packet_number, bits) = Mp_packet.extract_packet ic oc in 19 | let length_rest = (Bitstring.bitstring_length bits) - 8 in 20 | match%bitstring bits with 21 | | {| type_packet : 1*8 : int, unsigned, bigendian; 22 | rest : length_rest : bitstring |} -> 23 | if (type_packet = 0x00) then ( 24 | match type_sent with 25 | | Mp_com.Prepare -> ( 26 | let p = Mp_ok_prepare_packet.ok_prepare_packet rest ic oc in 27 | (Result_packet_prepare_ok p, packet_number) :: acc 28 | ) 29 | | Mp_com.Fetch -> ( 30 | let (_, p) = Mp_result_set_packet.result_set_packet (Int64.of_int type_packet) 31 | rest ic oc filter iter return_all_raw_mysql_data type_sent fields in 32 | (Result_packet_result_set p, packet_number) :: acc 33 | ) 34 | | _ -> ( 35 | let p = Mp_ok_packet.ok_packet rest in 36 | (Result_packet_ok p, packet_number) :: acc 37 | ) 38 | ) 39 | else if (type_packet >= 1 && type_packet <= 250 ) then 40 | let (server_more_results_exists, p) = 41 | Mp_result_set_packet.result_set_packet (Int64.of_int type_packet) 42 | rest ic oc filter iter return_all_raw_mysql_data type_sent fields in 43 | if (server_more_results_exists) then ( 44 | result_packet ic oc filter iter return_all_raw_mysql_data type_sent fields 45 | ((Result_packet_result_set p, packet_number) :: acc) 46 | ) else ( 47 | (Result_packet_result_set p, packet_number) :: acc 48 | ) 49 | else if type_packet = 0xfe then 50 | let p = Mp_eof_packet.eof_packet_bits rest in 51 | (Result_packet_eof p, packet_number) :: acc 52 | else if type_packet = 0xff then 53 | let p = Mp_error_packet.error_packet rest in 54 | (Result_packet_error p, packet_number) :: acc 55 | else 56 | failwith "Bad result packet" 57 | -------------------------------------------------------------------------------- /src/mp_result_set_packet.ml: -------------------------------------------------------------------------------- 1 | 2 | type result_set_packet = { 3 | result_set_field_count : Int64.t; 4 | result_set_extra : Int64.t; 5 | result_set_field_packets : Mp_field_packet.field_packet list; 6 | result_set_row_data_packets : Mp_raw_data.row_data list list; 7 | } 8 | 9 | type result_select = { 10 | rows : (Mp_field.field_name list * Mp_data.t list list); 11 | mysql_data : result_set_packet option; 12 | } 13 | 14 | let rows_to_string result_select = 15 | let (field_names, data) = result_select in 16 | let count_records = ref 1 in 17 | let count_fields = ref 0 in 18 | let row acc v = 19 | let s = 20 | match (Mp_data.to_string v) with 21 | | None -> "NULL" 22 | | Some x -> x 23 | in 24 | let (f, _) = List.nth field_names !count_fields in 25 | let () = incr count_fields in 26 | let s = f ^ ": " ^ s ^ "\n" in 27 | acc ^ s 28 | in 29 | let rows acc record = 30 | let () = count_fields := 0 in 31 | let s = List.fold_left row "" record in 32 | let s = "\n ---- Record " ^ (string_of_int !count_records) ^ " ---- \n" ^ s ^ " ---- " in 33 | let () = incr count_records in 34 | acc ^ s 35 | in 36 | List.fold_left rows "" data 37 | 38 | let result_set_packet_to_string p = 39 | let field_packets = 40 | let f acc e = 41 | acc ^ "---- field packet ----\n" ^ (Mp_field_packet.field_packet_to_string e) ^ "---- ----\n" 42 | in 43 | List.fold_left f "" p.result_set_field_packets 44 | in 45 | let row_data_packets = 46 | let f1 acc e = 47 | acc ^ "---- data packet ----\n" ^ (Mp_raw_data.row_data_to_string e) ^ "---- ----\n" 48 | in 49 | let f acc e = 50 | acc ^ (List.fold_left f1 "" e) 51 | in 52 | List.fold_left f "" p.result_set_row_data_packets 53 | in 54 | let fmt = format_of_string "result_set_field_count : %Lu\n" 55 | ^^ format_of_string "result_set_extra : %Lu\n" 56 | ^^ format_of_string "result_set_field_packets : \n%s\n" 57 | ^^ format_of_string "result_set_row_data_packets : \n%s\n" 58 | in 59 | Printf.sprintf fmt p.result_set_field_count 60 | p.result_set_extra 61 | field_packets 62 | row_data_packets 63 | 64 | let result_select_to_string result_select = 65 | let s1 = rows_to_string result_select.rows in 66 | let s2 = 67 | match result_select.mysql_data with 68 | | None -> "No MySQL data" 69 | | Some v -> result_set_packet_to_string v 70 | in 71 | s1 ^ "\n" ^ s2 72 | 73 | let result_set_packet result_set_field_count bits ic oc filter iter return_all_raw_mysql_data type_sent fields = 74 | let count = Int64.to_int result_set_field_count in 75 | let extra = 76 | if Bitstring.bitstring_length bits = 8 then 77 | let (n, _) = Mp_binary.length_coded_binary bits in 78 | n 79 | else 80 | Int64.zero 81 | in 82 | let list_field_packets = 83 | match type_sent with 84 | | Mp_com.Fetch -> fields (* no fields packets are sent in fetch case *) 85 | | _ -> ( 86 | let list_field_packets = ref [] in 87 | let () = 88 | if count > 0 then 89 | for _ = 1 to count do 90 | Mp_field_packet.field_packet list_field_packets ic oc 91 | done 92 | in 93 | List.rev !list_field_packets 94 | ) 95 | in 96 | let list_field_names = Mp_field.real_field_names list_field_packets in 97 | let eof_packet = 98 | match type_sent with 99 | | Mp_com.Fetch -> Mp_eof_packet.eof_packet_empty (* no eof packet to read in fetch case *) 100 | | _ -> Mp_eof_packet.eof_packet_chan ic oc 101 | in 102 | let list_raw_data_packets = ref [] in 103 | let data_packets_end = ref false in 104 | let server_more_results_exists = ref false in 105 | let list_sql_data = ref [] in 106 | let () = 107 | let status_cursor_exists = Mp_eof_packet.status_has_flag eof_packet.Mp_eof_packet.eof_status_flags Mp_eof_packet.Server_status_cursor_exists in 108 | let data_part_exist = 109 | match type_sent with 110 | | Mp_com.Fetch -> true 111 | | _ -> if status_cursor_exists then false else true 112 | in 113 | if (data_part_exist) then 114 | let (_, _, bits) = 115 | match type_sent with 116 | | Mp_com.Fetch -> (0, 0, bits) (* no extract packet for the first time in the fetch case *) 117 | | _ -> Mp_packet.extract_packet ic oc 118 | in 119 | let bits = ref bits in 120 | let count_rows = ref 0 in 121 | while (not !data_packets_end) do 122 | let first_byte = Bitstring.takebits 8 !bits in 123 | let () = 124 | match%bitstring first_byte with 125 | | {| test_packets_end : 1*8 : int, unsigned, bigendian |} -> ( 126 | if (test_packets_end = 0xfe) then ( 127 | data_packets_end := true; 128 | let eof = Mp_eof_packet.eof_packet_bits !bits in 129 | if (Mp_eof_packet.status_has_flag 130 | eof.Mp_eof_packet.eof_status_flags 131 | Mp_eof_packet.Server_more_results_exists) then ( 132 | server_more_results_exists := true 133 | ) 134 | ) 135 | ) 136 | in 137 | if (not !data_packets_end) then 138 | let l = Mp_raw_data.raw_data_packet list_field_packets type_sent !count_rows !bits in 139 | let () = 140 | if return_all_raw_mysql_data then 141 | list_raw_data_packets := l :: !list_raw_data_packets 142 | in 143 | let sql_data = Mp_data_process.data_row list_field_packets l in 144 | let filtered = ref false in 145 | let () = 146 | match filter with 147 | | None -> list_sql_data := sql_data :: !list_sql_data 148 | | Some f -> 149 | if (f list_field_names sql_data) then 150 | list_sql_data := sql_data :: !list_sql_data 151 | else 152 | filtered := true 153 | in 154 | let () = 155 | match iter with 156 | | None -> () 157 | | Some f -> 158 | if (not !filtered) then 159 | f list_field_names sql_data 160 | in 161 | let () = incr count_rows in 162 | let (_, _, next) = Mp_packet.extract_packet ic oc in 163 | bits := next 164 | done 165 | in 166 | let list_raw_data_packets = List.rev !list_raw_data_packets in 167 | let list_sql_data = List.rev !list_sql_data in 168 | (* Final EOF packet is read in the while loop below *) 169 | let mysql_data = 170 | if return_all_raw_mysql_data then 171 | Some { 172 | result_set_field_count = result_set_field_count; 173 | result_set_extra = extra; 174 | result_set_field_packets = list_field_packets; 175 | result_set_row_data_packets = list_raw_data_packets 176 | } 177 | else 178 | None 179 | in 180 | (!server_more_results_exists, 181 | { 182 | rows = (list_field_names, list_sql_data); 183 | mysql_data = mysql_data; 184 | }) 185 | -------------------------------------------------------------------------------- /src/mp_string.ml: -------------------------------------------------------------------------------- 1 | 2 | let rec null_terminated_string bits acc = 3 | let length_rest = (Bitstring.bitstring_length bits) - 8 in 4 | match%bitstring bits with 5 | | {| c : 1*8 : int, unsigned, bigendian; 6 | rest : length_rest : bitstring |} -> 7 | if c = 0 then 8 | (rest, acc) 9 | else 10 | let acc = acc ^ (String.make 1 (Char.chr c)) in 11 | null_terminated_string rest acc 12 | 13 | let length_coded_string bits = 14 | let (length, rest) = Mp_binary.length_coded_binary bits in 15 | let length_rest = (Bitstring.bitstring_length rest) - (8 * (Int64.to_int length)) in 16 | match%bitstring rest with 17 | | {| s : 8 * (Int64.to_int length) : string; 18 | rest : length_rest : bitstring |} -> (s, rest) 19 | 20 | let make_null_terminated_string s = 21 | let null = String.make 1 (Char.chr 0) in 22 | s ^ null 23 | -------------------------------------------------------------------------------- /src/mysql_protocol.mlpack: -------------------------------------------------------------------------------- 1 | mp_auth_switch_request 2 | mp_authentication 3 | mp_binary 4 | mp_bitstring 5 | mp_capabilities 6 | mp_change_user 7 | mp_charset 8 | mp_client 9 | mp_com 10 | mp_data 11 | mp_data_binary 12 | mp_data_process 13 | mp_data_simple 14 | mp_eof_packet 15 | mp_error_packet 16 | mp_execute 17 | mp_fetch 18 | mp_field 19 | mp_field_packet 20 | mp_handshake 21 | mp_ok_packet 22 | mp_ok_prepare_packet 23 | mp_packet 24 | mp_protocol 25 | mp_raw_data 26 | mp_result_packet 27 | mp_result_set_packet 28 | mp_string 29 | -------------------------------------------------------------------------------- /test/caml-inria-fr.128x58.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/slegrand45/mysql_protocol/01f856e3d757bec7a0d150efe5bb19392608b4ba/test/caml-inria-fr.128x58.gif -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (modules_without_implementation fixture) 4 | (libraries oUnit mysql_protocol)) 5 | -------------------------------------------------------------------------------- /test/fixture.mli: -------------------------------------------------------------------------------- 1 | open Mysql_protocol 2 | 3 | module type FIXTURE = sig 4 | val db_name : string 5 | val insert_var_string : string 6 | val update_var_string : string 7 | val blobtext1 : Buffer.t 8 | val blobtext2 : Buffer.t 9 | val blobblob1 : Buffer.t 10 | val blobblob2 : Buffer.t 11 | val blobtiny1 : Buffer.t 12 | val blobtiny2 : Buffer.t 13 | val blobmedium1 : Buffer.t 14 | val blobmedium2 : Buffer.t 15 | val bloblong1 : Buffer.t 16 | val bloblong2 : Buffer.t 17 | val blobimg1 : Buffer.t 18 | val blobimg2 : Buffer.t 19 | val bit1 : Bitstring.bitstring 20 | val bit2 : Bitstring.bitstring 21 | val records : Mp_data.t list list 22 | val blobbig : Buffer.t 23 | val records_blobbig : Mp_data.t list list 24 | val records_date : Test_types.vendor -> int -> Mp_data.t list list 25 | val records_bigstring : Mp_data.t list list 26 | val records_bigvarchar : Mp_data.t list list 27 | val records_bigvarbinary : Mp_data.t list list 28 | val records_manyblobs : Mp_data.t list list 29 | val records_proc_one_result : Test_types.vendor -> Mp_data.t list list 30 | val records_proc_multiple_results : Test_types.vendor -> Mp_data.t list list 31 | val ok_value_iter : string 32 | val sql : string 33 | end 34 | -------------------------------------------------------------------------------- /test/fixture_config.ml: -------------------------------------------------------------------------------- 1 | (** 2 | 3 | To run those tests, you should first create the following databases and user : 4 | 5 | DROP DATABASE IF EXISTS test_ocaml_ocmp_latin1; 6 | DROP DATABASE IF EXISTS test_ocaml_ocmp_utf8; 7 | CREATE DATABASE test_ocaml_ocmp_latin1 CHARACTER SET latin1; 8 | CREATE DATABASE test_ocaml_ocmp_utf8 CHARACTER SET utf8; 9 | 10 | GRANT ALL PRIVILEGES ON test_ocaml_ocmp_latin1.* TO 'user_ocaml_ocmp'@'localhost' IDENTIFIED BY 'ocmp'; 11 | GRANT ALL PRIVILEGES ON test_ocaml_ocmp_utf8.* TO 'user_ocaml_ocmp'@'localhost'; 12 | 13 | GRANT ALL PRIVILEGES ON test_ocaml_ocmp_latin1.* TO 'u_ocmp_npauth'@'localhost' IDENTIFIED WITH mysql_native_password; 14 | GRANT ALL PRIVILEGES ON test_ocaml_ocmp_utf8.* TO 'u_ocmp_npauth'@'localhost'; 15 | SET PASSWORD FOR 'u_ocmp_npauth'@'localhost' = PASSWORD('ocmpnpauth'); 16 | 17 | GRANT ALL PRIVILEGES ON test_ocaml_ocmp_latin1.* TO 'u_ocmp_npauth_2'@'localhost' IDENTIFIED WITH mysql_native_password; 18 | GRANT ALL PRIVILEGES ON test_ocaml_ocmp_utf8.* TO 'u_ocmp_npauth_2'@'localhost'; 19 | SET PASSWORD FOR 'u_ocmp_npauth_2'@'localhost' = PASSWORD('ocmpnpauth2'); 20 | 21 | GRANT FILE ON test_ocaml_ocmp_latin1.* TO 'user_ocaml_ocmp'@'localhost'; 22 | GRANT FILE ON test_ocaml_ocmp_utf8.* TO 'user_ocaml_ocmp'@'localhost'; 23 | 24 | GRANT GRANT OPTION ON test_ocaml_ocmp_latin1.* TO 'user_ocaml_ocmp'@'localhost'; 25 | GRANT GRANT OPTION ON test_ocaml_ocmp_utf8.* TO 'user_ocaml_ocmp'@'localhost'; 26 | 27 | 28 | For the test with several blob columns, you may have to increase innodb_log_file_size in my.cnf configuration file: 29 | 30 | [mysqld] 31 | innodb_log_file_size = 64M 32 | 33 | For the GRANT FILE, if you get the following error: 34 | ERROR 1221 (HY000): Incorrect usage of DB GRANT and GLOBAL PRIVILEGES 35 | you can add FILE privilege for each database: 36 | GRANT FILE ON *.* TO 'user_ocaml_ocmp'@'localhost'; 37 | 38 | For the GRANT rights, if you get the following error: 39 | Errno: 33285 / Sql state: 42000 / Message: You are not allowed to create a user with GRANT 40 | you can set the privilege from a mysql client: 41 | USE mysql; 42 | UPDATE user SET Create_user_priv='Y' WHERE User LIKE '%ocmp%'; 43 | 44 | *) 45 | 46 | let testfile f = 47 | let dir = Unix.getcwd () in 48 | let subdir = "" in 49 | Filename.concat (dir ^ (Filename.dir_sep) ^ subdir) f 50 | 51 | let testfile1 = testfile "caml-inria-fr.128x58.gif" 52 | let testfile2 = testfile "logo-full-thumb.png" 53 | let testfile3 = testfile "ocaml-3.12-refman.pdf" 54 | let testfile4 = testfile "twomega.bin" 55 | 56 | let content_file f = 57 | let handle = open_in_bin f in 58 | let length = in_channel_length handle in 59 | let buffer = Bytes.make length '\000' in 60 | let () = really_input handle buffer 0 length in 61 | buffer 62 | 63 | let content_testfile1 = content_file testfile1 64 | let content_testfile2 = content_file testfile2 65 | let content_testfile3 = content_file testfile3 66 | let content_testfile4 = content_file testfile4 67 | 68 | let big_enum_column = 69 | let s = ref "" in 70 | let () = 71 | for i = 0 to 300 do 72 | let e = Printf.sprintf "'%X', " i in 73 | s := !s ^ e 74 | done 75 | in 76 | String.sub !s 0 ((String.length !s) - 2) 77 | 78 | let mysql_escape_string s = 79 | let escape = ref "" in 80 | let f c = 81 | let backslash = (String.make 1 (Char.chr 92)) in 82 | let c_0 = Char.chr 0 in (* ASCII NULL *) 83 | let c_39 = Char.chr 39 in (* \' *) 84 | let c_34 = Char.chr 34 in (* "\"" *) 85 | let c_8 = Char.chr 8 in (* \b *) 86 | let c_10 = Char.chr 10 in (* \n *) 87 | let c_13 = Char.chr 13 in (* \r *) 88 | let c_9 = Char.chr 9 in (* \t *) 89 | let c_26 = Char.chr 26 in (* \Z *) 90 | let c_92 = Char.chr 92 in (* \\ *) 91 | let ok = 92 | if ( c = c_0 ) then 93 | backslash ^ "0" 94 | else if (c = c_39) then 95 | backslash ^ (String.make 1 c) 96 | else if (c = c_34) then 97 | backslash ^ (String.make 1 c) 98 | else if (c = c_8) then 99 | backslash ^ "b" 100 | else if (c = c_10) then 101 | backslash ^ "n" 102 | else if (c = c_13) then 103 | backslash ^ "r" 104 | else if (c = c_9) then 105 | backslash ^ "t" 106 | else if (c = c_26) then 107 | backslash ^ "Z" 108 | else if (c = c_92 ) then 109 | backslash ^ (String.make 1 c) 110 | else 111 | (String.make 1 c) 112 | in 113 | escape := !escape ^ ok 114 | in 115 | let () = String.iter f s in 116 | !escape 117 | 118 | let build_string n = 119 | let s = ref "" in 120 | let () = 121 | let c = ref 32 in 122 | while (String.length !s < n) do 123 | let () = c := 124 | if (!c = 127) then 32 else !c 125 | in 126 | let () = 127 | s := !s ^ (String.make 1 (Char.chr !c)) 128 | in 129 | incr c 130 | done 131 | in 132 | !s 133 | -------------------------------------------------------------------------------- /test/fixture_latin1.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/slegrand45/mysql_protocol/01f856e3d757bec7a0d150efe5bb19392608b4ba/test/fixture_latin1.ml -------------------------------------------------------------------------------- /test/logo-full-thumb.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/slegrand45/mysql_protocol/01f856e3d757bec7a0d150efe5bb19392608b4ba/test/logo-full-thumb.png -------------------------------------------------------------------------------- /test/ocaml-3.12-refman.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/slegrand45/mysql_protocol/01f856e3d757bec7a0d150efe5bb19392608b4ba/test/ocaml-3.12-refman.pdf -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | (* 5 | TODO: 6 | - TESTER procédure stockée qui renvoie plusieurs SELECT 7 | - TESTER appel de procédure préparée avec paramètres 8 | *) 9 | 10 | (* 11 | let host_55 = "192.168.1.30" 12 | let addr_55 = Unix.inet_addr_of_string host_55 13 | let version_55 = 5546 14 | 15 | let host_56 = "192.168.1.20" 16 | let addr_56 = Unix.inet_addr_of_string host_56 17 | let version_56 = 5627 18 | 19 | let host_57 = "192.168.1.20" 20 | let addr_57 = Unix.inet_addr_of_string host_57 21 | let version_57 = 5710 22 | 23 | let port = 3306 24 | let db_user = "user_ocaml_ocmp" 25 | let db_password = "ocmp" 26 | *) 27 | 28 | let hosts = [ 29 | (* (version_55, host_55, addr_55, port, db_user, db_password); 30 | (version_56, host_56, addr_56, port, db_user, db_password); 31 | (version_57, host_57, addr_57, port, db_user, db_password); *) 32 | (Test_types.MariaDB, 10560, Test_types.CUnix "/usr/jails/mariadb/var/run/mysql/mysql.sock", "root", "password") 33 | ] 34 | 35 | let init host sql db_name = 36 | let (_, _, connection_type, db_user, db_password) = host in 37 | let (tmp, oc) = Filename.open_temp_file "ocmp" "fixture" in 38 | let () = output_string oc sql in 39 | let () = flush oc in 40 | let option = match connection_type with 41 | | Test_types.CInet (hostname, _, _) -> "-h " ^ hostname 42 | | Test_types.CUnix path -> "--socket=" ^ path 43 | in 44 | let cmd = "mysql -u " ^ db_user ^ " -p" ^ db_password 45 | ^ " " ^ option ^ " " ^ db_name ^ " < " ^ tmp in 46 | let result = Unix.system cmd in 47 | let () = close_out oc in 48 | let () = Unix.unlink tmp in 49 | match result with 50 | | Unix.WEXITED v -> 51 | if (v <> 0) then 52 | failwith ("Unable to init test database (return code = " ^ (string_of_int v) ^ "). Please check that the command : \"" ^ cmd ^ "\" can be run with /bin/sh") 53 | | _ -> ( 54 | failwith ("Unable to init test database. Please check that the command : \"" ^ cmd ^ "\" can be run with /bin/sh") 55 | ) 56 | 57 | let suite host connection encoding config = 58 | let (vendor, version, _, _, _) = host in 59 | let (charset, _) = encoding in 60 | let l = ["test_query_bad" >:: Test_query_bad.test vendor connection; 61 | "test_query_ok" >:: Test_query_select.test host connection charset; 62 | "test_prepare_ok" >:: Test_query_prepare.test host connection charset; 63 | "test_execute_ok" >:: Test_query_execute.test host connection charset; 64 | "test_fetch_ok" >:: Test_query_fetch.test connection charset; 65 | "test_close_statement" >:: Test_query_close_statement.test host connection; 66 | "test_insert_ok" >:: Test_query_insert.test connection charset; 67 | "test_update_ok" >:: Test_query_update.test host connection charset; 68 | "test_delete_ok" >:: Test_query_delete.test connection; 69 | "test_grant_ok" >:: Test_query_grant.test host connection charset; 70 | "test_ping" >:: Test_ping.test connection; 71 | "test_change_user" >:: Test_change_user.test connection; 72 | "test_reset_session" >:: Test_reset_session.test connection; 73 | "test_reset_connection" >:: Test_reset_connection.test connection; 74 | "test_connect" >:: Test_connect.test host config encoding; 75 | "test_auto_increment" >:: Test_query_auto_increment.test connection; 76 | "test_client" >:: Test_client.test host encoding;] 77 | in 78 | let l = 79 | match vendor with 80 | | Test_types.MySQL -> 81 | if version > 5500 then 82 | l @ [("test_transaction" >:: Test_query_transaction.test connection;)] 83 | else 84 | l 85 | | Test_types.MariaDB -> 86 | l @ [("test_transaction" >:: Test_query_transaction.test connection;)] 87 | in 88 | "MySQL Protocol tests" >::: l 89 | 90 | let run_tests host sql encoding = 91 | let (_, _, connection_type, db_user, db_password) = host in 92 | let (charset, _) = encoding in 93 | let module F = ( 94 | val ( 95 | match charset with 96 | | Mp_charset.Latin1 -> ( 97 | let module E = struct 98 | include Fixture_latin1 99 | end 100 | in (module E : Fixture.FIXTURE) 101 | ) 102 | | Mp_charset.Utf8 -> ( 103 | let module E = struct 104 | include Fixture_utf8 105 | end 106 | in (module E : Fixture.FIXTURE) 107 | ) 108 | | _ -> assert false 109 | ) : Fixture.FIXTURE 110 | ) 111 | in 112 | let () = init host sql F.db_name in 113 | let sockaddr = match connection_type with 114 | | CInet (_, addr, port) -> Unix.ADDR_INET(addr, port) 115 | | CUnix path -> Unix.ADDR_UNIX path 116 | in 117 | let config = Mp_client.configuration ~user:db_user ~password:db_password ~sockaddr:sockaddr ~charset:encoding ~databasename:F.db_name () in 118 | let connection = Mp_client.connect ~configuration:config ~force:true () in 119 | let () = Mp_client.use_database ~connection:connection ~databasename:F.db_name in 120 | let () = Test_benchmark.reset_stats () in 121 | let _ = run_test_tt ~verbose:false (suite host connection encoding config) in 122 | let () = prerr_newline () in 123 | let () = prerr_endline (Test_benchmark.stats_to_string ()) in 124 | let () = Mp_client.disconnect ~connection:connection in 125 | () 126 | 127 | let run_host host = 128 | (* let () = run_tests host Fixture_latin1.sql (Mp_charset.Latin1, Mp_charset.Latin1_swedish_ci) in *) 129 | (* restart the SQL server between tests *) 130 | let () = run_tests host Fixture_utf8.sql (Mp_charset.Utf8, Mp_charset.Utf8_general_ci) in 131 | () 132 | 133 | let () = 134 | List.iter run_host hosts 135 | -------------------------------------------------------------------------------- /test/test_benchmark.ml: -------------------------------------------------------------------------------- 1 | let count_sql = ref 0 2 | let acc_time = ref 0.0 3 | 4 | let reset_stats () = 5 | let () = count_sql := 0 in 6 | let () = acc_time := 0.0 in 7 | () 8 | 9 | let stats_to_string () = 10 | let avg = !acc_time /. (float_of_int !count_sql) in 11 | let s = Printf.sprintf "%d sql requests in %f seconds (average : one request in %f seconds)" !count_sql !acc_time avg in 12 | s 13 | 14 | let time f _ (* msg *) = 15 | let start = Unix.gettimeofday () in 16 | let result = f () in 17 | let stop = Unix.gettimeofday () in 18 | let time = stop -. start in 19 | let () = incr count_sql in 20 | let () = acc_time := !acc_time +. time in 21 | (* let () = print_endline (Printf.sprintf "%s : \n Query sent (%f seconds)" msg time) in *) 22 | result 23 | -------------------------------------------------------------------------------- /test/test_change_user.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let test1 connection = 5 | let () = 6 | assert_equal ~msg:"Reset session" 7 | (()) 8 | (let _ = 9 | Mp_client.change_user ~connection:connection ~user:"u_ocmp_npauth_2" ~password:"ocmpnpauth2" 10 | ~databasename:connection.configuration.databasename () in 11 | ()) 12 | in 13 | () 14 | 15 | let test connection _ = 16 | try 17 | test1 connection 18 | with 19 | | Mp_client.Error err as e -> ( 20 | let () = prerr_endline (Mp_client.error_exception_to_string err) in 21 | raise e 22 | ) 23 | -------------------------------------------------------------------------------- /test/test_client.ml: -------------------------------------------------------------------------------- 1 | open Mysql_protocol 2 | 3 | let test1 host db_name encoding = 4 | let () = 5 | let (_, version, connection_type, db_user, db_password) = host in 6 | (* configuration *) 7 | let sockaddr = match connection_type with 8 | | Test_types.CInet (_, addr, port) -> Unix.ADDR_INET(addr, port) 9 | | Test_types.CUnix path -> Unix.ADDR_UNIX path 10 | in 11 | let config = Mp_client.configuration 12 | ~user:db_user ~password:db_password ~sockaddr:sockaddr 13 | ~databasename:db_name ~charset:encoding () in 14 | (* connection *) 15 | let connection = Mp_client.connect ~configuration:config ~force:true () in 16 | (* use database *) 17 | let () = Mp_client.use_database ~connection:connection ~databasename:db_name in 18 | (* delete (non prepared) to clean database *) 19 | let stmt = Mp_client.create_statement_from_string "DROP TABLE IF EXISTS test_ocmp_client" in 20 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 21 | let stmt = Mp_client.create_statement_from_string "DROP TABLE IF EXISTS test_ocmp_client_tmp" in 22 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 23 | (* create table (non prepared) *) 24 | let stmt = Mp_client.create_statement_from_string "CREATE TABLE IF NOT EXISTS test_ocmp_client (id BIGINT AUTO_INCREMENT NOT NULL, PRIMARY KEY (id))" in 25 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 26 | (* create table (prepared) *) 27 | let stmt = Mp_client.create_statement_from_string "CREATE TABLE IF NOT EXISTS test_ocmp_client_tmp (xx INT)" in 28 | let prep10 = Mp_client.prepare ~connection:connection ~statement:stmt in 29 | let _ = Mp_client.execute ~connection:connection ~statement:prep10 () in 30 | (* drop table (non prepared) *) 31 | let stmt = Mp_client.create_statement_from_string "DROP TABLE IF EXISTS test_ocmp_client_tmp" in 32 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 33 | (* alter table (non prepared) *) 34 | let stmt = Mp_client.create_statement_from_string "ALTER TABLE test_ocmp_client ADD name VARCHAR(250) DEFAULT NULL" in 35 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 36 | (* alter table (prepared) *) 37 | let stmt = Mp_client.create_statement_from_string "ALTER TABLE test_ocmp_client ADD number DECIMAL(20,5) DEFAULT 0" in 38 | let prep20 = Mp_client.prepare ~connection:connection ~statement:stmt in 39 | let _ = Mp_client.execute ~connection:connection ~statement:prep20 () in 40 | (* grant (non prepared) *) 41 | let stmt = Mp_client.create_statement_from_string ("GRANT SELECT ON " ^ db_name ^ ".test_ocmp_client TO '" ^ db_user ^ "'@'localhost'") in 42 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 43 | (* grant (prepared) *) 44 | let () = 45 | (* = 5.0.95 : Errno: 1295 / Sql state: HY000 / Message: This command is not supported in the prepared statement protocol yet *) 46 | if (version > 5095) then ( 47 | let stmt = Mp_client.create_statement_from_string ("GRANT UPDATE ON " ^ db_name ^ ".test_ocmp_client TO '" ^ db_user ^ "'@'localhost'") in 48 | let prep30 = Mp_client.prepare ~connection:connection ~statement:stmt in 49 | let _ = Mp_client.execute ~connection:connection ~statement:prep30 () in 50 | let () = Mp_client.close_statement ~connection:connection ~statement:prep30 in 51 | () 52 | ) 53 | in 54 | (* show (non prepared) *) 55 | let stmt = Mp_client.create_statement_from_string ("SHOW COLUMNS FROM test_ocmp_client") in 56 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 57 | (* show (prepared) *) 58 | let stmt = Mp_client.create_statement_from_string ("SHOW COLUMNS FROM test_ocmp_client") in 59 | let prep40 = Mp_client.prepare ~connection:connection ~statement:stmt in 60 | let _ = Mp_client.execute ~connection:connection ~statement:prep40 () in 61 | (* insert (non prepared) *) 62 | let stmt = Mp_client.create_statement_from_string ("INSERT INTO test_ocmp_client (name, number) VALUES ('nameX', 148.52)") in 63 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 64 | (* insert (prepared + params) *) 65 | let params = [Mp_data.data_varstring "name'2"; Mp_data.data_decimal (Num.num_of_string "26895/100")] in 66 | let stmt = Mp_client.create_statement_from_string ("INSERT INTO test_ocmp_client (name, number) VALUES (?, ?)") in 67 | let prep50 = Mp_client.prepare ~connection:connection ~statement:stmt in 68 | let _ = Mp_client.execute ~connection:connection ~statement:prep50 ~params:params () in 69 | (* update (non prepared) *) 70 | let stmt = Mp_client.create_statement_from_string ("UPDATE test_ocmp_client SET name='name\\'1' WHERE name='nameX'") in 71 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 72 | (* update (prepared + params) *) 73 | let params = [Mp_data.data_decimal (Num.num_of_string "1")] in 74 | let stmt = Mp_client.create_statement_from_string ("UPDATE test_ocmp_client SET number=number+?") in 75 | let prep60 = Mp_client.prepare ~connection:connection ~statement:stmt in 76 | let _ = Mp_client.execute ~connection:connection ~statement:prep60 ~params:params () in 77 | (* select (non prepared) *) 78 | let stmt = Mp_client.create_statement_from_string ("SELECT * FROM test_ocmp_client ORDER BY id") in 79 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 80 | (* select (prepared + params) *) 81 | let params = [Mp_data.data_longlongint Big_int.unit_big_int] in 82 | let stmt = Mp_client.create_statement_from_string ("SELECT * FROM test_ocmp_client WHERE id=?") in 83 | let prep70 = Mp_client.prepare ~connection:connection ~statement:stmt in 84 | let stmt = Mp_client.execute ~connection:connection ~statement:prep70 ~params:params ~flag:Mp_execute.Cursor_type_read_only () in 85 | (* fetch *) 86 | let _ = Mp_client.fetch ~connection:connection ~statement:stmt () in 87 | (* ping *) 88 | let () = Mp_client.ping ~connection:connection in 89 | (* change user *) 90 | let _ = Mp_client.change_user ~connection:connection ~user:"u_ocmp_npauth_2" ~password:"ocmpnpauth2" 91 | ~databasename:connection.configuration.databasename () in 92 | (* reset session *) 93 | let () = Mp_client.reset_session ~connection:connection in 94 | (* reset connection *) 95 | let () = Mp_client.reset_connection ~connection:connection in 96 | (* select (non prepared) *) 97 | let stmt = Mp_client.create_statement_from_string ("SELECT * FROM test_ocmp_client ORDER BY id LIMIT 1") in 98 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 99 | (* select (prepared) *) 100 | let stmt = Mp_client.create_statement_from_string ("SELECT * FROM test_ocmp_client WHERE id=2") in 101 | let prep80 = Mp_client.prepare ~connection:connection ~statement:stmt in 102 | let _ = Mp_client.execute ~connection:connection ~statement:prep80 () in 103 | (* reuse the prepared statement *) 104 | let _ = Mp_client.execute ~connection:connection ~statement:prep80 () in 105 | (* close prepared statements *) 106 | let () = Mp_client.close_statement ~connection:connection ~statement:prep10 in 107 | let () = Mp_client.close_statement ~connection:connection ~statement:prep20 in 108 | let () = Mp_client.close_statement ~connection:connection ~statement:prep40 in 109 | let () = Mp_client.close_statement ~connection:connection ~statement:prep50 in 110 | let () = Mp_client.close_statement ~connection:connection ~statement:prep60 in 111 | let () = Mp_client.close_statement ~connection:connection ~statement:prep70 in 112 | let () = Mp_client.close_statement ~connection:connection ~statement:prep80 in 113 | (* try using closed prepared statements *) 114 | let () = 115 | try 116 | let _ = Mp_client.execute ~connection:connection ~statement:prep80 () in 117 | () 118 | with 119 | | Mp_client.Error error -> 120 | if (error.Mp_client.client_error_errno <> 1243) then 121 | assert false 122 | in 123 | (* select (non prepared) + conversion to OCaml value *) 124 | let stmt = Mp_client.create_statement_from_string ("SELECT name FROM test_ocmp_client WHERE id=1") in 125 | let r = Mp_client.execute ~connection:connection ~statement:stmt () in 126 | let r = Mp_client.(get_result_set(get_result r)) in 127 | let (_, rows) = r.Mp_result_set_packet.rows in 128 | let row = List.nth rows 0 in 129 | let data = List.nth row 0 in 130 | let s = 131 | match Mp_data.to_ocaml_string data with 132 | | None -> assert false 133 | | Some v -> v 134 | in 135 | let () = if (s <> "name'1") then assert false in 136 | (* delete (non prepared) *) 137 | let stmt = Mp_client.create_statement_from_string ("DELETE FROM test_ocmp_client WHERE id=1") in 138 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 139 | (* delete (prepared) *) 140 | let params = [Mp_data.data_longlongint (Big_int.big_int_of_int 2)] in 141 | let stmt = Mp_client.create_statement_from_string ("DELETE FROM test_ocmp_client WHERE id=?") in 142 | let prep90 = Mp_client.prepare ~connection:connection ~statement:stmt in 143 | let _ = Mp_client.execute ~connection:connection ~statement:prep90 ~params:params () in 144 | (* select (non prepared) *) 145 | let stmt = Mp_client.create_statement_from_string ("SELECT * FROM test_ocmp_client") in 146 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 147 | (* select (prepared) *) 148 | let stmt = Mp_client.create_statement_from_string ("SELECT * FROM test_ocmp_client") in 149 | let prep100 = Mp_client.prepare ~connection:connection ~statement:stmt in 150 | let _ = Mp_client.execute ~connection:connection ~statement:prep100 () in 151 | (* catch MySQL error *) 152 | let stmt = Mp_client.create_statement_from_string ("BAD SQL QUERY") in 153 | let () = 154 | try 155 | let _ = Mp_client.execute ~connection:connection ~statement:stmt () in 156 | () 157 | with 158 | | Mp_client.Error error -> 159 | if (error.Mp_client.client_error_errno <> 1064) then 160 | assert false 161 | in 162 | (* close prepared statements *) 163 | let () = Mp_client.close_statement ~connection:connection ~statement:prep90 in 164 | let () = Mp_client.close_statement ~connection:connection ~statement:prep100 in 165 | (* disconnect *) 166 | let () = Mp_client.disconnect ~connection:connection in 167 | () 168 | in 169 | () 170 | 171 | let test host encoding _ = 172 | let module F = ( 173 | val ( 174 | match encoding with 175 | | (Mp_charset.Latin1, _) -> ( 176 | let module E = struct 177 | include Fixture_latin1 178 | end 179 | in (module E : Fixture.FIXTURE) 180 | ) 181 | | (Mp_charset.Utf8, _) -> ( 182 | let module E = struct 183 | include Fixture_utf8 184 | end 185 | in (module E : Fixture.FIXTURE) 186 | ) 187 | | _ -> assert false 188 | ) : Fixture.FIXTURE 189 | ) 190 | in 191 | try 192 | let () = test1 host F.db_name encoding in 193 | () 194 | with 195 | | Mp_client.Error err as e -> ( 196 | let () = prerr_endline (Mp_client.error_exception_to_string err) in 197 | raise e 198 | ) 199 | -------------------------------------------------------------------------------- /test/test_connect.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let build_ok_update affected matched changed = 5 | { Mp_client.affected_rows = Int64.of_int affected; 6 | Mp_client.insert_id = (Int64.zero, Big_int.zero_big_int); 7 | Mp_client.server_status = 8704; 8 | Mp_client.warning_count = 0; 9 | Mp_client.message = "(Rows matched: " ^ (string_of_int matched) ^ " Changed: " ^ (string_of_int changed) ^ " Warnings: 0"; 10 | } 11 | 12 | let result_equals ok r = 13 | let affected_rows_ok = ok.Mp_client.affected_rows in 14 | let (insert_id_int64_ok, insert_id_big_int_ok) = ok.Mp_client.insert_id in 15 | let server_status_ok = ok.Mp_client.server_status in 16 | let warning_count_ok = ok.Mp_client.warning_count in 17 | let message_ok = ok.Mp_client.message in 18 | 19 | let affected_rows_r = r.Mp_client.affected_rows in 20 | let (insert_id_int64_r, insert_id_big_int_r) = r.Mp_client.insert_id in 21 | let server_status_r = r.Mp_client.server_status in 22 | let warning_count_r = r.Mp_client.warning_count in 23 | let message_r = r.Mp_client.message in 24 | 25 | (affected_rows_ok = affected_rows_r) 26 | && (Int64.compare insert_id_int64_ok insert_id_int64_r = 0) 27 | && (Big_int.compare_big_int insert_id_big_int_ok insert_id_big_int_r = 0) 28 | && (server_status_ok = server_status_r) 29 | && (warning_count_ok = warning_count_r) 30 | && (message_ok = message_r) 31 | 32 | let test1 host config charset = 33 | let (_, _, connection_type, db_user, db_password) = host in 34 | let () = 35 | (* configuration *) 36 | let sockaddr = match connection_type with 37 | | Test_types.CInet (_, addr, port) -> Unix.ADDR_INET(addr, port) 38 | | Test_types.CUnix path -> Unix.ADDR_UNIX path 39 | in 40 | let databasename = config.Mp_client.databasename in 41 | let config = Mp_client.configuration 42 | ~user:db_user ~password:db_password ~sockaddr:sockaddr 43 | ~databasename:databasename ~charset:charset () in 44 | let connection = Mp_client.connect ~configuration:config ~force:true () in 45 | let sql = "UPDATE test_ocmp SET f_int_null_no_def = 7 WHERE f_int_null_no_def > f_int_null_no_def + 1" in 46 | let stmt = Mp_client.create_statement_from_string sql in 47 | let () = Mp_client.( 48 | assert_equal ~msg:sql 49 | ~cmp:result_equals 50 | (build_ok_update 0 0 0) 51 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 52 | ) in 53 | let () = Mp_client.disconnect ~connection:connection in 54 | (* don't set the database name in the configuration and send a use_database : should be ok *) 55 | let config = 56 | Mp_client.configuration ~user:db_user ~password:db_password ~sockaddr:sockaddr ~charset:charset () 57 | in 58 | let connection = Mp_client.connect ~configuration:config ~force:true () in 59 | let () = Mp_client.use_database ~connection:connection ~databasename:databasename in 60 | let sql = "UPDATE test_ocmp SET f_int_null_no_def = 7 WHERE f_int_null_no_def > f_int_null_no_def + 1" in 61 | let stmt = Mp_client.create_statement_from_string sql in 62 | let () = Mp_client.( 63 | assert_equal ~msg:sql 64 | ~cmp:result_equals 65 | (build_ok_update 0 0 0) 66 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 67 | ) in 68 | let () = Mp_client.disconnect ~connection:connection in 69 | (* don't set the database name in the configuration and don't send a use_database : should be ko *) 70 | let config = 71 | Mp_client.configuration ~user:db_user ~password:db_password ~sockaddr:sockaddr ~charset:charset () 72 | in 73 | let connection = Mp_client.connect ~configuration:config ~force:true () in 74 | let sql = "UPDATE test_ocmp SET f_int_null_no_def = 7 WHERE f_int_null_no_def > f_int_null_no_def + 1" in 75 | let stmt = Mp_client.create_statement_from_string sql in 76 | let () = Mp_client.( 77 | assert_raises ~msg:sql 78 | (Error { 79 | client_error_errno = 1046; 80 | client_error_sqlstate = "3D000"; 81 | client_error_message = "No database selected" 82 | } ) 83 | (fun _ -> (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql)) 84 | ) in 85 | let () = Mp_client.disconnect ~connection:connection in 86 | (* test the mysql_native_password case with the special user *) 87 | let config = 88 | Mp_client.configuration ~user:"u_ocmp_npauth" ~password:"ocmpnpauth" 89 | ~sockaddr:sockaddr ~charset:charset ~databasename:databasename () 90 | in 91 | let connection = Mp_client.connect ~configuration:config ~force:true () in 92 | let sql = "UPDATE test_ocmp SET f_int_null_no_def = 7 WHERE f_int_null_no_def > f_int_null_no_def + 1" in 93 | let stmt = Mp_client.create_statement_from_string sql in 94 | let () = Mp_client.( 95 | assert_equal ~msg:sql 96 | ~cmp:result_equals 97 | (build_ok_update 0 0 0) 98 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 99 | ) in 100 | let () = Mp_client.disconnect ~connection:connection in 101 | () 102 | in 103 | () 104 | 105 | let test host config charset _ = 106 | try 107 | test1 host config charset 108 | with 109 | | Mp_client.Error err as e -> ( 110 | let () = prerr_endline (Mp_client.error_exception_to_string err) in 111 | raise e 112 | ) 113 | -------------------------------------------------------------------------------- /test/test_ping.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let test1 connection = 5 | let () = 6 | assert_equal ~msg:"Ping" 7 | (()) 8 | (Mp_client.ping ~connection:connection) 9 | in 10 | () 11 | 12 | let test connection _ = 13 | try 14 | test1 connection 15 | with 16 | | Mp_client.Error err as e -> ( 17 | let () = prerr_endline (Mp_client.error_exception_to_string err) in 18 | raise e 19 | ) 20 | -------------------------------------------------------------------------------- /test/test_query.ml: -------------------------------------------------------------------------------- 1 | open Mysql_protocol 2 | 3 | let try_query ~f ~sql = 4 | try 5 | Test_benchmark.time (fun _ -> f) sql 6 | with 7 | | Mp_client.Error err as e -> ( 8 | let () = print_endline (Printf.sprintf "%s : Error : %s" sql (Mp_client.error_exception_to_string err)) in 9 | raise e 10 | ) 11 | -------------------------------------------------------------------------------- /test/test_query_auto_increment.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let test1 connection = 5 | let () = Mp_client.( 6 | let id = "4294967290" in 7 | let sql = "TRUNCATE test_ocmp_auto_increment_ui" in 8 | let stmt = create_statement_from_string sql in 9 | let _ = execute ~connection:connection ~statement:stmt () in 10 | let sql = "ALTER TABLE test_ocmp_auto_increment_ui AUTO_INCREMENT=" ^ id in 11 | let stmt = create_statement_from_string sql in 12 | let _ = execute ~connection:connection ~statement:stmt () in 13 | let sql = "INSERT INTO test_ocmp_auto_increment_ui (f_int) VALUES (100)" in 14 | let stmt = create_statement_from_string sql in 15 | let (insert_id_int64, _) = 16 | (get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))).insert_id 17 | in 18 | let () = assert_equal ~msg:("INSERT_ID INT UNSIGNED: " ^ sql) (Int64.compare insert_id_int64 (Int64.of_string id)) 0 in 19 | 20 | let id = "18446744073709551610" in 21 | let sql = "TRUNCATE test_ocmp_auto_increment_ubi" in 22 | let stmt = create_statement_from_string sql in 23 | let _ = execute ~connection:connection ~statement:stmt () in 24 | let sql = "ALTER TABLE test_ocmp_auto_increment_ubi AUTO_INCREMENT=" ^ id in 25 | let stmt = create_statement_from_string sql in 26 | let _ = execute ~connection:connection ~statement:stmt () in 27 | let sql = "INSERT INTO test_ocmp_auto_increment_ubi (f_int) VALUES (200)" in 28 | let stmt = create_statement_from_string sql in 29 | let (_, insert_id_big_int) = 30 | (get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))).insert_id 31 | in 32 | let () = assert_equal ~msg:("INSERT_ID BIGINT UNSIGNED: " ^ sql) 33 | (Big_int.compare_big_int insert_id_big_int (Big_int.big_int_of_string id)) 0 34 | in 35 | 36 | let id = "-9223372036854775800" in 37 | let sql = "TRUNCATE test_ocmp_auto_increment_sbi" in 38 | let stmt = create_statement_from_string sql in 39 | let _ = execute ~connection:connection ~statement:stmt () in 40 | let sql = "INSERT INTO test_ocmp_auto_increment_sbi (f_autoinc, f_int) VALUES (" ^ id ^ ", 300)" in 41 | let stmt = create_statement_from_string sql in 42 | let (insert_id_int64, _) = 43 | (get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))).insert_id 44 | in 45 | let () = assert_equal ~msg:("INSERT_ID BIGINT SIGNED 1: " ^ sql) (Int64.compare insert_id_int64 (Int64.of_string id)) 0 in 46 | 47 | let id = "9223372036854775800" in 48 | let sql = "TRUNCATE test_ocmp_auto_increment_sbi" in 49 | let stmt = create_statement_from_string sql in 50 | let _ = execute ~connection:connection ~statement:stmt () in 51 | let sql = "ALTER TABLE test_ocmp_auto_increment_sbi AUTO_INCREMENT=" ^ id in 52 | let stmt = create_statement_from_string sql in 53 | let _ = execute ~connection:connection ~statement:stmt () in 54 | let sql = "INSERT INTO test_ocmp_auto_increment_sbi (f_int) VALUES (400)" in 55 | let stmt = create_statement_from_string sql in 56 | let (insert_id_int64, _) = 57 | (get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))).insert_id 58 | in 59 | let () = assert_equal ~msg:("INSERT_ID BIGINT SIGNED 2: " ^ sql) (Int64.compare insert_id_int64 (Int64.of_string id)) 0 in 60 | () 61 | ) in 62 | () 63 | 64 | let test connection _ = 65 | try 66 | test1 connection 67 | with 68 | | Mp_client.Error e -> prerr_endline (Mp_client.error_exception_to_string e) 69 | -------------------------------------------------------------------------------- /test/test_query_bad.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let test vendor connection _ = 5 | let () = 6 | let sql = "SELC * FROM test_ocmp LIMIT 1" in 7 | let stmt = Mp_client.create_statement_from_string sql in 8 | assert_raises ~msg:sql 9 | (Mp_client.Error { 10 | Mp_client.client_error_errno = 1064; 11 | Mp_client.client_error_sqlstate = "42000"; 12 | Mp_client.client_error_message = "You have an error in your SQL syntax; check the manual that corresponds to your " ^ (Test_types.vendor_to_string vendor) ^ " server version for the right syntax to use near '" ^ sql ^ "' at line 1" 13 | } ) 14 | (fun _ -> (Test_query.try_query ~f:(Mp_client.execute ~connection:connection ~statement:stmt ()) ~sql:sql)) 15 | in 16 | let () = 17 | let sql = "SELECT * FROM test_ocmp WHERE f_varstring_null_no_def='" in 18 | let stmt = Mp_client.create_statement_from_string sql in 19 | assert_raises ~msg:sql 20 | (Mp_client.Error { 21 | Mp_client.client_error_errno = 1064; 22 | Mp_client.client_error_sqlstate = "42000"; 23 | Mp_client.client_error_message = "You have an error in your SQL syntax; check the manual that corresponds to your " ^ (Test_types.vendor_to_string vendor) ^ " server version for the right syntax to use near ''' at line 1" 24 | } ) 25 | (fun _ -> (Test_query.try_query ~f:(Mp_client.execute ~connection:connection ~statement:stmt ()) ~sql:sql)) 26 | in 27 | let () = 28 | let sql = "ALTER TABLE test_ocmp ADD f_varstring_null_no_def INT" in 29 | let stmt = Mp_client.create_statement_from_string sql in 30 | assert_raises ~msg:sql 31 | (Mp_client.Error { 32 | Mp_client.client_error_errno = 1060; 33 | Mp_client.client_error_sqlstate = "42S21"; 34 | Mp_client.client_error_message = "Duplicate column name 'f_varstring_null_no_def'" 35 | } ) 36 | (fun _ -> (Test_query.try_query ~f:(Mp_client.execute ~connection:connection ~statement:stmt ()) ~sql:sql)) 37 | in 38 | () 39 | -------------------------------------------------------------------------------- /test/test_query_close_statement.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let test1 connection = 5 | let () = 6 | let sql = "SELECT * FROM test_ocmp WHERE f_autoinc_not_null_no_def > 0" in 7 | let stmt = Mp_client.create_statement_from_string sql in 8 | let prep10 = Mp_client.prepare ~connection:connection ~statement:stmt in 9 | let _ = Mp_client.execute ~connection:connection ~statement:prep10 () in 10 | let () = 11 | assert_equal ~msg:sql 12 | (()) 13 | (Mp_client.close_statement ~connection:connection ~statement:prep10) 14 | in 15 | let () = 16 | let result = 17 | try 18 | let _ = Mp_client.execute ~connection:connection ~statement:prep10 () in 19 | false; 20 | with 21 | | Mp_client.Error e -> ( 22 | let errno_ok = 1243 in 23 | let state_ok = "HY000" in 24 | let msg_ok = "Unknown prepared statement handler" in 25 | let errno_e = e.Mp_client.client_error_errno in 26 | let state_e = e.Mp_client.client_error_sqlstate in 27 | let msg_e = e.Mp_client.client_error_message in 28 | (errno_ok = errno_e) && (state_ok = state_e) && ((String.sub msg_e 0 34) = msg_ok) 29 | ) 30 | | _ -> false 31 | in 32 | assert_equal ~msg:sql true result 33 | in 34 | () 35 | in 36 | () 37 | 38 | let test _ connection _ = 39 | try 40 | test1 connection 41 | with 42 | | Mp_client.Error err as e -> ( 43 | let () = prerr_endline (Mp_client.error_exception_to_string err) in 44 | raise e 45 | ) 46 | -------------------------------------------------------------------------------- /test/test_query_delete.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let build_ok_delete affected status = 5 | { Mp_client.affected_rows = affected; 6 | Mp_client.insert_id = (Int64.zero, Big_int.zero_big_int); 7 | Mp_client.server_status = status; 8 | Mp_client.warning_count = 0; 9 | Mp_client.message = ""; 10 | } 11 | 12 | let result_equals ok1 r = 13 | let ok2 = build_ok_delete ok1.Mp_client.affected_rows 8704 in 14 | 15 | let r_eq ok r = 16 | let affected_rows_ok = ok.Mp_client.affected_rows in 17 | let (insert_id_int64_ok, insert_id_big_int_ok) = ok.Mp_client.insert_id in 18 | let server_status_ok = ok.Mp_client.server_status in 19 | let warning_count_ok = ok.Mp_client.warning_count in 20 | let message_ok = ok.Mp_client.message in 21 | 22 | let affected_rows_r = r.Mp_client.affected_rows in 23 | let (insert_id_int64_r, insert_id_big_int_r) = r.Mp_client.insert_id in 24 | let server_status_r = r.Mp_client.server_status in 25 | let warning_count_r = r.Mp_client.warning_count in 26 | let message_r = r.Mp_client.message in 27 | 28 | (affected_rows_ok = affected_rows_r) 29 | && (Int64.compare insert_id_int64_ok insert_id_int64_r = 0) 30 | && (Big_int.compare_big_int insert_id_big_int_ok insert_id_big_int_r = 0) 31 | && (server_status_ok = server_status_r) 32 | && (warning_count_ok = warning_count_r) 33 | && (message_ok = message_r) 34 | in 35 | 36 | if (r_eq ok1 r || r_eq ok2 r) then 37 | true 38 | else 39 | false 40 | 41 | let test1 connection = 42 | let () = Mp_client.( 43 | let sql = "DELETE FROM test_ocmp WHERE f_autoinc_not_null_no_def=4" in 44 | let stmt = create_statement_from_string sql in 45 | assert_equal ~msg:sql 46 | ~cmp:result_equals 47 | (build_ok_delete (Int64.of_int 1) 512) 48 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 49 | ) in 50 | let () = Mp_client.( 51 | let sql = "DELETE FROM test_ocmp WHERE f_string_null_no_def='string : ABCDEFGHIJKLMNOPQRSTUVWXYZ'" in 52 | let stmt = create_statement_from_string sql in 53 | assert_equal ~msg:sql 54 | ~cmp:result_equals 55 | (build_ok_delete (Int64.of_int 1) 512) 56 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 57 | ) in 58 | let () = Mp_client.( 59 | let sql = "DELETE FROM test_ocmp WHERE f_int24_null_no_def=1677721" in 60 | let stmt = create_statement_from_string sql in 61 | assert_equal ~msg:sql 62 | ~cmp:result_equals 63 | (build_ok_delete (Int64.of_int 1) 512) 64 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 65 | ) in 66 | let () = Mp_client.( 67 | let sql = "DELETE FROM test_ocmp WHERE f_string_null_no_def='not exist : XXXXXXXXXXXXXXXXXXXXX'" in 68 | let stmt = create_statement_from_string sql in 69 | assert_equal ~msg:sql 70 | ~cmp:result_equals 71 | (build_ok_delete (Int64.of_int 0) 512) 72 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 73 | ) in 74 | let () = Mp_client.( 75 | let sql = "DELETE FROM test_ocmp" in 76 | let stmt = create_statement_from_string sql in 77 | assert_equal ~msg:sql 78 | ~cmp:result_equals 79 | (* status is either 512 or 8704, it seems to be not the same depending on the MySQL version *) 80 | (build_ok_delete (Int64.of_int 5) 512) 81 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 82 | ) in 83 | () 84 | 85 | let test connection _ = 86 | try 87 | test1 connection 88 | with 89 | | Mp_client.Error e -> prerr_endline (Mp_client.error_exception_to_string e) 90 | -------------------------------------------------------------------------------- /test/test_query_grant.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let build_ok_grant = 5 | { Mp_client.affected_rows = Int64.zero; 6 | Mp_client.insert_id = (Int64.zero, Big_int.zero_big_int); 7 | Mp_client.server_status = 512; 8 | Mp_client.warning_count = 0; 9 | Mp_client.message = ""; 10 | } 11 | 12 | let result_equals ok r = 13 | let affected_rows_ok = ok.Mp_client.affected_rows in 14 | let (insert_id_int64_ok, insert_id_big_int_ok) = ok.Mp_client.insert_id in 15 | let server_status_ok = ok.Mp_client.server_status in 16 | let warning_count_ok = ok.Mp_client.warning_count in 17 | let message_ok = ok.Mp_client.message in 18 | 19 | let affected_rows_r = r.Mp_client.affected_rows in 20 | let (insert_id_int64_r, insert_id_big_int_r) = r.Mp_client.insert_id in 21 | let server_status_r = r.Mp_client.server_status in 22 | let warning_count_r = r.Mp_client.warning_count in 23 | let message_r = r.Mp_client.message in 24 | 25 | (affected_rows_ok = affected_rows_r) 26 | && (Int64.compare insert_id_int64_ok insert_id_int64_r = 0) 27 | && (Big_int.compare_big_int insert_id_big_int_ok insert_id_big_int_r = 0) 28 | && (server_status_ok = server_status_r) 29 | && (warning_count_ok = warning_count_r) 30 | && (message_ok = message_r) 31 | 32 | let test1 host connection db_name = 33 | let (_, _, _, db_user, _) = host in 34 | let () = Mp_client.( 35 | let sql = "GRANT SELECT ON " ^ db_name ^ ".* TO '" ^ db_user ^ "'@'localhost'" in 36 | let stmt = create_statement_from_string sql in 37 | assert_equal ~msg:sql 38 | ~cmp:result_equals 39 | build_ok_grant 40 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 41 | ) in 42 | () 43 | 44 | let test host connection encoding _ = 45 | let module F = ( 46 | val ( 47 | match encoding with 48 | | Mp_charset.Latin1 -> ( 49 | let module E = struct 50 | include Fixture_latin1 51 | end 52 | in (module E : Fixture.FIXTURE) 53 | ) 54 | | Mp_charset.Utf8 -> ( 55 | let module E = struct 56 | include Fixture_utf8 57 | end 58 | in (module E : Fixture.FIXTURE) 59 | ) 60 | | _ -> assert false 61 | ) : Fixture.FIXTURE 62 | ) 63 | in 64 | try 65 | test1 host connection F.db_name 66 | with 67 | | Mp_client.Error e -> prerr_endline (Mp_client.error_exception_to_string e) 68 | -------------------------------------------------------------------------------- /test/test_query_insert.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let build_ok_insert id = 5 | { Mp_client.affected_rows = Int64.one; 6 | Mp_client.insert_id = (Int64.of_int id, Big_int.big_int_of_int id); 7 | Mp_client.server_status = 512; 8 | Mp_client.warning_count = 0; 9 | Mp_client.message = ""; 10 | } 11 | 12 | let result_equals ok r = 13 | let affected_rows_ok = ok.Mp_client.affected_rows in 14 | let (insert_id_int64_ok, insert_id_big_int_ok) = ok.Mp_client.insert_id in 15 | let server_status_ok = ok.Mp_client.server_status in 16 | let warning_count_ok = ok.Mp_client.warning_count in 17 | let message_ok = ok.Mp_client.message in 18 | 19 | let affected_rows_r = r.Mp_client.affected_rows in 20 | let (insert_id_int64_r, insert_id_big_int_r) = r.Mp_client.insert_id in 21 | let server_status_r = r.Mp_client.server_status in 22 | let warning_count_r = r.Mp_client.warning_count in 23 | let message_r = r.Mp_client.message in 24 | 25 | (affected_rows_ok = affected_rows_r) 26 | && (Int64.compare insert_id_int64_ok insert_id_int64_r = 0) 27 | && (Big_int.compare_big_int insert_id_big_int_ok insert_id_big_int_r = 0) 28 | && (server_status_ok = server_status_r) 29 | && (warning_count_ok = warning_count_r) 30 | && (message_ok = message_r) 31 | 32 | let test1 connection testfile2 testfile3 insert_var_string = 33 | let () = Mp_client.( 34 | let sql = "INSERT INTO test_ocmp (f_int_null_no_def) VALUES (1234)" in 35 | let stmt = create_statement_from_string sql in 36 | assert_equal ~msg:sql 37 | ~cmp:result_equals 38 | (build_ok_insert 3) 39 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 40 | ) in 41 | let () = Mp_client.( 42 | let sql = "INSERT INTO test_ocmp (f_blobimg_null_no_def) VALUES (LOAD_FILE('" ^ testfile2 ^ "'))" in 43 | let stmt = create_statement_from_string sql in 44 | assert_equal ~msg:sql 45 | ~cmp:result_equals 46 | (build_ok_insert 4) 47 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 48 | ) in 49 | let () = Mp_client.( 50 | let sql = "INSERT INTO test_ocmp (f_bloblong_null_no_def) VALUES (LOAD_FILE('" ^ testfile3 ^ "'))" in 51 | let stmt = create_statement_from_string sql in 52 | assert_equal ~msg:sql 53 | ~cmp:result_equals 54 | (build_ok_insert 5) 55 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 56 | ) in 57 | let () = Mp_client.( 58 | let sql = "INSERT INTO test_ocmp (f_varstring_null_no_def) VALUES ('" ^ insert_var_string ^ "')" in 59 | let stmt = create_statement_from_string sql in 60 | assert_equal ~msg:sql 61 | ~cmp:result_equals 62 | (build_ok_insert 6) 63 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 64 | ) in 65 | let () = Mp_client.( 66 | let sql = "INSERT INTO test_ocmp (f_varstring_null_no_def) VALUES ('varstring : ABCDEFGHIJKLMNOPQRSTUVWXYZ')" in 67 | let stmt = create_statement_from_string sql in 68 | assert_equal ~msg:sql 69 | ~cmp:result_equals 70 | (build_ok_insert 7) 71 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 72 | ) in 73 | let () = Mp_client.( 74 | let sql = "INSERT INTO test_ocmp (f_varstring_null_no_def) VALUES (?)" in 75 | let stmt = create_statement_from_string sql in 76 | let p = prepare ~connection:connection ~statement:stmt in 77 | let params = [Mp_data.data_varstring ""] in 78 | assert_equal ~msg:sql 79 | ~cmp:result_equals 80 | (build_ok_insert 8) 81 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:p ~params:params ()))) ~sql:sql) 82 | ) in 83 | () 84 | 85 | let test connection encoding _ = 86 | let module F = ( 87 | val ( 88 | match encoding with 89 | | Mp_charset.Latin1 -> ( 90 | let module E = struct 91 | include Fixture_latin1 92 | end 93 | in (module E : Fixture.FIXTURE) 94 | ) 95 | | Mp_charset.Utf8 -> ( 96 | let module E = struct 97 | include Fixture_utf8 98 | end 99 | in (module E : Fixture.FIXTURE) 100 | ) 101 | | _ -> assert false 102 | ) : Fixture.FIXTURE 103 | ) 104 | in 105 | try 106 | test1 connection Fixture_config.testfile2 Fixture_config.testfile3 F.insert_var_string 107 | with 108 | | Mp_client.Error e -> prerr_endline (Mp_client.error_exception_to_string e) 109 | -------------------------------------------------------------------------------- /test/test_query_prepare.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let fields = Test_query_select.fields 5 | let mysql_fields = Test_query_select.mysql_fields 6 | 7 | let field_name_questionmark = ("?", 0) 8 | let mysql_field_questionmark vendor = 9 | match vendor with 10 | | Test_types.MySQL -> 11 | { 12 | Mp_field_packet.field_catalog = "def"; 13 | Mp_field_packet.field_db = ""; 14 | Mp_field_packet.field_table = ""; 15 | Mp_field_packet.field_org_table = ""; 16 | Mp_field_packet.field_name = "?"; 17 | Mp_field_packet.field_org_name = ""; 18 | (* always Binary charset and collation, no matter the character encoding is *) 19 | Mp_field_packet.field_charset_number = Mp_charset.charset_number (Mp_charset.Binary_charset, Mp_charset.Binary_collation); 20 | Mp_field_packet.field_length = Int64.zero; 21 | Mp_field_packet.field_type = Mp_field_packet.Field_type_var_string; 22 | Mp_field_packet.field_flags = [Mp_field_packet.Field_flag_binary;]; 23 | Mp_field_packet.field_decimals = 0; 24 | Mp_field_packet.field_default = Int64.zero; 25 | Mp_field_packet.version = Mp_protocol.Protocol_version_41; 26 | } 27 | | Test_types.MariaDB -> 28 | { 29 | Mp_field_packet.field_catalog = "def"; 30 | Mp_field_packet.field_db = ""; 31 | Mp_field_packet.field_table = ""; 32 | Mp_field_packet.field_org_table = ""; 33 | Mp_field_packet.field_name = "?"; 34 | Mp_field_packet.field_org_name = ""; 35 | (* always Binary charset and collation, no matter the character encoding is *) 36 | Mp_field_packet.field_charset_number = Mp_charset.charset_number (Mp_charset.Binary_charset, Mp_charset.Binary_collation); 37 | Mp_field_packet.field_length = Int64.zero; 38 | Mp_field_packet.field_type = Mp_field_packet.Field_type_null; 39 | Mp_field_packet.field_flags = [Mp_field_packet.Field_flag_binary;]; 40 | Mp_field_packet.field_decimals = 0; 41 | Mp_field_packet.field_default = Int64.zero; 42 | Mp_field_packet.version = Mp_protocol.Protocol_version_41; 43 | } 44 | 45 | let build_ok_prepare vendor db_name charset version = 46 | (* 47 | In MariaDB, the handler is incremented by 1 each time. 48 | If needed, restart the MariaDB server to pass the test. 49 | *) 50 | { Mp_client.prepare_handler = Int64.of_int 1; 51 | Mp_client.prepare_nb_columns = 56; 52 | Mp_client.prepare_nb_parameters = 1; 53 | Mp_client.prepare_warning_count = 0; 54 | Mp_client.prepare_parameters_fields = [mysql_field_questionmark vendor]; 55 | Mp_client.prepare_parameters_names = [field_name_questionmark]; 56 | Mp_client.prepare_columns_fields = (mysql_fields vendor db_name charset version); 57 | Mp_client.prepare_columns_names = fields; 58 | } 59 | 60 | let test1 vendor connection db_name version = 61 | let () = 62 | let sql = "SELECT * FROM test_ocmp WHERE f_autoinc_not_null_no_def = ?" in 63 | let stmt = Mp_client.create_statement_from_string sql in 64 | let f = 65 | let p = Mp_client.prepare ~connection:connection ~statement:stmt in 66 | let (_, p) = Mp_client.get_prepared_statement p in 67 | p 68 | in 69 | assert_equal ~msg:sql 70 | (build_ok_prepare vendor db_name connection.Mp_client.configuration.Mp_client.charset_number version) 71 | (Test_query.try_query ~f:f ~sql:sql) 72 | in 73 | () 74 | 75 | let test host connection encoding _ = 76 | let (vendor, version, _, _, _) = host in 77 | let module F = ( 78 | val ( 79 | match encoding with 80 | | Mp_charset.Latin1 -> ( 81 | let module E = struct 82 | include Fixture_latin1 83 | end 84 | in (module E : Fixture.FIXTURE) 85 | ) 86 | | Mp_charset.Utf8 -> ( 87 | let module E = struct 88 | include Fixture_utf8 89 | end 90 | in (module E : Fixture.FIXTURE) 91 | ) 92 | | _ -> assert false 93 | ) : Fixture.FIXTURE 94 | ) 95 | in 96 | try 97 | test1 vendor connection F.db_name version 98 | with 99 | | Mp_client.Error err as e -> ( 100 | let () = prerr_endline (Mp_client.error_exception_to_string err) in 101 | raise e 102 | ) 103 | -------------------------------------------------------------------------------- /test/test_query_transaction.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let test1 connection = 5 | let () = Mp_client.( 6 | let sql = "TRUNCATE test_ocmp" in 7 | let stmt = create_statement_from_string sql in 8 | let _ = execute ~connection:connection ~statement:stmt () in 9 | (* Rollback test *) 10 | let sql = "START TRANSACTION" in 11 | let stmt = create_statement_from_string sql in 12 | let _ = execute ~connection:connection ~statement:stmt () in 13 | let sql = "INSERT INTO test_ocmp (f_varstring_null_no_def) VALUES ('TRANSACTION')" in 14 | let stmt = create_statement_from_string sql in 15 | let _ = execute ~connection:connection ~statement:stmt () in 16 | let sql = "SELECT * FROM test_ocmp WHERE f_varstring_null_no_def='TRANSACTION'" in 17 | let stmt = create_statement_from_string sql in 18 | let (_, rows) = (get_result_set(get_result(execute ~connection:connection ~statement:stmt ()))).Mp_result_set_packet.rows in 19 | let () = assert_equal ~msg:("Before rollback: " ^ sql) 1 (List.length rows) in 20 | let sql = "ROLLBACK" in 21 | let stmt = create_statement_from_string sql in 22 | let _ = execute ~connection:connection ~statement:stmt () in 23 | let sql = "SELECT * FROM test_ocmp WHERE f_varstring_null_no_def='TRANSACTION'" in 24 | let stmt = create_statement_from_string sql in 25 | let (_, rows) = (get_result_set(get_result(execute ~connection:connection ~statement:stmt ()))).Mp_result_set_packet.rows in 26 | let () = assert_equal ~msg:("After rollback: " ^ sql) 0 (List.length rows) in 27 | (* Commit test *) 28 | let sql = "START TRANSACTION" in 29 | let stmt = create_statement_from_string sql in 30 | let _ = execute ~connection:connection ~statement:stmt () in 31 | let sql = "INSERT INTO test_ocmp (f_varstring_null_no_def) VALUES ('TRANSACTION')" in 32 | let stmt = create_statement_from_string sql in 33 | let _ = execute ~connection:connection ~statement:stmt () in 34 | let sql = "SELECT * FROM test_ocmp WHERE f_varstring_null_no_def='TRANSACTION'" in 35 | let stmt = create_statement_from_string sql in 36 | let (_, rows) = (get_result_set(get_result(execute ~connection:connection ~statement:stmt ()))).Mp_result_set_packet.rows in 37 | let () = assert_equal ~msg:("Before commit: " ^ sql) 1 (List.length rows) in 38 | let sql = "COMMIT" in 39 | let stmt = create_statement_from_string sql in 40 | let _ = execute ~connection:connection ~statement:stmt () in 41 | let sql = "SELECT * FROM test_ocmp WHERE f_varstring_null_no_def='TRANSACTION'" in 42 | let stmt = create_statement_from_string sql in 43 | let (_, rows) = (get_result_set(get_result(execute ~connection:connection ~statement:stmt ()))).Mp_result_set_packet.rows in 44 | let () = assert_equal ~msg:("After commit: " ^ sql) 1 (List.length rows) in 45 | () 46 | ) in 47 | () 48 | 49 | let test connection _ = 50 | try 51 | test1 connection 52 | with 53 | | Mp_client.Error e -> prerr_endline (Mp_client.error_exception_to_string e) 54 | -------------------------------------------------------------------------------- /test/test_query_update.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let build_ok_update affected matched changed = 5 | { Mp_client.affected_rows = Int64.of_int affected; 6 | Mp_client.insert_id = (Int64.zero, Big_int.zero_big_int); 7 | Mp_client.server_status = 8704; 8 | Mp_client.warning_count = 0; 9 | Mp_client.message = "(Rows matched: " ^ (string_of_int matched) ^ " Changed: " ^ (string_of_int changed) ^ " Warnings: 0"; 10 | } 11 | 12 | let result_equals ok r = 13 | let affected_rows_ok = ok.Mp_client.affected_rows in 14 | let (insert_id_int64_ok, insert_id_big_int_ok) = ok.Mp_client.insert_id in 15 | let server_status_ok = ok.Mp_client.server_status in 16 | let warning_count_ok = ok.Mp_client.warning_count in 17 | let message_ok = ok.Mp_client.message in 18 | 19 | let affected_rows_r = r.Mp_client.affected_rows in 20 | let (insert_id_int64_r, insert_id_big_int_r) = r.Mp_client.insert_id in 21 | let server_status_r = r.Mp_client.server_status in 22 | let warning_count_r = r.Mp_client.warning_count in 23 | let message_r = r.Mp_client.message in 24 | 25 | (affected_rows_ok = affected_rows_r) 26 | && (Int64.compare insert_id_int64_ok insert_id_int64_r = 0) 27 | && (Big_int.compare_big_int insert_id_big_int_ok insert_id_big_int_r = 0) 28 | && (server_status_ok = server_status_r) 29 | && (warning_count_ok = warning_count_r) 30 | && (message_ok = message_r) 31 | 32 | let test1 _ connection testfile1 testfile2 update_var_string = 33 | let () = Mp_client.( 34 | let sql = "UPDATE test_ocmp SET f_int_null_no_def = 9999" in 35 | let stmt = create_statement_from_string sql in 36 | assert_equal ~msg:sql 37 | ~cmp:result_equals 38 | (build_ok_update 8 8 8) 39 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 40 | ) in 41 | let () = Mp_client.( 42 | let sql = "UPDATE test_ocmp SET f_blobimg_null_no_def = (LOAD_FILE('" ^ testfile1 ^ "'))" in 43 | let stmt = create_statement_from_string sql in 44 | let build_ok = build_ok_update 0 8 0 in 45 | assert_equal ~msg:sql 46 | ~cmp:result_equals 47 | build_ok 48 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 49 | ) in 50 | let () = Mp_client.( 51 | let sql = "UPDATE test_ocmp SET f_bloblong_null_no_def = (LOAD_FILE('" ^ testfile2 ^ "'))" in 52 | let stmt = create_statement_from_string sql in 53 | let build_ok = build_ok_update 2 8 2 in 54 | assert_equal ~msg:sql 55 | ~cmp:result_equals 56 | build_ok 57 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 58 | ) in 59 | let () = Mp_client.( 60 | let sql = "UPDATE test_ocmp SET f_varstring_null_no_def = '" ^ update_var_string ^ "'" in 61 | let stmt = create_statement_from_string sql in 62 | assert_equal ~msg:sql 63 | ~cmp:result_equals 64 | (build_ok_update 8 8 8) 65 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 66 | ) in 67 | let () = Mp_client.( 68 | let sql = "UPDATE test_ocmp SET f_varstring_null_no_def = 'update varstring : ABCDEFGHIJKLMNOPQRSTUVWXYZ'" in 69 | let stmt = create_statement_from_string sql in 70 | assert_equal ~msg:sql 71 | ~cmp:result_equals 72 | (build_ok_update 8 8 8) 73 | (Test_query.try_query ~f:(get_result_ok(get_result(execute ~connection:connection ~statement:stmt ()))) ~sql:sql) 74 | ) in 75 | () 76 | 77 | let test host connection encoding _ = 78 | let module F = ( 79 | val ( 80 | match encoding with 81 | | Mp_charset.Latin1 -> ( 82 | let module E = struct 83 | include Fixture_latin1 84 | end 85 | in (module E : Fixture.FIXTURE) 86 | ) 87 | | Mp_charset.Utf8 -> ( 88 | let module E = struct 89 | include Fixture_utf8 90 | end 91 | in (module E : Fixture.FIXTURE) 92 | ) 93 | | _ -> assert false 94 | ) : Fixture.FIXTURE 95 | ) 96 | in 97 | try 98 | test1 host connection Fixture_config.testfile1 Fixture_config.testfile2 F.update_var_string 99 | with 100 | | Mp_client.Error e -> prerr_endline (Mp_client.error_exception_to_string e) 101 | -------------------------------------------------------------------------------- /test/test_reset_connection.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let test1 connection = 5 | let () = 6 | assert_equal ~msg:"Reset connection" 7 | (()) 8 | (Mp_client.reset_connection ~connection:connection) 9 | in 10 | () 11 | 12 | let test connection _ = 13 | try 14 | test1 connection 15 | with 16 | | Mp_client.Error err as e -> ( 17 | let () = prerr_endline (Mp_client.error_exception_to_string err) in 18 | raise e 19 | ) 20 | -------------------------------------------------------------------------------- /test/test_reset_session.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Mysql_protocol 3 | 4 | let test1 connection = 5 | let () = 6 | assert_equal ~msg:"Reset session" 7 | (()) 8 | (Mp_client.reset_session ~connection:connection) 9 | in 10 | () 11 | 12 | let test connection _ = 13 | try 14 | test1 connection 15 | with 16 | | Mp_client.Error err as e -> ( 17 | let () = prerr_endline (Mp_client.error_exception_to_string err) in 18 | raise e 19 | ) 20 | -------------------------------------------------------------------------------- /test/test_types.ml: -------------------------------------------------------------------------------- 1 | type vendor = 2 | | MySQL 3 | | MariaDB 4 | 5 | type connection_type = 6 | | CInet of (string * Unix.inet_addr * int) 7 | | CUnix of string 8 | 9 | let vendor_to_string v = 10 | match v with 11 | | MySQL -> "MySQL" 12 | | MariaDB -> "MariaDB" 13 | -------------------------------------------------------------------------------- /test/twomega.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/slegrand45/mysql_protocol/01f856e3d757bec7a0d150efe5bb19392608b4ba/test/twomega.bin -------------------------------------------------------------------------------- /tutorials/tutorial.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/slegrand45/mysql_protocol/01f856e3d757bec7a0d150efe5bb19392608b4ba/tutorials/tutorial.pdf --------------------------------------------------------------------------------