db-mysql/mysql-api.lisp

   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-api.lisp,v 1.2 2003/05/17 07:27:15 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 (:struct-pointer mysql-used-mem))
  79   (used (:struct-pointer mysql-used-mem))
  80   (pre-alloc (:struct-pointer 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 #-(or win32 mswindows)
 112 (uffi:def-struct mysql-field
 113     (name (* :char))
 114   (table (* :char))
 115   (def (* :char))
 116   (type mysql-field-types)
 117   (length :unsigned-int)
 118   (max-length :unsigned-int)
 119   (flags :unsigned-int)
 120   (decimals :unsigned-int))
 121
 122 ;; structure changed in mysql 4.0.12, win32
 123 #+(or win32 mswindows)
 124 (uffi:def-struct mysql-field
 125     (name (* :char))
 126   (table (* :char))
 127   (org_table (* :char))
 128   (db (* :char))
 129   (def (* :char))
 130   (length :unsigned-int)
 131   (max-length :unsigned-int)
 132   (flags :unsigned-int)
 133   (decimals :unsigned-int)
 134   (type mysql-field-types))
 135
 136 ;;; MYSQL-ROWS
 137
 138 (uffi:def-array-pointer mysql-row (* :unsigned-char))
 139
 140 (uffi:def-array-pointer mysql-field-vector (* mysql-field))
 141
 142 (uffi:def-foreign-type mysql-field-offset :unsigned-int)
 143
 144 (uffi:def-struct mysql-rows
 145     (next :pointer-self)
 146   (data mysql-row))
 147
 148 (uffi:def-foreign-type mysql-row-offset (:struct-pointer mysql-rows))
 149
 150 (uffi:def-struct mysql-data
 151     (rows-high32 :unsigned-long)
 152   (rows-low32 :unsigned-long)
 153   (fields :unsigned-int)
 154   (data (:struct-pointer mysql-rows))
 155   (alloc (:struct mysql-mem-root)))
 156
 157 ;;; MYSQL
 158 (uffi:def-struct mysql-options
 159     (connect-timeout :unsigned-int)
 160   (client-flag :unsigned-int)
 161   (compress mysql-bool)
 162   (named-pipe mysql-bool)
 163   (port :unsigned-int)
 164   (host (* :char))
 165   (init-command (* :char))
 166   (user (* :char))
 167   (password (* :char))
 168   (unix-socket (* :char))
 169   (db (* :char))
 170   (my-cnf-file (* :char))
 171   (my-cnf-group (* :char))
 172   (charset-dir (* :char))
 173   (charset-name (* :char))
 174   (use-ssl mysql-bool)
 175   (ssl-key (* :char))
 176   (ssl-cert (* :char))
 177   (ssl-ca (* :char))
 178   (ssl-capath (* :char)))
 179
 180 (uffi:def-enum mysql-option
 181     (:connect-timeout
 182      :compress
 183      :named-pipe
 184      :init-command
 185      :read-default-file
 186      :read-default-group))
 187
 188 (uffi:def-enum mysql-status
 189     (:ready
 190      :get-result
 191      :use-result))
 192
 193 (uffi:def-struct mysql-mysql
 194     (net (:struct mysql-net))
 195   (connected-fd (* :char))
 196   (host (* :char))
 197   (user (* :char))
 198   (passwd (* :char))
 199   (unix-socket (* :char))
 200   (server-version (* :char))
 201   (host-info (* :char))
 202   (info (* :char))
 203   (db (* :char))
 204   (port :unsigned-int)
 205   (client-flag :unsigned-int)
 206   (server-capabilities :unsigned-int)
 207   (protocol-version :unsigned-int)
 208   (field-count :unsigned-int)
 209   (server-status :unsigned-int)
 210   (thread-id :unsigned-long)
 211   (affected-rows-high32 :unsigned-long)
 212   (affected-rows-low32 :unsigned-long)
 213   (insert-id-high32 :unsigned-long)
 214   (insert-id-low32 :unsigned-long)
 215   (extra-info-high32 :unsigned-long)
 216   (extra-info-low32 :unsigned-long)
 217   (packet-length :unsigned-long)
 218   (status mysql-status)
 219   (fields (:struct-pointer mysql-field))
 220   (field-alloc (:struct mysql-mem-root))
 221   (free-me mysql-bool)
 222   (reconnect mysql-bool)
 223   (options (:struct mysql-options))
 224   (scramble-buff (:array :char 9))
 225   (charset :pointer-void)
 226   (server-language :unsigned-int))
 227
 228
 229 ;;; MYSQL-RES
 230 (uffi:def-struct mysql-mysql-res
 231     (row-count-high32 :unsigned-long)
 232   (row-count-low32 :unsigned-long)
 233   (field-count :unsigned-int)
 234   (current-field :unsigned-int)
 235   (fields (:struct-pointer mysql-field))
 236   (data (:struct-pointer mysql-data))
 237   (data-cursor (:struct-pointer mysql-rows))
 238   (field-alloc (:struct mysql-mem-root))
 239   (row mysql-row)
 240   (current-row mysql-row)
 241   (lengths (* :unsigned-long))
 242   (handle (:struct-pointer mysql-mysql))
 243   (eof mysql-bool))
 244
 245 ;;;; The Foreign C routines
 246 (declaim (inline mysql-init))
 247 (uffi:def-function "mysql_init"
 248   ((mysql (* mysql-mysql)))
 249   :module "mysql"
 250   :returning (* mysql-mysql))
 251
 252 (declaim (inline mysql-connect))
 253 (uffi:def-function "mysql_connect"
 254     ((mysql (* mysql-mysql))
 255      (host :cstring)
 256      (user :cstring)
 257      (passwd :cstring))
 258   :module "mysql"
 259   :returning (* mysql-mysql))
 260
 261 ;; Need to comment this out for LW 4.2.6
 262 ;; ? bug in LW version
 263 ;;(declaim (inline mysql-real-connect))
 264 (uffi:def-function "mysql_real_connect"
 265     ((mysql (* mysql-mysql))
 266      (host :cstring)
 267      (user :cstring)
 268      (passwd :cstring)
 269      (db :cstring)
 270      (port :unsigned-int)
 271      (unix-socket :cstring)
 272      (clientflag :unsigned-int))
 273   :module "mysql"
 274   :returning (* mysql-mysql))
 275
 276 (declaim (inline mysql-close))
 277 (uffi:def-function "mysql_close"
 278     ((sock (* mysql-mysql)))
 279   :module "mysql"
 280   :returning :void)
 281
 282 (declaim (inline mysql-select-db))
 283 (uffi:def-function "mysql_select_db"
 284   ((mysql (* mysql-mysql))
 285    (db :cstring))
 286   :module "mysql"
 287   :returning :int)
 288
 289 (declaim (inline mysql-query))
 290 (uffi:def-function "mysql_query"
 291     ((mysql (* mysql-mysql))
 292      (query :cstring))
 293   :module "mysql"
 294   :returning :int)
 295
 296  ;;; I doubt that this function is really useful for direct Lisp usage,
 297 ;;; but it is here for completeness...
 298
 299 (declaim (inline mysql-real-query))
 300 (uffi:def-function "mysql_real_query"
 301     ((mysql (* mysql-mysql))
 302      (query :cstring)
 303      (length :unsigned-int))
 304   :module "mysql"
 305   :returning :int)
 306
 307 (declaim (inline mysql-create-db))
 308 (uffi:def-function "mysql_create_db"
 309   ((mysql (* mysql-mysql))
 310    (db :cstring))
 311   :module "mysql"
 312   :returning :int)
 313
 314 (declaim (inline mysql-drop-db))
 315 (uffi:def-function "mysql_drop_db"
 316     ((mysql (* mysql-mysql))
 317      (db :cstring))
 318   :module "mysql"
 319   :returning :int)
 320
 321 (declaim (inline mysql-shutdown))
 322 (uffi:def-function "mysql_shutdown"
 323   ((mysql (* mysql-mysql)))
 324   :module "mysql"
 325   :returning :int)
 326
 327 (declaim (inline mysql-dump-debug-info))
 328 (uffi:def-function "mysql_dump_debug_info"
 329   ((mysql (* mysql-mysql)))
 330   :module "mysql"
 331   :returning :int)
 332
 333 (declaim (inline mysql-refresh))
 334 (uffi:def-function "mysql_refresh"
 335   ((mysql (* mysql-mysql))
 336    (refresh-options :unsigned-int))
 337   :module "mysql"
 338   :returning :int)
 339
 340 (declaim (inline mysql-kill))
 341 (uffi:def-function "mysql_kill"
 342     ((mysql (* mysql-mysql))
 343      (pid :unsigned-long))
 344   :module "mysql"
 345   :returning :int)
 346
 347 (declaim (inline mysql-ping))
 348 (uffi:def-function "mysql_ping"
 349     ((mysql (* mysql-mysql)))
 350   :module "mysql"
 351   :returning :int)
 352
 353 (declaim (inline mysql-stat))
 354 (uffi:def-function "mysql_stat"
 355   ((mysql (* mysql-mysql)))
 356   :module "mysql"
 357   :returning :cstring)
 358
 359 (declaim (inline mysql-get-server-info))
 360 (uffi:def-function "mysql_get_server_info"
 361     ((mysql (* mysql-mysql)))
 362   :module "mysql"
 363   :returning :cstring)
 364
 365 (declaim (inline mysql-get-client-info))
 366 (uffi:def-function "mysql_get_client_info"
 367     ()
 368   :module "mysql"
 369   :returning :cstring)
 370
 371 (declaim (inline mysql-get-host-info))
 372 (uffi:def-function "mysql_get_host_info"
 373     ((mysql (* mysql-mysql)))
 374   :module "mysql"
 375   :returning :cstring)
 376
 377 (declaim (inline mysql-get-proto-info))
 378 (uffi:def-function "mysql_get_proto_info"
 379   ((mysql (* mysql-mysql)))
 380   :module "mysql"
 381   :returning :unsigned-int)
 382
 383 (declaim (inline mysql-list-dbs))
 384 (uffi:def-function "mysql_list_dbs"
 385   ((mysql (* mysql-mysql))
 386    (wild :cstring))
 387   :module "mysql"
 388   :returning (* mysql-mysql-res))
 389
 390 (declaim (inline mysql-list-tables))
 391 (uffi:def-function "mysql_list_tables"
 392   ((mysql (* mysql-mysql))
 393    (wild :cstring))
 394   :module "mysql"
 395   :returning (* mysql-mysql-res))
 396
 397 (declaim (inline mysql-list-fields))
 398 (uffi:def-function "mysql_list_fields"
 399   ((mysql (* mysql-mysql))
 400    (table :cstring)
 401    (wild :cstring))
 402   :module "mysql"
 403   :returning (* mysql-mysql-res))
 404
 405 (declaim (inline mysql-list-processes))
 406 (uffi:def-function "mysql_list_processes"
 407   ((mysql (* mysql-mysql)))
 408   :module "mysql"
 409   :returning (* mysql-mysql-res))
 410
 411 (declaim (inline mysql-store-result))
 412 (uffi:def-function "mysql_store_result"
 413   ((mysql (* mysql-mysql)))
 414   :module "mysql"
 415   :returning (* mysql-mysql-res))
 416
 417 (declaim (inline mysql-use-result))
 418 (uffi:def-function "mysql_use_result"
 419   ((mysql (* mysql-mysql)))
 420   :module "mysql"
 421   :returning (* mysql-mysql-res))
 422
 423 (declaim (inline mysql-options))
 424 (uffi:def-function "mysql_options"
 425   ((mysql (* mysql-mysql))
 426    (option mysql-option)
 427    (arg :cstring))
 428   :module "mysql"
 429   :returning :int)
 430
 431 (declaim (inline mysql-free-result))
 432 (uffi:def-function "mysql_free_result"
 433     ((res (* mysql-mysql-res)))
 434   :module "mysql"
 435   :returning :void)
 436
 437 (declaim (inline mysql-row-seek))
 438 (uffi:def-function "mysql_row_seek"
 439   ((res (* mysql-mysql-res))
 440    (offset mysql-row-offset))
 441   :module "mysql"
 442   :returning mysql-row-offset)
 443
 444 (declaim (inline mysql-field-seek))
 445 (uffi:def-function "mysql_field_seek"
 446   ((res (* mysql-mysql-res))
 447   (offset mysql-field-offset))
 448   :module "mysql"
 449   :returning mysql-field-offset)
 450
 451 (declaim (inline mysql-fetch-row))
 452 (uffi:def-function "mysql_fetch_row"
 453     ((res (* mysql-mysql-res)))
 454   :module "mysql"
 455   :returning (* (* :unsigned-char)))
 456
 457 (declaim (inline mysql-fetch-lengths))
 458 (uffi:def-function "mysql_fetch_lengths"
 459   ((res (* mysql-mysql-res)))
 460   :module "mysql"
 461   :returning (* :unsigned-long))
 462
 463 (declaim (inline mysql-fetch-field))
 464 (uffi:def-function "mysql_fetch_field"
 465   ((res (* mysql-mysql-res)))
 466   :module "mysql"
 467   :returning (* mysql-field))
 468
 469 (declaim (inline mysql-fetch-fields))
 470 (uffi:def-function "mysql_fetch_fields"
 471   ((res (* mysql-mysql-res)))
 472   :module "mysql"
 473   :returning (* mysql-field))
 474
 475 (declaim (inline mysql-fetch-field-direct))
 476 (uffi:def-function "mysql_fetch_field_direct"
 477   ((res (* mysql-mysql-res))
 478    (field-num :unsigned-int))
 479   :module "mysql"
 480   :returning (* mysql-field))
 481
 482 (declaim (inline mysql-escape-string))
 483 (uffi:def-function "mysql_escape_string"
 484     ((to :cstring)
 485      (from :cstring)
 486      (length :unsigned-int))
 487   :module "mysql"
 488   :returning :unsigned-int)
 489
 490 (declaim (inline mysql-debug))
 491 (uffi:def-function "mysql_debug"
 492     ((debug :cstring))
 493   :module "mysql"
 494   :returning :void)
 495
 496 (declaim (inline clsql-mysql-num-rows))
 497 (uffi:def-function "clsql_mysql_num_rows"
 498     ((res (* mysql-mysql-res))
 499      (p-high32 (* :unsigned-int)))
 500   :module "clsql-mysql"
 501   :returning :unsigned-int)
 502
 503
 504 ;;;; Equivalents of C Macro definitions for accessing various fields
 505 ;;;; in the internal MySQL Datastructures
 506
 507
 508 (declaim (inline mysql-num-rows))
 509 (defun mysql-num-rows (res)
 510   (uffi:with-foreign-object (p-high32 :unsigned-int)
 511     (let ((low32 (clsql-mysql-num-rows res p-high32))
 512           (high32 (uffi:deref-pointer p-high32 :unsigned-int)))
 513       (if (zerop high32)
 514           low32
 515         (make-64-bit-integer high32 low32)))))
 516
 517 (uffi:def-function "clsql_mysql_affected_rows"
 518     ((mysql (* mysql-mysql))
 519      (p-high32 (* :unsigned-int)))
 520   :returning :unsigned-int
 521   :module "clsql-mysql")
 522
 523 (defun mysql-affected-rows (mysql)
 524   (uffi:with-foreign-object (p-high32 :unsigned-int)
 525     (let ((low32 (clsql-mysql-affected-rows mysql p-high32))
 526           (high32 (uffi:deref-pointer p-high32 :unsigned-int)))
 527       (if (zerop high32)
 528           low32
 529         (make-64-bit-integer high32 low32)))))
 530
 531 (uffi:def-function "clsql_mysql_insert_id"
 532     ((res (* mysql-mysql))
 533      (p-high32 (* :unsigned-int)))
 534   :returning :unsigned-int
 535   :module "clsql-mysql")
 536
 537 (defun mysql-insert-id (mysql)
 538   (uffi:with-foreign-object (p-high32 :unsigned-int)
 539   (let ((low32 (clsql-mysql-insert-id mysql p-high32))
 540         (high32 (uffi:deref-pointer p-high32 :unsigned-int)))
 541     (if (zerop high32)
 542         low32
 543       (make-64-bit-integer high32 low32)))))
 544
 545
 546 (declaim (inline mysql-num-fields))
 547 (uffi:def-function "mysql_num_fields"
 548   ((res (* mysql-mysql-res)))
 549   :returning :unsigned-int
 550   :module "mysql")
 551
 552 (declaim (inline clsql-mysql-eof))
 553 (uffi:def-function ("mysql_eof" clsql-mysql-eof)
 554   ((res (* mysql-mysql-res)))
 555   :returning :char
 556   :module "mysql")
 557
 558 (declaim (inline mysql-eof))
 559 (defun mysql-eof (res)
 560   (if (zerop (clsql-mysql-eof res))
 561       nil
 562     t))
 563
 564 (declaim (inline mysql-error))
 565 (uffi:def-function ("mysql_error" mysql-error)
 566   ((mysql (* mysql-mysql)))
 567   :returning :cstring
 568   :module "mysql")
 569
 570 (declaim (inline mysql-error-string))
 571 (defun mysql-error-string (mysql)
 572   (uffi:convert-from-cstring (mysql-error mysql)))
 573
 574 (declaim (inline mysql-errno))
 575 (uffi:def-function "mysql_errno"
 576   ((mysql (* mysql-mysql)))
 577   :returning :unsigned-int
 578   :module "mysql")
 579
 580 (declaim (inline mysql-info))
 581 (uffi:def-function ("mysql_info" mysql-info)
 582   ((mysql (* mysql-mysql)))
 583   :returning :cstring
 584   :module "mysql")
 585
 586 (declaim (inline mysql-info-string))
 587 (defun mysql-info-string (mysql)
 588   (uffi:convert-from-cstring (mysql-info mysql)))
 589
 590 (declaim (inline clsql-mysql-data-seek))
 591 (uffi:def-function "clsql_mysql_data_seek"
 592   ((res (* mysql-mysql-res))
 593    (offset-high32 :unsigned-int)
 594    (offset-low32 :unsigned-int))
 595   :module "clsql-mysql"
 596   :returning :void)
 597
 598
 599 (defun mysql-data-seek (res offset)
 600   (multiple-value-bind (high32 low32) (split-64-bit-integer offset)
 601     (clsql-mysql-data-seek res high32 low32)))