make odbc-drivers more tolerant of bad attr strings
This commit is contained in:
parent
356c7fa937
commit
d94a1cf079
|
@ -75,18 +75,11 @@
|
||||||
(handle-status* 'odbc-data-sources (SQLFreeHandle SQL_HANDLE_ENV env))))))
|
(handle-status* 'odbc-data-sources (SQLFreeHandle SQL_HANDLE_ENV env))))))
|
||||||
|
|
||||||
(define (odbc-drivers)
|
(define (odbc-drivers)
|
||||||
(define driver-buf (make-bytes 1024))
|
(define driver-buf (make-bytes 1000))
|
||||||
|
(define attr-buf (make-bytes 2000))
|
||||||
(call-with-env 'odbc-drivers
|
(call-with-env 'odbc-drivers
|
||||||
(lambda (env)
|
(lambda (env)
|
||||||
(let* ([attrlens
|
(let ([result
|
||||||
(let loop ()
|
|
||||||
(let-values ([(status name attrlen)
|
|
||||||
(SQLDrivers env SQL_FETCH_NEXT driver-buf #f)])
|
|
||||||
(cond [(or (= status SQL_SUCCESS) (= status SQL_SUCCESS_WITH_INFO))
|
|
||||||
(cons attrlen (loop))]
|
|
||||||
[else null])))] ;; SQL_NO_DATA
|
|
||||||
[attr-buf (make-bytes (+ 1 (apply max 0 attrlens)))] ;; +1 for null terminator
|
|
||||||
[result
|
|
||||||
(let loop ()
|
(let loop ()
|
||||||
(let-values ([(status name attrlen) ;; & writes to attr-buf
|
(let-values ([(status name attrlen) ;; & writes to attr-buf
|
||||||
(SQLDrivers env SQL_FETCH_NEXT driver-buf attr-buf)])
|
(SQLDrivers env SQL_FETCH_NEXT driver-buf attr-buf)])
|
||||||
|
@ -99,14 +92,15 @@
|
||||||
|
|
||||||
(define (parse-driver-attrs buf len)
|
(define (parse-driver-attrs buf len)
|
||||||
(let* ([attrs (regexp-split #rx#"\0" buf 0 len)])
|
(let* ([attrs (regexp-split #rx#"\0" buf 0 len)])
|
||||||
|
(filter values
|
||||||
(for/list ([p (in-list attrs)]
|
(for/list ([p (in-list attrs)]
|
||||||
#:when (positive? (bytes-length p)))
|
#:when (positive? (bytes-length p)))
|
||||||
(let* ([s (bytes->string/utf-8 p)]
|
(let* ([s (bytes->string/utf-8 p)]
|
||||||
[m (regexp-match-positions #rx"=" s)])
|
[m (regexp-match-positions #rx"=" s)])
|
||||||
(unless m (error/internal 'odbc-drivers "bad attribute syntax: ~e" s))
|
;; Sometimes (eg iodbc on openbsd), returns ill-formatted attr-buf; just discard
|
||||||
|
(and m
|
||||||
(let ([=-pos (caar m)])
|
(let ([=-pos (caar m)])
|
||||||
(cons (substring s 0 =-pos) (substring s (+ 1 =-pos))))))))
|
(cons (substring s 0 =-pos) (substring s (+ 1 =-pos))))))))))
|
||||||
|
|
||||||
|
|
||||||
(define odbc-proxy%
|
(define odbc-proxy%
|
||||||
(class place-proxy-connection%
|
(class place-proxy-connection%
|
||||||
|
|
Loading…
Reference in New Issue
Block a user