make odbc-drivers more tolerant of bad attr strings

This commit is contained in:
Ryan Culpepper 2013-09-13 17:58:44 -04:00
parent 356c7fa937
commit d94a1cf079

View File

@ -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%