diff --git a/lighttpd.conf b/lighttpd.conf
new file mode 100644
index 0000000..49181de
--- /dev/null
+++ b/lighttpd.conf
@@ -0,0 +1,16 @@
+server.document-root = "/your-project-path"
+server.errorlog = "/your-project-path/error.log"
+server.modules = ("mod_scgi")
+
+server.port = 3000
+scgi.debug = 1
+scgi.server = ("/" =>
+ (( "host" => "127.0.0.1",
+ "port" => 3001,
+ "check-local" => "disable")))
+
+mimetype.assign = (
+ ".html" => "text/html",
+ ".txt" => "text/plain",
+ ".jpg" => "image/jpeg",
+ ".png" => "image/png")
diff --git a/retropikzel/cgi.scm b/retropikzel/cgi.scm
index 09fa398..c494df5 100644
--- a/retropikzel/cgi.scm
+++ b/retropikzel/cgi.scm
@@ -1,96 +1,5 @@
(define stdin (open-binary-input-file "/dev/fd/0"))
(define buffer-size 4000)
-(define temporary-directory (if (get-environment-variable "SCHEME_CGI_TMP_PATH")
- (get-environment-variable "SCHEME_CGI_TMP_PATH")
- "/tmp"))
-(define file-move-buffer-size 4000)
-(define encode-replacements
- (list (list " " "%20")
- (list " " "+")
- (list "!" "%21")
- (list "#" "%23")
- (list "$" "%24")
- (list "%" "%25")
- (list "&" "%26")
- (list "'" "%27")
- (list "(" "%28")
- (list ")" "%29")
- (list "*" "%2A")
- (list "+" "%2B")
- (list "," "%2C")
- (list "/" "%2F")
- (list ":" "%3A")
- (list ";" "%3B")
- (list "=" "%3D")
- (list "?" "%3F")
- (list "@" "%40")
- (list "[" "%5B")
- (list "]" "%5D")
- (list "<" "%3C")
- (list ">" "%3E")
- (list "\\" "%5C")
- (list "\"" "%22")
- (list "\n" "%0A")
- (list "\r" "%0D")))
-(define decode-replacements (map reverse encode-replacements))
-
-(define make-temp-filename
- (lambda (filename)
- (letrec* ((dev-random (open-binary-input-file "/dev/random"))
- (min-byte (char->integer #\a))
- (max-byte (char->integer #\z))
- (max-length 10)
- (looper (lambda (result count)
- (if (>= count max-length)
- result
- (let ((byte (read-u8 dev-random)))
- (if (and (> byte min-byte) (< byte max-byte))
- (looper (bytevector-append result
- (bytevector byte))
- (+ count 1))
- (looper result count))))))
- (result (string-append (utf8->string (looper (bytevector) 0))
- "_"
- (utf8->string (looper (bytevector) 0))
- "_"
- filename)))
- (close-port dev-random)
- result)))
-
-#;(define headers->string
- (lambda (headers)
- (apply string-append (map
- (lambda (key-value)
- (string-append (car key-value) ": " (cdr key-value) "\r\n"))
- headers))))
-
-(define get-replacement
- (lambda (key mode)
- (let ((r (if (string=? mode "encode")
- (assoc key encode-replacements)
- (assoc key decode-replacements))))
- (if r (car (cdr r)) key))))
-
-(define endecode
- (lambda (mode s)
- (if (not s)
- ""
- (letrec ((s-length (string-length s))
- (looper
- (lambda (i result)
- (if (< i s-length)
- (let ((key-length (if (and (string=? mode "decode")
- (string=? (string-copy s i (+ i 1)) "%")
- (> s-length (+ i 2)))
- 3
- 1)))
- (looper (+ i key-length)
- (string-append result
- (get-replacement
- (string-copy s i (+ i key-length))
- mode))))
- result))))
- (looper 0 "")))))
(define string-split
(lambda (str mark)
@@ -191,47 +100,13 @@
(define breaker (char->integer #\-))
-
-#;(define request
- (list (cons 'headers headers)
- (cons 'parameters parameters)
- (cons 'cookies cookies)
- (cons 'body body)
- (cons 'files files)))
-
-(define (get from key)
- (let ((value (assoc (if (string? key)
- (string->symbol (endecode "encode" key))
- key)
- from)))
- (if value (cdr value) #f)))
-(define (get-file file)
- (let ((value (assoc (endecode "encode" (if (symbol? file)
- (symbol->string file)
- file))
- files)))
- (if value (cdr value) #f)))
-(define (move-file from to)
- (letrec* ((input (open-binary-input-file from))
- (output (open-binary-output-file to))
- (looper (lambda (bytes)
- (when (not (eof-object? bytes))
- (write-bytevector bytes output)
- (looper (read-bytevector file-move-buffer-size input))))))
- (looper (read-bytevector file-move-buffer-size input))
- (close-port input)
- (close-port output)))
-
-(define cgi-exit
+(define cgi-clean
(lambda args
(for-each (lambda (file)
(let ((path (cdr file)))
(when (file-exists? path)
(delete-file path))))
- files)
- (if (null? args)
- (exit 0)
- (exit (car args)))))
+ files)))
(define (cgi)
(cond ((and content-type-pair (string=? content-type "multipart/form-data"))
@@ -287,9 +162,7 @@
(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))))
+ (let* ((tmp-file-path (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))))
@@ -319,3 +192,26 @@
(cons 'cookies cookies)
(cons 'body body)
(cons 'files files)))
+
+(define (write-to-string str)
+ (let ((port (open-output-string)))
+ (write str port)
+ (get-output-string port)))
+
+(define (handle-request options thunk)
+ (let* ((request (cgi)))
+ (with-exception-handler
+ (lambda (exn) (cgi-clean) #f)
+ (lambda ()
+ (display
+ (parameterize
+ ((current-output-port (open-output-string)))
+ (apply thunk
+ (list request
+ (cdr (assq 'headers request))
+ (cdr (assq 'parameters request))
+ (cdr (assq 'cookies request))
+ (cdr (assq 'body request))
+ (cdr (assq 'files request))))
+ (get-output-string (current-output-port))))))
+ (cgi-clean)))
diff --git a/retropikzel/cgi.sld b/retropikzel/cgi.sld
index 8ef9994..d048fa9 100644
--- a/retropikzel/cgi.sld
+++ b/retropikzel/cgi.sld
@@ -6,7 +6,7 @@
(scheme write)
(scheme file)
(scheme char)
- (scheme process-context))
- (export cgi
- cgi-exit)
+ (scheme process-context)
+ (retropikzel net))
+ (export handle-request)
(include "cgi.scm"))
diff --git a/retropikzel/cgi/VERSION b/retropikzel/cgi/VERSION
index 7dea76e..9084fa2 100644
--- a/retropikzel/cgi/VERSION
+++ b/retropikzel/cgi/VERSION
@@ -1 +1 @@
-1.0.1
+1.1.0
diff --git a/retropikzel/fcgi.scm b/retropikzel/fcgi.scm
new file mode 100644
index 0000000..2ec74e0
--- /dev/null
+++ b/retropikzel/fcgi.scm
@@ -0,0 +1,219 @@
+(define FCGI-BEGIN-REQUEST 1)
+(define FCGI-ABORT-REQUEST 2)
+(define FCGI-END-REQUEST 7)
+(define FCGI-PARAMS 4)
+(define FCGI-STDIN 5)
+(define FCGI-STDOUT 6)
+(define FCGI-STDERR 7)
+(define FCGI-DATA 8)
+(define FCGI-GET-VALUES 9)
+(define FCGI-GET-VALUES-RESULT 10)
+(define FCGI-UNKNOWN-TYPE 11)
+
+(define (fcgi-type->symbol type)
+ (cond ((= type FCGI-BEGIN-REQUEST) 'FCGI-BEGIN-REQUEST)
+ ((= type FCGI-ABORT-REQUEST) 'FCGI-ABORT-REQUEST)
+ ((= type FCGI-END-REQUEST) 'FCGI-END-REQUEST)
+ ((= type FCGI-PARAMS) 'FCGI-PARAMS)
+ ((= type FCGI-STDIN) 'FCGI-STDIN)
+ ((= type FCGI-STDOUT) 'FCGI-STDOUT)
+ ((= type FCGI-STDERR) 'FCGI-STDERR)
+ ((= type FCGI-DATA) 'FCGI-DATA)
+ ((= type FCGI-GET-VALUES) 'FCGI-GET-VALUES)
+ ((= type FCGI-GET-VALUES-RESULT) 'FCGI-GET-VALUES-RESULT)
+ ((= type FCGI-UNKNOWN-TYPE) 'FCGI-UNKNOWN-TYPE)))
+
+(define FCGI-KEEP-CONN 1)
+
+(define FCGI-RESPONDER 1)
+(define FCGI-AUTHORIZER 2)
+(define FCGI-FILTER 3)
+
+(define (fcgi-role->symbol role)
+ (cond ((= role FCGI-RESPONDER) 'FCGI-RESPONDER)
+ ((= role FCGI-AUTHORIZER) 'FCGI-AUTHORIZER)
+ ((= role FCGI-FILTER) 'FCGI-FILTER)))
+
+(define (b1+b0 b1 b0)
+ ;; https://web.archive.org/web/20160119141816/http://www.fastcgi.com/drupal/node/6?q=node%2F22
+ ;; FROM SPECIFICATION:
+ ;; When two adjacent structure components are named identically except for
+ ;; the suffixes "B1" and "B0," it means that the two components may be viewed
+ ;; as a single number, computed as B1<<8 + B0
+ ;; BUT IN CODE THEY DO: (B1<<8) + B0
+ (+ (arithmetic-shift b1 8) b0))
+
+(define (integer->b1-b0 int)
+ (let ((b1 (bitwise-and (arithmetic-shift int -8) 255))
+ (b0 (bitwise-and int 255)))
+ `((b1 . ,b1) (b0 . ,b0))))
+
+(define (parse-request-content type content)
+ (cond
+ ((symbol=? type 'FCGI-BEGIN-REQUEST)
+ (let ((role-b1 (bytevector-u8-ref content 0))
+ (role-b0 (bytevector-u8-ref content 1))
+ (flags (bytevector-u8-ref content 2)))
+ `((role . ,(b1+b0 role-b1 role-b0))
+ (flags . ,flags))))
+ ((symbol=? type 'FCGI-PARAMS)
+ ;; https://web.archive.org/web/20160119141816/http://www.fastcgi.com/drupal/node/6?q=node%2F22
+ ;; 3.4 Name-Value Pairs
+ (letrec*
+ ((>>7 (lambda (n) (exact (floor (* n (expt 2 -7))))))
+ (read-length
+ (lambda (bv start-index)
+ (let*
+ ((b0 (bytevector-u8-ref bv (+ start-index 0)))
+ (b0>>7 (>>7 b0))
+ (b3 (if (= b0>>7 0) 0 b0))
+ (b2 (if (= b0>>7 0) 0 (bytevector-u8-ref bv (+ start-index 1))))
+ (b1 (if (= b0>>7 0) 0 (bytevector-u8-ref bv (+ start-index 2))))
+ ;; Notice redefinition of b0
+ (b0 (if (= b0>>7 0) b0 (bytevector-u8-ref bv (+ start-index 3))))
+ (bytes-in-length (if (= b0>>7 0) 1 4)))
+ (cons bytes-in-length
+ (if (= b0>>7 0)
+ b0
+ ;; ((B3 & 0x7f) << 24) + (B2 << 16) + (B1 << 8) + B0
+ (+ (arithmetic-shift (bitwise-and b3 127) 24)
+ (arithmetic-shift b2 16)
+ (arithmetic-shift b1 8)
+ b0))))))
+ (content-length (bytevector-length content))
+ (looper
+ (lambda (start-index result)
+ (if (>= start-index content-length)
+ result
+ (let*
+ ((name-length (read-length content start-index))
+ (value-length
+ (read-length content (+ start-index (car name-length))))
+ (lengths-length (+ (car name-length) (car value-length)))
+ (name (string->symbol
+ (utf8->string
+ (bytevector-copy content
+ (+ start-index lengths-length)
+ (+ start-index
+ lengths-length
+ (cdr name-length))))))
+ (value (utf8->string
+ (bytevector-copy content
+ (+ start-index
+ lengths-length
+ (cdr name-length))
+ (+ start-index
+ lengths-length
+ (cdr name-length)
+ (cdr value-length))))))
+ (looper (+ start-index
+ lengths-length
+ (cdr name-length)
+ (cdr value-length))
+ (append result (list (cons name value)))))))))
+ (if (= content-length 0)
+ (bytevector)
+ (looper 0 '()))))
+ ((symbol=? type 'FCGI-STDIN)
+ (utf8->string content))
+ (else content)))
+
+(define (read-request socket)
+ (let* ((fields (socket-recv socket 8))
+ (version (bytevector-u8-ref fields 0))
+ (type (bytevector-u8-ref fields 1))
+ (type-symbol (fcgi-type->symbol type))
+ (request-id-b1 (bytevector-u8-ref fields 2))
+ (request-id-b0 (bytevector-u8-ref fields 3))
+ (request-id (b1+b0 request-id-b1 request-id-b0))
+ (content-length-b1 (bytevector-u8-ref fields 4))
+ (content-length-b0 (bytevector-u8-ref fields 5))
+ (content-length (b1+b0 content-length-b1 content-length-b0))
+ (padding-length (bytevector-u8-ref fields 6))
+ (reserved (bytevector-u8-ref fields 7))
+ (content-data (if (> content-length 0)
+ (socket-recv socket content-length)
+ (bytevector)))
+ (padding-data (if (> padding-length 0)
+ (socket-recv socket padding-length)
+ (bytevector))))
+ (when (not (= version 1)) (error "Unsupported fastcgi version" version))
+ `(,type-symbol
+ (id . ,request-id)
+ (content . ,(parse-request-content type-symbol content-data)))))
+
+(define (read-requests socket result)
+ (let ((request (read-request socket)))
+ (if (symbol=? (car request) 'FCGI-STDIN)
+ (reverse (cons request result))
+ (read-requests socket (cons request result)))))
+
+(define (write-response socket type id response-bytes)
+ (let* ((version 1)
+ (header-bytes
+ (let* ((bytes (make-bytevector 8 0))
+ (id-b1-b0 (integer->b1-b0 id))
+ (content-length (bytevector-length response-bytes))
+ (content-length-b1-b0 (integer->b1-b0 content-length))
+ (padding-length 0)
+ (reserved 0))
+ (bytevector-u8-set! bytes 0 version)
+ (bytevector-u8-set! bytes 1 type)
+ (bytevector-u8-set! bytes 2 (cdr (assoc 'b1 id-b1-b0)))
+ (bytevector-u8-set! bytes 3 (cdr (assoc 'b0 id-b1-b0)))
+ (bytevector-u8-set! bytes 4 (cdr (assoc 'b1 content-length-b1-b0)))
+ (bytevector-u8-set! bytes 5 (cdr (assoc 'b0 content-length-b1-b0)))
+ (bytevector-u8-set! bytes 6 padding-length)
+ (bytevector-u8-set! bytes 7 reserved)
+ bytes))
+ (response (bytevector-append header-bytes response-bytes)))
+ (socket-send socket response)))
+
+(define (check-role role)
+ (if (= role FCGI-RESPONDER)
+ role
+ (error "Unsupported fastcgi role" (fcgi-role->symbol role))))
+
+(define fcgi-internal-handle
+ (lambda (client-socket thunk)
+ (let*
+ ((requests (read-requests client-socket '()))
+ (begin-request (cdr (assoc 'FCGI-BEGIN-REQUEST requests)))
+ (begin-request-content (cdr (assoc 'content begin-request)))
+ (id (cdr (assoc 'id begin-request)))
+ (role (check-role (cdr (assoc 'role begin-request-content))))
+ (flags (cdr (assoc 'flags begin-request-content)))
+ (params-request (cdr (assoc 'FCGI-PARAMS requests)))
+ (headers (cdr (assoc 'content params-request)))
+ (content-length (string->number (cdr (assoc 'CONTENT_LENGTH headers))))
+ (query-string (cdr (assoc 'QUERY_STRING headers)))
+ (parameters '()) ;; TODO
+ (stdin-request (cdr (assoc 'FCGI-STDIN requests)))
+ (body (cdr (assoc 'content stdin-request)))
+ (files '()) ;; TODO
+ (request '())
+ (response (parameterize
+ ((current-output-port (open-output-string)))
+ (apply thunk
+ (list request
+ headers
+ parameters
+ '() ;; TODO Cookies
+ body
+ files))
+ (get-output-string (current-output-port)))))
+ (write-response client-socket FCGI-STDOUT id (string->utf8 response))
+ (write-response client-socket FCGI-STDERR id (make-bytevector 0))
+ (write-response client-socket FCGI-END-REQUEST id (make-bytevector 0))
+ (socket-close client-socket))))
+
+(define fcgi-listen
+ (lambda (socket thunk)
+ (fcgi-internal-handle (socket-accept socket) thunk)
+ (fcgi-listen socket thunk)))
+
+(define (handle-request options thunk)
+ (let ((port (assoc 'port options)))
+ (when (not port)
+ (error "handle-request (fcgi) requires port to be passed in options, example: '((port . \"3000\"))"))
+ (fcgi-listen (make-server-socket (cdr port) *af-inet* *sock-stream* *ipproto-ip*) thunk)))
diff --git a/retropikzel/fcgi.sld b/retropikzel/fcgi.sld
new file mode 100644
index 0000000..ac4cd93
--- /dev/null
+++ b/retropikzel/fcgi.sld
@@ -0,0 +1,12 @@
+(define-library
+ (retropikzel fcgi)
+ (import (scheme base)
+ (scheme write)
+ (scheme char)
+ (scheme file)
+ (scheme complex)
+ (scheme process-context)
+ (srfi 60)
+ (srfi 106))
+ (export handle-request)
+ (include "fcgi.scm"))
diff --git a/retropikzel/fcgi/LICENSE b/retropikzel/fcgi/LICENSE
new file mode 100644
index 0000000..0a04128
--- /dev/null
+++ b/retropikzel/fcgi/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/fcgi/README.md b/retropikzel/fcgi/README.md
new file mode 100644
index 0000000..edcc9bb
--- /dev/null
+++ b/retropikzel/fcgi/README.md
@@ -0,0 +1,43 @@
+Scheme library implementing [FastCGI](https://en.wikipedia.org/wiki/FastCGI)
+
+## Simple example
+### Scheme Server
+ (import (scheme base)
+ (scheme write)
+ (retropikzel scgi))
+
+ (handle-request
+ '((port . "3001"))
+ (lambda (request)
+ (display "Content-type: text/html")
+ (display "\r\n")
+ (display "\r\n")
+ (display "Hello world")))
+
+### HTTP Server
+
+Using lighttpd might be the simplest to get started, install it and then
+put this into file called lighttpd.conf in your project folder.
+
+ server.document-root = "/your-project-path"
+ server.errorlog = "/tmp/scgi-error.log"
+ server.modules = ("mod_scgi")
+
+ server.port = 3000
+ scgi.debug = 1
+ scgi.server = ("/" =>
+ (( "host" => "127.0.0.1",
+ "port" => 3001,
+ "check-local" => "disable")))
+
+ mimetype.assign = (
+ ".html" => "text/html",
+ ".txt" => "text/plain",
+ ".jpg" => "image/jpeg",
+ ".png" => "image/png")
+
+Run ligghtpd:
+
+ lighttpd -D -f lighttpd.conf
+
+Then run your SCGI porgram and open your browser to http://127.0.0.1:3000/
diff --git a/retropikzel/fcgi/VERSION b/retropikzel/fcgi/VERSION
new file mode 100644
index 0000000..3eefcb9
--- /dev/null
+++ b/retropikzel/fcgi/VERSION
@@ -0,0 +1 @@
+1.0.0
diff --git a/retropikzel/net.scm b/retropikzel/net.scm
new file mode 100644
index 0000000..6c4fa7f
--- /dev/null
+++ b/retropikzel/net.scm
@@ -0,0 +1,95 @@
+(define temporary-directory
+ (if (get-environment-variable "NET_TMP_PATH")
+ (get-environment-variable "NET_TMP_PATH")
+ "/tmp"))
+
+(define encode-replacements
+ (list (list " " "%20")
+ (list " " "+")
+ (list "!" "%21")
+ (list "#" "%23")
+ (list "$" "%24")
+ (list "%" "%25")
+ (list "&" "%26")
+ (list "'" "%27")
+ (list "(" "%28")
+ (list ")" "%29")
+ (list "*" "%2A")
+ (list "+" "%2B")
+ (list "," "%2C")
+ (list "/" "%2F")
+ (list ":" "%3A")
+ (list ";" "%3B")
+ (list "=" "%3D")
+ (list "?" "%3F")
+ (list "@" "%40")
+ (list "[" "%5B")
+ (list "]" "%5D")
+ (list "<" "%3C")
+ (list ">" "%3E")
+ (list "\\" "%5C")
+ (list "\"" "%22")
+ (list "\n" "%0A")
+ (list "\r" "%0D")))
+
+(define decode-replacements (map reverse encode-replacements))
+
+(define get-replacement
+ (lambda (key mode)
+ (let ((r (if (string=? mode "encode")
+ (assoc key encode-replacements)
+ (assoc key decode-replacements))))
+ (if r (car (cdr r)) key))))
+
+(define endecode
+ (lambda (mode s)
+ (if (not s)
+ ""
+ (letrec ((s-length (string-length s))
+ (looper
+ (lambda (i result)
+ (if (< i s-length)
+ (let ((key-length (if (and (string=? mode "decode")
+ (string=? (string-copy s i (+ i 1)) "%")
+ (> s-length (+ i 2)))
+ 3
+ 1)))
+ (looper (+ i key-length)
+ (string-append result
+ (get-replacement
+ (string-copy s i (+ i key-length))
+ mode))))
+ result))))
+ (looper 0 "")))))
+
+(define url-encode
+ (lambda (str)
+ (cond ((string? str) (endecode "encode" str))
+ (else str))))
+(define url-decode
+ (lambda (str)
+ (cond ((string? str) (endecode "decode" str))
+ (else str))))
+
+(define make-temp-filename
+ (lambda (filename)
+ (letrec* ((dev-random (open-binary-input-file "/dev/random"))
+ (min-byte (char->integer #\a))
+ (max-byte (char->integer #\z))
+ (max-length 10)
+ (looper (lambda (result count)
+ (if (>= count max-length)
+ result
+ (let ((byte (read-u8 dev-random)))
+ (if (and (> byte min-byte) (< byte max-byte))
+ (looper (bytevector-append result
+ (bytevector byte))
+ (+ count 1))
+ (looper result count))))))
+ (result (string-append (utf8->string (looper (bytevector) 0))
+ "_"
+ (utf8->string (looper (bytevector) 0))
+ "_"
+ filename)))
+ (close-port dev-random)
+ result)))
diff --git a/retropikzel/net.sld b/retropikzel/net.sld
new file mode 100644
index 0000000..46f520d
--- /dev/null
+++ b/retropikzel/net.sld
@@ -0,0 +1,9 @@
+(define-library
+ (retropikzel net)
+ (import (scheme base)
+ (scheme file)
+ (scheme process-context))
+ (export url-encode
+ url-decode
+ make-temp-filename)
+ (include "net.scm"))
diff --git a/retropikzel/net/LICENSE b/retropikzel/net/LICENSE
new file mode 100644
index 0000000..0a04128
--- /dev/null
+++ b/retropikzel/net/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/net/README.md b/retropikzel/net/README.md
new file mode 100644
index 0000000..7f55b70
--- /dev/null
+++ b/retropikzel/net/README.md
@@ -0,0 +1 @@
+Utilities related to networking libraries
diff --git a/retropikzel/net/VERSION b/retropikzel/net/VERSION
new file mode 100644
index 0000000..3eefcb9
--- /dev/null
+++ b/retropikzel/net/VERSION
@@ -0,0 +1 @@
+1.0.0
diff --git a/retropikzel/scgi.scm b/retropikzel/scgi.scm
new file mode 100644
index 0000000..9f0186b
--- /dev/null
+++ b/retropikzel/scgi.scm
@@ -0,0 +1,277 @@
+(define buffer-size 4000)
+
+(define get-replacement
+ (lambda (key mode)
+ (let ((r (if (string=? mode "encode")
+ (assoc key encode-replacements)
+ (assoc key decode-replacements))))
+ (if r (car (cdr r)) key))))
+
+(define scgi-split-by-zero->list
+ (lambda (source)
+ (let ((result (list))
+ (source-size (bytevector-length source)))
+ (letrec ((looper
+ (lambda (index last-index key value)
+ (if (< index source-size)
+ (if (and key value)
+ (begin
+ (if (> (bytevector-length key) 0)
+ (set! result
+ (append
+ result
+ (list (cons (utf8->string key)
+ (if (= (bytevector-length value) 0)
+ ""
+ (utf8->string value)))))))
+ (looper index last-index #f #f))
+ (if (= (bytevector-u8-ref source index) 0)
+ (let ((slice (bytevector-copy source last-index index)))
+ (if (not key)
+ (looper (+ index 1) (+ index 1) slice value)
+ (looper (+ index 1) (+ index 1) key slice)))
+ (looper (+ index 1) last-index key value)))))))
+ (looper 0 0 #f #f))
+ result)))
+
+#;(define scgi-netstring->list
+ (lambda (netstring)
+ (let ((request (list)))
+ (letrec ((get-request
+ (lambda (index)
+ (if (= (bytevector-u8-ref netstring index) 58)
+ (bytevector-copy netstring (+ index 1))
+ (get-request (+ index 1))))))
+ (if (> (bytevector-length netstring) 0)
+ (scgi-split-by-zero->list (get-request 0))
+ (list))))))
+
+#;(define scgi-get-request-body
+ (lambda (request-bytes content-length)
+ (letrec ((looper
+ (lambda (index)
+ (if (and (> (bytevector-length request-bytes) 0)
+ (= (bytevector-u8-ref request-bytes index) 0)
+ (= (bytevector-u8-ref request-bytes (+ index 1)) 44))
+ (bytevector-copy request-bytes (+ index 2))
+ (looper (- index 1))))))
+ (looper (- (bytevector-length request-bytes) 1)))))
+
+#;(define read-all-from-socket
+ (lambda (socket result)
+ (let ((bytes (socket-recv socket buffer-size)))
+ (if (or (eof-object? bytes)
+ (< (bytevector-length bytes) buffer-size))
+ (bytevector-append result bytes)
+ (read-all-from-socket socket (bytevector-append result bytes))))))
+
+(define (read-size-from-socket result socket)
+ (let ((bytes (socket-recv socket 1)))
+ (if (char=? (integer->char (bytevector-u8-ref bytes 0)) #\:)
+ (string->number (utf8->string result))
+ (read-size-from-socket (bytevector-append result bytes) socket))))
+
+(define (read-headers-from-socket socket)
+ (socket-recv socket (read-size-from-socket (bytevector) socket)))
+
+(define (read-body-from-socket socket content-size)
+ (socket-recv socket 1) ; Read away ","
+ (socket-recv socket content-size))
+
+(define (clean-files)
+ (for-each
+ (lambda (file)
+ (let ((path (cdr file)))
+ (when (file-exists? path)
+ (delete-file path))))
+ files))
+
+(define request (list))
+(define files (list))
+
+(define string-split
+ (lambda (str mark)
+ (let* ((str-l (string->list str))
+ (res (list))
+ (last-index 0)
+ (index 0)
+ (splitter (lambda (c)
+ (cond ((char=? c mark)
+ (begin
+ (set! res (append res (list (string-copy str last-index index))))
+ (set! last-index (+ index 1))))
+ ((equal? (length str-l) (+ index 1))
+ (set! res (append res (list (string-copy str last-index (+ index 1)))))))
+ (set! index (+ index 1)))))
+ (for-each splitter str-l)
+ res)))
+
+(define split-http-parameters
+ (lambda (body)
+ (cond ((or (not (string? body))
+ (string=? "" body))
+ (list))
+ (else (let ((bodylist (string->list body)))
+ (map (lambda (p)
+ (cons (list-ref p 0)
+ (if (> (length p) 1)
+ (list-ref p 1)
+ "")))
+ (map (lambda (x) (string-split x #\=))
+ (string-split (list->string bodylist)
+ #\&))))))))
+
+(define string-filter
+ (lambda (str filter)
+ (let ((result (list)))
+ (string-for-each
+ (lambda (c)
+ (if (filter c)
+ (set! result (append result (list c)))))
+ str)
+ (list->string result))))
+
+(define read-binary-port-until
+ (lambda (port result until)
+ (let ((byte (read-u8 port)))
+ (if (or (eof-object? byte)
+ (= byte until))
+ result
+ (read-binary-port-until port (bytevector-append result
+ (bytevector byte))
+ until)))))
+
+(define read-bytevector-line
+ (lambda (port)
+ (let* ((result (utf8->string (read-binary-port-until port
+ (bytevector)
+ (char->integer #\newline))))
+ (result-length (string-length result))
+ (ends-in-return? (and (> result-length 0)
+ (char=? (string-ref result (- result-length 1))
+ #\return))))
+ (cond ((= result-length 0) "")
+ (ends-in-return? (string-copy result 0 (- result-length 1)))
+ (else result)))))
+
+(define breaker (char->integer #\-))
+
+(define scgi-internal-handle
+ (lambda (client-socket thunk)
+ (let* ((headers (scgi-split-by-zero->list (read-headers-from-socket client-socket)))
+ (request-method (if (not (null? headers)) (cdr (assoc "REQUEST_METHOD" headers)) ""))
+ (content-length (if (not (null? headers)) (string->number (cdr (assoc "CONTENT_LENGTH" headers))) 0))
+ (content-type-pair (if (assoc "CONTENT_TYPE" headers)
+ (assoc "CONTENT_TYPE" headers)
+ (cons "Content-Type" "text/html")))
+ (parameters (list))
+ (content-type-data (string-split (cdr content-type-pair) #\;))
+ (content-type (list-ref content-type-data 0))
+ (body (if (> content-length 0)
+ (if (string=? content-type "multipart/form-data")
+ (bytevector)
+ (read-body-from-socket client-socket content-length))
+ (bytevector))))
+ (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 (read-body-from-socket client-socket content-length))
+ (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 (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)))
+ ((string=? request-method "POST")
+ (set! parameters (split-http-parameters (url-decode (utf8->string body)))))
+ (else (if (not (null? headers))
+ (split-http-parameters (cdr (assoc "QUERY_STRING" headers)))
+ (list))))
+ (set! request (list (cons 'headers headers)
+ (cons 'parameters parameters)
+ (cons 'files files)
+ (cons 'body (url-decode (utf8->string body)))))
+ (with-exception-handler
+ (lambda (ex)
+ (socket-send client-socket (string->utf8 "#f")))
+ (lambda ()
+ (let ((response (parameterize
+ ((current-output-port (open-output-string)))
+ (apply thunk
+ (list request
+ headers
+ parameters
+ '() ;; TODO Cookies
+ (url-decode (utf8->string body))
+ files))
+ (set! request (list))
+ (set! files (list))
+ (get-output-string (current-output-port)))))
+ (socket-send client-socket
+ (string->utf8 (if (string? response)
+ response
+ ""))))))
+ (socket-close client-socket))))
+
+(define scgi-listen
+ (lambda (socket thunk)
+ (scgi-internal-handle (socket-accept socket) thunk)
+ (clean-files)
+ (scgi-listen socket thunk)))
+
+(define (handle-request options thunk)
+ (let ((port (assoc 'port options)))
+ (when (not port)
+ (error "handle-request (scgi) requires port to be passed in options, example: '((port . \"3000\"))"))
+ (scgi-listen (make-server-socket (cdr port) *af-inet* *sock-stream* *ipproto-ip*) thunk)))
diff --git a/retropikzel/scgi.sld b/retropikzel/scgi.sld
new file mode 100644
index 0000000..542f91e
--- /dev/null
+++ b/retropikzel/scgi.sld
@@ -0,0 +1,11 @@
+(define-library
+ (retropikzel scgi)
+ (import (scheme base)
+ (scheme write)
+ (scheme char)
+ (scheme file)
+ (scheme process-context)
+ (srfi 106)
+ (retropikzel net))
+ (export handle-request)
+ (include "scgi.scm"))
diff --git a/retropikzel/scgi/LICENSE b/retropikzel/scgi/LICENSE
new file mode 100644
index 0000000..0a04128
--- /dev/null
+++ b/retropikzel/scgi/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/scgi/README.md b/retropikzel/scgi/README.md
new file mode 100644
index 0000000..4ac3d84
--- /dev/null
+++ b/retropikzel/scgi/README.md
@@ -0,0 +1,43 @@
+Scheme library implementing [Simple Common Gateway Interface](https://python.ca/scgi/protocol.txt)
+
+## Simple example
+### Scheme Server
+ (import (scheme base)
+ (scheme write)
+ (retropikzel scgi))
+
+ (handle-request
+ '((port . "3001"))
+ (lambda (request)
+ (display "Content-type: text/html")
+ (display "\r\n")
+ (display "\r\n")
+ (display "Hello world")))
+
+### HTTP Server
+
+Using lighttpd might be the simplest to get started, install it and then
+put this into file called lighttpd.conf in your project folder.
+
+ server.document-root = "/your-project-path"
+ server.errorlog = "/tmp/scgi-error.log"
+ server.modules = ("mod_scgi")
+
+ server.port = 3000
+ scgi.debug = 1
+ scgi.server = ("/" =>
+ (( "host" => "127.0.0.1",
+ "port" => 3001,
+ "check-local" => "disable")))
+
+ mimetype.assign = (
+ ".html" => "text/html",
+ ".txt" => "text/plain",
+ ".jpg" => "image/jpeg",
+ ".png" => "image/png")
+
+Run ligghtpd:
+
+ lighttpd -D -f lighttpd.conf
+
+Then run your SCGI porgram and open your browser to http://127.0.0.1:3000/
diff --git a/retropikzel/scgi/VERSION b/retropikzel/scgi/VERSION
new file mode 100644
index 0000000..3eefcb9
--- /dev/null
+++ b/retropikzel/scgi/VERSION
@@ -0,0 +1 @@
+1.0.0