Improvements to pstk

.gitignore

@@ -22,3 +22,5 @@ test-r7rs
 example.scm
 example.sps
 example
+venv
+foreign

Makefile

@@ -1,6 +1,7 @@
 .SILENT: build install test-r6rs test-r6rs-docker test-r7rs test-r7rs-docker clean
 .PHONY: test-r6rs test-r7rs example.scm example.sps
 SCHEME=chibi
+RNRS=r7rs
 LIBRARY=system
 EXAMPLE=editor
 EXAMPLE_FILE=retropikzel/${LIBRARY}/examples/${EXAMPLE}
@@ -22,8 +23,9 @@ endif
 all: build
 
 build: retropikzel/${LIBRARY}/LICENSE retropikzel/${LIBRARY}/VERSION
-	echo "<pre>$$(cat retropikzel/${LIBRARY}/README.md)</pre>" > ${README}
+	@rm -rf *.tgz
-	snow-chibi package --version=${VERSION} --authors=${AUTHOR} --doc=${README} --description="${DESCRIPTION}" ${LIBRARY_FILE}
+	@echo "<pre>$$(cat retropikzel/${LIBRARY}/README.md)</pre>" > ${README}
+	@snow-chibi package --version=${VERSION} --authors=${AUTHOR} --doc=${README} --description="${DESCRIPTION}" ${LIBRARY_FILE}
 
 install:
 	snow-chibi install --impls=${SCHEME} ${SNOW_CHIBI_ARGS} ${PKG}
@@ -31,6 +33,29 @@ install:
 uninstall:
 	-snow-chibi remove --impls=${SCHEME} ${PKG}
 
