aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAnonymized <anonymous@example.com>2018-01-20 00:04:03 +0100
committerAnonymized <anonymous@example.com>2018-01-20 00:04:03 +0100
commitc0cb936b41bc9ecb6e1ccae1fad3815cc095aae0 (patch)
tree693e0f9bec4a1cb214575c62c3ba41856b30b401
parent2a53ce66dbd2383ec323b4edac486fee3b54af21 (diff)
downloadgnunet-guile2-c0cb936b41bc9ecb6e1ccae1fad3815cc095aae0.tar.gz
gnunet-guile2-c0cb936b41bc9ecb6e1ccae1fad3815cc095aae0.zip
add web boilerplate for c3b2 prototype
-rw-r--r--prototypes/c3b2/README1
-rw-r--r--prototypes/c3b2/static/bg.pngbin0 -> 6267 bytes
-rw-r--r--prototypes/c3b2/static/main.css68
-rw-r--r--prototypes/c3b2/static/normalize.css419
-rwxr-xr-xprototypes/c3b2/web.scm64
-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
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 @@
1body {
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
10h1, 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
18p {
19 margin: 0px;
20 padding: 0px;
21}
22
23a:link,
24a:visited,
25a:active {
26 color: white;
27 text-decoration: none;
28}
29
30body > 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
8html {
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
18body {
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
31article,
32aside,
33details, /* 1 */
34figcaption,
35figure,
36footer,
37header,
38main, /* 2 */
39menu,
40nav,
41section,
42summary { /* 1 */
43 display: block;
44}
45
46/**
47 * Add the correct display in IE 9-.
48 */
49
50audio,
51canvas,
52progress,
53video {
54 display: inline-block;
55}
56
57/**
58 * Add the correct display in iOS 4-7.
59 */
60
61audio:not([controls]) {
62 display: none;
63 height: 0;
64}
65
66/**
67 * Add the correct vertical alignment in Chrome, Firefox, and Opera.
68 */
69
70progress {
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
79template, /* 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
92a {
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
102a:active,
103a: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
115abbr[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
125b,
126strong {
127 font-weight: inherit;
128}
129
130/**
131 * Add the correct font weight in Chrome, Edge, and Safari.
132 */
133
134b,
135strong {
136 font-weight: bolder;
137}
138
139/**
140 * Add the correct font style in Android 4.3-.
141 */
142
143dfn {
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
152h1 {
153 font-size: 2em;
154 margin: 0.67em 0;
155}
156
157/**
158 * Add the correct background and color in IE 9-.
159 */
160
161mark {
162 background-color: #ff0;
163 color: #000;
164}
165
166/**
167 * Add the correct font size in all browsers.
168 */
169
170small {
171 font-size: 80%;
172}
173
174/**
175 * Prevent `sub` and `sup` elements from affecting the line height in
176 * all browsers.
177 */
178
179sub,
180sup {
181 font-size: 75%;
182 line-height: 0;
183 position: relative;
184 vertical-align: baseline;
185}
186
187sub {
188 bottom: -0.25em;
189}
190
191sup {
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
202img {
203 border-style: none;
204}
205
206/**
207 * Hide the overflow in IE.
208 */
209
210svg: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
222code,
223kbd,
224pre,
225samp {
226 font-family: monospace, monospace; /* 1 */
227 font-size: 1em; /* 2 */
228}
229
230/**
231 * Add the correct margin in IE 8.
232 */
233
234figure {
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
243hr {
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
257button,
258input,
259select,
260textarea {
261 font: inherit; /* 1 */
262 margin: 0; /* 2 */
263}
264
265/**
266 * Restore the font weight unset by the previous rule.
267 */
268
269optgroup {
270 font-weight: bold;
271}
272
273/**
274 * Show the overflow in IE.
275 * 1. Show the overflow in Edge.
276 */
277
278button,
279input { /* 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
288button,
289select { /* 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
299button,
300html [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
310button::-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
322button:-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
333fieldset {
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
346legend {
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
359textarea {
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 -*-
3exec 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
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)))