aboutsummaryrefslogtreecommitdiff
path: root/prototypes/c3b2/web
diff options
context:
space:
mode:
Diffstat (limited to 'prototypes/c3b2/web')
-rw-r--r--prototypes/c3b2/web/decode.scm54
-rw-r--r--prototypes/c3b2/web/helpers.scm50
-rw-r--r--prototypes/c3b2/web/html.scm133
-rw-r--r--prototypes/c3b2/web/mime-types.scm553
-rw-r--r--prototypes/c3b2/web/static.scm45
5 files changed, 835 insertions, 0 deletions
diff --git a/prototypes/c3b2/web/decode.scm b/prototypes/c3b2/web/decode.scm
new file mode 100644
index 0000000..abf200a
--- /dev/null
+++ b/prototypes/c3b2/web/decode.scm
@@ -0,0 +1,54 @@
1;;; Copyright © 2017 Amirouche Boubekki <amirouche@hypermove.net>
2;;
3;; This program is free software: you can redistribute it and/or modify
4;; it under the terms of the GNU General Public License as published by
5;; the Free Software Foundation, either version 3 of the License, or
6;; (at your option) any later version.
7
8;; This program is distributed in the hope that it will be useful,
9;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11;; GNU General Public License for more details.
12
13;; You should have received a copy of the GNU General Public License
14;; along with this program. If not, see <http://www.gnu.org/licenses/>.
15(define-module (web decode))
16
17(use-modules (ice-9 match))
18(use-modules (rnrs bytevectors))
19(use-modules (srfi srfi-1))
20(use-modules (srfi srfi-26))
21(use-modules (web uri))
22
23;;;
24;;; decode
25;;;
26
27(define (acons-list k v alist)
28 "Add V to K to alist as list"
29 (let ((value (assoc-ref alist k)))
30 (if value
31 (let ((alist (alist-delete k alist)))
32 (acons k (cons v value) alist))
33 (acons k (list v) alist))))
34
35(define (list->alist lst)
36 "Build a alist of list based on a list of key and values.
37
38 Multiple values can be associated with the same key"
39 (let next ((lst lst)
40 (out '()))
41 (if (null? lst)
42 out
43 (next (cdr lst) (acons-list (caar lst) (cdar lst) out)))))
44
45(define-public (decode bv)
46 "Convert BV querystring or form data to an alist"
47 (define string (utf8->string bv))
48 (define pairs (map (cut string-split <> #\=)
49 ;; semi-colon and amp can be used as pair separator
50 (append-map (cut string-split <> #\;)
51 (string-split string #\&))))
52 (list->alist (map (match-lambda
53 ((key value)
54 (cons (uri-decode key) (uri-decode value)))) pairs)))
diff --git a/prototypes/c3b2/web/helpers.scm b/prototypes/c3b2/web/helpers.scm
new file mode 100644
index 0000000..597d6a0
--- /dev/null
+++ b/prototypes/c3b2/web/helpers.scm
@@ -0,0 +1,50 @@
1;;; Copyright © 2015-2017 Amirouche Boubekki <amirouche@hypermove.net>
2;;
3;; This program is free software: you can redistribute it and/or modify
4;; it under the terms of the GNU General Public License as published by
5;; the Free Software Foundation, either version 3 of the License, or
6;; (at your option) any later version.
7
8;; This program is distributed in the hope that it will be useful,
9;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11;; GNU General Public License for more details.
12
13;; You should have received a copy of the GNU General Public License
14;; along with this program. If not, see <http://www.gnu.org/licenses/>.
15(define-module (web helpers))
16
17;; stdlib
18(use-modules (web request))
19(use-modules (web response))
20(use-modules (web uri))
21
22;; local
23(use-modules (web html))
24
25
26;;; helpers
27
28(define-public (request-path-components request)
29 "Split the URI path of REQUEST into a list of component strings. For
30example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
31 (split-and-decode-uri-path (uri-path (request-uri request))))
32
33(define-public (render-html sxml)
34 (values '((content-type . (text/html)))
35 (lambda (port)
36 (sxml->html sxml port))))
37
38(define-public (forbidden)
39 (values (build-response #:code 403)
40 "Forbidden"))
41
42(define-public (not-found uri)
43 (values (build-response #:code 404)
44 (string-append "Resource not found: " uri)))
45
46(define-public (redirect uri)
47 (values (build-response #:code 303 #:headers `((Location . ,uri))) ""))
48
49(define-public (error)
50 (values (build-response #:code 500)))
diff --git a/prototypes/c3b2/web/html.scm b/prototypes/c3b2/web/html.scm
new file mode 100644
index 0000000..9190316
--- /dev/null
+++ b/prototypes/c3b2/web/html.scm
@@ -0,0 +1,133 @@
1;;; Copyright © 2015 David Thompson <davet@gnu.org>
2;;; Copyright © 2016-2017 Amirouche Boubekki <amirouche@hypermove.net>
3;;;
4;;; This program is free software: you can redistribute it and/or modify
5;;; it under the terms of the GNU General Public License as published by
6;;; the Free Software Foundation, either version 3 of the License, or
7;;; (at your option) any later version.
8;;;
9;;; This program is distributed in the hope that it will be useful,
10;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12;;; GNU General Public License for more details.
13;;;
14;;; You should have received a copy of the GNU General Public License
15;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
16
17;; ChangeLog:
18;;
19;; - 2017-XX-XX: add support for script tags
20;;
21
22(define-module (web html))
23
24(use-modules (ice-9 rdelim))
25(use-modules (sxml simple))
26(use-modules (srfi srfi-26))
27(use-modules (ice-9 match))
28(use-modules (ice-9 format))
29(use-modules (ice-9 hash-table))
30(use-modules (srfi srfi-1))
31
32(use-modules (web uri))
33(use-modules ((sxml xpath) #:renamer (symbol-prefix-proc 'sxml:)))
34
35;;;
36;;; sxml->html
37;;;
38
39(define %void-elements
40 '(area
41 base
42 br
43 col
44 command
45 embed
46 hr
47 img
48 input
49 keygen
50 link
51 meta
52 param
53 source
54 track
55 wbr))
56
57(define (void-element? tag)
58 "Return #t if TAG is a void element."
59 (pair? (memq tag %void-elements)))
60
61(define %escape-chars
62 (alist->hash-table
63 '((#\" . "quot")
64 (#\& . "amp")
65 (#\' . "apos")
66 (#\< . "lt")
67 (#\> . "gt"))))
68
69(define (string->escaped-html s port)
70 "Write the HTML escaped form of S to PORT."
71 (define (escape c)
72 (let ((escaped (hash-ref %escape-chars c)))
73 (if escaped
74 (format port "&~a;" escaped)
75 (display c port))))
76 (string-for-each escape s))
77
78(define (object->escaped-html obj port)
79 "Write the HTML escaped form of OBJ to PORT."
80 (string->escaped-html
81 (call-with-output-string (cut display obj <>))
82 port))
83
84(define (attribute-value->html value port)
85 "Write the HTML escaped form of VALUE to PORT."
86 (if (string? value)
87 (string->escaped-html value port)
88 (object->escaped-html value port)))
89
90(define (attribute->html attr value port)
91 "Write ATTR and VALUE to PORT."
92 (format port "~a=\"" attr)
93 (attribute-value->html value port)
94 (display #\" port))
95
96(define (element->html tag attrs body port)
97 "Write the HTML TAG to PORT, where TAG has the attributes in the
98list ATTRS and the child nodes in BODY."
99 (format port "<~a" tag)
100 (for-each (match-lambda
101 ((attr value)
102 (display #\space port)
103 (attribute->html attr value port)))
104 attrs)
105 (cond
106 ((and (null? body) (void-element? tag)) (display " />" port))
107 ((eqv? tag 'script) (display #\> port) (unless (null? body) (display (car body) port)) (display "</script>" port))
108 (else (begin
109 (display #\> port)
110 (for-each (cut sxml->html <> port) body)
111 (format port "</~a>" tag)))))
112
113(define (doctype->html doctype port)
114 (format port "<!DOCTYPE ~a>" doctype))
115
116(define* (sxml->html tree #:optional (port (current-output-port)))
117 "Write the serialized HTML form of TREE to PORT."
118 (match tree
119 (() *unspecified*)
120 (('doctype type)
121 (doctype->html type port))
122 (((? symbol? tag) ('@ attrs ...) body ...)
123 (element->html tag attrs body port))
124 (((? symbol? tag) body ...)
125 (element->html tag '() body port))
126 ((nodes ...)
127 (for-each (cut sxml->html <> port) nodes))
128 ((? string? text)
129 (string->escaped-html text port))
130 ;; Render arbitrary Scheme objects, too.
131 (obj (object->escaped-html obj port))))
132
133(export sxml->html)
diff --git a/prototypes/c3b2/web/mime-types.scm b/prototypes/c3b2/web/mime-types.scm
new file mode 100644
index 0000000..3413d02
--- /dev/null
+++ b/prototypes/c3b2/web/mime-types.scm
@@ -0,0 +1,553 @@
1;;; Copyright © 2014 David Thompson <davet@gnu.org>
2;;; Copyright © 2015-2017 Amirouche Boubekki <amirouche@hypermove.net>
3;;
4;; This program is free software: you can redistribute it and/or modify
5;; it under the terms of the GNU General Public License as published by
6;; the Free Software Foundation, either version 3 of the License, or
7;; (at your option) any later version.
8
9;; This program is distributed in the hope that it will be useful,
10;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12;; GNU General Public License for more details.
13
14;; You should have received a copy of the GNU General Public License
15;; along with this program. If not, see <http://www.gnu.org/licenses/>.
16(define-module (web mime-types))
17
18;; stdlib
19(use-modules (ice-9 hash-table))
20(use-modules (ice-9 regex))
21(use-modules (web uri))
22
23;;;
24;;; mime types
25;;;
26
27(define %mime-types
28 (alist->hash-table
29 '(("ez" . application/andrew-inset)
30 ("anx" . application/annodex)
31 ("atom" . application/atom+xml)
32 ("atomcat" . application/atomcat+xml)
33 ("atomsrv" . application/atomserv+xml)
34 ("lin" . application/bbolin)
35 ("cap" . application/cap)
36 ("pcap" . application/cap)
37 ("cu" . application/cu-seeme)
38 ("davmount" . application/davmount+xml)
39 ("tsp" . application/dsptype)
40 ("es" . application/ecmascript)
41 ("spl" . application/futuresplash)
42 ("hta" . application/hta)
43 ("jar" . application/java-archive)
44 ("ser" . application/java-serialized-object)
45 ("class" . application/java-vm)
46 ("js" . application/javascript)
47 ("m3g" . application/m3g)
48 ("hqx" . application/mac-binhex40)
49 ("cpt" . application/mac-compactpro)
50 ("nb" . application/mathematica)
51 ("nbp" . application/mathematica)
52 ("mdb" . application/msaccess)
53 ("doc" . application/msword)
54 ("dot" . application/msword)
55 ("mxf" . application/mxf)
56 ("bin" . application/octet-stream)
57 ("oda" . application/oda)
58 ("ogx" . application/ogg)
59 ("pdf" . application/pdf)
60 ("key" . application/pgp-keys)
61 ("pgp" . application/pgp-signature)
62 ("prf" . application/pics-rules)
63 ("ps" . application/postscript)
64 ("ai" . application/postscript)
65 ("eps" . application/postscript)
66 ("epsi" . application/postscript)
67 ("epsf" . application/postscript)
68 ("eps2" . application/postscript)
69 ("eps3" . application/postscript)
70 ("rar" . application/rar)
71 ("rdf" . application/rdf+xml)
72 ("rss" . application/rss+xml)
73 ("rtf" . application/rtf)
74 ("smi" . application/smil)
75 ("smil" . application/smil)
76 ("xhtml" . application/xhtml+xml)
77 ("xht" . application/xhtml+xml)
78 ("xml" . application/xml)
79 ("xsl" . application/xml)
80 ("xsd" . application/xml)
81 ("xspf" . application/xspf+xml)
82 ("zip" . application/zip)
83 ("apk" . application/vnd.android.package-archive)
84 ("cdy" . application/vnd.cinderella)
85 ("kml" . application/vnd.google-earth.kml+xml)
86 ("kmz" . application/vnd.google-earth.kmz)
87 ("xul" . application/vnd.mozilla.xul+xml)
88 ("xls" . application/vnd.ms-excel)
89 ("xlb" . application/vnd.ms-excel)
90 ("xlt" . application/vnd.ms-excel)
91 ("cat" . application/vnd.ms-pki.seccat)
92 ("stl" . application/vnd.ms-pki.stl)
93 ("ppt" . application/vnd.ms-powerpoint)
94 ("pps" . application/vnd.ms-powerpoint)
95 ("odc" . application/vnd.oasis.opendocument.chart)
96 ("odb" . application/vnd.oasis.opendocument.database)
97 ("odf" . application/vnd.oasis.opendocument.formula)
98 ("odg" . application/vnd.oasis.opendocument.graphics)
99 ("otg" . application/vnd.oasis.opendocument.graphics-template)
100 ("odi" . application/vnd.oasis.opendocument.image)
101 ("odp" . application/vnd.oasis.opendocument.presentation)
102 ("otp" . application/vnd.oasis.opendocument.presentation-template)
103 ("ods" . application/vnd.oasis.opendocument.spreadsheet)
104 ("ots" . application/vnd.oasis.opendocument.spreadsheet-template)
105 ("odt" . application/vnd.oasis.opendocument.text)
106 ("odm" . application/vnd.oasis.opendocument.text-master)
107 ("ott" . application/vnd.oasis.opendocument.text-template)
108 ("oth" . application/vnd.oasis.opendocument.text-web)
109 ("xlsx" . application/vnd.openxmlformats-officedocument.spreadsheetml.sheet)
110 ("xltx" . application/vnd.openxmlformats-officedocument.spreadsheetml.template)
111 ("pptx" . application/vnd.openxmlformats-officedocument.presentationml.presentation)
112 ("ppsx" . application/vnd.openxmlformats-officedocument.presentationml.slideshow)
113 ("potx" . application/vnd.openxmlformats-officedocument.presentationml.template)
114 ("docx" . application/vnd.openxmlformats-officedocument.wordprocessingml.document)
115 ("dotx" . application/vnd.openxmlformats-officedocument.wordprocessingml.template)
116 ("cod" . application/vnd.rim.cod)
117 ("mmf" . application/vnd.smaf)
118 ("sdc" . application/vnd.stardivision.calc)
119 ("sds" . application/vnd.stardivision.chart)
120 ("sda" . application/vnd.stardivision.draw)
121 ("sdd" . application/vnd.stardivision.impress)
122 ("sdf" . application/vnd.stardivision.math)
123 ("sdw" . application/vnd.stardivision.writer)
124 ("sgl" . application/vnd.stardivision.writer-global)
125 ("sxc" . application/vnd.sun.xml.calc)
126 ("stc" . application/vnd.sun.xml.calc.template)
127 ("sxd" . application/vnd.sun.xml.draw)
128 ("std" . application/vnd.sun.xml.draw.template)
129 ("sxi" . application/vnd.sun.xml.impress)
130 ("sti" . application/vnd.sun.xml.impress.template)
131 ("sxm" . application/vnd.sun.xml.math)
132 ("sxw" . application/vnd.sun.xml.writer)
133 ("sxg" . application/vnd.sun.xml.writer.global)
134 ("stw" . application/vnd.sun.xml.writer.template)
135 ("sis" . application/vnd.symbian.install)
136 ("vsd" . application/vnd.visio)
137 ("wbxml" . application/vnd.wap.wbxml)
138 ("wmlc" . application/vnd.wap.wmlc)
139 ("wmlsc" . application/vnd.wap.wmlscriptc)
140 ("wpd" . application/vnd.wordperfect)
141 ("wp5" . application/vnd.wordperfect5.1)
142 ("wk" . application/x-123)
143 ("7z" . application/x-7z-compressed)
144 ("bz2" . application/x-bzip2)
145 ("gz" . application/x-gzip)
146 ("abw" . application/x-abiword)
147 ("dmg" . application/x-apple-diskimage)
148 ("bcpio" . application/x-bcpio)
149 ("torrent" . application/x-bittorrent)
150 ("cab" . application/x-cab)
151 ("cbr" . application/x-cbr)
152 ("cbz" . application/x-cbz)
153 ("cdf" . application/x-cdf)
154 ("cda" . application/x-cdf)
155 ("vcd" . application/x-cdlink)
156 ("pgn" . application/x-chess-pgn)
157 ("cpio" . application/x-cpio)
158 ("csh" . application/x-csh)
159 ("deb" . application/x-debian-package)
160 ("udeb" . application/x-debian-package)
161 ("dcr" . application/x-director)
162 ("dir" . application/x-director)
163 ("dxr" . application/x-director)
164 ("dms" . application/x-dms)
165 ("wad" . application/x-doom)
166 ("dvi" . application/x-dvi)
167 ("rhtml" . application/x-httpd-eruby)
168 ("pfa" . application/x-font)
169 ("pfb" . application/x-font)
170 ("gsf" . application/x-font)
171 ("pcf" . application/x-font)
172 ("pcf.Z" . application/x-font)
173 ("mm" . application/x-freemind)
174 ("spl" . application/x-futuresplash)
175 ("gnumeric" . application/x-gnumeric)
176 ("sgf" . application/x-go-sgf)
177 ("gcf" . application/x-graphing-calculator)
178 ("gtar" . application/x-gtar)
179 ("tgz" . application/x-gtar)
180 ("taz" . application/x-gtar)
181 ("tar.gz" . application/x-gtar)
182 ("tar.bz2" . application/x-gtar)
183 ("tbz2" . application/x-gtar)
184 ("hdf" . application/x-hdf)
185 ("phtml" . application/x-httpd-php)
186 ("pht" . application/x-httpd-php)
187 ("php" . application/x-httpd-php)
188 ("phps" . application/x-httpd-php-source)
189 ("php3" . application/x-httpd-php3)
190 ("php3p" . application/x-httpd-php3-preprocessed)
191 ("php4" . application/x-httpd-php4)
192 ("php5" . application/x-httpd-php5)
193 ("ica" . application/x-ica)
194 ("info" . application/x-info)
195 ("ins" . application/x-internet-signup)
196 ("isp" . application/x-internet-signup)
197 ("iii" . application/x-iphone)
198 ("iso" . application/x-iso9660-image)
199 ("jam" . application/x-jam)
200 ("jnlp" . application/x-java-jnlp-file)
201 ("jmz" . application/x-jmol)
202 ("chrt" . application/x-kchart)
203 ("kil" . application/x-killustrator)
204 ("skp" . application/x-koan)
205 ("skd" . application/x-koan)
206 ("skt" . application/x-koan)
207 ("skm" . application/x-koan)
208 ("kpr" . application/x-kpresenter)
209 ("kpt" . application/x-kpresenter)
210 ("ksp" . application/x-kspread)
211 ("kwd" . application/x-kword)
212 ("kwt" . application/x-kword)
213 ("latex" . application/x-latex)
214 ("lha" . application/x-lha)
215 ("lyx" . application/x-lyx)
216 ("lzh" . application/x-lzh)
217 ("lzx" . application/x-lzx)
218 ("frm" . application/x-maker)
219 ("maker" . application/x-maker)
220 ("frame" . application/x-maker)
221 ("fm" . application/x-maker)
222 ("fb" . application/x-maker)
223 ("book" . application/x-maker)
224 ("fbdoc" . application/x-maker)
225 ("mif" . application/x-mif)
226 ("wmd" . application/x-ms-wmd)
227 ("wmz" . application/x-ms-wmz)
228 ("com" . application/x-msdos-program)
229 ("exe" . application/x-msdos-program)
230 ("bat" . application/x-msdos-program)
231 ("dll" . application/x-msdos-program)
232 ("msi" . application/x-msi)
233 ("nc" . application/x-netcdf)
234 ("pac" . application/x-ns-proxy-autoconfig)
235 ("dat" . application/x-ns-proxy-autoconfig)
236 ("nwc" . application/x-nwc)
237 ("o" . application/x-object)
238 ("oza" . application/x-oz-application)
239 ("p7r" . application/x-pkcs7-certreqresp)
240 ("crl" . application/x-pkcs7-crl)
241 ("pyc" . application/x-python-code)
242 ("pyo" . application/x-python-code)
243 ("qgs" . application/x-qgis)
244 ("shp" . application/x-qgis)
245 ("shx" . application/x-qgis)
246 ("qtl" . application/x-quicktimeplayer)
247 ("rpm" . application/x-redhat-package-manager)
248 ("rb" . application/x-ruby)
249 ("sh" . application/x-sh)
250 ("shar" . application/x-shar)
251 ("swf" . application/x-shockwave-flash)
252 ("swfl" . application/x-shockwave-flash)
253 ("scr" . application/x-silverlight)
254 ("sit" . application/x-stuffit)
255 ("sitx" . application/x-stuffit)
256 ("sv4cpio" . application/x-sv4cpio)
257 ("sv4crc" . application/x-sv4crc)
258 ("tar" . application/x-tar)
259 ("tcl" . application/x-tcl)
260 ("gf" . application/x-tex-gf)
261 ("pk" . application/x-tex-pk)
262 ("texinfo" . application/x-texinfo)
263 ("texi" . application/x-texinfo)
264 ("~" . application/x-trash)
265 ("%" . application/x-trash)
266 ("bak" . application/x-trash)
267 ("old" . application/x-trash)
268 ("sik" . application/x-trash)
269 ("t" . application/x-troff)
270 ("tr" . application/x-troff)
271 ("roff" . application/x-troff)
272 ("man" . application/x-troff-man)
273 ("me" . application/x-troff-me)
274 ("ms" . application/x-troff-ms)
275 ("ustar" . application/x-ustar)
276 ("src" . application/x-wais-source)
277 ("wz" . application/x-wingz)
278 ("crt" . application/x-x509-ca-cert)
279 ("xcf" . application/x-xcf)
280 ("fig" . application/x-xfig)
281 ("xpi" . application/x-xpinstall)
282 ("amr" . audio/amr)
283 ("awb" . audio/amr-wb)
284 ("amr" . audio/amr)
285 ("awb" . audio/amr-wb)
286 ("axa" . audio/annodex)
287 ("au" . audio/basic)
288 ("snd" . audio/basic)
289 ("flac" . audio/flac)
290 ("mid" . audio/midi)
291 ("midi" . audio/midi)
292 ("kar" . audio/midi)
293 ("mpga" . audio/mpeg)
294 ("mpega" . audio/mpeg)
295 ("mp2" . audio/mpeg)
296 ("mp3" . audio/mpeg)
297 ("m4a" . audio/mpeg)
298 ("m3u" . audio/mpegurl)
299 ("oga" . audio/ogg)
300 ("ogg" . audio/ogg)
301 ("spx" . audio/ogg)
302 ("sid" . audio/prs.sid)
303 ("aif" . audio/x-aiff)
304 ("aiff" . audio/x-aiff)
305 ("aifc" . audio/x-aiff)
306 ("gsm" . audio/x-gsm)
307 ("m3u" . audio/x-mpegurl)
308 ("wma" . audio/x-ms-wma)
309 ("wax" . audio/x-ms-wax)
310 ("ra" . audio/x-pn-realaudio)
311 ("rm" . audio/x-pn-realaudio)
312 ("ram" . audio/x-pn-realaudio)
313 ("ra" . audio/x-realaudio)
314 ("pls" . audio/x-scpls)
315 ("sd2" . audio/x-sd2)
316 ("wav" . audio/x-wav)
317 ("alc" . chemical/x-alchemy)
318 ("cac" . chemical/x-cache)
319 ("cache" . chemical/x-cache)
320 ("csf" . chemical/x-cache-csf)
321 ("cbin" . chemical/x-cactvs-binary)
322 ("cascii" . chemical/x-cactvs-binary)
323 ("ctab" . chemical/x-cactvs-binary)
324 ("cdx" . chemical/x-cdx)
325 ("cer" . chemical/x-cerius)
326 ("c3d" . chemical/x-chem3d)
327 ("chm" . chemical/x-chemdraw)
328 ("cif" . chemical/x-cif)
329 ("cmdf" . chemical/x-cmdf)
330 ("cml" . chemical/x-cml)
331 ("cpa" . chemical/x-compass)
332 ("bsd" . chemical/x-crossfire)
333 ("csml" . chemical/x-csml)
334 ("csm" . chemical/x-csml)
335 ("ctx" . chemical/x-ctx)
336 ("cxf" . chemical/x-cxf)
337 ("cef" . chemical/x-cxf)
338 ("emb" . chemical/x-embl-dl-nucleotide)
339 ("embl" . chemical/x-embl-dl-nucleotide)
340 ("spc" . chemical/x-galactic-spc)
341 ("inp" . chemical/x-gamess-input)
342 ("gam" . chemical/x-gamess-input)
343 ("gamin" . chemical/x-gamess-input)
344 ("fch" . chemical/x-gaussian-checkpoint)
345 ("fchk" . chemical/x-gaussian-checkpoint)
346 ("cub" . chemical/x-gaussian-cube)
347 ("gau" . chemical/x-gaussian-input)
348 ("gjc" . chemical/x-gaussian-input)
349 ("gjf" . chemical/x-gaussian-input)
350 ("gal" . chemical/x-gaussian-log)
351 ("gcg" . chemical/x-gcg8-sequence)
352 ("gen" . chemical/x-genbank)
353 ("hin" . chemical/x-hin)
354 ("istr" . chemical/x-isostar)
355 ("ist" . chemical/x-isostar)
356 ("jdx" . chemical/x-jcamp-dx)
357 ("dx" . chemical/x-jcamp-dx)
358 ("kin" . chemical/x-kinemage)
359 ("mcm" . chemical/x-macmolecule)
360 ("mmd" . chemical/x-macromodel-input)
361 ("mmod" . chemical/x-macromodel-input)
362 ("mol" . chemical/x-mdl-molfile)
363 ("rd" . chemical/x-mdl-rdfile)
364 ("rxn" . chemical/x-mdl-rxnfile)
365 ("sd" . chemical/x-mdl-sdfile)
366 ("sdf" . chemical/x-mdl-sdfile)
367 ("tgf" . chemical/x-mdl-tgf)
368 ("mcif" . chemical/x-mmcif)
369 ("mol2" . chemical/x-mol2)
370 ("b" . chemical/x-molconn-Z)
371 ("gpt" . chemical/x-mopac-graph)
372 ("mop" . chemical/x-mopac-input)
373 ("mopcrt" . chemical/x-mopac-input)
374 ("mpc" . chemical/x-mopac-input)
375 ("zmt" . chemical/x-mopac-input)
376 ("moo" . chemical/x-mopac-out)
377 ("mvb" . chemical/x-mopac-vib)
378 ("asn" . chemical/x-ncbi-asn1)
379 ("prt" . chemical/x-ncbi-asn1-ascii)
380 ("ent" . chemical/x-ncbi-asn1-ascii)
381 ("val" . chemical/x-ncbi-asn1-binary)
382 ("aso" . chemical/x-ncbi-asn1-binary)
383 ("asn" . chemical/x-ncbi-asn1-spec)
384 ("pdb" . chemical/x-pdb)
385 ("ent" . chemical/x-pdb)
386 ("ros" . chemical/x-rosdal)
387 ("sw" . chemical/x-swissprot)
388 ("vms" . chemical/x-vamas-iso14976)
389 ("vmd" . chemical/x-vmd)
390 ("xtel" . chemical/x-xtel)
391 ("xyz" . chemical/x-xyz)
392 ("gif" . image/gif)
393 ("ief" . image/ief)
394 ("jpeg" . image/jpeg)
395 ("jpg" . image/jpeg)
396 ("jpe" . image/jpeg)
397 ("pcx" . image/pcx)
398 ("png" . image/png)
399 ("svg" . image/svg+xml)
400 ("svgz" . image/svg+xml)
401 ("tiff" . image/tiff)
402 ("tif" . image/tiff)
403 ("djvu" . image/vnd.djvu)
404 ("djv" . image/vnd.djvu)
405 ("wbmp" . image/vnd.wap.wbmp)
406 ("cr2" . image/x-canon-cr2)
407 ("crw" . image/x-canon-crw)
408 ("ras" . image/x-cmu-raster)
409 ("cdr" . image/x-coreldraw)
410 ("pat" . image/x-coreldrawpattern)
411 ("cdt" . image/x-coreldrawtemplate)
412 ("cpt" . image/x-corelphotopaint)
413 ("erf" . image/x-epson-erf)
414 ("ico" . image/x-icon)
415 ("art" . image/x-jg)
416 ("jng" . image/x-jng)
417 ("bmp" . image/x-ms-bmp)
418 ("nef" . image/x-nikon-nef)
419 ("orf" . image/x-olympus-orf)
420 ("psd" . image/x-photoshop)
421 ("pnm" . image/x-portable-anymap)
422 ("pbm" . image/x-portable-bitmap)
423 ("pgm" . image/x-portable-graymap)
424 ("ppm" . image/x-portable-pixmap)
425 ("rgb" . image/x-rgb)
426 ("xbm" . image/x-xbitmap)
427 ("xpm" . image/x-xpixmap)
428 ("xwd" . image/x-xwindowdump)
429 ("eml" . message/rfc822)
430 ("igs" . model/iges)
431 ("iges" . model/iges)
432 ("msh" . model/mesh)
433 ("mesh" . model/mesh)
434 ("silo" . model/mesh)
435 ("wrl" . model/vrml)
436 ("vrml" . model/vrml)
437 ("x3dv" . model/x3d+vrml)
438 ("x3d" . model/x3d+xml)
439 ("x3db" . model/x3d+binary)
440 ("manifest" . text/cache-manifest)
441 ("ics" . text/calendar)
442 ("icz" . text/calendar)
443 ("css" . text/css)
444 ("csv" . text/csv)
445 ("323" . text/h323)
446 ("html" . text/html)
447 ("htm" . text/html)
448 ("shtml" . text/html)
449 ("uls" . text/iuls)
450 ("mml" . text/mathml)
451 ("asc" . text/plain)
452 ("txt" . text/plain)
453 ("text" . text/plain)
454 ("pot" . text/plain)
455 ("brf" . text/plain)
456 ("rtx" . text/richtext)
457 ("sct" . text/scriptlet)
458 ("wsc" . text/scriptlet)
459 ("tm" . text/texmacs)
460 ("ts" . text/texmacs)
461 ("tsv" . text/tab-separated-values)
462 ("jad" . text/vnd.sun.j2me.app-descriptor)
463 ("wml" . text/vnd.wap.wml)
464 ("wmls" . text/vnd.wap.wmlscript)
465 ("bib" . text/x-bibtex)
466 ("boo" . text/x-boo)
467 ("h++" . text/x-c++hdr)
468 ("hpp" . text/x-c++hdr)
469 ("hxx" . text/x-c++hdr)
470 ("hh" . text/x-c++hdr)
471 ("c++" . text/x-c++src)
472 ("cpp" . text/x-c++src)
473 ("cxx" . text/x-c++src)
474 ("cc" . text/x-c++src)
475 ("h" . text/x-chdr)
476 ("htc" . text/x-component)
477 ("csh" . text/x-csh)
478 ("c" . text/x-csrc)
479 ("d" . text/x-dsrc)
480 ("diff" . text/x-diff)
481 ("patch" . text/x-diff)
482 ("hs" . text/x-haskell)
483 ("java" . text/x-java)
484 ("lhs" . text/x-literate-haskell)
485 ("moc" . text/x-moc)
486 ("p" . text/x-pascal)
487 ("pas" . text/x-pascal)
488 ("gcd" . text/x-pcs-gcd)
489 ("pl" . text/x-perl)
490 ("pm" . text/x-perl)
491 ("py" . text/x-python)
492 ("scala" . text/x-scala)
493 ("etx" . text/x-setext)
494 ("sh" . text/x-sh)
495 ("tcl" . text/x-tcl)
496 ("tk" . text/x-tcl)
497 ("tex" . text/x-tex)
498 ("ltx" . text/x-tex)
499 ("sty" . text/x-tex)
500 ("cls" . text/x-tex)
501 ("vcs" . text/x-vcalendar)
502 ("vcf" . text/x-vcard)
503 ("json" . text/javascript)
504 ("3gp" . video/3gpp)
505 ("axv" . video/annodex)
506 ("dl" . video/dl)
507 ("dif" . video/dv)
508 ("dv" . video/dv)
509 ("fli" . video/fli)
510 ("gl" . video/gl)
511 ("mpeg" . video/mpeg)
512 ("mpg" . video/mpeg)
513 ("mpe" . video/mpeg)
514 ("mp4" . video/mp4)
515 ("qt" . video/quicktime)
516 ("mov" . video/quicktime)
517 ("ogv" . video/ogg)
518 ("mxu" . video/vnd.mpegurl)
519 ("flv" . video/x-flv)
520 ("lsf" . video/x-la-asf)
521 ("lsx" . video/x-la-asf)
522 ("mng" . video/x-mng)
523 ("asf" . video/x-ms-asf)
524 ("asx" . video/x-ms-asf)
525 ("wm" . video/x-ms-wm)
526 ("wmv" . video/x-ms-wmv)
527 ("wmx" . video/x-ms-wmx)
528 ("wvx" . video/x-ms-wvx)
529 ("avi" . video/x-msvideo)
530 ("movie" . video/x-sgi-movie)
531 ("mpv" . video/x-matroska)
532 ("mkv" . video/x-matroska)
533 ("ice" . x-conference/x-cooltalk)
534 ("sisx" . x-epoc/x-sisx-app)
535 ("vrm" . x-world/x-vrml)
536 ("vrml" . x-world/x-vrml)
537 ("wrl" . x-world/x-vrml))))
538
539(define %file-ext-regexp
540 (make-regexp "(\\.(.*)|[~%])$"))
541
542(define (file-extension file-name)
543 "Return the file extension for FILE-NAME, or #f if one is not
544found."
545 (and=> (regexp-exec %file-ext-regexp file-name)
546 (lambda (match)
547 (or (match:substring match 2)
548 (match:substring match 1)))))
549
550(define-public (mime-type file-name)
551 "Guess the MIME type for FILE-NAME based upon its file extension."
552 (or (hash-ref %mime-types (file-extension file-name))
553 'text/plain))
diff --git a/prototypes/c3b2/web/static.scm b/prototypes/c3b2/web/static.scm
new file mode 100644
index 0000000..49c618d
--- /dev/null
+++ b/prototypes/c3b2/web/static.scm
@@ -0,0 +1,45 @@
1;;; Copyright © 2014 David Thompson <davet@gnu.org>
2;;; Copyright © 2015-2017 Amirouche Boubekki <amirouche@hypermove.net>
3;;
4;; This program is free software: you can redistribute it and/or modify
5;; it under the terms of the GNU General Public License as published by
6;; the Free Software Foundation, either version 3 of the License, or
7;; (at your option) any later version.
8
9;; This program is distributed in the hope that it will be useful,
10;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12;; GNU General Public License for more details.
13
14;; You should have received a copy of the GNU General Public License
15;; along with this program. If not, see <http://www.gnu.org/licenses/>.
16(define-module (web static))
17
18;; stdlib
19(use-modules (ice-9 binary-ports))
20
21;; local
22(use-modules (web mime-types))
23(use-modules (web helpers))
24
25;;;
26;;; static assets rendering
27;;;
28
29(define (valid? path)
30 (null? (filter (lambda (component) (equal? component "..")) path)))
31
32(define (directory? filename)
33 (string=? filename (dirname filename)))
34
35(define-public (render-static-asset path)
36 (if (valid? path)
37 ;; XXX: the requested file is translated into a filpath related to where
38 ;; the server is executed.
39 (let ((filename (string-join (cons* (getcwd) "static" path)
40 "/")))
41 (if (and (file-exists? filename) (not (directory? filename)))
42 (values `((content-type ,(mime-type filename)))
43 (call-with-input-file filename get-bytevector-all))
44 (not-found (string-join (cons "static" path) "/" 'prefix))))
45 (forbidden)))