patch: workaround for ooracle segfaults in unicode sbcl
James Bielman <[email protected]> Sun, 13 Nov 2005 23:20:09 -0800
| Newsgroups | gmane.lisp.clsql.devel |
|---|---|
| Organization | Hayton Systems, Inc. |
| Message-ID | <[email protected]> |
Hi, I think I've come up with a reasonable workaround for the segfaults that occur when using the Oracle backend under SBCL. OCI functions appear to be extremely picky about the strings that are passed to them. When passing a Lisp string through the FFI directly to an OCI function it sometimes causes a segmentation fault deep within Oracle C functions. I'm not sure what's different about the string that gets passed to the C function under :SB-UNICODE. The attached patch implements a simple workaround for SBCL: before passing strings to OCI functions, I malloc some foreign memory to hold the string, then pass that to the C function. For other Lisps, WITH-OCI-STRINGS expands into UFFI:CONVERT-TO-CSTRING like before. I would love to figure out if this is an OCI bug or an SBCL issue, but so far I haven't been able to narrow it down to a test case without Oracle... I also removed some OCI calls that are, according to my testing, not necessary in DATABASE-CONNECT. CLSQL-ORACLE now passes all tests except :FDDL/BIG/1 (which has always failed AFAICT) on SBCL x86/x86-64 with or without SB-UNICODE. Hooray! James _______________________________________________ CLSQL-Devel mailing list [email protected] http://lists.b9.com/mailman/listinfo/clsql-devel
clsql-sb-unicode.diff
(text/x-patch, 8 KB)
diff -rN -u old-clsql-devel/db-oracle/oracle-sql.lisp new-clsql-devel/db-oracle/oracle-sql.lisp
--- old-clsql-devel/db-oracle/oracle-sql.lisp 2005-11-13 22:32:37.000000000 -0800
+++ new-clsql-devel/db-oracle/oracle-sql.lisp 2005-11-13 22:42:22.000000000 -0800
@@ -225,6 +225,49 @@
:unsigned-char))))
(if (string-equal str "NULL") nil str)))
+;;; Due to either bugs in OCI or SBCL, passing strings directly to OCI
+;;; functions causes segmentation faults on Unicode-enabled SBCLs. As
+;;; a workaround, we malloc our own buffer for strings before passing
+;;; them to OCI functions. [13-Nov-2005 JJB]
+
+#+sbcl
+(uffi:def-function "malloc"
+ ((size size_t))
+ :returning (* :char))
+
+#+sbcl
+(uffi:def-function "free"
+ ((ptr (* :char)))
+ :returning :void)
+
+;;; Create a malloc'ed copy of a Lisp string S and return it.
+#+sbcl
+(defun strdup (s)
+ (let ((ptr (malloc (1+ (length s)))))
+ (loop for i from 0
+ for ch across (coerce s 'simple-base-string)
+ do (setf (uffi:deref-array ptr '(:array :char) i) (char-code ch))
+ finally (setf (uffi:deref-array ptr '(:array :char) i) 0))
+ ptr))
+
+;;; Evalute BODY with Lisp strings bound to malloc'ed C strings. The
+;;; buffers will be free'd upon exit from BODY.
+#+sbcl
+(defmacro with-oci-strings (bindings &body body)
+ `(let (,@(loop for (var string) in bindings
+ collect `(,var (strdup ,string))))
+ (unwind-protect
+ (progn ,@body)
+ ,@(loop for (var nil) in bindings
+ collect `(free ,var)))))
+
+;;; Evaluate BODY with Lisp strings converted to foreign strings.
+#-sbcl
+(defmacro with-oci-strings (bindings &body body)
+ `(let (,@(loop for (var string) in bindings
+ collect `(,var (uffi:convert-to-cstring ,string))))
+ ,@body))
+
;; the OCI library, part Z: no-longer used logic to convert from
;; Oracle's binary date representation to Common Lisp's native date
;; representation
@@ -498,46 +541,47 @@
(defun sql-stmt-exec (sql-stmt-string db result-types field-names)
(with-slots (envhp svchp errhp) db
- (let ((stmthp (uffi:allocate-foreign-object :pointer-void))
- select-p)
+ (with-oci-strings ((c-stmt-string sql-stmt-string))
+ (let ((stmthp (uffi:allocate-foreign-object :pointer-void))
+ select-p)
- (uffi:with-foreign-object (stmttype :unsigned-short)
- (unwind-protect
- (progn
- (oci-handle-alloc (deref-vp envhp)
- stmthp
- +oci-htype-stmt+ 0 +null-void-pointer-pointer+)
- (oci-stmt-prepare (deref-vp stmthp)
- (deref-vp errhp)
- (uffi:convert-to-cstring sql-stmt-string)
- (length sql-stmt-string)
- +oci-ntv-syntax+ +oci-default+ :database db)
- (oci-attr-get (deref-vp stmthp)
- +oci-htype-stmt+
- stmttype
- +unsigned-int-null-pointer+
- +oci-attr-stmt-type+
- (deref-vp errhp)
- :database db)
-
- (setq select-p (= (uffi:deref-pointer stmttype :unsigned-short) 1))
- (let ((iters (if select-p 0 1)))
-
- (oci-stmt-execute (deref-vp svchp)
- (deref-vp stmthp)
- (deref-vp errhp)
- iters 0 +null-void-pointer+ +null-void-pointer+ +oci-default+
- :database db)))
- ;; free resources unless a query
- (unless select-p
- (oci-handle-free (deref-vp stmthp) +oci-htype-stmt+)
- (uffi:free-foreign-object stmthp))))
-
- (cond
- (select-p
- (make-query-cursor db stmthp result-types field-names))
- (t
- nil)))))
+ (uffi:with-foreign-object (stmttype :unsigned-short)
+ (unwind-protect
+ (progn
+ (oci-handle-alloc (deref-vp envhp)
+ stmthp
+ +oci-htype-stmt+ 0 +null-void-pointer-pointer+)
+ (oci-stmt-prepare (deref-vp stmthp)
+ (deref-vp errhp)
+ c-stmt-string
+ (length sql-stmt-string)
+ +oci-ntv-syntax+ +oci-default+ :database db)
+ (oci-attr-get (deref-vp stmthp)
+ +oci-htype-stmt+
+ stmttype
+ +unsigned-int-null-pointer+
+ +oci-attr-stmt-type+
+ (deref-vp errhp)
+ :database db)
+
+ (setq select-p (= (uffi:deref-pointer stmttype :unsigned-short) 1))
+ (let ((iters (if select-p 0 1)))
+
+ (oci-stmt-execute (deref-vp svchp)
+ (deref-vp stmthp)
+ (deref-vp errhp)
+ iters 0 +null-void-pointer+ +null-void-pointer+ +oci-default+
+ :database db)))
+ ;; free resources unless a query
+ (unless select-p
+ (oci-handle-free (deref-vp stmthp) +oci-htype-stmt+)
+ (uffi:free-foreign-object stmthp))))
+
+ (cond
+ (select-p
+ (make-query-cursor db stmthp result-types field-names))
+ (t
+ nil))))))
;; Return a QUERY-CURSOR representing the table returned from the OCI
@@ -795,6 +839,7 @@
(oci-env-create envhp +oci-default+ +null-void-pointer+
+null-void-pointer+ +null-void-pointer+
+null-void-pointer+ 0 +null-void-pointer-pointer+)
+
#+oci7
(progn
(oci-initialize +oci-object+ +null-void-pointer+ +null-void-pointer+
@@ -803,27 +848,12 @@
+oci-htype-env+ 0
+null-void-pointer-pointer+)) ;no testing return
(oci-env-init envhp +oci-default+ 0 +null-void-pointer-pointer+))
+
(oci-handle-alloc (deref-vp envhp) errhp
+oci-htype-error+ 0 +null-void-pointer-pointer+)
(oci-handle-alloc (deref-vp envhp) srvhp
+oci-htype-server+ 0 +null-void-pointer-pointer+)
- #+ignore ;; not used since CLSQL uses the OCILogon function instead
- (uffi:with-cstring (dblink nil)
- (oci-server-attach (deref-vp srvhp)
- (deref-vp errhp)
- dblink
- 0 +oci-default+))
-
- (oci-handle-alloc (deref-vp envhp) svchp
- +oci-htype-svcctx+ 0 +null-void-pointer-pointer+)
- (oci-attr-set (deref-vp svchp)
- +oci-htype-svcctx+
- (deref-vp srvhp) 0 +oci-attr-server+
- (deref-vp errhp))
- ;; oci-handle-alloc((dvoid *)encvhp, (dvoid **)&stmthp, OCI_HTYPE_STMT, 0, 0);
- ;;#+nil
-
(let ((db (make-instance 'oracle-database
:name (database-name-from-spec connection-spec
database-type)
@@ -834,13 +864,16 @@
:svchp svchp
:dsn data-source-name
:user user)))
- (oci-logon (deref-vp envhp)
- (deref-vp errhp)
- svchp
- (uffi:convert-to-cstring user) (length user)
- (uffi:convert-to-cstring password) (length password)
- (uffi:convert-to-cstring data-source-name) (length data-source-name)
- :database db)
+ (with-oci-strings ((c-user user)
+ (c-password password)
+ (c-data-source-name data-source-name))
+ (oci-logon (deref-vp envhp)
+ (deref-vp errhp)
+ svchp
+ c-user (length user)
+ c-password (length password)
+ c-data-source-name (length data-source-name)
+ :database db))
;; :date-format-length (1+ (length date-format)))))
(setf (slot-value db 'clsql-sys::state) :open)
(database-execute-command