Re: patch: workaround for ooracle segfaults in unicode sbcl
James Bielman <[email protected]> Mon, 14 Nov 2005 15:51:09 -0800
| Newsgroups | gmane.lisp.clsql.devel |
|---|---|
| Organization | Hayton Systems, Inc. |
| Message-ID | <[email protected]> |
On Mon, 2005-11-14 at 10:30 -0700, Kevin Rosenberg wrote: > If it's really a SBCL bug, then perhaps the right place to move the > work-around is UFFI so that other applications wouldn't be affected by > the bug. If it is a bug in Oracle (which seems less likely), then > opening a support ticket with Oracle would make sense. I thought about this some more this afternoon, and I think I finally understand what's going on. The OCI functions are assuming the extent of the C strings lasts beyond the extent of the Lisp string on a Unicode SBCL, because it must make a temporary copy to convert a string to a SIMPLE-BASE-STRING. Really, this isn't an SBCL or a UFFI bug: it's just a bug in the Oracle backend, but only shows up currently in SBCL/Unicode because of the temporary string copy. The strings passed in other Lisps must last long enough (being on the stack of the calling function, etc). (I suspect other binding libraries have similar bugs; this would probably be a good thing to document somewhere...) After peering around in UFFI I realized there's no point in writing my STRDUP function, as UFFI already has what I need: WITH-FOREIGN-STRING. Here's 2 patches: a better fix for the Oracle backend and a patch adding WITH-FOREIGN-STRINGS to UFFI. Also, CONVERT-TO-FOREIGN-STRING in SBCL (and CMU, SCL) allocates an alien with type (UNSIGNED 8), not (SIGNED 8) as I would expect. Without a cast, you cannot pass such an alien to a :CSTRING parameter of an alien routine (hence my change in the OCI API functions to (* :unsigned-char). I was worried "fixing" this would break someone else's code that depends on this, but it seems fishy to me. PS. Is there a version control repository for CLSQL/UFFI? It would be handy to have something to generate diffs against instead of downloading the latest tarballs every release... James _______________________________________________ CLSQL-Devel mailing list [email protected] http://lists.b9.com/mailman/listinfo/clsql-devel
clsql-oracle-sb-unicode.diff
(text/x-patch, 7.3 KB)
diff -rN -u old-clsql-devel/db-oracle/oracle-api.lisp new-clsql-devel/db-oracle/oracle-api.lisp
--- old-clsql-devel/db-oracle/oracle-api.lisp 2005-11-13 22:28:17.000000000 -0800
+++ new-clsql-devel/db-oracle/oracle-api.lisp 2005-11-14 15:12:03.000000000 -0800
@@ -132,11 +132,11 @@
(envhp :pointer-void) ; env
(errhp :pointer-void) ; err
(svchpp (* :pointer-void)) ; svc
- (username :cstring) ; username
+ (username (* :unsigned-char)) ; username
(uname-len ub4) ;
- (passwd :cstring) ; passwd
+ (passwd (* :unsigned-char)) ; passwd
(password-len ub4) ;
- (dsn :cstring) ; datasource
+ (dsn (* :unsigned-char)) ; datasource
(dsn-len ub4)) ;
(def-oci-routine ("OCILogoff" oci-logoff)
@@ -159,7 +159,7 @@
:int
(stmtp :pointer-void)
(errhp :pointer-void)
- (stmt :cstring)
+ (stmt (* :unsigned-char))
(stmt_len ub4)
(language ub4)
(mode ub4))
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 23:01:40.000000000 -0800
+++ new-clsql-devel/db-oracle/oracle-sql.lisp 2005-11-14 15:17:24.000000000 -0800
@@ -498,46 +498,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)
+ (uffi:with-foreign-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 +796,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 +805,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 +821,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)
+ (uffi:with-foreign-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
uffi-with-foreign-strings.diff
(text/x-patch, 1 KB)
diff -ru uffi-1.5.6/src/package.lisp /home/jamesjb/.sbcl/site/uffi-1.5.5/src/package.lisp
--- uffi-1.5.6/src/package.lisp 2005-11-04 11:03:06.000000000 -0800
+++ /home/jamesjb/.sbcl/site/uffi-1.5.5/src/package.lisp 2005-11-14 15:16:44.000000000 -0800
@@ -63,6 +63,7 @@
#:convert-to-foreign-string
#:allocate-foreign-string
#:with-foreign-string
+ #:with-foreign-strings
#:foreign-string-length
;; function call
diff -ru uffi-1.5.6/src/strings.lisp /home/jamesjb/.sbcl/site/uffi-1.5.5/src/strings.lisp
--- uffi-1.5.6/src/strings.lisp 2005-07-05 17:35:14.000000000 -0700
+++ /home/jamesjb/.sbcl/site/uffi-1.5.5/src/strings.lisp 2005-11-14 15:16:25.000000000 -0800
@@ -284,6 +284,11 @@
(free-foreign-object ,foreign-string)
,result)))
+(defmacro with-foreign-strings (bindings &body body)
+ `(with-foreign-string ,(car bindings)
+ ,@(if (cdr bindings)
+ `((with-foreign-strings ,(cdr bindings) ,@body))
+ body)))
;; Modified from CMUCL's source to handle non-null terminated strings
#+cmu