From 42753c1b18c74b9ef0f4cdb90272fcf663ac0c56 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sat, 17 Jan 2026 10:33:44 +0200 Subject: [PATCH] Adding fastcgi library --- lighttpd.conf | 16 +++ retropikzel/cgi.scm | 156 ++++----------------- retropikzel/cgi.sld | 6 +- retropikzel/cgi/VERSION | 2 +- retropikzel/fcgi.scm | 219 +++++++++++++++++++++++++++++ retropikzel/fcgi.sld | 12 ++ retropikzel/fcgi/LICENSE | 165 ++++++++++++++++++++++ retropikzel/fcgi/README.md | 43 ++++++ retropikzel/fcgi/VERSION | 1 + retropikzel/net.scm | 95 +++++++++++++ retropikzel/net.sld | 9 ++ retropikzel/net/LICENSE | 165 ++++++++++++++++++++++ retropikzel/net/README.md | 1 + retropikzel/net/VERSION | 1 + retropikzel/scgi.scm | 277 +++++++++++++++++++++++++++++++++++++ retropikzel/scgi.sld | 11 ++ retropikzel/scgi/LICENSE | 165 ++++++++++++++++++++++ retropikzel/scgi/README.md | 43 ++++++ retropikzel/scgi/VERSION | 1 + 19 files changed, 1254 insertions(+), 134 deletions(-) create mode 100644 lighttpd.conf create mode 100644 retropikzel/fcgi.scm create mode 100644 retropikzel/fcgi.sld create mode 100644 retropikzel/fcgi/LICENSE create mode 100644 retropikzel/fcgi/README.md create mode 100644 retropikzel/fcgi/VERSION create mode 100644 retropikzel/net.scm create mode 100644 retropikzel/net.sld create mode 100644 retropikzel/net/LICENSE create mode 100644 retropikzel/net/README.md create mode 100644 retropikzel/net/VERSION create mode 100644 retropikzel/scgi.scm create mode 100644 retropikzel/scgi.sld create mode 100644 retropikzel/scgi/LICENSE create mode 100644 retropikzel/scgi/README.md create mode 100644 retropikzel/scgi/VERSION 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