conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* make string operations safe in all io layers.

This commit is contained in:
Abdulaziz Ghuloum 2007-05-17 05:41:00 -04:00
parent 5249a8ec31
commit 49dc13d5ee
10 changed files with 52 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
bin/ikarus
View File

Binary file not shown.

31
bin/ikarus-runtime.c
View File

@ -480,6 +480,7 @@ ikp ik_uuid(ikp str){
} }
#if 0
ikp ik_read(ikp fdptr, ikp bufptr, ikp lenptr){ ikp ik_read(ikp fdptr, ikp bufptr, ikp lenptr){
int fd = unfix(fdptr); int fd = unfix(fdptr);
int len = unfix(lenptr); int len = unfix(lenptr);
@ -491,7 +492,7 @@ ikp ik_read(ikp fdptr, ikp bufptr, ikp lenptr){
} }
return fix(bytes); return fix(bytes);
} }
#endif
ikp ik_write(ikp fdptr, ikp idx, ikp str){ ikp ik_write(ikp fdptr, ikp idx, ikp str){
fprintf(stderr, "IK_WRITE\n"); fprintf(stderr, "IK_WRITE\n");
@ -782,8 +783,8 @@ ikrt_close_file(ikp fd, ikpcb* pcb){
} }
} }
ikp static ikp
ikrt_read(ikp fd, ikp buff, ikpcb* pcb){ ikrt_read_to_string(ikp fd, ikp buff, ikpcb* pcb){
int bytes = int bytes =
read(unfix(fd), string_data(buff), unfix(ref(buff, off_string_length))); read(unfix(fd), string_data(buff), unfix(ref(buff, off_string_length)));
ikp fbytes = fix(bytes); ikp fbytes = fix(bytes);
@ -795,6 +796,30 @@ ikrt_read(ikp fd, ikp buff, ikpcb* pcb){
} }
} }
static ikp
ikrt_read_to_bytevector(ikp fd, ikp buff, ikpcb* pcb){
int bytes =
read(unfix(fd), buff+off_bytevector_data, unfix(ref(buff, off_bytevector_length)));
ikp fbytes = fix(bytes);
if (bytes == unfix(fbytes)){
return fbytes;
} else {
fprintf(stderr, "ERR: ikrt_read: too big\n");
exit(-1);
}
}
ikp ikrt_read(ikp fd, ikp buff, ikpcb* pcb){
if(tagof(buff) == string_tag){
return ikrt_read_to_string(fd,buff,pcb);
} else {
return ikrt_read_to_bytevector(fd,buff,pcb);
}
}
#if 0 #if 0
if(bytes == -1){ if(bytes == -1){
fprintf(stderr, "ERR=%s (%d)\n", strerror(errno), errno); fprintf(stderr, "ERR=%s (%d)\n", strerror(errno), errno);

BIN
src/ikarus.boot
View File

Binary file not shown.

2
src/ikarus.collect.ss
View File

@ -3,7 +3,7 @@
(export do-overflow do-overflow-words do-vararg-overflow collect (export do-overflow do-overflow-words do-vararg-overflow collect
do-stack-overflow) do-stack-overflow)
(import (import
(ikarus) (except (ikarus) collect)
(ikarus system $fx)) (ikarus system $fx))
(define do-overflow (define do-overflow

12
src/ikarus.io-ports.ss
View File

@ -52,7 +52,7 @@
;;; ;;;
(define $make-input-port (define $make-input-port
(lambda (handler buffer) (lambda (handler buffer)
($make-port/input handler buffer 0 ($string-length buffer) #f 0 0))) ($make-port/input handler buffer 0 (string-length buffer) #f 0 0)))
;;; ;;;
(define make-input-port (define make-input-port
(lambda (handler buffer) (lambda (handler buffer)
@ -64,7 +64,7 @@
;;; ;;;
(define $make-output-port (define $make-output-port
(lambda (handler buffer) (lambda (handler buffer)
($make-port/output handler #f 0 0 buffer 0 ($string-length buffer)))) ($make-port/output handler #f 0 0 buffer 0 (string-length buffer))))
;;; ;;;
(define make-output-port (define make-output-port
(lambda (handler buffer) (lambda (handler buffer)
@ -77,8 +77,8 @@
(define $make-input/output-port (define $make-input/output-port
(lambda (handler input-buffer output-buffer) (lambda (handler input-buffer output-buffer)
($make-port/both handler ($make-port/both handler
input-buffer 0 ($string-length input-buffer) input-buffer 0 (string-length input-buffer)
output-buffer 0 ($string-length output-buffer)))) output-buffer 0 (string-length output-buffer))))
;;; ;;;
(define make-input/output-port (define make-input/output-port
(lambda (handler input-buffer output-buffer) (lambda (handler input-buffer output-buffer)
@ -151,7 +151,7 @@
(if (input-port? p) (if (input-port? p)
(if (fixnum? i) (if (fixnum? i)
(if ($fx>= i 0) (if ($fx>= i 0)
(if ($fx<= i ($string-length ($port-input-buffer p))) (if ($fx<= i (string-length ($port-input-buffer p)))
(begin (begin
($set-port-input-index! p 0) ($set-port-input-index! p 0)
($set-port-input-size! p i)) ($set-port-input-size! p i))
@ -177,7 +177,7 @@
(if (output-port? p) (if (output-port? p)
(if (fixnum? i) (if (fixnum? i)
(if ($fx>= i 0) (if ($fx>= i 0)
(if ($fx<= i ($string-length ($port-output-buffer p))) (if ($fx<= i (string-length ($port-output-buffer p)))
(begin (begin
($set-port-output-index! p 0) ($set-port-output-index! p 0)
($set-port-output-size! p i)) ($set-port-output-size! p i))

8
src/ikarus.io-primitives.unsafe.ss
View File

@ -14,7 +14,7 @@
(let ([idx (port-output-index p)]) (let ([idx (port-output-index p)])
(if ($fx< idx ($port-output-size p)) (if ($fx< idx ($port-output-size p))
(begin (begin
($string-set! ($port-output-buffer p) idx c) (string-set! ($port-output-buffer p) idx c)
($set-port-output-index! p ($fxadd1 idx))) ($set-port-output-index! p ($fxadd1 idx)))
(($port-handler p) 'write-char c p))))) (($port-handler p) 'write-char c p)))))
@ -24,7 +24,7 @@
(if ($fx< idx ($port-input-size p)) (if ($fx< idx ($port-input-size p))
(begin (begin
($set-port-input-index! p ($fxadd1 idx)) ($set-port-input-index! p ($fxadd1 idx))
($string-ref ($port-input-buffer p) idx)) (string-ref ($port-input-buffer p) idx))
(begin (begin
(($port-handler p) 'read-char p)))))) (($port-handler p) 'read-char p))))))
@ -32,7 +32,7 @@
(lambda (p) (lambda (p)
(let ([idx ($port-input-index p)]) (let ([idx ($port-input-index p)])
(if ($fx< idx ($port-input-size p)) (if ($fx< idx ($port-input-size p))
($string-ref ($port-input-buffer p) idx) (string-ref ($port-input-buffer p) idx)
(($port-handler p) 'peek-char p))))) (($port-handler p) 'peek-char p)))))
(define $unread-char (define $unread-char
@ -42,7 +42,7 @@
($fx< idx ($port-input-size p))) ($fx< idx ($port-input-size p)))
(begin (begin
($set-port-input-index! p idx) ($set-port-input-index! p idx)
($string-set! ($port-input-buffer p) idx c)) (string-set! ($port-input-buffer p) idx c))
(($port-handler p) 'unread-char c p))))) (($port-handler p) 'unread-char c p)))))
(define $reset-input-port! (define $reset-input-port!

6
src/ikarus.io.input-files.ss
View File

@ -57,7 +57,7 @@
(if ($fx< idx ($port-input-size p)) (if ($fx< idx ($port-input-size p))
(begin (begin
($set-port-input-index! p ($fxadd1 idx)) ($set-port-input-index! p ($fxadd1 idx))
($string-ref ($port-input-buffer p) idx)) (string-ref ($port-input-buffer p) idx))
(if open? (if open?
(let ([bytes (let ([bytes
(foreign-call "ikrt_read" (foreign-call "ikrt_read"
@ -78,7 +78,7 @@
(error 'peek-char "~s is not an input port" p)) (error 'peek-char "~s is not an input port" p))
(let ([idx ($port-input-index p)]) (let ([idx ($port-input-index p)])
(if ($fx< idx ($port-input-size p)) (if ($fx< idx ($port-input-size p))
($string-ref ($port-input-buffer p) idx) (string-ref ($port-input-buffer p) idx)
(if open? (if open?
(let ([bytes (let ([bytes
(foreign-call "ikrt_read" fd (foreign-call "ikrt_read" fd
@ -101,7 +101,7 @@
($fx< idx ($port-input-size p))) ($fx< idx ($port-input-size p)))
(begin (begin
($set-port-input-index! p idx) ($set-port-input-index! p idx)
($string-set! ($port-input-buffer p) idx c)) (string-set! ($port-input-buffer p) idx c))
(if open? (if open?
(error 'unread-char "port ~s is closed" p) (error 'unread-char "port ~s is closed" p)
(error 'unread-char "too many unread-chars"))))] (error 'unread-char "too many unread-chars"))))]

6
src/ikarus.io.input-strings.ss
View File

@ -41,7 +41,7 @@
(if ($fx< idx ($port-input-size p)) (if ($fx< idx ($port-input-size p))
(begin (begin
($set-port-input-index! p ($fxadd1 idx)) ($set-port-input-index! p ($fxadd1 idx))
($string-ref ($port-input-buffer p) idx)) (string-ref ($port-input-buffer p) idx))
(if open? (if open?
(eof-object) (eof-object)
(error 'read-char "port ~s is closed" p))))] (error 'read-char "port ~s is closed" p))))]
@ -50,7 +50,7 @@
(error 'peek-char "~s is not an input port" p)) (error 'peek-char "~s is not an input port" p))
(let ([idx ($port-input-index p)]) (let ([idx ($port-input-index p)])
(if ($fx< idx ($port-input-size p)) (if ($fx< idx ($port-input-size p))
($string-ref ($port-input-buffer p) idx) (string-ref ($port-input-buffer p) idx)
(if open? (if open?
(eof-object) (eof-object)
(error 'peek-char "port ~s is closed" p))))] (error 'peek-char "port ~s is closed" p))))]
@ -62,7 +62,7 @@
($fx< idx ($port-input-size p))) ($fx< idx ($port-input-size p)))
(begin (begin
($set-port-input-index! p idx) ($set-port-input-index! p idx)
($string-set! ($port-input-buffer p) idx c)) (string-set! ($port-input-buffer p) idx c))
(if open? (if open?
(error 'unread-char "port ~s is closed" p) (error 'unread-char "port ~s is closed" p)
(error 'unread-char "too many unread-chars"))))] (error 'unread-char "too many unread-chars"))))]

2
src/ikarus.io.output-files.ss
View File

@ -70,7 +70,7 @@
(let ([idx ($port-output-index p)]) (let ([idx ($port-output-index p)])
(if ($fx< idx ($port-output-size p)) (if ($fx< idx ($port-output-size p))
(begin (begin
($string-set! ($port-output-buffer p) idx c) (string-set! ($port-output-buffer p) idx c)
($set-port-output-index! p ($fxadd1 idx))) ($set-port-output-index! p ($fxadd1 idx)))
(if open? (if open?
(begin (begin

12
src/ikarus.io.output-strings.ss
View File

@ -38,18 +38,18 @@
(define concat (define concat
(lambda (str i ls) (lambda (str i ls)
(let ([n (sum i ls)]) (let ([n (sum i ls)])
(let ([outstr ($make-string n)]) (let ([outstr (make-string n)])
(let f ([n (copy outstr str i n)] [ls ls]) (let f ([n (copy outstr str i n)] [ls ls])
(if (null? ls) (if (null? ls)
outstr outstr
(let ([a ($car ls)]) (let ([a ($car ls)])
(f (copy outstr a ($string-length a) n) ($cdr ls))))))))) (f (copy outstr a (string-length a) n) ($cdr ls)))))))))
(define sum (define sum
(lambda (ac ls) (lambda (ac ls)
(cond (cond
[(null? ls) ac] [(null? ls) ac]
[else (sum ($fx+ ac ($string-length ($car ls))) ($cdr ls))]))) [else (sum ($fx+ ac (string-length ($car ls))) ($cdr ls))])))
(define copy (define copy
(lambda (dst src n end) (lambda (dst src n end)
@ -59,7 +59,7 @@
[($fx= si 0) di] [($fx= si 0) di]
[else [else
(let ([di ($fxsub1 di)] [si ($fxsub1 si)]) (let ([di ($fxsub1 di)] [si ($fxsub1 si)])
($string-set! dst di ($string-ref src si)) (string-set! dst di (string-ref src si))
(f di si))])))) (f di si))]))))
(define make-output-string-handler (define make-output-string-handler
@ -75,7 +75,7 @@
(let ([idx ($port-output-index p)]) (let ([idx ($port-output-index p)])
(if ($fx< idx ($port-output-size p)) (if ($fx< idx ($port-output-size p))
(begin (begin
($string-set! ($port-output-buffer p) idx c) (string-set! ($port-output-buffer p) idx c)
($set-port-output-index! p ($fxadd1 idx))) ($set-port-output-index! p ($fxadd1 idx)))
(if open? (if open?
(begin (begin
@ -83,7 +83,7 @@
(cons (string-copy (port-output-buffer p)) (cons (string-copy (port-output-buffer p))
buffer-list)) buffer-list))
($set-port-output-size! p ($set-port-output-size! p
($string-length ($port-output-buffer p))) (string-length ($port-output-buffer p)))
($write-char c p)) ($write-char c p))
(error 'write-char "port ~s is closed" p)))) (error 'write-char "port ~s is closed" p))))
(error 'write-char "~s is not an output-port" p)) (error 'write-char "~s is not an output-port" p))