diff options
Diffstat (limited to 'cgi-bin')
| -rwxr-xr-x | cgi-bin/guest_book.cgi | 75 |
1 files changed, 69 insertions, 6 deletions
diff --git a/cgi-bin/guest_book.cgi b/cgi-bin/guest_book.cgi index 966093a..d527d2d 100755 --- a/cgi-bin/guest_book.cgi +++ b/cgi-bin/guest_book.cgi @@ -3,6 +3,8 @@ !# (use-modules (ice-9 exceptions)) +(use-modules (srfi srfi-19)) +(use-modules (sxml simple)) (use-modules (json)) (define guest-book-json-file "cgi-bin/guest_book.json") @@ -12,6 +14,7 @@ (string->number (string-append "#x" hex))))) +;; Handle query string encoding (define (format-query-string item) (letrec ((decode-query (lambda (value) @@ -38,16 +41,76 @@ ;; Progress form data (define (get-form) (let ((query (getenv "QUERY_STRING"))) - (cond ((= (string-length query) 0) #f) + (cond ((string= query "") #f) (else (map (lambda (item) (let ((pairs (string-split item #\=))) (set-cdr! pairs (format-query-string (cadr pairs))) pairs)) (string-split query #\&)))))) - + +(define (sanitize-input value) + (let ((output (open-output-string)) + (sanitized "")) + (sxml->xml `(*TOP* ,value) output) + (set! sanitized (get-output-string output)) + (close-output-port output) + sanitized)) + +(define (write-guest-to-json name url message) + (let ((guest-book '()) + (guest `(("name" . ,name) + ("url" . ,url) + ("message" . ,message) + ("date" . ,(date->string (current-date) "~B, ~d ~Y"))))) + (if (file-exists? guest-book-json-file) + (call-with-input-file guest-book-json-file + (lambda (fp) + (set! guest-book (vector->list (json->scm fp))) + ;; Handle order thingy + (set! guest-book (map (lambda (item) + (reverse item)) + guest-book))))) + + ;; Guest already added. + (letrec ((check-if-already-added + (lambda (guests) + (unless (eq? guests '()) + (unless (letrec ((guest-item-compare + (lambda (index) + (if (< index (- (length guest) 1)) + (and (cdr (list-ref (car guests) + index)) + (cdr (list-ref guest index)) + (guest-item-compare + (+ index 1))) ;; Unholyness + + (check-if-already-added (cdr guests)))))) + (check-if-already-added guest-book)) + + ;; Add guest to guest-book + (cond ((eq? guest-book '()) + (set! guest-book (list guest))) + (else + (append! guest-book (list guest)))) + + ;; Write guest book to json + (call-with-output-file guest-book-json-file + (lambda (fp) + (scm->json (list->vector guest-book) fp))))) + (define (handle-fields) - (display (get-form))) + (let ((form (get-form))) + (if form + (let ((name (sanitize-input (cdr (list-ref form 0)))) + (url (sanitize-input (cdr (list-ref form 1)))) + (message (sanitize-input (cdr (list-ref form 2))))) + (cond ((string= name "") ;; No name given + (display "<p>name is required</p>")) + ((string= message "") ;; No message given + (display "<p>please write a silly something (:</p>")) + (else + (write-guest-to-json name url message))))))) ;; Display a guest in the guest book (define (display-guest guest) @@ -133,9 +196,9 @@ table {\n\ (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))))) + (if (> index 0) + (guest-loop (- index 1)))))) + (guest-loop (- (vector-length guest-book) 1)))))) #:unwind? #t) (display " </center>\n\ |