diff --git a/Makefile b/Makefile index f6fec66..37e4279 100644 --- a/Makefile +++ b/Makefile @@ -51,7 +51,7 @@ init-venv: build run-test: init-venv if [ "${RNRS}" = "r6rs" ]; then ./venv/bin/scheme-compile venv/test.sps; fi - if [ "${RNRS}" = "r7rs" ]; then VENV_CSC_ARGS="-L -lcurl" ./venv/bin/scheme-compile venv/test.scm; fi + if [ "${RNRS}" = "r7rs" ]; then CSC_OPTIONS="-L -lcurl" ./venv/bin/scheme-compile venv/test.scm; fi ./venv/test test-r7rs: diff --git a/retropikzel/requests.scm b/retropikzel/requests.scm index 202834c..2d42f5f 100644 --- a/retropikzel/requests.scm +++ b/retropikzel/requests.scm @@ -13,7 +13,7 @@ (define CURLINFO-COOKIELIST 4194332) (define randomized? #f) -(define-c-library libc '("stdlib.h" "stdio.h" "time.h") libc-name '((additional-versions ("6")))) +(define-c-library libc '("stdlib.h" "stdio.h" "time.h") #f '()) (define-c-procedure c-fopen libc 'fopen 'pointer '(pointer pointer)) (define-c-procedure c-fclose libc 'fclose 'int '(pointer)) (define-c-procedure c-time libc 'time 'int '(pointer)) @@ -49,7 +49,7 @@ (define (random-to max) (when (not randomized?) - (c-srand (c-time (make-c-null))) + (c-srand (c-time (c-bytevector-null))) (set! randomized? #t)) (modulo (c-rand) max)) @@ -80,7 +80,7 @@ (define handle-errors (lambda (result) (when (not (= result 0)) - (error (c-utf8->string (curl-easy-strerror result)))) + (error (c-bytevector->string (curl-easy-strerror result)))) result)) (define handle (curl-easy-init)) @@ -114,21 +114,21 @@ (pointer (make-c-bytevector (c-type-size 'long)))) (curl-easy-getinfo handle CURLINFO-RESPONSE-CODE pointer) (let ((code (c-bytevector-ref pointer 'int 0))) - (c-free pointer) + (c-bytevector-free pointer) code))) (define (set-body handle body) - (curl-easy-setopt-pointer handle CURLOPT-POSTFIELDS (string->c-utf8 body)) + (curl-easy-setopt-pointer handle CURLOPT-POSTFIELDS (string->c-bytevector body)) (curl-easy-setopt-int handle CURLOPT-POSTFIELDSIZE (string-length body))) (define (set-headers handle headers) - (let ((headers-slist (make-c-null))) + (let ((headers-slist (c-bytevector-null))) (for-each (lambda (header) (set! headers-slist (curl-slist-append headers-slist - (string->c-utf8 (string-append (if (symbol? (car header)) + (string->c-bytevector (string-append (if (symbol? (car header)) (symbol->string (car header)) (car header)) ":" @@ -143,14 +143,14 @@ CURLHE-HEADER 0 previous-header-struct))) - (if (c-null? header-struct) + (if (c-bytevector-null? header-struct) result (let* ((name (string->symbol (string-downcase - (c-utf8->string + (c-bytevector->string (c-bytevector-ref header-struct 'pointer 0))))) - (value (c-utf8->string (c-bytevector-ref header-struct + (value (c-bytevector->string (c-bytevector-ref header-struct 'pointer (c-type-size 'pointer))))) (get-headers handle header-struct (append result @@ -183,7 +183,7 @@ (cdr header)) "; "))) cookies) - (curl-easy-setopt-pointer handle CURLOPT-COOKIE (string->c-utf8 cookies-string)))) + (curl-easy-setopt-pointer handle CURLOPT-COOKIE (string->c-bytevector cookies-string)))) (define request (lambda (method url . options) @@ -194,20 +194,20 @@ (tmp-file-path (if download-path (cdr download-path) (random-temp-file))) - (tmp-file (c-fopen (string->c-utf8 tmp-file-path) - (string->c-utf8 "w")))) + (tmp-file (c-fopen (string->c-bytevector tmp-file-path) + (string->c-bytevector "w")))) (curl-easy-setopt-pointer handle CURLOPT-CUSTOMREQUEST - (string->c-utf8 + (string->c-bytevector (string-upcase (symbol->string method)))) (curl-easy-setopt-pointer handle CURLOPT-WRITEDATA tmp-file) - (curl-easy-setopt-pointer handle CURLOPT-URL (string->c-utf8 url)) + (curl-easy-setopt-pointer handle CURLOPT-URL (string->c-bytevector url)) (when headers (set-headers handle (cdr headers))) (when cookies (set-cookies handle (cdr cookies))) (when body (set-body handle (cdr body))) (handle-errors (curl-easy-perform handle)) (c-fclose tmp-file) - (let* ((headers (get-headers handle (make-c-null) (list))) + (let* ((headers (get-headers handle (c-bytevector-null) (list))) (response (make-response (slurp-bytes tmp-file-path) ;(get-cookies handle) headers diff --git a/retropikzel/shell.scm b/retropikzel/shell.scm index 0d6ede2..3ea04ae 100644 --- a/retropikzel/shell.scm +++ b/retropikzel/shell.scm @@ -1,17 +1,13 @@ -(define-c-library libc - '("stdlib.h" "stdio.h" "unistd.h") - libc-name - '((additional-versions ("0" "6")))) - +(define-c-library libc '("stdlib.h" "stdio.h" "unistd.h") #f '()) (define-c-procedure c-tempnam libc 'tempnam 'pointer '(pointer pointer)) -(define-c-procedure c-system libc 'system 'int '(pointer)) (define previous-exit-code #f) (define (shell cmd) - (let* ((temp-prefix (string->c-utf8 "npcmd")) + (when (not (string? cmd)) (error "shell: cmd must be string" cmd)) + (let* ((temp-prefix (string->c-bytevector "npcmd")) (temp-name (lambda () - (c-utf8->string (c-tempnam (make-c-null) + (c-bytevector->string (c-tempnam (c-bytevector-null) temp-prefix)))) (input-path (temp-name)) (shell-command (string-append cmd @@ -21,7 +17,7 @@ input-path " & "))) (create-pipe input-path 0777) - (set! previous-exit-code (c-system (string->c-utf8 shell-command))) + (set! previous-exit-code (system shell-command)) (pipe-read-string 64000 (open-input-pipe input-path #t)))) (define (lines->list port result) diff --git a/retropikzel/shell.sld b/retropikzel/shell.sld index 1fdc677..213710c 100644 --- a/retropikzel/shell.sld +++ b/retropikzel/shell.sld @@ -5,6 +5,7 @@ (scheme read) (scheme file) (foreign c) + (retropikzel system) (retropikzel named-pipes)) (export shell shell->list diff --git a/retropikzel/shell/test.scm b/retropikzel/shell/test.scm index 1020d27..d1496c2 100644 --- a/retropikzel/shell/test.scm +++ b/retropikzel/shell/test.scm @@ -1,9 +1,3 @@ -(import (scheme base) - (scheme write) - (scheme file) - (scheme process-context) - (retropikzel shell) - (srfi 64)) (test-begin "shell") diff --git a/retropikzel/system/VERSION b/retropikzel/system/VERSION index 65087b4..e25d8d9 100644 --- a/retropikzel/system/VERSION +++ b/retropikzel/system/VERSION @@ -1 +1 @@ -1.1.4 +1.1.5