Update shell to use new (foreign c) and (retropikzel system). Make system now check that cmd is string.

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:

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)
+           (tmp-file (c-fopen (string->c-bytevector tmp-file-path)
-                              (string->c-utf8 "w"))))
+                              (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

retropikzel/shell.scm

@@ -1,17 +1,13 @@
-(define-c-library libc
+(define-c-library libc '("stdlib.h" "stdio.h" "unistd.h") #f '())
-                  '("stdlib.h" "stdio.h" "unistd.h")
-                  libc-name
-                  '((additional-versions ("0" "6"))))
-
 (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)

retropikzel/shell.sld

@@ -5,6 +5,7 @@
           (scheme read)
           (scheme file)
           (foreign c)
+          (retropikzel system)
           (retropikzel named-pipes))
   (export shell
           shell->list

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")
 

retropikzel/system/VERSION

@@ -1 +1 @@
-1.1.4
+1.1.5