blob: 3963b25e0449aef49f601e4cc7cbf847b1b49841 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
#! /usr/bin/guile \
-e main -s
!#
(use-modules (ice-9 exceptions))
(use-modules (json))
(define guest-book-json-file "cgi-bin/guest_book.json")
;; Display a guest in the guest book
(define (display-guest guest)
(let ((date (cdr (list-ref guest 0)))
(message (cdr (list-ref guest 1)))
(url (cdr (list-ref guest 2)))
(name (cdr (list-ref guest 3))))
(format #t " <table border=\"1\" width=\"60%\">\n\
<tr><td>\n\
<b>~a</b> <a href=\"~a\" target=\"_blank\">~a</a> --- signed ~a\n\
</td></tr>\n\
<tr><td>\n\
<p>~a</p>\n\
</table>\n\n" name url url date message)))
;; Display pretty much everything
(define (display-guest-book)
(display "Content-Type: text/html\n\n\
<!DOCTYPE html>\n\
<html>\n\
<head>\n\
<title>Guest Book</title>\n\
<style>\n\
body {\n\
color: black;\n\
background-image: url('../images/guest_book_background.png');\n\
}\n\
\n\
table {\n\
color: black;\n\
background-color: #bebebe;\n\
margin-top: 10px;\n\
margin-bottom: 10px;\n\
margin-left: 10px;\n\
margin-right: 10px;\n\
}\n\
</style>\n\
</head>\n\
<body>\n\
<a href=\"../index.html\"><img src=\"../images/back_home.png\"\n\
alt=\"Back to home page\"/></a>\n\
<center>\n\
<table border=\"1\" width=\"60%\">\n\
<tr>\n\
<td>\n\
<h3>Sign my fucking guest book</h3>\n\
<form action = \"guest_book.cgi\" method = \"get\">\n\
<lable for = \"name\" maxlength=\"100\">Name</lable>\n\
<input type = \"text\" name = \"name\"/>\n\
<br/>\n\
<lable for = \"url\" maxlength=\"256\">Website (Optional)\n\
</lable>\n\
<input type = \"text\" name = \"url\"/>\n\
<br/><br/>\n\
<lable for = \"message\">Write a little silly something</lable>\n\
<br/>\n\
<textarea type = \"text\" name = \"message\" rows = \"4\"\n\
cols = \"40\" maxlength=\"512\"></textarea>\n\
<br/>\n\
<input type = \"submit\" value = \"Fucking submit\">\n\
<b>You can't delete/edit it afterwards</b>\n\
</form>\n\
<p>\n\
<b>Be nice! Dont be a fucking ass.</b>\n\
</p>\n\
</td>\n\
</tr>\n\
</table>\n\n")
;; Try to read the guest book json
(with-exception-handler
(lambda (error)
(display " <table border=\"1\" width=\"60%\">\n\
<tr><td>\n\
<p>No guest have been added ): But you can be the first!</p>\n\
</td></tr>\n\
</table>\n"))
(lambda ()
(call-with-input-file guest-book-json-file
(lambda (fp)
(letrec ((guest-book (json->scm fp))
(guest-loop
(lambda (index)
(display-guest (vector-ref guest-book index))
(if (< index (- (vector-length guest-book) 1))
(guest-loop (+ index 1))))))
(guest-loop 0)))))
#:unwind? #t)
(display " </center>\n\
</body>\n\
</html>\n"))
(define (main args)
(display-guest-book))
|
