From 4e749697600bab526b1cf51bcca493f6d31d2e34 Mon Sep 17 00:00:00 2001
From: nathansmith <nathansmith@posteo.com>
Date: Fri, 23 May 2025 07:43:34 -0600
Subject: Almost done with this stupidness

---
 cgi-bin/guest_book.cgi | 218 -------------------------------------------------
 1 file changed, 218 deletions(-)
 delete mode 100755 cgi-bin/guest_book.cgi

(limited to 'cgi-bin')

diff --git a/cgi-bin/guest_book.cgi b/cgi-bin/guest_book.cgi
deleted file mode 100755
index 8c0057b..0000000
--- a/cgi-bin/guest_book.cgi
+++ /dev/null
@@ -1,218 +0,0 @@
-#! /usr/local/bin/guile3 \
--e main -s
-!#
-
-(use-modules (ice-9 exceptions))
-(use-modules (srfi srfi-19))
-(use-modules (sxml simple))
-(use-modules (json))
-
-(define guest-book-json-file "guest_book.json")
-
-(define (decode-hex hex)
-  (string (integer->char
-           (string->number (string-append "#x"
-                                          hex)))))
-
-;; Handle query string encoding
-(define (format-query-string item)
-  (letrec ((decode-query
-            (lambda (value)
-              (let ((index (string-index value #\%))
-                    (value-length (string-length value)))
-                (cond ((and index value-length)
-                       (string-append (substring value 0 index)
-                                      (decode-hex (substring value
-                                                             (+ index 1)
-                                                             (+ index 3)))
-                                      (cond ((< index (- value-length 3))
-                                             (decode-query
-                                              (substring value
-                                                         (+ index 3)
-                                                         value-length)))
-                                            (else ""))))
-                      (else value))))))
-    (decode-query (string-map (lambda (character)
-                                (case character
-                                  ((#\+) #\space)
-                                  (else character)))
-                              item))))
-
-;; Progress form data
-(define (get-form)
-  (let ((query (getenv "QUERY_STRING")))
-    (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"))))
-        (not-already-added #t))
-    
-    (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 '())
-                  (cond ((compare-guests 0 (car guests) guest)
-                         (set! not-already-added #f))
-                        (else
-                         (check-if-already-added (cdr guests)))))))
-             (compare-guests
-              (lambda (index guest1 guest2)
-                (and (string= (cdr (list-ref guest1 index))
-                              (cdr (list-ref guest2 index)))
-                     (cond ((< index 3)
-                            (compare-guests (+ index 1) guest1 guest2))
-                           (else #t))))))
-      (check-if-already-added guest-book))
-
-    ;; Add guest to guest-book
-    (cond (not-already-added
-           (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)))
-
-           (display "<p>You been added to the guest book yippe (:</p>\
-<img src=\"../images/yippee.gif\" alt=\"yippee!\"/>\n"))
-           (else
-            (display "You already been added\n")))))
-
-(define (handle-fields)
-  (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)
-  (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")
-  (handle-fields)
-  (display "        </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(s) 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 0)
-                          (guest-loop (- index 1))))))
-            (guest-loop (- (vector-length guest-book) 1))))))
-    #:unwind? #t)
-
-  (display "  </center>\n\
-</body>\n\
-</html>\n"))
-
-(define (main args)
-  (display-guest-book))
-- 
cgit v1.2.3