interfaces/mysql/mysql-uffi.cl

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          mysql.cl
   6 ;;;; Purpose:       Low-level MySQL interface using UFFI
   7 ;;;; Programmers:   Kevin M. Rosenberg based on
   8 ;;;;                Original code by Pierre R. Mai
   9 ;;;; Date Started:  Feb 2002
  10 ;;;;
  11 ;;;; $Id: mysql-uffi.cl,v 1.1 2002/03/23 14:04:53 kevin Exp $
  12 ;;;;
  13 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
  14 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
  15 ;;;;
  16 ;;;; CLSQL users are granted the rights to distribute and use this software
  17 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  18 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  19 ;;;; *************************************************************************
  20
  21 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
  22
  23 (in-package :mysql)
  24
  25 ;;;; Modifications from original code
  26 ;;;;  - Updated C-structures to conform to structures in MySQL 3.23.46
  27 ;;;;  - Changed from CMUCL interface to UFFI
  28 ;;;;  - Added and call a C-helper file to support 64-bit integers
  29 ;;;;    that are used in a few routines.
  30 ;;;;  - Removed all references to interiors of C-structions, this will
  31 ;;;;    increase robustness when MySQL's internal structures change.
  32
  33 ;;;; Type definitions
  34
  35 ;;; Basic Types
  36
  37 (uffi:def-foreign-type mysql-socket :int)
  38 (uffi:def-foreign-type mysql-bool :char)
  39 (uffi:def-foreign-type mysql-byte :unsigned-char)
  40
  41 (uffi:def-enum mysql-net-type
  42     (:tcp-ip
  43      :socket
  44      :named-pipe))
  45
  46 (uffi:def-struct mysql-net
  47     (vio :pointer-void)
  48   (fd mysql-socket)
  49   (fcntl :int)
  50   (buff (* :unsigned-char))
  51   (buff-end (* :unsigned-char))
  52   (write-pos (* :unsigned-char))
  53   (read-pos (* :unsigned-char))
  54   (last-error (:array :char 200))
  55   (last-errno :unsigned-int)
  56   (max-packet :unsigned-int)
  57   (timeout :unsigned-int)
  58   (pkt-nr :unsigned-int)
  59   (error mysql-bool)
  60   (return-errno mysql-bool)
  61   (compress mysql-bool)
  62   (no-send-ok mysql-bool)
  63   (remain-in-buf :unsigned-long)
  64   (length :unsigned-long)
  65   (buf-length :unsigned-long)
  66   (where-b :unsigned-long)
  67   (return-status (* :unsigned-int))
  68   (reading-or-writing :unsigned-char)
  69   (save-char :char))
  70
  71 ;;; Mem-Root
  72 (uffi:def-struct mysql-used-mem
  73     (next :pointer-self)
  74   (left :unsigned-int)
  75   (size :unsigned-int))
  76
  77 (uffi:def-struct mysql-mem-root
  78     (free (* mysql-used-mem))
  79   (used (* mysql-used-mem))
  80   (pre-alloc (* mysql-used-mem))
  81   (min-alloc :unsigned-int)
  82   (block-size :unsigned-int)
  83   (error-handler :pointer-void))
  84
  85 ;;; MYSQL-FIELD
  86 (uffi:def-enum mysql-field-types
  87     (:decimal
  88      :tiny
  89      :short
  90      :long
  91      :float
  92      :double
  93      :null
  94      :timestamp
  95      :longlong
  96      :int24
  97      :date
  98      :time
  99      :datetime
 100      :year
 101      :newdate
 102      (:enum 247)
 103      (:set 248)
 104      (:tiny-blob 249)
 105      (:medium-blob 250)
 106      (:long-blob 251)
 107      (:blob 252)
 108      (:var-string 253)
 109      (:string 254)))
 110
 111 (uffi:def-struct mysql-field
 112     (name (* :char))
 113   (table (* :char))
 114   (def (* :char))
 115   (type mysql-field-types)
 116   (length :unsigned-int)
 117   (max-length :unsigned-int)
 118   (flags :unsigned-int)
 119   (decimals :unsigned-int))
 120
 121 ;;; MYSQL-ROWS
 122
 123 (uffi:def-array-pointer mysql-row (* :unsigned-char))
 124
 125 (uffi:def-foreign-type mysql-field-offset :unsigned-int)
 126
 127 (uffi:def-struct mysql-rows
 128     (next :pointer-self)
 129   (data mysql-row))
 130
 131 (uffi:def-foreign-type mysql-row-offset (* mysql-rows))
 132
 133 (uffi:def-struct mysql-data
 134     (rows-high32 :unsigned-long)
 135   (rows-low32 :unsigned-long)
 136   (fields :unsigned-int)
 137   (data (* mysql-rows))
 138   (alloc mysql-mem-root))
 139
 140 ;;; MYSQL
 141 (uffi:def-struct mysql-options
 142     (connect-timeout :unsigned-int)
 143   (client-flag :unsigned-int)
 144   (compress mysql-bool)
 145   (named-pipe mysql-bool)
 146   (port :unsigned-int)
 147   (host (* :char))
 148   (init-command (* :char))
 149   (user (* :char))
 150   (password (* :char))
 151   (unix-socket (* :char))
 152   (db (* :char))
 153   (my-cnf-file (* :char))
 154   (my-cnf-group (* :char))
 155   (charset-dir (* :char))
 156   (charset-name (* :char))
 157   (use-ssl mysql-bool)
 158   (ssl-key (* :char))
 159   (ssl-cert (* :char))
 160   (ssl-ca (* :char))
 161   (ssl-capath (* :char)))
 162
 163 (uffi:def-enum mysql-option
 164     (:connect-timeout
 165      :compress
 166      :named-pipe
 167      :init-command
 168      :read-default-file
 169      :read-default-group))
 170
 171 (uffi:def-enum mysql-status
 172     (:ready
 173      :get-result
 174      :use-result))
 175
 176 (uffi:def-struct mysql-mysql
 177     (net mysql-net)
 178   (connected-fd (* :char))
 179   (host (* :char))
 180   (user (* :char))
 181   (passwd (* :char))
 182   (unix-socket (* :char))
 183   (server-version (* :char))
 184   (host-info (* :char))
 185   (info (* :char))
 186   (db (* :char))
 187   (port :unsigned-int)
 188   (client-flag :unsigned-int)
 189   (server-capabilities :unsigned-int)
 190   (protocol-version :unsigned-int)
 191   (field-count :unsigned-int)
 192   (server-status :unsigned-int)
 193   (thread-id :unsigned-long)
 194   (affected-rows-high32 :unsigned-long)
 195   (affected-rows-low32 :unsigned-long)
 196   (insert-id-high32 :unsigned-long)
 197   (insert-id-low32 :unsigned-long)
 198   (extra-info-high32 :unsigned-long)
 199   (extra-info-low32 :unsigned-long)
 200   (packet-length :unsigned-long)
 201   (status mysql-status)
 202   (fields (* mysql-field))
 203   (field-alloc mysql-mem-root)
 204   (free-me mysql-bool)
 205   (reconnect mysql-bool)
 206   (options mysql-options)
 207   (scramble-buff (:array :char 9))
 208   (charset :pointer-void)
 209   (server-language :unsigned-int))
 210
 211
 212 ;;; MYSQL-RES
 213 (uffi:def-struct mysql-mysql-res
 214     (row-count-high32 :unsigned-long)
 215   (row-count-low32 :unsigned-long)
 216   (field-count :unsigned-int)
 217   (current-field :unsigned-int)
 218   (fields (* mysql-field))
 219   (data (* mysql-data))
 220   (data-cursor (* mysql-rows))
 221   (field-alloc mysql-mem-root)
 222   (row mysql-row)
 223   (current-row mysql-row)
 224   (lengths (* :unsigned-long))
 225   (handle (* mysql-mysql))
 226   (eof mysql-bool))
 227
 228 ;;;; The Foreign C routines
 229 (declaim (inline mysql-init))
 230 (uffi:def-function "mysql_init"
 231   ((mysql (* mysql-mysql)))
 232   :module "mysql"
 233   :returning (* mysql-mysql))
 234
 235 (declaim (inline mysql-connect))
 236 (uffi:def-function "mysql_connect"
 237     ((mysql (* mysql-mysql))
 238      (host :cstring)
 239      (user :cstring)
 240      (passwd :cstring))
 241   :module "mysql"
 242   :returning (* mysql-mysql))
 243
 244 (declaim (inline mysql-real-connect))
 245 (uffi:def-function "mysql_real_connect"
 246   ((mysql (* mysql-mysql))
 247    (host :cstring)
 248    (user :cstring)
 249    (passwd :cstring)
 250    (db :cstring)
 251    (port :unsigned-int)
 252    (unix-socket :cstring)
 253    (clientflag :unsigned-int))
 254   :module "mysql"
 255   :returning (* mysql-mysql))
 256
 257 (declaim (inline mysql-close))
 258 (uffi:def-function "mysql_close"
 259     ((sock (* mysql-mysql)))
 260   :module "mysql"
 261   :returning :void)
 262
 263 (declaim (inline mysql-select-db))
 264 (uffi:def-function "mysql_select_db"
 265   ((mysql (* mysql-mysql))
 266    (db :cstring))
 267   :module "mysql"
 268   :returning :int)
 269
 270 (declaim (inline mysql-query))
 271 (uffi:def-function "mysql_query"
 272     ((mysql (* mysql-mysql))
 273      (query :cstring))
 274   :module "mysql"
 275   :returning :int)
 276
 277  ;;; I doubt that this function is really useful for direct Lisp usage,
 278 ;;; but it is here for completeness...
 279
 280 (declaim (inline mysql-real-query))
 281 (uffi:def-function "mysql_real_query"
 282     ((mysql (* mysql-mysql))
 283      (query :cstring)
 284      (length :unsigned-int))
 285   :module "mysql"
 286   :returning :int)
 287
 288 (declaim (inline mysql-create-db))
 289 (uffi:def-function "mysql_create_db"
 290   ((mysql (* mysql-mysql))
 291    (db :cstring))
 292   :module "mysql"
 293   :returning :int)
 294
 295 (declaim (inline mysql-drop-db))
 296 (uffi:def-function "mysql_drop_db"
 297     ((mysql (* mysql-mysql))
 298      (db :cstring))
 299   :module "mysql"
 300   :returning :int)
 301
 302 (declaim (inline mysql-shutdown))
 303 (uffi:def-function "mysql_shutdown"
 304   ((mysql (* mysql-mysql)))
 305   :module "mysql"
 306   :returning :int)
 307
 308 (declaim (inline mysql-dump-debug-info))
 309 (uffi:def-function "mysql_dump_debug_info"
 310   ((mysql (* mysql-mysql)))
 311   :module "mysql"
 312   :returning :int)
 313
 314 (declaim (inline mysql-refresh))
 315 (uffi:def-function "mysql_refresh"
 316   ((mysql (* mysql-mysql))
 317    (refresh-options :unsigned-int))
 318   :module "mysql"
 319   :returning :int)
 320
 321 (declaim (inline mysql-kill))
 322 (uffi:def-function "mysql_kill"
 323     ((mysql (* mysql-mysql))
 324      (pid :unsigned-long))
 325   :module "mysql"
 326   :returning :int)
 327
 328 (declaim (inline mysql-ping))
 329 (uffi:def-function "mysql_ping"
 330     ((mysql (* mysql-mysql)))
 331   :module "mysql"
 332   :returning :int)
 333
 334 (declaim (inline mysql-stat))
 335 (uffi:def-function "mysql_stat"
 336   ((mysql (* mysql-mysql)))
 337   :module "mysql"
 338   :returning :cstring)
 339
 340 (declaim (inline mysql-get-server-info))
 341 (uffi:def-function "mysql_get_server_info"
 342     ((mysql (* mysql-mysql)))
 343   :module "mysql"
 344   :returning :cstring)
 345
 346 (declaim (inline mysql-get-client-info))
 347 (uffi:def-function "mysql_get_client_info"
 348     ()
 349   :module "mysql"
 350   :returning :cstring)
 351
 352 (declaim (inline mysql-get-host-info))
 353 (uffi:def-function "mysql_get_host_info"
 354     ((mysql (* mysql-mysql)))
 355   :module "mysql"
 356   :returning :cstring)
 357
 358 (declaim (inline mysql-get-proto-info))
 359 (uffi:def-function "mysql_get_proto_info"
 360   ((mysql (* mysql-mysql)))
 361   :module "mysql"
 362   :returning :unsigned-int)
 363
 364 (declaim (inline mysql-list-dbs))
 365 (uffi:def-function "mysql_list_dbs"
 366   ((mysql (* mysql-mysql))
 367    (wild :cstring))
 368   :module "mysql"
 369   :returning (* mysql-mysql-res))
 370
 371 (declaim (inline mysql-list-tables))
 372 (uffi:def-function "mysql_list_tables"
 373   ((mysql (* mysql-mysql))
 374    (wild :cstring))
 375   :module "mysql"
 376   :returning (* mysql-mysql-res))
 377
 378 (declaim (inline mysql-list-fields))
 379 (uffi:def-function "mysql_list_fields"
 380   ((mysql (* mysql-mysql))
 381    (table :cstring)
 382    (wild :cstring))
 383   :module "mysql"
 384   :returning (* mysql-mysql-res))
 385
 386 (declaim (inline mysql-list-processes))
 387 (uffi:def-function "mysql_list_processes"
 388   ((mysql (* mysql-mysql)))
 389   :module "mysql"
 390   :returning (* mysql-mysql-res))
 391
 392 (declaim (inline mysql-store-result))
 393 (uffi:def-function "mysql_store_result"
 394   ((mysql (* mysql-mysql)))
 395   :module "mysql"
 396   :returning (* mysql-mysql-res))
 397
 398 (declaim (inline mysql-use-result))
 399 (uffi:def-function "mysql_use_result"
 400   ((mysql (* mysql-mysql)))
 401   :module "mysql"
 402   :returning (* mysql-mysql-res))
 403
 404 (declaim (inline mysql-options))
 405 (uffi:def-function "mysql_options"
 406   ((mysql (* mysql-mysql))
 407    (option mysql-option)
 408    (arg :cstring))
 409   :module "mysql"
 410   :returning :int)
 411
 412 (declaim (inline mysql-free-result))
 413 (uffi:def-function "mysql_free_result"
 414     ((res (* mysql-mysql-res)))
 415   :module "mysql"
 416   :returning :void)
 417
 418 (declaim (inline mysql-row-seek))
 419 (uffi:def-function "mysql_row_seek"
 420   ((res (* mysql-mysql-res))
 421    (offset mysql-row-offset))
 422   :module "mysql"
 423   :returning mysql-row-offset)
 424
 425 (declaim (inline mysql-field-seek))
 426 (uffi:def-function "mysql_field_seek"
 427   ((res (* mysql-mysql-res))
 428   (offset mysql-field-offset))
 429   :module "mysql"
 430   :returning mysql-field-offset)
 431
 432 (declaim (inline mysql-fetch-row))
 433 (uffi:def-function "mysql_fetch_row"
 434     ((res (* mysql-mysql-res)))
 435   :module "mysql"
 436   :returning mysql-row)
 437
 438 (declaim (inline mysql-fetch-lengths))
 439 (uffi:def-function "mysql_fetch_lengths"
 440   ((res (* mysql-mysql-res)))
 441   :module "mysql"
 442   :returning (* :unsigned-long))
 443
 444 (declaim (inline mysql-fetch-field))
 445 (uffi:def-function "mysql_fetch_field"
 446   ((res (* mysql-mysql-res)))
 447   :module "mysql"
 448   :returning (* mysql-field))
 449
 450 (declaim (inline mysql-escape-string))
 451 (uffi:def-function "mysql_escape_string"
 452     ((to :cstring)
 453      (from :cstring)
 454      (length :unsigned-int))
 455   :module "mysql"
 456   :returning :unsigned-int)
 457
 458 (declaim (inline mysql-debug))
 459 (uffi:def-function "mysql_debug"
 460     ((debug :cstring))
 461   :module "mysql"
 462   :returning :void)
 463
 464 (declaim (inline clsql-mysql-num-rows))
 465 (uffi:def-function "clsql_mysql_num_rows"
 466     ((res (* mysql-mysql-res))
 467      (p-high32 (* :unsigned-int)))
 468   :module "clsql-mysql"
 469   :returning :unsigned-int)
 470
 471
 472 ;;;; Equivalents of C Macro definitions for accessing various fields
 473 ;;;; in the internal MySQL Datastructures
 474
 475 (uffi:def-constant +2^32+ 4294967296)
 476 (uffi:def-constant +2^32-1+ (1- +2^32+))
 477
 478 (defmacro make-64-bit-integer (high32 low32)
 479   `(+ ,low32 (* ,high32 +2^32+)))
 480
 481 (declaim (inline mysql-num-rows))
 482 (defun mysql-num-rows (res)
 483   (uffi:with-foreign-object (p-high32 :unsigned-int)
 484     (let ((low32 (clsql-mysql-num-rows res p-high32))
 485           (high32 (uffi:deref-pointer p-high32 :unsigned-int)))
 486       (if (zerop high32)
 487           low32
 488         (make-64-bit-integer high32 low32)))))
 489
 490 (uffi:def-function "clsql_mysql_affected_rows"
 491     ((mysql (* mysql-mysql))
 492      (p-high32 (* :unsigned-int)))
 493   :returning :unsigned-int
 494   :module "clsql-mysql")
 495
 496 (defun mysql-affected-rows (mysql)
 497   (uffi:with-foreign-object (p-high32 :unsigned-int)
 498     (let ((low32 (clsql-mysql-affected-rows mysql p-high32))
 499           (high32 (uffi:deref-pointer p-high32 :unsigned-int)))
 500       (if (zerop high32)
 501           low32
 502         (make-64-bit-integer high32 low32)))))
 503
 504 (uffi:def-function "clsql_mysql_insert_id"
 505     ((res (* mysql-mysql))
 506      (p-high32 (* :unsigned-int)))
 507   :returning :unsigned-int
 508   :module "clsql-mysql")
 509
 510 (defun mysql-insert-id (mysql)
 511   (uffi:with-foreign-object (p-high32 :unsigned-int)
 512   (let ((low32 (clsql-mysql-insert-id mysql p-high32))
 513         (high32 (uffi:deref-pointer p-high32 :unsigned-int)))
 514     (if (zerop high32)
 515         low32
 516       (make-64-bit-integer high32 low32)))))
 517
 518
 519 (declaim (inline mysql-num-fields))
 520 (uffi:def-function "mysql_num_fields"
 521   ((res (* mysql-mysql-res)))
 522   :returning :unsigned-int
 523   :module "mysql")
 524
 525 (declaim (inline clsql-mysql-eof))
 526 (uffi:def-function ("mysql_eof" clsql-mysql-eof)
 527   ((res (* mysql-mysql-res)))
 528   :returning :char
 529   :module "mysql")
 530
 531 (declaim (inline mysql-eof))
 532 (defun mysql-eof (res)
 533   (if (zerop (clsql-mysql-eof res))
 534       nil
 535     t))
 536
 537 (declaim (inline mysql-error))
 538 (uffi:def-function ("mysql_error" mysql-error)
 539   ((mysql (* mysql-mysql)))
 540   :returning :cstring
 541   :module "mysql")
 542
 543 (declaim (inline mysql-error-string))
 544 (defun mysql-error-string (mysql)
 545   (uffi:convert-from-cstring (mysql-error mysql)))
 546
 547 (declaim (inline mysql-errno))
 548 (uffi:def-function "mysql_errno"
 549   ((mysql (* mysql-mysql)))
 550   :returning :unsigned-int
 551   :module "mysql")
 552
 553 (declaim (inline mysql-info))
 554 (uffi:def-function ("mysql_info" mysql-info)
 555   ((mysql (* mysql-mysql)))
 556   :returning :cstring
 557   :module "mysql")
 558
 559 (declaim (inline mysql-info-string))
 560 (defun mysql-info-string (mysql)
 561   (uffi:convert-from-cstring (mysql-info mysql)))
 562
 563 (declaim (inline clsql-mysql-data-seek))
 564 (uffi:def-function "clsql_mysql_data_seek"
 565   ((res (* mysql-mysql-res))
 566    (offset-high32 :unsigned-int)
 567    (offset-low32 :unsigned-int))
 568   :module "clsql-mysql"
 569   :returning :void)
 570
 571
 572 (declaim (inline split-64bit-integer))
 573 (defun split-64bit-integer (int64)
 574   (values (ash int64 -32) (logand int64 +2^32-1+)))
 575
 576 (defun mysql-data-seek (res offset)
 577   (multiple-value-bind (high32 low32) (split-64bit-integer offset)
 578     (clsql-mysql-data-seek res high32 low32)))
 579