+init-venv: build
+	@rm -rf venv
+	@scheme-venv ${SCHEME} ${RNRS} venv
+	@echo "(import (scheme base) (scheme write) (scheme read) (scheme char) (scheme file) (scheme process-context) (srfi 64) (retropikzel ${LIBRARY}))" > venv/test.scm
+	@printf "#!r6rs\n(import (rnrs) (srfi :64) (retropikzel ${LIBRARY}))" > venv/test.sps
+	@cat ${TESTFILE} >> venv/test.scm
+	@cat ${TESTFILE} >> venv/test.sps
+	@if [ "${RNRS}" = "r6rs" ]; then if [ -d ../foreign-c ]; then cp -r ../foreign-c/foreign venv/lib/; fi; fi
+	@if [ "${RNRS}" = "r6rs" ]; then cp -r retropikzel venv/lib/; fi
+	@if [ "${SCHEME}" = "chezs" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
+	@if [ "${SCHEME}" = "ikarus" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
+	@if [ "${SCHEME}" = "ironscheme" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
+	@if [ "${SCHEME}" = "racket" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
+	@if [ "${RNRS}" = "r6rs" ]; then ./venv/bin/akku install; fi
+	@if [ "${SCHEME}" = "chicken" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi
+	@if [ "${SCHEME}-${RNRS}" = "mosh-r7rs" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi
+	@if [ "${RNRS}" = "r7rs" ]; then ./venv/bin/snow-chibi install ${PKG}; fi
+
+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
+	./venv/test
+
 test-r7rs:
 	echo "(import (scheme base) (scheme write) (scheme file) (scheme process-context) (foreign c) (retropikzel ${LIBRARY}) (srfi 64))" > test-r7rs.scm
 	cat retropikzel/${LIBRARY}/test.scm >> test-r7rs.scm

README.md

@@ -0,0 +1,7 @@
+To install library run
+
+    make SCHEME=chibi LIBRARY=named-pipes build install
+
+
+Change chibi to any other implementation supported by snow-chibi, and library
+to any filename without suffix in retropikzel/*.sld

retropikzel/named-pipes.scm

@@ -8,7 +8,7 @@
 
 ;(define-c-procedure c-system libc-stdlib 'system 'int '(pointer))
 (define-c-procedure c-mkfifo libc-stdlib 'mkfifo 'int '(pointer int))
-(define-c-procedure c-open libc-stdlib 'open 'int '(pointer int))
+(define-c-procedure c-open libc-stdlib 'open 'int '(pointer int int))
 (define-c-procedure c-read libc-stdlib 'read 'int '(int pointer int))
 (define-c-procedure c-write libc-stdlib 'write 'int '(int pointer int))
 (define-c-procedure c-close libc-stdlib 'close 'int '(int))
@@ -33,10 +33,15 @@
 (define O_WRONLY+O_CREAT 65)
 (define O_WRONLY+O_NONBLOCK+O_CREAT 2113)
 
+(define S_IRUSR-S_IWUSR 384)
+
 (define handle-c-errors
   (lambda (msg return-code)
     (when (and (number? return-code)
                (< return-code 0))
+      (display "HERE: ")
+      (write return-code)
+      (newline)
       (c-perror (string->c-utf8 msg))
       (error msg return-code))
     return-code))
@@ -46,11 +51,13 @@
     (let* ((path* (string->c-utf8 path))
            (octal-mode (string->number (string-append "#o"
                                                       (number->string mode)))))
-      (handle-c-errors (string-append "open-output-pipe mkfifo"
+      (handle-c-errors (string-append "open-output-pipe mkfifo: "
-                                      " "
+                                      " path: "
                                       path
-                                      " "
+                                      ", mode: "
-                                      (number->string mode))
+                                      (number->string mode)
+                                      ", octal-mode: "
+                                      (number->string octal-mode))
                        (c-mkfifo path* octal-mode)))))
 
 (define open-input-pipe
@@ -61,7 +68,8 @@
                                       (c-open (string->c-utf8 path)
                                               (if (null? block?)
                                                 O_RDONLY+O_NONBLOCK+O_CREAT
-                                                O_RDONLY+O_CREAT))))))
+                                                O_RDONLY+O_CREAT)
+                                              S_IRUSR-S_IWUSR)))))
 
 (define open-output-pipe
   (lambda (path . block?)
@@ -72,7 +80,8 @@
                                        (c-open (string->c-utf8 path)
                                                (if (null? block?)
                                                  O_WRONLY+O_NONBLOCK+O_CREAT
-                                                 O_WRONLY+O_CREAT))))))
+                                                 O_WRONLY+O_CREAT)
+                                               S_IRUSR-S_IWUSR)))))
 
 (define pipe-read-u8-buffer (make-c-bytevector (c-type-size 'u8)))
 (define pipe-read-u8

retropikzel/named-pipes/VERSION

@@ -1 +1 @@
-0.2.0
+1.0.1

retropikzel/named-pipes/test.scm

@@ -1,7 +1,3 @@
-(import (scheme base)
-        (scheme file)
-        (scheme write)
-        (retropikzel named-pipes))
 
 (define pipe-path "/tmp/named-pipes-test")
 (when (file-exists? pipe-path) (delete-file pipe-path))
@@ -65,7 +61,7 @@
 (newline)
 (define should-be-eof (pipe-read-line input))
 (when (not (eof-object? should-be-eof))
-  (error "Reading line from empty buffer should eof"))
+  (error "Reading line from empty buffer should eof" should-be-eof))
 (define line (string-append "Hello world" (string #\newline)))
 (define expected-output-line "Hello world")
 (pipe-write-string line output)
@@ -84,7 +80,7 @@
 (newline)
 (set! should-be-eof (pipe-read input))
 (when (not (eof-object? should-be-eof))
-  (error "Reading from empty buffer should eof"))
+  (error "Reading from empty buffer should eof" should-be-eof))
 (define text1 (string-append "Hello world" (string #\newline)))
 (pipe-write-string text1 output)
 (define output-text1 (pipe-read input))

retropikzel/pstk.scm

@@ -1,6 +1,5 @@
-(random-source-randomize! default-random-source)
-
 (define (temp-name)
+  (random-source-randomize! default-random-source)
   (let ((file (string-append "/tmp/pstk-"
                              (number->string (random-integer 1000))
                              "-"
@@ -21,28 +20,41 @@
 (define (shell-command program output-path input-path)
   (string-append program " < " output-path " 1> " input-path " & "))
 
-(define wish-newline
+(define wish-newline (lambda (pipe) (pipe-write-char #\newline pipe)))
-  (lambda (pipe)
-    (pipe-write-char #\newline pipe)))
 (define wish-flush (lambda () #t)) ; No need to do anything
 (define wish-read-line pipe-read-line)
+(define input-pipe-path (temp-name))
+(define output-pipe-path (temp-name))
+(define input-pipe #f)
+(define output-pipe #f)
 (define (run-program program)
-  (let* ((input-path (temp-name))
+    (create-pipe input-pipe-path 0777)
-         (output-path (temp-name)))
+    (create-pipe output-pipe-path 0777)
-    (create-pipe input-path 0777)
+    (system (shell-command program output-pipe-path input-pipe-path))
-    (create-pipe output-path 0777)
+    (set! input-pipe (open-input-pipe input-pipe-path))
-    (system (shell-command program output-path input-path))
+    (set! output-pipe (open-output-pipe output-pipe-path))
-    (list (open-input-pipe input-path)
+    (list input-pipe output-pipe))
-          (open-output-pipe output-path))))
 
 (define *wish-program* "tclsh")
 (define *wish-debug-input* (if (get-environment-variable "PSTK_DEBUG") #t #f))
 (define *wish-debug-output* (if (get-environment-variable "PSTK_DEBUG") #t #f))
 
-(define *use-keywords?* #t)
+(define *use-keywords?*
+  (cond-expand
+    (stklos #t)
+    (else #f)))
 
-(define (keyword? x) #f)        ;; TODO: handle keywords?
+(define (%keyword? x)
-(define (keyword->string x) x)
+  (cond-expand
+    (kawa (keyword? x))
+    (srfi-88 (keyword? x))
+    (else (error "Keywords not supported" x))))
+
+(define (%keyword->string x)
+  (cond-expand
+    (kawa (keyword->string x))
+    (stklos (keyword->string x))
+    (else (error "Keywords not supported" x))))
 
 (define nl (string #\newline))
 
@@ -146,16 +158,11 @@
   (lambda (x)
     (newline)
     (display x)
-    (newline)
+    (newline)))
-    ; (bottom x)
-    ))
-
-
 
 (define option?
   (lambda (x)
-    (or (and *use-keywords?*
+    (or (and *use-keywords?* (%keyword? x))
-             (keyword? x))
         (and (symbol? x)
              (let* ((s (symbol->string x))
                     (n (string-length s)))
@@ -163,12 +170,11 @@
 
 (define make-option-string
   (lambda (x)
-    (if (and *use-keywords?*
+    (if (and *use-keywords?* (%keyword? x))
-             (keyword? x))
+      (string-append " -" (%keyword->string x))
-      (string-append " -" (keyword->string x))
+      (let* ((s (symbol->string x))
-      (let ((s (symbol->string x)))
+             (option (string-append " -" (substring s 0 (- (string-length s) 1)))))
-        (string-append " -"
+        option))))
-                       (substring s 0 (- (string-length s) 1)))))))
 
 (define improper-list->string
   (lambda (a first)
@@ -193,6 +199,7 @@
                                  (improper-list->string x #t))
                           ")"))
           ((eof-object? x) "#<eof>")
+          ((and *use-keywords?* (%keyword? x)) (%keyword->string x))
           (else "#<unspecified>"))))
 
 (define string-translate
@@ -424,9 +431,7 @@
 
 (define scheme-arglist->tk-argstring
   (lambda (args)
-    (apply string-append
+    (apply string-append (map scheme-arg->tk-arg args))))
-           (map scheme-arg->tk-arg
-                args))))
 
 (define make-wish-func
   (lambda (tkname)
@@ -552,7 +557,11 @@
 (define tk-end
   (lambda ()
     (set! tk-is-running #f)
-    (wish "after 200 exit")))
+    (wish "after 200 exit")
+    (close-pipe input-pipe)
+    (close-pipe output-pipe)
+    (delete-file input-pipe-path)
+    (delete-file output-pipe-path)))
 
 (define tk-dispatch-event
   (lambda ()

retropikzel/pstk.sld

@@ -162,5 +162,9 @@
           ttk/available-themes
           ttk/set-theme
           ttk/style)
+  (cond-expand
+    (kawa (import (only (kawa base) keyword? keyword->string)))
+    (srfi-88 (import (srfi 88)))
+    (else))
   (include "pstk.scm"))
 

retropikzel/pstk/VERSION

@@ -1 +1 @@
-1.0.5
+1.0.7

retropikzel/requests.scm

@@ -0,0 +1,219 @@
+(define CURLOPT-POSTFIELDSIZE 60)
+(define CURLOPT-POSTFIELDS 10015)
+(define CURLOPT-URL 10002)
+(define CURLOPT-HTTPHEADER 10023)
+(define CURLOPT-WRITEDATA 10001)
+(define CURLOPT-CUSTOMREQUEST 10036)
+(define CURLOPT-COOKIE 10022)
+(define CURLOPT-COOKIEFILE 10031)
+(define CURLOPT-COOKIEJAR 10082)
+(define CURLINFO-RESPONSE-CODE 2097154)
+(define CURLHE-BADINDEX 1)
+(define CURLHE-HEADER 1)
+(define CURLINFO-COOKIELIST 4194332)
+(define randomized? #f)
+
+(define-c-library libc '("stdlib.h" "stdio.h" "time.h") libc-name '((additional-versions ("6"))))
+(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))
+(define-c-procedure c-srand libc 'srand 'void '(int))
+(define-c-procedure c-rand libc 'rand 'int '())
+
+(define-c-library libcurl '("curl/curl.h") "curl" '((additional-versions ("4" "8"))))
+(define-c-procedure curl-easy-init libcurl 'curl_easy_init 'pointer '())
+(define-c-procedure curl-easy-setopt-pointer libcurl 'curl_easy_setopt 'int '(pointer int pointer))
+(define-c-procedure curl-easy-setopt-int libcurl 'curl_easy_setopt 'int '(pointer int int))
+(define-c-procedure curl-slist-append libcurl 'curl_slist_append 'pointer '(pointer pointer))
+(define-c-procedure curl-easy-strerror libcurl 'curl_easy_strerror 'pointer '(int))
+(define-c-procedure curl-easy-perform libcurl 'curl_easy_perform 'int '(pointer))
+(define-c-procedure curl-easy-getinfo libcurl 'curl_easy_getinfo 'int '(pointer int pointer))
+(define-c-procedure curl-easy-nextheader libcurl 'curl_easy_nextheader 'pointer '(pointer int int pointer))
+
+(define-record-type response
+  (make-response bytes
+                 ;cookies
+                 headers
+                 status-code
+                 text
+                 url
+                 download-path)
+  response?
+  (bytes response-bytes)
+  ;(cookies response-cookies)
+  (headers response-headers)
+  (status-code response-status-code)
+  (text response-text)
+  (url response-url)
+  (download-path response-download-path))
+
+(define (random-to max)
+  (when (not randomized?)
+    (c-srand (c-time (make-c-null)))
+    (set! randomized? #t))
+  (modulo (c-rand) max))
+
+(define (random-string size)
+  (letrec
+    ((looper
+       (lambda (result integer)
+         (cond ((= (string-length result) size) result)
+               ((or (< integer 0)
+                    (> integer 128))
+                (looper result (random-to 128)))
+               (else
+                 (let ((char (integer->char integer)))
+                   (if (not (or (char-alphabetic? char)
+                                (char-numeric? char)))
+                     (looper result (c-rand))
+                     (looper (string-append result
+                                            (string (integer->char integer)))
+                             (random-to 128)))))))))
+    (looper "" (random-to 128))))
+
+(define (random-temp-file)
+  (string-append (cond-expand (windows (get-environment-variable "TMP"))
+                              (else "/tmp"))
+                 "/scheme-requests-tmp-"
+                 (random-string 6)))
+
+(define handle-errors
+  (lambda (result)
+    (when (not (= result 0))
+      (error (c-utf8->string (curl-easy-strerror result))))
+    result))
+
+(define handle (curl-easy-init))
+
+(define (slurp path)
+  (with-input-from-file
+    path
+    (lambda ()
+      (letrec
+        ((looper (lambda (result text)
+                   (if (eof-object? text)
+                     result
+                     (looper (string-append result text)
+                             (read-string 4000))))))
+        (looper "" (read-string 4000))))))
+
+(define (slurp-bytes path)
+  (let ((port (open-binary-input-file path)))
+    (letrec
+      ((looper (lambda (result bytes)
+                 (cond ((eof-object? bytes)
+                        (close-port port)
+                        result)
+                       (else
+                         (looper (bytevector-append result bytes)
+                                 (read-bytevector 4000 port)))))))
+      (looper (bytevector) (read-bytevector 4000 port)))))
+
+(define (get-status-code handle)
+  (let* ((pointer-size (c-type-size 'long))
+         (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)
+      code)))
+
+(define (set-body handle body)
+  (curl-easy-setopt-pointer handle CURLOPT-POSTFIELDS (string->c-utf8 body))
+  (curl-easy-setopt-int handle CURLOPT-POSTFIELDSIZE (string-length body)))
+
+(define (set-headers handle headers)
+  (let ((headers-slist (make-c-null)))
+    (for-each
+      (lambda (header)
+        (set! headers-slist
+          (curl-slist-append
+            headers-slist
+            (string->c-utf8 (string-append (if (symbol? (car header))
+                                             (symbol->string (car header))
+                                             (car header))
+                                           ":"
+                                           (if (symbol? (cdr header))
+                                             (symbol->string (cdr header))
+                                             (cdr header)))))))
+      headers)
+    (curl-easy-setopt-pointer handle CURLOPT-HTTPHEADER headers-slist)))
+
+(define (get-headers handle previous-header-struct result)
+  (let* ((header-struct (curl-easy-nextheader handle
+                                              CURLHE-HEADER
+                                              0
+                                              previous-header-struct)))
+    (if (c-null? header-struct)
+      result
+      (let* ((name
+               (string->symbol
+                 (string-downcase
+                   (c-utf8->string
+                     (c-bytevector-ref header-struct 'pointer 0)))))
+             (value (c-utf8->string (c-bytevector-ref header-struct
+                                                      'pointer
+                                                      (c-type-size 'pointer)))))
+        (get-headers handle header-struct (append result
+                                                  (list (cons name value))))))))
+
+(define (copy-string-until str begin-index char)
+  (let ((result (list)))
+    (call-with-current-continuation
+      (lambda (return)
+        (string-for-each
+          (lambda (c)
+            (if (char=? c char)
+              (return #t)
+              (set! result (cons c result))))
+          (string-copy str begin-index))))
+    (list->string (reverse result))))
+
+(define (set-cookies handle cookies)
+  (let ((cookies-string ""))
+    (for-each
+      (lambda (header)
+        (set! cookies-string
+          (string-append cookies-string
+                         (if (symbol? (car header))
+                           (symbol->string (car header))
+                           (car header))
+                         "="
+                         (if (symbol? (cdr header))
+                           (symbol->string (cdr header))
+                           (cdr header))
+                         "; ")))
+      cookies)
+    (curl-easy-setopt-pointer handle CURLOPT-COOKIE (string->c-utf8 cookies-string))))
+
+(define request
+  (lambda (method url . options)
+    (let* ((cookies (assoc 'cookies options))
+           (headers (assoc 'headers options))
+           (body (assoc 'body options))
+           (download-path (assoc 'download-path options))
+           (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"))))
+      (curl-easy-setopt-pointer handle
+                                CURLOPT-CUSTOMREQUEST
+                                (string->c-utf8
+                                  (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))
+      (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)))
+             (response (make-response (slurp-bytes tmp-file-path)
+                                      ;(get-cookies handle)
+                                      headers
+                                      (get-status-code handle)
+                                      (slurp tmp-file-path)
+                                      url
+                                      download-path)))
+        (if (not download-path) (delete-file tmp-file-path))
+        response))))

retropikzel/requests.sld

@@ -0,0 +1,17 @@
+(define-library
+  (retropikzel requests)
+  (import (scheme base)
+          (scheme write)
+          (scheme char)
+          (scheme file)
+          (scheme process-context)
+          (foreign c))
+  (export request
+          response-status-code
+          response-text
+          response-bytes
+          response-headers
+          ;response-cookies
+          )
+  (include "requests.scm"))
+

retropikzel/requests/LICENSE

@@ -0,0 +1,165 @@
+                   GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+  This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+  0. Additional Definitions.
+
+  As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+  "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+  An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+  A "Combined Work" is a work produced by combining or linking an
+Application with the Library.  The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+  The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+  The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+  1. Exception to Section 3 of the GNU GPL.
+
+  You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+  2. Conveying Modified Versions.
+
+  If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+   a) under this License, provided that you make a good faith effort to
+   ensure that, in the event an Application does not supply the
+   function or data, the facility still operates, and performs
+   whatever part of its purpose remains meaningful, or
+
+   b) under the GNU GPL, with none of the additional permissions of
+   this License applicable to that copy.
+
+  3. Object Code Incorporating Material from Library Header Files.
+
+  The object code form of an Application may incorporate material from
+a header file that is part of the Library.  You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+   a) Give prominent notice with each copy of the object code that the
+   Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the object code with a copy of the GNU GPL and this license
+   document.
+
+  4. Combined Works.
+
+  You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+   a) Give prominent notice with each copy of the Combined Work that
+   the Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the Combined Work with a copy of the GNU GPL and this license
+   document.
+
+   c) For a Combined Work that displays copyright notices during
+   execution, include the copyright notice for the Library among
+   these notices, as well as a reference directing the user to the
+   copies of the GNU GPL and this license document.
+
+   d) Do one of the following:
+
+       0) Convey the Minimal Corresponding Source under the terms of this
+       License, and the Corresponding Application Code in a form
+       suitable for, and under terms that permit, the user to
+       recombine or relink the Application with a modified version of
+       the Linked Version to produce a modified Combined Work, in the
+       manner specified by section 6 of the GNU GPL for conveying
+       Corresponding Source.
+
+       1) Use a suitable shared library mechanism for linking with the
+       Library.  A suitable mechanism is one that (a) uses at run time
+       a copy of the Library already present on the user's computer
+       system, and (b) will operate properly with a modified version
+       of the Library that is interface-compatible with the Linked
+       Version.
+
+   e) Provide Installation Information, but only if you would otherwise
+   be required to provide such information under section 6 of the
+   GNU GPL, and only to the extent that such information is
+   necessary to install and execute a modified version of the
+   Combined Work produced by recombining or relinking the
+   Application with a modified version of the Linked Version. (If
+   you use option 4d0, the Installation Information must accompany
+   the Minimal Corresponding Source and Corresponding Application
+   Code. If you use option 4d1, you must provide the Installation
+   Information in the manner specified by section 6 of the GNU GPL
+   for conveying Corresponding Source.)
+
+  5. Combined Libraries.
+
+  You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+   a) Accompany the combined library with a copy of the same work based
+   on the Library, uncombined with any other library facilities,
+   conveyed under the terms of this License.
+
+   b) Give prominent notice with the combined library that part of it
+   is a work based on the Library, and explaining where to find the
+   accompanying uncombined form of the same work.
+
+  6. Revised Versions of the GNU Lesser General Public License.
+
+  The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+  Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+  If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.

retropikzel/requests/README.md

@@ -0,0 +1,84 @@
+# requests
+
+Scheme library to make https requests. Built with
+[foreign c](https://sr.ht/~retropikzel/foreign-c/) and libcurl.
+
+[Repository](https://git.sr.ht/~retropikzel/foreign-c-requests)
+
+[Issue tracker](https://sr.ht/~retropikzel/foreign-c/trackers)
+
+[Jenkins](https://jenkins.scheme.org/job/foreign_c/job/foreign-c-requests/)
+
+
+
+## Caveats
+
+- Not yet working on Mosh
+- No cookie reading support yet
+
+
+
+## Dependencies
+
+Depends on libcurl, on Debian/Ubuntu:
+
+    apt-get install libcurl4-openssl-dev
+
+or
+    apt-get install libcurl4-gnutls-dev
+
+
+## Documentation
+
+
+
+(**request** method url . option ...)
+
+Method is [http method](https://developer.mozilla.org/en-US/docs/Web/HTTP/Reference/Methods)
+as a symbol. For example 'GET or 'POST.
+
+Url is the url you want to make request to.
+
+Options are pairs passed in after other arguments, for example:
+
+    (define url "https://snow-fort.org/s/gmail.com/nma.arvydas.silanskas/arvyy/mustache/1.0.2/arvyy-mustache-1.0.2.tgz")
+    (request 'GET url '(download-path . "/tmp/arvyy-mustache-1.0.2.tgz"))
+
+Options:
+
+- download-path
+    - Downloads the response of request to given path
+    - If this is not given temporary file is used and deleted after
+- headers
+    - An association list of headers
+- body
+    - Request body as a string
+    - Example: (define response
+                       (request 'POST
+                                "http://echo-http-requests.appspot.com/echo"
+                                '(body . "Hello world")))
+
+
+
+(**response-status-code** response)
+
+Returns the HTTP status code of the response.
+
+
+
+(**response-text** response)
+
+Returns the content of the response as text.
+
+
+
+(**response-bytes** response)
+
+Returns the content of the response as bytes.
+
+
+
+(**response-headers** response)
+
+Returns the response headers as an association list.
+Header names are downcased symbols.

retropikzel/requests/VERSION

@@ -0,0 +1 @@
+0.10.3

retropikzel/requests/test.scm

@@ -0,0 +1,52 @@
+
+(define response (request 'GET
+                          "http://echo-http-requests.appspot.com/echo"
+                          '(headers (foo . bar))
+                          '(cookies (foo . bar))))
+
+(display "Response")
+(newline)
+
+(display "status-code: ")
+(write (response-status-code response))
+(newline)
+
+(display "bytes: ")
+(write (response-bytes response))
+(newline)
+
+(display "text: ")
+(write (response-text response))
+(newline)
+
+(display "headers: ")
+(write (response-headers response))
+(newline)
+
+(when (not (= (response-status-code response) 200))
+  (error "Status code not 200" response))
+
+(define response1 (request 'POST
+                          "http://echo-http-requests.appspot.com/echo"
+                          '(headers (foo . bar))
+                          '(cookies (foo . bar))
+                          '(body . "Hello world")))
+
+(display "Response")
+(newline)
+
+(display "status-code: ")
+(write (response-status-code response1))
+(newline)
+
+(display "bytes: ")
+(write (response-bytes response1))
+(newline)
+
+(display "text: ")
+(write (response-text response1))
+(newline)
+
+(display "headers: ")
+(write (response-headers response1))
+(newline)

retropikzel/stdio.scm

@@ -0,0 +1,29 @@
+(define-c-library libc '("stdio.h") libc-name '((additional-versions ("0" "6"))))
+(define-c-procedure internal-fopen libc 'fopen 'pointer '(pointer poiner))
+(define-c-procedure internal-fclose libc 'fclose 'int '(pointer))
+
+(define-record-type <stdio-file>
+  (make-stdio-file file)
+  stdio-file?
+  (file stdio-file))
+
+(define modes `("r" "w" "a" "r+" "w+" "a+" "rb" "wb" "ab" "rb+" "wb+" "ab+"))
+
+(define (fopen filename mode)
+  (when (not (string? filename)) (error "fopen: Filename must be string"))
+  (when (not (string? mode)) (error "fopen: Mode must be string"))
+  (when (not (member mode modes))
+    (error (string-append "fopen: Mode not in allowed modes of "
+                          (apply (lambda (item) (string-append mode " "))
+                                 modes))))
+  (let* ((filename-pointer (string->c-utf8 filename))
+         (mode-pointer (string->c-utf8 mode))
+         (file (make-stdio-file (fopen filename mode))))
+    (c-free filename-pointer)
+    (c-free mode-pointer)
+    file))
+
+(define (fclose file)
+  (when (not (stdio-file? file)) (error "fclose: File must be stdio-file"))
+  (internal-fclose (stdio-file file)))
+

retropikzel/stdio.sld

@@ -0,0 +1,35 @@
+(define-library
+  (retropikzel stdio)
+  (import (scheme base)
+          (scheme write)
+          (foreign c))
+  (export fopen
+          fclose
+          ;feof
+          ;ferror
+          ;fgetc
+          ;fgets
+          ;fprintf
+          ;fputc
+          ;fputs
+          ;fread
+          ;fscanf
+          ;fseek
+          ;ftell
+          ;fwrite
+          ;getc
+          ;getchar
+          ;printf
+          ;putc
+          ;putchar
+          ;puts
+          ;remove
+          ;rename
+          ;rewind
+          ;scanf
+          ;snprintf
+          ;sprintf
+          ;sscanf
+          )
+  (include "stiod.scm"))
+

retropikzel/stdio/LICENSE

@@ -0,0 +1,165 @@
+                   GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+  This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+  0. Additional Definitions.
+
+  As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+  "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+  An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+  A "Combined Work" is a work produced by combining or linking an
+Application with the Library.  The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+  The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+  The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+  1. Exception to Section 3 of the GNU GPL.
+
+  You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+  2. Conveying Modified Versions.
+
+  If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+   a) under this License, provided that you make a good faith effort to
+   ensure that, in the event an Application does not supply the
+   function or data, the facility still operates, and performs
+   whatever part of its purpose remains meaningful, or
+
+   b) under the GNU GPL, with none of the additional permissions of
+   this License applicable to that copy.
+
+  3. Object Code Incorporating Material from Library Header Files.
+
+  The object code form of an Application may incorporate material from
+a header file that is part of the Library.  You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+   a) Give prominent notice with each copy of the object code that the
+   Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the object code with a copy of the GNU GPL and this license
+   document.
+
+  4. Combined Works.
+
+  You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+   a) Give prominent notice with each copy of the Combined Work that
+   the Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the Combined Work with a copy of the GNU GPL and this license
+   document.
+
+   c) For a Combined Work that displays copyright notices during
+   execution, include the copyright notice for the Library among
+   these notices, as well as a reference directing the user to the
+   copies of the GNU GPL and this license document.
+
+   d) Do one of the following:
+
+       0) Convey the Minimal Corresponding Source under the terms of this
+       License, and the Corresponding Application Code in a form
+       suitable for, and under terms that permit, the user to
+       recombine or relink the Application with a modified version of
+       the Linked Version to produce a modified Combined Work, in the
+       manner specified by section 6 of the GNU GPL for conveying
+       Corresponding Source.
+
+       1) Use a suitable shared library mechanism for linking with the
+       Library.  A suitable mechanism is one that (a) uses at run time
+       a copy of the Library already present on the user's computer
+       system, and (b) will operate properly with a modified version
+       of the Library that is interface-compatible with the Linked
+       Version.
+
+   e) Provide Installation Information, but only if you would otherwise
+   be required to provide such information under section 6 of the
+   GNU GPL, and only to the extent that such information is
+   necessary to install and execute a modified version of the
+   Combined Work produced by recombining or relinking the
+   Application with a modified version of the Linked Version. (If
+   you use option 4d0, the Installation Information must accompany
+   the Minimal Corresponding Source and Corresponding Application
+   Code. If you use option 4d1, you must provide the Installation
+   Information in the manner specified by section 6 of the GNU GPL
+   for conveying Corresponding Source.)
+
+  5. Combined Libraries.
+
+  You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+   a) Accompany the combined library with a copy of the same work based
+   on the Library, uncombined with any other library facilities,
+   conveyed under the terms of this License.
+
+   b) Give prominent notice with the combined library that part of it
+   is a work based on the Library, and explaining where to find the
+   accompanying uncombined form of the same work.
+
+  6. Revised Versions of the GNU Lesser General Public License.
+
+  The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+  Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+  If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.

retropikzel/stdio/VERSION

@@ -0,0 +1 @@
+0.1.0

retropikzel/stdio/test.scm

@@ -0,0 +1,3 @@
+
+(test-begin "stdio")
+(test-end "stdio")

retropikzel/system.sld

@@ -2,6 +2,7 @@
   (retropikzel system)
   (import (scheme base)
           (scheme write)
+          (scheme process-context)
           (foreign c))
   (export system)
   (include "system.scm"))