Derick Eddington
2009-04-07 12:38:13 UTC
I've implemented SRFI 98: An Interface to Access Environment Variables.
I've used the FFI in order to access the C environ variable and to do my
own transcoding of strings. This is my first time using Larceny's FFI,
so I would like to know if what I've done is correct or if it could be
done better, and I have some other questions (noted in the source code).
Also, attached is a little test program; it works for me.
Also, the document at doc/LarcenyNotes/note7-ffi.html says of ffi/dlsym
"handle can be #f, which means that the symbol will be resolved in the
symbol table of the running program", but that's no longer true; is this
intentional?
(library (srfi :98 os-environment-variables)
(export
get-environment-variable get-environment-variables)
(import
(rnrs base)
(rnrs control)
(rnrs bytevectors)
(rnrs io ports)
(primitives
foreign-procedure #;foreign-variable foreign-null-pointer? sizeof:pointer
%peek-pointer %peek8u void*->address ffi/dlopen ffi/dlsym))
;; TODO: Will the convenient string converters use the native transcoder in
;; the future? So that scheme-str->c-str-bv and c-str-ptr->scheme-str
;; won't be needed.
(define (scheme-str->c-str-bv x)
(let* ((bv (string->bytevector x (native-transcoder)))
(len (bytevector-length bv))
(bv/z (make-bytevector (+ 1 len))))
(bytevector-copy! bv 0 bv/z 0 len)
(bytevector-u8-set! bv/z len 0)
bv/z))
(define (c-str-ptr->scheme-str x)
(let loop ((x x) (a '()))
(let ((b (%peek8u x)))
(if (zero? b)
(bytevector->string (u8-list->bytevector (reverse a))
(native-transcoder))
(loop (+ 1 x) (cons b a))))))
(define getenv
(foreign-procedure "getenv" '(boxed) 'void*))
(define (get-environment-variable name)
(unless (string? name)
(assertion-violation 'get-environment-variable "not a string" name))
(let ((p (getenv (scheme-str->c-str-bv name))))
(and p
(c-str-ptr->scheme-str (void*->address p)))))
;; TODO: Will foreign-variable support a pointer type in the future?
;; Would this be the correct way to use it?
#;(define environ
(foreign-variable "environ" 'void*))
;; TODO: Is (ffi/dlopen "") okay? It works for me.
(define environ
(%peek-pointer (ffi/dlsym (ffi/dlopen "") "environ")))
(define (get-environment-variables)
(define (entry->pair x)
(let* ((s (c-str-ptr->scheme-str x))
(len (string-length s)))
(let loop ((i 0))
(if (< i len)
(if (char=? #\= (string-ref s i))
(cons (substring s 0 i)
(substring s (+ 1 i) len))
(loop (+ 1 i)))
(cons s #F)))))
(let loop ((e environ) (a '()))
(let ((entry (%peek-pointer e)))
(if (foreign-null-pointer? entry)
a
(loop (+ sizeof:pointer e)
(cons (entry->pair entry) a))))))
)
I've used the FFI in order to access the C environ variable and to do my
own transcoding of strings. This is my first time using Larceny's FFI,
so I would like to know if what I've done is correct or if it could be
done better, and I have some other questions (noted in the source code).
Also, attached is a little test program; it works for me.
Also, the document at doc/LarcenyNotes/note7-ffi.html says of ffi/dlsym
"handle can be #f, which means that the symbol will be resolved in the
symbol table of the running program", but that's no longer true; is this
intentional?
(library (srfi :98 os-environment-variables)
(export
get-environment-variable get-environment-variables)
(import
(rnrs base)
(rnrs control)
(rnrs bytevectors)
(rnrs io ports)
(primitives
foreign-procedure #;foreign-variable foreign-null-pointer? sizeof:pointer
%peek-pointer %peek8u void*->address ffi/dlopen ffi/dlsym))
;; TODO: Will the convenient string converters use the native transcoder in
;; the future? So that scheme-str->c-str-bv and c-str-ptr->scheme-str
;; won't be needed.
(define (scheme-str->c-str-bv x)
(let* ((bv (string->bytevector x (native-transcoder)))
(len (bytevector-length bv))
(bv/z (make-bytevector (+ 1 len))))
(bytevector-copy! bv 0 bv/z 0 len)
(bytevector-u8-set! bv/z len 0)
bv/z))
(define (c-str-ptr->scheme-str x)
(let loop ((x x) (a '()))
(let ((b (%peek8u x)))
(if (zero? b)
(bytevector->string (u8-list->bytevector (reverse a))
(native-transcoder))
(loop (+ 1 x) (cons b a))))))
(define getenv
(foreign-procedure "getenv" '(boxed) 'void*))
(define (get-environment-variable name)
(unless (string? name)
(assertion-violation 'get-environment-variable "not a string" name))
(let ((p (getenv (scheme-str->c-str-bv name))))
(and p
(c-str-ptr->scheme-str (void*->address p)))))
;; TODO: Will foreign-variable support a pointer type in the future?
;; Would this be the correct way to use it?
#;(define environ
(foreign-variable "environ" 'void*))
;; TODO: Is (ffi/dlopen "") okay? It works for me.
(define environ
(%peek-pointer (ffi/dlsym (ffi/dlopen "") "environ")))
(define (get-environment-variables)
(define (entry->pair x)
(let* ((s (c-str-ptr->scheme-str x))
(len (string-length s)))
(let loop ((i 0))
(if (< i len)
(if (char=? #\= (string-ref s i))
(cons (substring s 0 i)
(substring s (+ 1 i) len))
(loop (+ 1 i)))
(cons s #F)))))
(let loop ((e environ) (a '()))
(let ((entry (%peek-pointer e)))
(if (foreign-null-pointer? entry)
a
(loop (+ sizeof:pointer e)
(cons (entry->pair entry) a))))))
)
--
: Derick
----------------------------------------------------------------
: Derick
----------------------------------------------------------------