diff --git a/Makefile b/Makefile
index df1db7b..65f099c 100644
--- a/Makefile
+++ b/Makefile
@@ -1,7 +1,7 @@
.SILENT: build install test test-docker clean ${TMPDIR}
SCHEME=chibi
LIBRARY=cgi
-AUTHOR=Retropikzel
+AUTHOR=retropikzel
LIBRARY_FILE=retropikzel/${LIBRARY}.sld
VERSION=$(shell cat retropikzel/${LIBRARY}/VERSION)
diff --git a/retropikzel/cgi.scm b/retropikzel/cgi.scm
index eb31164..09fa398 100644
--- a/retropikzel/cgi.scm
+++ b/retropikzel/cgi.scm
@@ -192,7 +192,7 @@
(define breaker (char->integer #\-))
-(define request
+#;(define request
(list (cons 'headers headers)
(cons 'parameters parameters)
(cons 'cookies cookies)
@@ -222,8 +222,6 @@
(close-port input)
(close-port output)))
-(define (cgi) request)
-
(define cgi-exit
(lambda args
(for-each (lambda (file)
@@ -235,82 +233,89 @@
(exit 0)
(exit (car args)))))
-(cond ((and content-type-pair (string=? content-type "multipart/form-data"))
- (letrec* ((boundary (string->utf8 (string-append (list-ref (string-split
- (list-ref content-type-data 1) #\=) 1))))
- (boundary-length (bytevector-length boundary))
- (content (letrec ((looper (lambda (bytes result)
- (if (eof-object? bytes)
- result
- (looper (read-bytevector buffer-size stdin)
- (bytevector-append result bytes))))))
- (looper (read-bytevector buffer-size stdin)
- (bytevector))))
- (header-content-length (string->number (cdr (assoc 'CONTENT_LENGTH headers))))
- (content-length (bytevector-length content))
- (content-mark 0)
- (looper (lambda (index)
- (cond ((< index (- content-length 4))
- (if (and (= breaker (bytevector-u8-ref content index))
- (= breaker (bytevector-u8-ref content (+ index 1)))
- (equal? boundary (bytevector-copy content (+ index 2) (+ index 2 boundary-length))))
- (let* ((part (bytevector-copy content content-mark index))
- (part-length (bytevector-length part))
- (part-port (open-input-bytevector part))
- (part-headers-length 0)
- (part-headers (letrec ((loop (lambda (line result)
- (if (or (eof-object? line) (string=? line ""))
- (map (lambda (p) (string-split p #\:)) result)
- (begin
- (set! part-headers-length (+ part-headers-length
- (string-length line)
- 2))
- (loop (read-bytevector-line part-port)
- (append result (list line))))))))
- (loop (read-bytevector-line part-port) (list)))))
- (if (and (not (null? part-headers))
- (assoc "Content-Disposition" part-headers))
- (let* ((content-disposition
- (map
- (lambda (str)
- (let ((split (string-split str #\=)))
- (cons (string-filter (list-ref split 0) (lambda (c) (not (char=? c #\space))))
- (if (= (length split) 2)
- (string-filter (list-ref split 1) (lambda (c) (not (char=? c #\"))))
- ""))))
- (string-split (car (cdr (assoc "Content-Disposition" part-headers))) #\;)))
- (filename (assoc "filename" content-disposition)))
- (if (not filename)
- (set! parameters
- (append parameters
- (list
- (cons (cdr (assoc "name" content-disposition))
- (utf8->string (bytevector-copy content
- (+ (+ content-mark part-headers-length) 2)
- (- index 2)))))))
- (let* ((tmp-file-path (string-append temporary-directory
- "/"
- (make-temp-filename (cdr filename))))
- (tmp-file-port (begin (when (file-exists? tmp-file-path)
- (delete-file tmp-file-path))
- (open-binary-output-file tmp-file-path))))
- (write-bytevector (bytevector-copy content
- (+ (+ content-mark part-headers-length) 2)
- (- index 2))
- tmp-file-port)
- (close-port tmp-file-port)
- (set! files (append files (list
- (cons (cdr (assoc "name" content-disposition))
- tmp-file-path))))))
- (set! content-mark index)))
- (looper (+ index boundary-length)))
- (looper (+ index 1))))))))
- (looper 0)))
- (else (let ((raw-body (if (string=? request-method "POST")
- (read-until-eof stdin (bytevector))
- "")))
- (set! parameters (split-http-parameters (if (string=? request-method "POST")
- raw-body
- query-string)))
- (when (string=? request-method "POST")
- (set! body raw-body)))))
+(define (cgi)
+ (cond ((and content-type-pair (string=? content-type "multipart/form-data"))
+ (letrec* ((boundary (string->utf8 (string-append (list-ref (string-split
+ (list-ref content-type-data 1) #\=) 1))))
+ (boundary-length (bytevector-length boundary))
+ (content (letrec ((looper (lambda (bytes result)
+ (if (eof-object? bytes)
+ result
+ (looper (read-bytevector buffer-size stdin)
+ (bytevector-append result bytes))))))
+ (looper (read-bytevector buffer-size stdin)
+ (bytevector))))
+ (header-content-length (string->number (cdr (assoc 'CONTENT_LENGTH headers))))
+ (content-length (bytevector-length content))
+ (content-mark 0)
+ (looper (lambda (index)
+ (cond ((< index (- content-length 4))
+ (if (and (= breaker (bytevector-u8-ref content index))
+ (= breaker (bytevector-u8-ref content (+ index 1)))
+ (equal? boundary (bytevector-copy content (+ index 2) (+ index 2 boundary-length))))
+ (let* ((part (bytevector-copy content content-mark index))
+ (part-length (bytevector-length part))
+ (part-port (open-input-bytevector part))
+ (part-headers-length 0)
+ (part-headers (letrec ((loop (lambda (line result)
+ (if (or (eof-object? line) (string=? line ""))
+ (map (lambda (p) (string-split p #\:)) result)
+ (begin
+ (set! part-headers-length (+ part-headers-length
+ (string-length line)
+ 2))
+ (loop (read-bytevector-line part-port)
+ (append result (list line))))))))
+ (loop (read-bytevector-line part-port) (list)))))
+ (if (and (not (null? part-headers))
+ (assoc "Content-Disposition" part-headers))
+ (let* ((content-disposition
+ (map
+ (lambda (str)
+ (let ((split (string-split str #\=)))
+ (cons (string-filter (list-ref split 0) (lambda (c) (not (char=? c #\space))))
+ (if (= (length split) 2)
+ (string-filter (list-ref split 1) (lambda (c) (not (char=? c #\"))))
+ ""))))
+ (string-split (car (cdr (assoc "Content-Disposition" part-headers))) #\;)))
+ (filename (assoc "filename" content-disposition)))
+ (if (not filename)
+ (set! parameters
+ (append parameters
+ (list
+ (cons (cdr (assoc "name" content-disposition))
+ (utf8->string (bytevector-copy content
+ (+ (+ content-mark part-headers-length) 2)
+ (- index 2)))))))
+ (let* ((tmp-file-path (string-append temporary-directory
+ "/"
+ (make-temp-filename (cdr filename))))
+ (tmp-file-port (begin (when (file-exists? tmp-file-path)
+ (delete-file tmp-file-path))
+ (open-binary-output-file tmp-file-path))))
+ (write-bytevector (bytevector-copy content
+ (+ (+ content-mark part-headers-length) 2)
+ (- index 2))
+ tmp-file-port)
+ (close-port tmp-file-port)
+ (set! files (append files (list
+ (cons (cdr (assoc "name" content-disposition))
+ tmp-file-path))))))
+ (set! content-mark index)))
+ (looper (+ index boundary-length)))
+ (looper (+ index 1))))))))
+ (looper 0)))
+ (else (let ((raw-body (if (string=? request-method "POST")
+ (read-until-eof stdin (bytevector))
+ "")))
+ (set! parameters (split-http-parameters (if (string=? request-method "POST")
+ raw-body
+ query-string)))
+ (when (string=? request-method "POST")
+ (set! body raw-body)))))
+
+ (list (cons 'headers headers)
+ (cons 'parameters parameters)
+ (cons 'cookies cookies)
+ (cons 'body body)
+ (cons 'files files)))
diff --git a/retropikzel/cgi/LICENSE b/retropikzel/cgi/LICENSE
new file mode 100644
index 0000000..0a04128
--- /dev/null
+++ b/retropikzel/cgi/LICENSE
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ 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.
diff --git a/retropikzel/cgi/README.html b/retropikzel/cgi/README.html
new file mode 100644
index 0000000..0f60aef
--- /dev/null
+++ b/retropikzel/cgi/README.html
@@ -0,0 +1,137 @@
+R7RS Scheme library for Common Gateway Interface
+
+If you dont know what CGI is, in short server runs your Scheme script and
+displays it's output as a webpage. Also checkout
+[https://git.sr.ht/~retropikzel/scheme-php](https://git.sr.ht/~retropikzel/scheme-php).
+
+[Project](https://sr.ht/~retropikzel/scheme-cgi/)
+
+[Repository](https://git.sr.ht/~retropikzel/scheme-cgi)
+
+[Issue tracker](https://todo.sr.ht/~retropikzel/scheme-cgi)
+
+## Caveats
+
+- Works only on unix as it reads from /dev/fd/0 and /dev/random.
+
+## Buggy on implementations
+
+- Does not work with mit-scheme
+ - For some reason mit-scheme exits when it reads eof-object from standard
+ input
+- STklos
+ - No output for some reason
+
+## How to use
+
+Example using Gauche in Docker.
+
+lighttpd.conf:
+
+ server.document-root = "/workdir"
+ server.port = 3000
+ server.modules += ("mod_cgi", "mod_dirlisting")
+ cgi.assign = (".scm" => "/usr/bin/scheme-script")
+ dir-listing.activate = "enable"
+
+Dockerfile:
+
+ FROM schemers/gauche
+ RUN apt-get update && apt-get install -y --no-install-recommends lighttpd
+ WORKDIR /workdir
+ EXPOSE 3000
+ COPY lighttpd.conf /lighttpd.conf
+ RUN echo "#!/bin/sh" > /usr/bin/scheme-script
+ RUN echo "exec gosh -r7 -I ./snow \$@" >> /usr/bin/scheme-script
+ RUN chmod +x /usr/bin/scheme-script
+ ENTRYPOINT ["/usr/sbin/lighttpd", "-D", "-f", "/lighttpd.conf"]
+
+hello.scm:
+
+ (import (scheme base)
+ (scheme write)
+ (retropikzel cgi))
+
+ (display "Content-type: text/html")
+ (display "
+")
+ (display "
+")
+ (display "Hello")
+ (display "")
+
+ (display "Request: ")
+ (write (get-request))
+ (display "")
+ (cgi-exit)
+
+Run:
+
+ docker build . --tag=scheme-cgi
+ docker run -it -v ${PWD}:/workdir -p 3000:3000 scheme-cgi
+
+Then navigate with your browser to http://127.0.0.1:3000
+
+## Documentation
+
+### Reference
+
+**get-request**
+
+Returns the whole request as association list.
+
+**get-header** _name_
+
+Name can be symbol or a string. Returns the value of given header or #f.
+
+**get-headers**
+
+Returns association list of all headers.
+
+**get-parameter** _name_
+
+Name can be symbol or a string. Returns the value of given parameter or #f.
+
+**get-parameters**
+
+Returns association list of all parameters.
+
+**get-cookie** _name_
+
+Returns the value of given cookie or #f if.
+
+**get-cookies**
+
+Returns association list of all cookies.
+
+**get-file** _filename_
+
+Filename is a symbol or a string. Returns the path of given file from files or #f.
+
+Uploaded files are stored in /tmp, with randomly generated prefix on their
+name. They are not deleted unless cgi-exit is called. Use **move-file** to move
+them into preferred location.
+
+**get-files**
+
+Returns association list of all files.
+
+**move-file** _from_ _to_
+
+Moves a file from _from_ path to _to_ path.
+
+**get-body**
+
+Returns the request body.
+
+**cgi-exit**
+**cgi-exit** _code_
+
+Does necessary cleanup and exits the script. Code is a number, if it is given
+then that is used as exit code.
+
+### Environment variables
+
+**SCHEME\_CGI\_TMP\_PATH**
+
+Path to where uploaded files are stored. Default is /tmp.