From fd1a6e93db21ac2b8ef2fab7c4349df5713afe5d Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Thu, 21 Sep 2017 15:25:47 -0700 Subject: [PATCH] x11: Ensure C strings are null terminated. --- src/x11/x11-base.scm | 48 ++++++++++++++++++++++++++++------------ src/x11/x11-graphics.scm | 27 +++++----------------- src/x11/x11-terminal.scm | 29 +++++++++--------------- src/x11/x11.pkg | 5 +---- 4 files changed, 50 insertions(+), 59 deletions(-) diff --git a/src/x11/x11-base.scm b/src/x11/x11-base.scm index ed50a8b5a..8eb177e3f 100644 --- a/src/x11/x11-base.scm +++ b/src/x11/x11-base.scm @@ -52,6 +52,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (error "XAllocWMHints failed."))) (define (->bytes string) + ;; NOT null terminated (if (and (or (bytevector? string) (and (ustring? string) (fix:= 1 (ustring-cp-size string)))) @@ -68,14 +69,33 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (loop (fix:+ i 1))) #t))) +(define (->cstring string) + (if (bytevector? string) + (if (let ((end (bytevector-length string))) + (let loop ((i 0)) + (if (fix:< i end) + (or (fix:zero? (bytevector-u8-ref string i)) + (loop (fix:1+ i))) + #f))) + string + (error "C string not null terminated:" string)) + ;; String->iso8859-1 would be incorrect here; it does not null terminate. + (let* ((end (string-length string)) + (result (make-bytevector (fix:1+ end)))) + (do ((i 0 (fix:1+ i))) + ((not (fix:< i end)) + (bytevector-u8-set! result i #x00)) + (bytevector-u8-set! result i (char->integer (string-ref string i)))) + result))) + (define (x-window-set-name window name) (guarantee-xwindow window 'x-window-set-name) - (if (not (zero? (C-call "x_window_set_name" window (->bytes name)))) + (if (not (zero? (C-call "x_window_set_name" window (->cstring name)))) (error "XStringListToTextProperty failed."))) (define (x-window-set-icon-name window name) (guarantee-xwindow window 'x-window-set-icon-name) - (if (not (zero? (C-call "x_window_set_icon_name" window (->bytes name)))) + (if (not (zero? (C-call "x_window_set_icon_name" window (->cstring name)))) (error "XStringListToTextProperty failed."))) ;;; Open/Close @@ -84,7 +104,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (let ((alien (make-alien '(struct |xdisplay|)))) (C-call "x_open_display" alien (if (eq? #f display-name) 0 - (->bytes display-name))) + (->cstring display-name))) (if (alien-null? alien) (error "Could not open display:" display-name) alien))) @@ -104,7 +124,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (x-set-default-font display font-name) (guarantee-xdisplay display 'x-set-default-font) - (if (not (zero? (c-call "x_set_default_font" display (->bytes font-name)))) + (if (not (zero? (c-call "x_set_default_font" display (->cstring font-name)))) (error "Could not load font:" font-name))) ;;; Event Processing @@ -432,8 +452,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (x-display-get-default display resource-name class-name) (guarantee-xdisplay display 'x-display-get-default) - (let ((alien (C-call "x_display_get_default" (make-alien 'char) - display (->bytes resource-name) (->bytes class-name)))) + (let ((alien (C-call "x_display_get_default" (make-alien 'char) display + (->cstring resource-name) (->cstring class-name)))) (and (not (alien-null? alien)) (c-peek-cstring alien)))) @@ -487,7 +507,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (x-window-set-foreground-color window color) (guarantee-xwindow window 'x-window-set-foreground-color) (cond ((string? color) - (C-call "x_window_set_foreground_color_name" window (->bytes color))) + (C-call "x_window_set_foreground_color_name" window (->cstring color))) ((integer? color) (C-call "x_window_set_foreground_color_pixel" window color)) (else @@ -497,7 +517,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (x-window-set-background-color window color) (guarantee-xwindow window 'x-window-set-background-color) (cond ((string? color) - (C-call "x_window_set_background_color_name" window (->bytes color))) + (C-call "x_window_set_background_color_name" window (->cstring color))) ((integer? color) (C-call "x_window_set_background_color_pixel" window color)) (else @@ -507,7 +527,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (x-window-set-border-color window color) (guarantee-xwindow window 'x-window-set-border-color) (cond ((string? color) - (C-call "x_window_set_border_color_name" window (->bytes color))) + (C-call "x_window_set_border_color_name" window (->cstring color))) ((integer? color) (C-call "x_window_set_border_color_pixel" window color)) (else @@ -517,7 +537,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (x-window-set-cursor-color window color) (guarantee-xwindow window 'x-window-set-cursor-color) (cond ((string? color) - (C-call "x_window_set_cursor_color_name" window (->bytes color))) + (C-call "x_window_set_cursor_color_name" window (->cstring color))) ((integer? color) (C-call "x_window_set_cursor_color_pixel" window color)) (else @@ -527,7 +547,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (x-window-set-mouse-color window color) (guarantee-xwindow window 'x-window-set-mouse-color) (cond ((string? color) - (C-call "x_window_set_mouse_color_name" window (->bytes color))) + (C-call "x_window_set_mouse_color_name" window (->cstring color))) ((integer? color) (C-call "x_window_set_mouse_color_pixel" window color)) (else @@ -542,7 +562,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (x-window-set-font window font) (guarantee-xwindow window 'x-window-set-font) (guarantee string? font 'x-window-set-font) - (not (zero? (C-call "x_window_set_font" window (->bytes font))))) + (not (zero? (C-call "x_window_set_font" window (->cstring font))))) (define (x-window-set-border-width window width) (guarantee-xwindow window 'x-window-set-border-width) @@ -620,7 +640,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (guarantee-xdisplay display 'x-font-structure) (let ((font-struct (make-alien '(struct |XFontStruct|)))) (cond ((string? name/id) - (let ((name (->bytes name/id))) + (let ((name (->cstring name/id))) (add-alien-cleanup! font-struct (named-lambda (font-struct-init-by-name! copy) @@ -735,7 +755,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (x-intern-atom display name soft?) (guarantee-xdisplay display 'x-intern-atom) - (c-call "x_intern_atom" display (->bytes name) (if soft? 1 0))) + (c-call "x_intern_atom" display (->cstring name) (if soft? 1 0))) (define (x-get-atom-name display atom) diff --git a/src/x11/x11-graphics.scm b/src/x11/x11-graphics.scm index f160f5542..db4910fc4 100644 --- a/src/x11/x11-graphics.scm +++ b/src/x11/x11-graphics.scm @@ -58,23 +58,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (x-graphics-reconfigure window width height) (C-call "x_graphics_reconfigure" window width height)) -(define (->bytes string) - (if (and (or (bytevector? string) - (and (ustring? string) - (fix:= 1 (ustring-cp-size string)))) - (let ((end (string-length string))) - (every-loop (lambda (cp) (fix:< cp #x80)) - cp1-ref string 0 end))) - string - (string->iso8859-1 string))) - -(define-integrable (every-loop proc ref string start end) - (let loop ((i start)) - (if (fix:< i end) - (and (proc (ref string i)) - (loop (fix:+ i 1))) - #t))) - (define (x-graphics-open-window display geometry suppress-map) ;; Open a window on DISPLAY using GEOMETRY. If GEOMETRY is false ;; map window interactively. If third argument SUPPRESS-MAP? is @@ -99,9 +82,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (let ((window (c-call "x_graphics_open_window" (make-alien '(struct |xwindow|)) display - (->bytes geometry) - (->bytes name) - (->bytes class) + (->cstring geometry) + (->cstring name) + (->cstring class) (if map? 1 0)))) (if (alien-null? window) (error "Could not open window:" geometry)) @@ -137,12 +120,12 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (x-graphics-draw-string window x y string) ;; Draw characters in the current font at the given coordinates, with ;; transparent background. - (C-call "x_graphics_draw_string" window x y (->bytes string))) + (C-call "x_graphics_draw_string" window x y (->cstring string))) (define (x-graphics-draw-image-string window x y string) ;; Draw characters in the current font at the given coordinates, with ;; solid background. - (C-call "x_graphics_draw_image_string" window x y (->bytes string))) + (C-call "x_graphics_draw_image_string" window x y (->cstring string))) (define (x-graphics-set-function window function) (if (not (zero? (C-call "x_graphics_set_function" window function))) diff --git a/src/x11/x11-terminal.scm b/src/x11/x11-terminal.scm index 1cee3cb1e..548492901 100644 --- a/src/x11/x11-terminal.scm +++ b/src/x11/x11-terminal.scm @@ -75,9 +75,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (let ((window (c-call "xterm_open_window" (make-alien '(struct |xwindow|)) display - (string->utf8 geometry) - (string->utf8 name) - (string->utf8 class) + (->cstring geometry) + (->cstring name) + (->cstring class) (if map? 1 0)))) (if (alien-null? window) (error "Could not open xterm:" geometry)) @@ -109,23 +109,14 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. ((2) (error:bad-range-argument y 'xterm-write-char!)) ((3) (error:bad-range-argument highlight 'xterm-write-char!))))) -(define (all-ascii? string) - (let ((len (string-length string))) - (let loop ((i 0)) - (if (fix:< i len) - (and (char-ascii? (string-ref string i)) - (loop (fix:+ i 1))) - #t)))) - -(define (guarantee-all-ascii string operator) - (if (not (all-ascii? string)) - (error:wrong-type-argument string "an ASCII string" operator)) - string) - (define (xterm-write-substring! xterm x y string start end highlight) - (guarantee-all-ascii string 'xterm-write-substring!) - (let ((code (c-call "xterm_write_substring" - xterm x y (string->utf8 string) start end highlight))) + (let ((code (if (bytevector? string) + (c-call "xterm_write_substring" + xterm x y string start end highlight) + (c-call "xterm_write_substring" + xterm x y + (string->iso8859-1 string start end) + 0 (fix:- end start) highlight)))) (case code ((1) (error:bad-range-argument x 'xterm-write-substring!)) ((2) (error:bad-range-argument y 'xterm-write-substring!)) diff --git a/src/x11/x11.pkg b/src/x11/x11.pkg index 071ba2e4c..c67e3ae6b 100644 --- a/src/x11/x11.pkg +++ b/src/x11/x11.pkg @@ -38,6 +38,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. ustring-cp-size ustring?) (export (x11) + ->cstring x-visual-deallocate x-close-display x-close-all-displays @@ -141,10 +142,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define-package (x11 graphics) (files "x11-graphics") (parent (x11)) - (import (runtime ustring) - cp1-ref - ustring-cp-size - ustring?) (export (x11) x-graphics-set-vdc-extent x-graphics-vdc-extent -- 2.25.1