From 6463a9f09032f22c8e39ccea757b8a7054f199ba Mon Sep 17 00:00:00 2001
From: "Jakob L. Kreuze" <zerodaysfordays@sdf.org>
Date: Sat, 11 Mar 2023 19:33:53 -0500
Subject: Guard against non-emoji reactions

---
 haunt/jakob/dynamic/capabilities/comments.scm |  3 ++-
 haunt/jakob/dynamic/util.scm                  | 21 +++++++++++++++++++++
 2 files changed, 23 insertions(+), 1 deletion(-)

(limited to 'haunt')

diff --git a/haunt/jakob/dynamic/capabilities/comments.scm b/haunt/jakob/dynamic/capabilities/comments.scm
index 1da8abb..996c549 100644
--- a/haunt/jakob/dynamic/capabilities/comments.scm
+++ b/haunt/jakob/dynamic/capabilities/comments.scm
@@ -194,7 +194,8 @@ This is a wrapper around `get-comments-by-slug'."
     (let* ((id (assoc-value form-data "id"))
            (reaction (assoc-value form-data "reaction"))
            (reactions (comment-reactions id)))
-      (unless reactions (panic "no such comment"))
+      (unless id (panic "no such comment"))
+      (unless (emoji? reaction) (panic "invalid reaction"))
       (set-reactions id (add-reaction reactions reaction))
       (values '((content-type . (application/json)))
               (scm->json-string `((success . #t)))))))
diff --git a/haunt/jakob/dynamic/util.scm b/haunt/jakob/dynamic/util.scm
index a7fd38d..92b2f25 100644
--- a/haunt/jakob/dynamic/util.scm
+++ b/haunt/jakob/dynamic/util.scm
@@ -82,3 +82,24 @@ If KEY does not exist in TABLE, initialize kEY to (list ITEM)"
   (if (hash-ref table key)
       (hash-set! table key (cons item (hash-ref table key)))
       (hash-set! table key (list item))))
+
+(define (emoji? str)
+  "Determine if `str' is an 'acceptable' emoji character
+
+Acceptable is the following subset:
+
+- The 'Emoticons' block
+- The 'Supplemental Symbols and Pictographs' block, excluding U+1F900
+  through U+1F90B
+- The hand symbols from the 'Miscellaneous Symbols and Pictographs'
+  block
+- The hand symbols from the 'Dingbats' block
+
+Notably, U+1F946 isn't normally treated an emoji, but it is here. I
+think it should be! As an American, I should be able to use pictographs
+to express my God-given constitutional rights!"
+  (and (string str)
+       (= 1 (string-length str))
+       (let ((codepoint (char->integer
+                         (first (string->list str)))))
+         (and (>= codepoint #x1F600) (<= codepoint #x1F64F)))))
-- 
cgit v1.3