cgi: Improvements on readme. New temp-file name generator
This commit is contained in:
parent
8bff17c6c7
commit
62296ec2d7
14
Makefile
14
Makefile
|
|
@ -38,15 +38,25 @@ package: retropikzel/${LIBRARY}/LICENSE retropikzel/${LIBRARY}/VERSION retropikz
|
|||
--version=${VERSION} \
|
||||
--authors=${AUTHOR} \
|
||||
--doc=${DOCFILE} \
|
||||
--test=${TESTFILE} \
|
||||
--description="${DESCRIPTION}" \
|
||||
${LIBRARY_FILE}
|
||||
|
||||
${PKG}: package
|
||||
|
||||
install: ${PKG}
|
||||
snow-chibi install --impls=${SCHEME} --always-yes --install-tests?=1 --show-tests?=1 ${PKG}
|
||||
snow-chibi install \
|
||||
--impls=${SCHEME} \
|
||||
--always-yes \
|
||||
--verbose?=1 \
|
||||
--install-tests?=1 \
|
||||
--show-tests?=1 \
|
||||
${PKG}
|
||||
|
||||
test:
|
||||
test: package
|
||||
snow-chibi --impls=${SCHEME} test-package ${PKG}
|
||||
|
||||
test-compile-r7rs:
|
||||
COMPILE_R7RS=${SCHEME} compile-r7rs -o test-program ${TESTFILE}
|
||||
./test-program
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,18 @@
|
|||
(define stdin (open-binary-input-file "/dev/fd/0"))
|
||||
(define stdin (current-input-port))
|
||||
(define buffer-size 4000)
|
||||
|
||||
(define (make-temp-filename filename)
|
||||
(let* ((tmpdir (or (get-environment-variable "SCM_CGI_TMPDIR")
|
||||
(cond-expand (windows (get-environment-variable "TMP"))
|
||||
(else "/tmp"))))
|
||||
(tmpfile (string-append tmpdir
|
||||
filename
|
||||
"_"
|
||||
(number->string (random-integer 1000000)))))
|
||||
(if (file-exists? tmpfile)
|
||||
(make-temp-filename filename)
|
||||
tmpfile)))
|
||||
|
||||
(define string-split
|
||||
(lambda (str mark)
|
||||
(let* ((str-l (string->list str))
|
||||
|
|
@ -33,7 +45,6 @@
|
|||
(string-split (list->string bodylist)
|
||||
#\&))))))))
|
||||
|
||||
|
||||
(define read-until-eof
|
||||
(lambda (port result)
|
||||
(let ((c (read-bytevector buffer-size port)))
|
||||
|
|
@ -179,8 +190,7 @@
|
|||
(looper (+ index 1))))))))
|
||||
(looper 0)))
|
||||
(else (let ((raw-body (if (string=? request-method "POST")
|
||||
(read-until-eof stdin (bytevector))
|
||||
"")))
|
||||
(read-until-eof stdin (bytevector)) "")))
|
||||
(set! parameters (split-http-parameters (if (string=? request-method "POST")
|
||||
raw-body
|
||||
query-string)))
|
||||
|
|
@ -193,11 +203,6 @@
|
|||
(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
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@
|
|||
(scheme file)
|
||||
(scheme char)
|
||||
(scheme process-context)
|
||||
(retropikzel net))
|
||||
(retropikzel net)
|
||||
(srfi 27))
|
||||
(export handle-request)
|
||||
(include "cgi.scm"))
|
||||
|
|
|
|||
|
|
@ -1,50 +1,41 @@
|
|||
<pre>R7RS Scheme library for Common Gateway Interface
|
||||
|
||||
If you dont know what CGI is, in short server runs your Scheme script and
|
||||
displays it's output as a webpage. Also checkout
|
||||
[https://git.sr.ht/~retropikzel/scheme-php](https://git.sr.ht/~retropikzel/scheme-php).
|
||||
displays it's output as a webpage.
|
||||
|
||||
[Project](https://sr.ht/~retropikzel/scheme-cgi/)
|
||||
## Installation
|
||||
|
||||
[Repository](https://git.sr.ht/~retropikzel/scheme-cgi)
|
||||
snow-chibi --impls=$SCHEME retropikzel.cgi
|
||||
|
||||
[Issue tracker](https://todo.sr.ht/~retropikzel/scheme-cgi)
|
||||
|
||||
## Caveats
|
||||
|
||||
- Works only on unix as it reads from /dev/fd/0 and /dev/random.
|
||||
|
||||
## Buggy on implementations
|
||||
|
||||
- Does not work with mit-scheme
|
||||
- For some reason mit-scheme exits when it reads eof-object from standard
|
||||
input
|
||||
- STklos
|
||||
- No output for some reason
|
||||
|
||||
## How to use
|
||||
|
||||
Example using Gauche in Docker.
|
||||
## Usage example
|
||||
|
||||
lighttpd.conf:
|
||||
|
||||
server.document-root = "/workdir"
|
||||
var.basedir = env.PWD
|
||||
server.document-root = basedir
|
||||
server.port = 3000
|
||||
server.modules += ("mod_cgi", "mod_dirlisting")
|
||||
cgi.assign = (".scm" => "/usr/bin/scheme-script")
|
||||
cgi.assign = (".scm" => basedir + "/scheme-script")
|
||||
dir-listing.activate = "enable"
|
||||
|
||||
Dockerfile:
|
||||
scheme-script:
|
||||
|
||||
FROM schemers/gauche
|
||||
RUN apt-get update && apt-get install -y --no-install-recommends lighttpd
|
||||
WORKDIR /workdir
|
||||
EXPOSE 3000
|
||||
COPY lighttpd.conf /lighttpd.conf
|
||||
RUN echo "#!/bin/sh" > /usr/bin/scheme-script
|
||||
RUN echo "exec gosh -r7 -I ./snow \$@" >> /usr/bin/scheme-script
|
||||
RUN chmod +x /usr/bin/scheme-script
|
||||
ENTRYPOINT ["/usr/sbin/lighttpd", "-D", "-f", "/lighttpd.conf"]
|
||||
#!/bin/sh
|
||||
#exec capy --r7rs --script "$@"
|
||||
#exec chibi-scheme "$@"
|
||||
#exec csi -quiet -batch "$@"
|
||||
#exec icyc -s "$@"
|
||||
#exec gsi /home/youruser/.gambit_userlib/ "$@"
|
||||
exec gosh "$@"
|
||||
#exec kawa --r7rs -Dkawa.import.path=/usr/local/share/kawa/lib/*.sld "$@"
|
||||
#exec loko --program "$@"
|
||||
#exec mit-scheme --batch-mode --load "$@"
|
||||
#exec racket -I r7rs --script "$@"
|
||||
#exec sash -r7 "$@"
|
||||
#exec skint "$@"
|
||||
#exec stklos "$@"
|
||||
#exec tr7i "$@"
|
||||
|
||||
hello.scm:
|
||||
|
||||
|
|
@ -55,80 +46,45 @@ hello.scm:
|
|||
(handle-request
|
||||
'()
|
||||
(lambda (request headers parameters cookies body files)
|
||||
(display "Content-type: text/html")
|
||||
(display "
|
||||
(display "Content-type: text/html
|
||||
")
|
||||
(display "
|
||||
")
|
||||
(display "Hello")))
|
||||
(display "Hello</br>")
|
||||
(write request)))
|
||||
|
||||
Run:
|
||||
run:
|
||||
|
||||
docker build . --tag=scheme-cgi
|
||||
docker run -it -v ${PWD}:/workdir -p 3000:3000 scheme-cgi
|
||||
chmod +x scheme-cript
|
||||
lighttpd -D -f lighttpd.conf
|
||||
|
||||
Then navigate with your browser to http://127.0.0.1:3000/hello.scm
|
||||
|
||||
Then navigate with your browser to http://127.0.0.1:3000
|
||||
|
||||
## Documentation
|
||||
|
||||
### Reference
|
||||
(**handle-request** options thunk)
|
||||
|
||||
**get-request**
|
||||
Options must be association list. Thunk must be procedure taking arguments:
|
||||
|
||||
Returns the whole request as association list.
|
||||
- request
|
||||
- Full request
|
||||
- headers
|
||||
- Request headers
|
||||
- parameters
|
||||
- Request parameters
|
||||
- The ?foo=bar&baz=1 part parsed
|
||||
- cookies
|
||||
- Request cookies
|
||||
- body
|
||||
- Request body
|
||||
- files
|
||||
- Request files
|
||||
|
||||
**get-header** _name_
|
||||
|
||||
Name can be symbol or a string. Returns the value of given header or #f.
|
||||
|
||||
**get-headers**
|
||||
|
||||
Returns association list of all headers.
|
||||
|
||||
**get-parameter** _name_
|
||||
|
||||
Name can be symbol or a string. Returns the value of given parameter or #f.
|
||||
|
||||
**get-parameters**
|
||||
|
||||
Returns association list of all parameters.
|
||||
|
||||
**get-cookie** _name_
|
||||
|
||||
Returns the value of given cookie or #f if.
|
||||
|
||||
**get-cookies**
|
||||
|
||||
Returns association list of all cookies.
|
||||
|
||||
**get-file** _filename_
|
||||
|
||||
Filename is a symbol or a string. Returns the path of given file from files or #f.
|
||||
|
||||
Uploaded files are stored in /tmp, with randomly generated prefix on their
|
||||
name. They are not deleted unless cgi-exit is called. Use **move-file** to move
|
||||
them into preferred location.
|
||||
|
||||
**get-files**
|
||||
|
||||
Returns association list of all files.
|
||||
|
||||
**move-file** _from_ _to_
|
||||
|
||||
Moves a file from _from_ path to _to_ path.
|
||||
|
||||
**get-body**
|
||||
|
||||
Returns the request body.
|
||||
|
||||
**cgi-exit**</br>
|
||||
**cgi-exit** _code_
|
||||
|
||||
Does necessary cleanup and exits the script. Code is a number, if it is given
|
||||
then that is used as exit code.
|
||||
Whatever thunk writes to (current-output-port) is sent back as response.
|
||||
|
||||
### Environment variables
|
||||
|
||||
**SCHEME\_CGI\_TMP\_PATH**
|
||||
**SCM_CGI_TMPDIR**
|
||||
|
||||
Path to where uploaded files are stored. Default is /tmp.</pre>
|
||||
|
|
|
|||
|
|
@ -1,50 +1,66 @@
|
|||
R7RS Scheme library for Common Gateway Interface
|
||||
|
||||
If you dont know what CGI is, in short server runs your Scheme script and
|
||||
displays it's output as a webpage. Also checkout
|
||||
[https://git.sr.ht/~retropikzel/scheme-php](https://git.sr.ht/~retropikzel/scheme-php).
|
||||
displays it's output as a webpage.
|
||||
|
||||
[Project](https://sr.ht/~retropikzel/scheme-cgi/)
|
||||
## Installation
|
||||
|
||||
[Repository](https://git.sr.ht/~retropikzel/scheme-cgi)
|
||||
snow-chibi --impls=$SCHEME retropikzel.cgi
|
||||
|
||||
[Issue tracker](https://todo.sr.ht/~retropikzel/scheme-cgi)
|
||||
|
||||
## Caveats
|
||||
## Documentation
|
||||
|
||||
- Works only on unix as it reads from /dev/fd/0 and /dev/random.
|
||||
(**handle-request** options thunk)
|
||||
|
||||
## Buggy on implementations
|
||||
Options must be association list. Thunk must be procedure taking arguments:
|
||||
|
||||
- Does not work with mit-scheme
|
||||
- For some reason mit-scheme exits when it reads eof-object from standard
|
||||
input
|
||||
- STklos
|
||||
- No output for some reason
|
||||
- request
|
||||
- Full request
|
||||
- headers
|
||||
- Request headers
|
||||
- parameters
|
||||
- Request parameters
|
||||
- The ?foo=bar&baz=1 part parsed
|
||||
- cookies
|
||||
- Request cookies
|
||||
- body
|
||||
- Request body
|
||||
- files
|
||||
- Request files
|
||||
|
||||
## How to use
|
||||
Whatever thunk writes to (current-output-port) is sent back as response.
|
||||
|
||||
Example using Gauche in Docker.
|
||||
|
||||
lighttpd.conf:
|
||||
### Environment variables
|
||||
|
||||
server.document-root = "/workdir"
|
||||
server.port = 3000
|
||||
server.modules += ("mod_cgi", "mod_dirlisting")
|
||||
cgi.assign = (".scm" => "/usr/bin/scheme-script")
|
||||
dir-listing.activate = "enable"
|
||||
**SCM_CGI_TMPDIR**
|
||||
|
||||
Dockerfile:
|
||||
Path to where uploaded files are stored. Default is /tmp.
|
||||
|
||||
FROM schemers/gauche
|
||||
RUN apt-get update && apt-get install -y --no-install-recommends lighttpd
|
||||
WORKDIR /workdir
|
||||
EXPOSE 3000
|
||||
COPY lighttpd.conf /lighttpd.conf
|
||||
RUN echo "#!/bin/sh" > /usr/bin/scheme-script
|
||||
RUN echo "exec gosh -r7 -I ./snow \$@" >> /usr/bin/scheme-script
|
||||
RUN chmod +x /usr/bin/scheme-script
|
||||
ENTRYPOINT ["/usr/sbin/lighttpd", "-D", "-f", "/lighttpd.conf"]
|
||||
|
||||
## Usage examples
|
||||
|
||||
These files are shared among all examples. We will be usign Gauche for examples,
|
||||
but you can comment out your preferred implementation or copy just that exec
|
||||
line from scheme-script. (Without the #)
|
||||
|
||||
scheme-script:
|
||||
|
||||
#!/bin/sh
|
||||
#exec capy --r7rs --script "$@"
|
||||
#exec chibi-scheme "$@"
|
||||
#exec csi -quiet -batch "$@"
|
||||
#exec icyc -s "$@"
|
||||
#exec gsi /home/youruser/.gambit_userlib/ "$@"
|
||||
exec gosh "$@"
|
||||
#exec kawa --r7rs -Dkawa.import.path=/usr/local/share/kawa/lib/*.sld "$@"
|
||||
#exec loko --program "$@"
|
||||
#exec mit-scheme --batch-mode --load "$@"
|
||||
#exec racket -I r7rs --script "$@"
|
||||
#exec sash -r7 "$@"
|
||||
#exec skint "$@"
|
||||
#exec stklos "$@"
|
||||
#exec tr7i "$@"
|
||||
|
||||
hello.scm:
|
||||
|
||||
|
|
@ -55,78 +71,68 @@ hello.scm:
|
|||
(handle-request
|
||||
'()
|
||||
(lambda (request headers parameters cookies body files)
|
||||
(display "Content-type: text/html")
|
||||
(display "Content-type: text/html\r\n")
|
||||
(display "\r\n")
|
||||
(display "\r\n")
|
||||
(display "Hello")))
|
||||
(display "Hello</br>")
|
||||
(write request)))
|
||||
|
||||
Run:
|
||||
|
||||
docker build . --tag=scheme-cgi
|
||||
docker run -it -v ${PWD}:/workdir -p 3000:3000 scheme-cgi
|
||||
### Usage lighttpd example
|
||||
|
||||
Then navigate with your browser to http://127.0.0.1:3000
|
||||
Debian/Ubuntu/Mint:
|
||||
|
||||
## Documentation
|
||||
apt-get install lighttpd
|
||||
|
||||
### Reference
|
||||
Files in any (same) directory.
|
||||
|
||||
**get-request**
|
||||
lighttpd.conf:
|
||||
|
||||
Returns the whole request as association list.
|
||||
var.basedir = env.PWD
|
||||
server.document-root = basedir
|
||||
server.port = 3000
|
||||
server.modules += ("mod_cgi", "mod_dirlisting")
|
||||
cgi.assign = (".scm" => basedir + "/scheme-script")
|
||||
dir-listing.activate = "enable"
|
||||
|
||||
**get-header** _name_
|
||||
run:
|
||||
|
||||
Name can be symbol or a string. Returns the value of given header or #f.
|
||||
chmod +x scheme-cript
|
||||
lighttpd -D -f lighttpd.conf
|
||||
|
||||
**get-headers**
|
||||
Then navigate with your browser to http://127.0.0.1:3000/hello.scm
|
||||
|
||||
Returns association list of all headers.
|
||||
|
||||
**get-parameter** _name_
|
||||
### Usage apache2 example
|
||||
|
||||
Name can be symbol or a string. Returns the value of given parameter or #f.
|
||||
Debian/Ubuntu/Mint:
|
||||
|
||||
**get-parameters**
|
||||
apt-get install apache2
|
||||
a2enmod cgi
|
||||
systemctl restart apache
|
||||
|
||||
Returns association list of all parameters.
|
||||
Only hello.scm in /var/lib/cgi-bin/
|
||||
|
||||
**get-cookie** _name_
|
||||
Add shebang line as first line of hello.scm, for example:
|
||||
|
||||
Returns the value of given cookie or #f if.
|
||||
#!/usr/local/bin/gosh
|
||||
|
||||
**get-cookies**
|
||||
run:
|
||||
|
||||
Returns association list of all cookies.
|
||||
chmod +x /var/lib/cgi-bin/hello.scm
|
||||
|
||||
**get-file** _filename_
|
||||
Then navigate with your browser to http://127.0.0.1/cgi-bin/hello.scm
|
||||
|
||||
Filename is a symbol or a string. Returns the path of given file from files or #f.
|
||||
If your server does not have cgi-bin directory you can try adding it
|
||||
|
||||
Uploaded files are stored in /tmp, with randomly generated prefix on their
|
||||
name. They are not deleted unless cgi-exit is called. Use **move-file** to move
|
||||
them into preferred location.
|
||||
mkdir cgi-bin
|
||||
|
||||
**get-files**
|
||||
cgi-bin/.htaccess:
|
||||
|
||||
Returns association list of all files.
|
||||
Options +ExecCGI
|
||||
SetHandler cgi-script
|
||||
|
||||
**move-file** _from_ _to_
|
||||
|
||||
Moves a file from _from_ path to _to_ path.
|
||||
That should work in any other dir too, but you propably want to make it treat
|
||||
only .scm files as cgi scripts.
|
||||
|
||||
**get-body**
|
||||
|
||||
Returns the request body.
|
||||
|
||||
**cgi-exit**</br>
|
||||
**cgi-exit** _code_
|
||||
|
||||
Does necessary cleanup and exits the script. Code is a number, if it is given
|
||||
then that is used as exit code.
|
||||
|
||||
### Environment variables
|
||||
|
||||
**SCHEME\_CGI\_TMP\_PATH**
|
||||
|
||||
Path to where uploaded files are stored. Default is /tmp.
|
||||
SetHandler cgi-script "scm"
|
||||
|
|
|
|||
|
|
@ -0,0 +1,11 @@
|
|||
(import (scheme base)
|
||||
(scheme write)
|
||||
(retropikzel cgi))
|
||||
|
||||
(handle-request
|
||||
'()
|
||||
(lambda (request headers parameters cookies body files)
|
||||
(display "Content-type: text/html\r\n")
|
||||
(display "\r\n")
|
||||
(display "Hello</br>")
|
||||
(write request)))
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
var.basedir = env.PWD
|
||||
server.document-root = basedir
|
||||
server.port = 3000
|
||||
server.modules += ("mod_cgi", "mod_dirlisting")
|
||||
cgi.assign = (".scm" => basedir + "/scheme-script")
|
||||
dir-listing.activate = "enable"
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
#!/bin/sh
|
||||
#exec capy --r7rs --script "$@"
|
||||
exec chibi-scheme "$@"
|
||||
#exec csi -quiet -batch "$@"
|
||||
#exec gsi /home/retropikzel/.gambit_userlib/ "$@"
|
||||
#exec gosh "$@"
|
||||
#exec kawa --r7rs -Dkawa.import.path=/usr/local/share/kawa/lib/*.sld "$@"
|
||||
#exec loko --program "$@"
|
||||
#exec mit-scheme --batch-mode --load "$@"
|
||||
#exec racket -I r7rs --script "$@"
|
||||
#exec sash -r7 "$@"
|
||||
#exec skint "$@"
|
||||
#exec stklos "$@"
|
||||
#exec tr7i "$@"
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
Scheme library implementing [FastCGI](https://en.wikipedia.org/wiki/FastCGI)
|
||||
R7RS Scheme library implementing FastCGI
|
||||
|
||||
## Simple example
|
||||
### Scheme Server
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
(import (scheme base)
|
||||
(scheme write)
|
||||
(retropikzel mouth)
|
||||
(srfi 64))
|
||||
|
||||
|
||||
(test-begin "mouth")
|
||||
|
||||
|
|
|
|||
|
|
@ -1,8 +1,3 @@
|
|||
(define temporary-directory
|
||||
(if (get-environment-variable "NET_TMP_PATH")
|
||||
(get-environment-variable "NET_TMP_PATH")
|
||||
"/tmp"))
|
||||
|
||||
(define encode-replacements
|
||||
(list (list " " "%20")
|
||||
(list " " "+")
|
||||
|
|
@ -70,26 +65,3 @@
|
|||
(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)))
|
||||
|
|
|
|||
|
|
@ -4,6 +4,5 @@
|
|||
(scheme file)
|
||||
(scheme process-context))
|
||||
(export url-encode
|
||||
url-decode
|
||||
make-temp-filename)
|
||||
url-decode)
|
||||
(include "net.scm"))
|
||||
|
|
|
|||
Loading…
Reference in New Issue