From 5074f14e00f00fb0343fadcf7b2ec1c33c8efaaf Mon Sep 17 00:00:00 2001
From: "Jakob L. Kreuze" <zerodaysfordays@sdf.org>
Date: Tue, 8 Nov 2022 20:49:48 -0500
Subject: [dynamic] Drop (hashing) for (gcrypt hash)

Since it's a more standard Guile dependency, meaning I don't need to bing out
Akku for something as simple as calling a hash function.
---
 .gitmodules                    |  3 +++
 dynamic/captcha.scm            | 13 +++++++++----
 ext-srfi-197                   |  1 +
 haunt/jakob/utils/comments.scm | 29 ++++++++++++++++++++++-------
 4 files changed, 35 insertions(+), 11 deletions(-)
 create mode 100644 .gitmodules
 create mode 160000 ext-srfi-197

diff --git a/.gitmodules b/.gitmodules
new file mode 100644
index 0000000..461dfa9
--- /dev/null
+++ b/.gitmodules
@@ -0,0 +1,3 @@
+[submodule "ext-srfi-197"]
+	path = ext-srfi-197
+	url = https://github.com/ar-nelson/srfi-197
diff --git a/dynamic/captcha.scm b/dynamic/captcha.scm
index 99aa0cd..b095ebf 100644
--- a/dynamic/captcha.scm
+++ b/dynamic/captcha.scm
@@ -16,7 +16,7 @@
 
 (define-module (captcha)
   #:use-module (base64)
-  #:use-module (hashing sha-2)
+  #:use-module (gcrypt hash)
   #:use-module (gcrypt mac)
   #:use-module (gcrypt random)
   #:use-module (ice-9 binary-ports)
@@ -155,10 +155,15 @@
 (define (check-proof-of-work prefix
                              challenge challenge-signature
                              expiry-timestamp timestamp-signature)
+  (define hash-value
+    (chain (list prefix challenge)
+           (string-concatenate _)
+           (string->bytevector _ "utf8")
+           (bytevector-hash _ (lookup-hash-algorithm 'sha256))
+           (bytevector->base16-string _)))
+  (define zero-prefix (string-join (map (lambda (_) "0") (iota %hardness)) ""))
   (and (= 32 (string-length prefix))
-       (string-prefix?
-        (string-join (map (lambda (_) "0") (iota %hardness)) "")
-        (sha-256->string (sha-256 (string->bytevector (string-concatenate (list prefix challenge)) "utf8"))))
+       (string-prefix? zero-prefix hash-value)
        (valid-base64-signature? %pow-mac-key challenge challenge-signature)
        (valid-base64-signature? %pow-mac-key expiry-timestamp timestamp-signature)
        (time<=? (current-time)
diff --git a/ext-srfi-197 b/ext-srfi-197
new file mode 160000
index 0000000..78ced23
--- /dev/null
+++ b/ext-srfi-197
@@ -0,0 +1 @@
+Subproject commit 78ced23a1af519ee2969939138b3ffff442f339a
diff --git a/haunt/jakob/utils/comments.scm b/haunt/jakob/utils/comments.scm
index a1deea7..65befca 100644
--- a/haunt/jakob/utils/comments.scm
+++ b/haunt/jakob/utils/comments.scm
@@ -17,24 +17,39 @@
 (define-module (jakob utils comments)
   ;; #:use-module (dynamic capabilities comments)
   #:use-module (dynamic util)
-  #:use-module (hashing md5)
+  #:use-module (gcrypt base16)
+  #:use-module (gcrypt hash)
   #:use-module (ice-9 receive)
   #:use-module (ice-9 iconv)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-43)
+  #:use-module (srfi-197)
   #:use-module (json)
   #:use-module (web client)
   #:use-module (web response)
   #:export (render-comment-view fetch-comments))
 
 (define (gravatar-url email)
-  (format #f "https://www.gravatar.com/avatar/~a" (md5->string (md5 (string->bytevector (string-trim-both (string-downcase email)) "utf8")))))
-;; (chain email
-;;        (string-downcase _)
-;;        (string-trim-both _)
-;;        (string->bytevector _ "utf8")
-;;        (md5 _))
+  (chain email
+         (string-downcase _)
+         (string-trim-both _)
+         (string->bytevector _ "utf8")
+         (bytevector-hash _ (lookup-hash-algorithm 'md5))
+         (bytevector->base16-string _)
+         (format #f "https://www.gravatar.com/avatar/~a" _)))
+
+(define (safe-markdown->sxml text)
+  "Convert TEXT to an sxml form filtering out any unsafe entities"
+  (define (sanitize sexp)
+    (cond ((and (list? sexp)
+                (positive? (length sexp))
+                (eqv? 'img (car sexp)))
+           #f)
+          ((list? sexp)
+           (filter identity (map sanitize sexp)))
+          (else sexp)))
+  (sanitize (commonmark->sxml text)))
 
 (define (format-comment comment)
   "Format `comment', an alist, as SXML for a comment-type interaction"
-- 
cgit v1.3