diff options
author | Anonymized <anonymous@example.com> | 2018-01-20 00:04:03 +0100 |
---|---|---|
committer | Anonymized <anonymous@example.com> | 2018-01-20 00:04:03 +0100 |
commit | c0cb936b41bc9ecb6e1ccae1fad3815cc095aae0 (patch) | |
tree | 693e0f9bec4a1cb214575c62c3ba41856b30b401 | |
parent | 2a53ce66dbd2383ec323b4edac486fee3b54af21 (diff) | |
download | gnunet-guile2-c0cb936b41bc9ecb6e1ccae1fad3815cc095aae0.tar.gz gnunet-guile2-c0cb936b41bc9ecb6e1ccae1fad3815cc095aae0.zip |
add web boilerplate for c3b2 prototype
-rw-r--r-- | prototypes/c3b2/README | 1 | ||||
-rw-r--r-- | prototypes/c3b2/static/bg.png | bin | 0 -> 6267 bytes | |||
-rw-r--r-- | prototypes/c3b2/static/main.css | 68 | ||||
-rw-r--r-- | prototypes/c3b2/static/normalize.css | 419 | ||||
-rwxr-xr-x | prototypes/c3b2/web.scm | 64 | ||||
-rw-r--r-- | prototypes/c3b2/web/decode.scm | 54 | ||||
-rw-r--r-- | prototypes/c3b2/web/helpers.scm | 50 | ||||
-rw-r--r-- | prototypes/c3b2/web/html.scm | 133 | ||||
-rw-r--r-- | prototypes/c3b2/web/mime-types.scm | 553 | ||||
-rw-r--r-- | prototypes/c3b2/web/static.scm | 45 |
10 files changed, 1387 insertions, 0 deletions
diff --git a/prototypes/c3b2/README b/prototypes/c3b2/README new file mode 100644 index 0000000..0de364e --- /dev/null +++ b/prototypes/c3b2/README | |||
@@ -0,0 +1 @@ | |||
* code crafting codex bulletin board | |||
diff --git a/prototypes/c3b2/static/bg.png b/prototypes/c3b2/static/bg.png new file mode 100644 index 0000000..3656b07 --- /dev/null +++ b/prototypes/c3b2/static/bg.png | |||
Binary files differ | |||
diff --git a/prototypes/c3b2/static/main.css b/prototypes/c3b2/static/main.css new file mode 100644 index 0000000..8a39fc8 --- /dev/null +++ b/prototypes/c3b2/static/main.css | |||
@@ -0,0 +1,68 @@ | |||
1 | body { | ||
2 | background: url('bg.png'); | ||
3 | font-family: mono; | ||
4 | color: #FEFEFE; | ||
5 | font-size: 12px; | ||
6 | line-height: 1.6em; | ||
7 | padding: 15px; | ||
8 | } | ||
9 | |||
10 | h1, h2, h3, h4, h5, h6 { | ||
11 | font-family: mono; | ||
12 | text-shadow: 2px 2px 0px black; | ||
13 | margin: 0px; | ||
14 | padding: 0px; | ||
15 | line-height: 1em; | ||
16 | } | ||
17 | |||
18 | p { | ||
19 | margin: 0px; | ||
20 | padding: 0px; | ||
21 | } | ||
22 | |||
23 | a:link, | ||
24 | a:visited, | ||
25 | a:active { | ||
26 | color: white; | ||
27 | text-decoration: none; | ||
28 | } | ||
29 | |||
30 | body > div { | ||
31 | background: hsla(0, 0%, 0%, 0.3); | ||
32 | background: linear-gradient(0deg, hsla(0, 0%, 0%, 0.1) 5px, hsla(0, 0%, 100%, 0.1)); | ||
33 | border-bottom: 1px solid hsla(0, 0%, 0%, 1); | ||
34 | border-radius: 3px; | ||
35 | border-right: 1px solid hsla(0, 0%, 0%, 1); | ||
36 | box-shadow: -1px -1px 0px hsla(0, 0%, 100%, 0.3), 1px 1px 2px black; | ||
37 | display: block; | ||
38 | margin: auto; | ||
39 | margin-bottom: 15px; | ||
40 | max-width: 500px; | ||
41 | padding: 15px; | ||
42 | text-align: justify; | ||
43 | } | ||
44 | |||
45 | /* #container .repositories a { | ||
46 | display: block; | ||
47 | padding: 30px; | ||
48 | border-bottom: 1px solid hsla(0, 0%, 0%, 0.7); | ||
49 | background: linear-gradient(0deg, hsla(0, 0%, 0%, 0.1) 5px, hsla(0, 0%, 100%, 0.1)); | ||
50 | } | ||
51 | |||
52 | #container .repositories a:last-child { | ||
53 | border-bottom: none; | ||
54 | } | ||
55 | |||
56 | #container .repositories a p { | ||
57 | margin-top: 10px; | ||
58 | } | ||
59 | |||
60 | .branches { | ||
61 | padding: 15px; | ||
62 | background: linear-gradient(0deg, hsla(0, 0%, 0%, 0.1) 5px, hsla(0, 0%, 100%, 0.1)); | ||
63 | } | ||
64 | |||
65 | .branches > ul { | ||
66 | list-style: outside none none; | ||
67 | padding-left: 10px; | ||
68 | } */ | ||
diff --git a/prototypes/c3b2/static/normalize.css b/prototypes/c3b2/static/normalize.css new file mode 100644 index 0000000..18ddf7f --- /dev/null +++ b/prototypes/c3b2/static/normalize.css | |||
@@ -0,0 +1,419 @@ | |||
1 | /*! normalize.css v4.1.1 | MIT License | github.com/necolas/normalize.css */ | ||
2 | |||
3 | /** | ||
4 | * 1. Change the default font family in all browsers (opinionated). | ||
5 | * 2. Prevent adjustments of font size after orientation changes in IE and iOS. | ||
6 | */ | ||
7 | |||
8 | html { | ||
9 | font-family: sans-serif; /* 1 */ | ||
10 | -ms-text-size-adjust: 100%; /* 2 */ | ||
11 | -webkit-text-size-adjust: 100%; /* 2 */ | ||
12 | } | ||
13 | |||
14 | /** | ||
15 | * Remove the margin in all browsers (opinionated). | ||
16 | */ | ||
17 | |||
18 | body { | ||
19 | margin: 0; | ||
20 | } | ||
21 | |||
22 | /* HTML5 display definitions | ||
23 | ========================================================================== */ | ||
24 | |||
25 | /** | ||
26 | * Add the correct display in IE 9-. | ||
27 | * 1. Add the correct display in Edge, IE, and Firefox. | ||
28 | * 2. Add the correct display in IE. | ||
29 | */ | ||
30 | |||
31 | article, | ||
32 | aside, | ||
33 | details, /* 1 */ | ||
34 | figcaption, | ||
35 | figure, | ||
36 | footer, | ||
37 | header, | ||
38 | main, /* 2 */ | ||
39 | menu, | ||
40 | nav, | ||
41 | section, | ||
42 | summary { /* 1 */ | ||
43 | display: block; | ||
44 | } | ||
45 | |||
46 | /** | ||
47 | * Add the correct display in IE 9-. | ||
48 | */ | ||
49 | |||
50 | audio, | ||
51 | canvas, | ||
52 | progress, | ||
53 | video { | ||
54 | display: inline-block; | ||
55 | } | ||
56 | |||
57 | /** | ||
58 | * Add the correct display in iOS 4-7. | ||
59 | */ | ||
60 | |||
61 | audio:not([controls]) { | ||
62 | display: none; | ||
63 | height: 0; | ||
64 | } | ||
65 | |||
66 | /** | ||
67 | * Add the correct vertical alignment in Chrome, Firefox, and Opera. | ||
68 | */ | ||
69 | |||
70 | progress { | ||
71 | vertical-align: baseline; | ||
72 | } | ||
73 | |||
74 | /** | ||
75 | * Add the correct display in IE 10-. | ||
76 | * 1. Add the correct display in IE. | ||
77 | */ | ||
78 | |||
79 | template, /* 1 */ | ||
80 | [hidden] { | ||
81 | display: none; | ||
82 | } | ||
83 | |||
84 | /* Links | ||
85 | ========================================================================== */ | ||
86 | |||
87 | /** | ||
88 | * 1. Remove the gray background on active links in IE 10. | ||
89 | * 2. Remove gaps in links underline in iOS 8+ and Safari 8+. | ||
90 | */ | ||
91 | |||
92 | a { | ||
93 | background-color: transparent; /* 1 */ | ||
94 | -webkit-text-decoration-skip: objects; /* 2 */ | ||
95 | } | ||
96 | |||
97 | /** | ||
98 | * Remove the outline on focused links when they are also active or hovered | ||
99 | * in all browsers (opinionated). | ||
100 | */ | ||
101 | |||
102 | a:active, | ||
103 | a:hover { | ||
104 | outline-width: 0; | ||
105 | } | ||
106 | |||
107 | /* Text-level semantics | ||
108 | ========================================================================== */ | ||
109 | |||
110 | /** | ||
111 | * 1. Remove the bottom border in Firefox 39-. | ||
112 | * 2. Add the correct text decoration in Chrome, Edge, IE, Opera, and Safari. | ||
113 | */ | ||
114 | |||
115 | abbr[title] { | ||
116 | border-bottom: none; /* 1 */ | ||
117 | text-decoration: underline; /* 2 */ | ||
118 | text-decoration: underline dotted; /* 2 */ | ||
119 | } | ||
120 | |||
121 | /** | ||
122 | * Prevent the duplicate application of `bolder` by the next rule in Safari 6. | ||
123 | */ | ||
124 | |||
125 | b, | ||
126 | strong { | ||
127 | font-weight: inherit; | ||
128 | } | ||
129 | |||
130 | /** | ||
131 | * Add the correct font weight in Chrome, Edge, and Safari. | ||
132 | */ | ||
133 | |||
134 | b, | ||
135 | strong { | ||
136 | font-weight: bolder; | ||
137 | } | ||
138 | |||
139 | /** | ||
140 | * Add the correct font style in Android 4.3-. | ||
141 | */ | ||
142 | |||
143 | dfn { | ||
144 | font-style: italic; | ||
145 | } | ||
146 | |||
147 | /** | ||
148 | * Correct the font size and margin on `h1` elements within `section` and | ||
149 | * `article` contexts in Chrome, Firefox, and Safari. | ||
150 | */ | ||
151 | |||
152 | h1 { | ||
153 | font-size: 2em; | ||
154 | margin: 0.67em 0; | ||
155 | } | ||
156 | |||
157 | /** | ||
158 | * Add the correct background and color in IE 9-. | ||
159 | */ | ||
160 | |||
161 | mark { | ||
162 | background-color: #ff0; | ||
163 | color: #000; | ||
164 | } | ||
165 | |||
166 | /** | ||
167 | * Add the correct font size in all browsers. | ||
168 | */ | ||
169 | |||
170 | small { | ||
171 | font-size: 80%; | ||
172 | } | ||
173 | |||
174 | /** | ||
175 | * Prevent `sub` and `sup` elements from affecting the line height in | ||
176 | * all browsers. | ||
177 | */ | ||
178 | |||
179 | sub, | ||
180 | sup { | ||
181 | font-size: 75%; | ||
182 | line-height: 0; | ||
183 | position: relative; | ||
184 | vertical-align: baseline; | ||
185 | } | ||
186 | |||
187 | sub { | ||
188 | bottom: -0.25em; | ||
189 | } | ||
190 | |||
191 | sup { | ||
192 | top: -0.5em; | ||
193 | } | ||
194 | |||
195 | /* Embedded content | ||
196 | ========================================================================== */ | ||
197 | |||
198 | /** | ||
199 | * Remove the border on images inside links in IE 10-. | ||
200 | */ | ||
201 | |||
202 | img { | ||
203 | border-style: none; | ||
204 | } | ||
205 | |||
206 | /** | ||
207 | * Hide the overflow in IE. | ||
208 | */ | ||
209 | |||
210 | svg:not(:root) { | ||
211 | overflow: hidden; | ||
212 | } | ||
213 | |||
214 | /* Grouping content | ||
215 | ========================================================================== */ | ||
216 | |||
217 | /** | ||
218 | * 1. Correct the inheritance and scaling of font size in all browsers. | ||
219 | * 2. Correct the odd `em` font sizing in all browsers. | ||
220 | */ | ||
221 | |||
222 | code, | ||
223 | kbd, | ||
224 | pre, | ||
225 | samp { | ||
226 | font-family: monospace, monospace; /* 1 */ | ||
227 | font-size: 1em; /* 2 */ | ||
228 | } | ||
229 | |||
230 | /** | ||
231 | * Add the correct margin in IE 8. | ||
232 | */ | ||
233 | |||
234 | figure { | ||
235 | margin: 1em 40px; | ||
236 | } | ||
237 | |||
238 | /** | ||
239 | * 1. Add the correct box sizing in Firefox. | ||
240 | * 2. Show the overflow in Edge and IE. | ||
241 | */ | ||
242 | |||
243 | hr { | ||
244 | box-sizing: content-box; /* 1 */ | ||
245 | height: 0; /* 1 */ | ||
246 | overflow: visible; /* 2 */ | ||
247 | } | ||
248 | |||
249 | /* Forms | ||
250 | ========================================================================== */ | ||
251 | |||
252 | /** | ||
253 | * 1. Change font properties to `inherit` in all browsers (opinionated). | ||
254 | * 2. Remove the margin in Firefox and Safari. | ||
255 | */ | ||
256 | |||
257 | button, | ||
258 | input, | ||
259 | select, | ||
260 | textarea { | ||
261 | font: inherit; /* 1 */ | ||
262 | margin: 0; /* 2 */ | ||
263 | } | ||
264 | |||
265 | /** | ||
266 | * Restore the font weight unset by the previous rule. | ||
267 | */ | ||
268 | |||
269 | optgroup { | ||
270 | font-weight: bold; | ||
271 | } | ||
272 | |||
273 | /** | ||
274 | * Show the overflow in IE. | ||
275 | * 1. Show the overflow in Edge. | ||
276 | */ | ||
277 | |||
278 | button, | ||
279 | input { /* 1 */ | ||
280 | overflow: visible; | ||
281 | } | ||
282 | |||
283 | /** | ||
284 | * Remove the inheritance of text transform in Edge, Firefox, and IE. | ||
285 | * 1. Remove the inheritance of text transform in Firefox. | ||
286 | */ | ||
287 | |||
288 | button, | ||
289 | select { /* 1 */ | ||
290 | text-transform: none; | ||
291 | } | ||
292 | |||
293 | /** | ||
294 | * 1. Prevent a WebKit bug where (2) destroys native `audio` and `video` | ||
295 | * controls in Android 4. | ||
296 | * 2. Correct the inability to style clickable types in iOS and Safari. | ||
297 | */ | ||
298 | |||
299 | button, | ||
300 | html [type="button"], /* 1 */ | ||
301 | [type="reset"], | ||
302 | [type="submit"] { | ||
303 | -webkit-appearance: button; /* 2 */ | ||
304 | } | ||
305 | |||
306 | /** | ||
307 | * Remove the inner border and padding in Firefox. | ||
308 | */ | ||
309 | |||
310 | button::-moz-focus-inner, | ||
311 | [type="button"]::-moz-focus-inner, | ||
312 | [type="reset"]::-moz-focus-inner, | ||
313 | [type="submit"]::-moz-focus-inner { | ||
314 | border-style: none; | ||
315 | padding: 0; | ||
316 | } | ||
317 | |||
318 | /** | ||
319 | * Restore the focus styles unset by the previous rule. | ||
320 | */ | ||
321 | |||
322 | button:-moz-focusring, | ||
323 | [type="button"]:-moz-focusring, | ||
324 | [type="reset"]:-moz-focusring, | ||
325 | [type="submit"]:-moz-focusring { | ||
326 | outline: 1px dotted ButtonText; | ||
327 | } | ||
328 | |||
329 | /** | ||
330 | * Change the border, margin, and padding in all browsers (opinionated). | ||
331 | */ | ||
332 | |||
333 | fieldset { | ||
334 | border: 1px solid #c0c0c0; | ||
335 | margin: 0 2px; | ||
336 | padding: 0.35em 0.625em 0.75em; | ||
337 | } | ||
338 | |||
339 | /** | ||
340 | * 1. Correct the text wrapping in Edge and IE. | ||
341 | * 2. Correct the color inheritance from `fieldset` elements in IE. | ||
342 | * 3. Remove the padding so developers are not caught out when they zero out | ||
343 | * `fieldset` elements in all browsers. | ||
344 | */ | ||
345 | |||
346 | legend { | ||
347 | box-sizing: border-box; /* 1 */ | ||
348 | color: inherit; /* 2 */ | ||
349 | display: table; /* 1 */ | ||
350 | max-width: 100%; /* 1 */ | ||
351 | padding: 0; /* 3 */ | ||
352 | white-space: normal; /* 1 */ | ||
353 | } | ||
354 | |||
355 | /** | ||
356 | * Remove the default vertical scrollbar in IE. | ||
357 | */ | ||
358 | |||
359 | textarea { | ||
360 | overflow: auto; | ||
361 | } | ||
362 | |||
363 | /** | ||
364 | * 1. Add the correct box sizing in IE 10-. | ||
365 | * 2. Remove the padding in IE 10-. | ||
366 | */ | ||
367 | |||
368 | [type="checkbox"], | ||
369 | [type="radio"] { | ||
370 | box-sizing: border-box; /* 1 */ | ||
371 | padding: 0; /* 2 */ | ||
372 | } | ||
373 | |||
374 | /** | ||
375 | * Correct the cursor style of increment and decrement buttons in Chrome. | ||
376 | */ | ||
377 | |||
378 | [type="number"]::-webkit-inner-spin-button, | ||
379 | [type="number"]::-webkit-outer-spin-button { | ||
380 | height: auto; | ||
381 | } | ||
382 | |||
383 | /** | ||
384 | * 1. Correct the odd appearance in Chrome and Safari. | ||
385 | * 2. Correct the outline style in Safari. | ||
386 | */ | ||
387 | |||
388 | [type="search"] { | ||
389 | -webkit-appearance: textfield; /* 1 */ | ||
390 | outline-offset: -2px; /* 2 */ | ||
391 | } | ||
392 | |||
393 | /** | ||
394 | * Remove the inner padding and cancel buttons in Chrome and Safari on OS X. | ||
395 | */ | ||
396 | |||
397 | [type="search"]::-webkit-search-cancel-button, | ||
398 | [type="search"]::-webkit-search-decoration { | ||
399 | -webkit-appearance: none; | ||
400 | } | ||
401 | |||
402 | /** | ||
403 | * Correct the text style of placeholders in Chrome, Edge, and Safari. | ||
404 | */ | ||
405 | |||
406 | ::-webkit-input-placeholder { | ||
407 | color: inherit; | ||
408 | opacity: 0.54; | ||
409 | } | ||
410 | |||
411 | /** | ||
412 | * 1. Correct the inability to style clickable types in iOS and Safari. | ||
413 | * 2. Change font properties to `inherit` in Safari. | ||
414 | */ | ||
415 | |||
416 | ::-webkit-file-upload-button { | ||
417 | -webkit-appearance: button; /* 1 */ | ||
418 | font: inherit; /* 2 */ | ||
419 | } | ||
diff --git a/prototypes/c3b2/web.scm b/prototypes/c3b2/web.scm new file mode 100755 index 0000000..aadd744 --- /dev/null +++ b/prototypes/c3b2/web.scm | |||
@@ -0,0 +1,64 @@ | |||
1 | #!/bin/sh | ||
2 | # -*- scheme -*- | ||
3 | exec guile -L $(pwd) -e '(@@ (web) main)' -s "$0" "$@" | ||
4 | !# | ||
5 | ;;; Copyright © 2014 David Thompson <davet@gnu.org> | ||
6 | ;;; Copyright © 2015-2017 Amirouche Boubekki <amirouche@hypermove.net> | ||
7 | ;; | ||
8 | ;; This program is free software: you can redistribute it and/or modify | ||
9 | ;; it under the terms of the GNU General Public License as published by | ||
10 | ;; the Free Software Foundation, either version 3 of the License, or | ||
11 | ;; (at your option) any later version. | ||
12 | |||
13 | ;; This program is distributed in the hope that it will be useful, | ||
14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
16 | ;; GNU General Public License for more details. | ||
17 | |||
18 | ;; You should have received a copy of the GNU General Public License | ||
19 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | ||
20 | (define-module (web)) | ||
21 | |||
22 | ;; stdlib | ||
23 | (use-modules (ice-9 match)) | ||
24 | (use-modules (web request)) | ||
25 | (use-modules (web uri)) | ||
26 | |||
27 | ;; third party | ||
28 | (use-modules (fibers web server)) | ||
29 | |||
30 | ;; local | ||
31 | (use-modules (web decode)) | ||
32 | (use-modules (web helpers)) | ||
33 | (use-modules (web html)) | ||
34 | (use-modules (web mime-types)) | ||
35 | (use-modules (web static)) | ||
36 | |||
37 | |||
38 | (setlocale LC_ALL "") | ||
39 | |||
40 | ;;; | ||
41 | |||
42 | (define (template body-class body) | ||
43 | `((doctype "html") | ||
44 | (html | ||
45 | (head | ||
46 | (meta (@ (charset "utf-8"))) | ||
47 | (title "guile-web boilerplate") | ||
48 | (link (@ (rel "stylesheet") (href "/static/normalize.css"))) | ||
49 | (link (@ (rel "stylesheet") (href "/static/main.css")))) | ||
50 | (body | ||
51 | (div (h1 (a (@ (href "/")) "c3b2"))) | ||
52 | ,body)))) | ||
53 | |||
54 | |||
55 | (define (handler request body) | ||
56 | (match (cons (request-method request) (request-path-components request)) | ||
57 | (('GET) (render-html (template "index" '(div "Héllo Guilers")))) | ||
58 | (('GET "static" path ...) (render-static-asset path)) | ||
59 | (_ (not-found (uri->string (request-uri request)))))) | ||
60 | |||
61 | |||
62 | (define (main _) | ||
63 | (format #t "Server running @ http://localhost:8080\n") | ||
64 | (run-server handler)) | ||
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 | ||
30 | example: \"/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 | ||
98 | list 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 | ||
544 | found." | ||
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))) | ||