From 2d59f730728effe577c99291ef12919c44ea5e94 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Wed, 6 Jul 2022 18:00:41 +0200
Subject: Use a stable hash algorithm for message ids.

---
 mumi/web/controller.scm | 4 ++--
 mumi/web/util.scm       | 6 ++++++
 mumi/web/view/html.scm  | 2 +-
 mumi/xapian.scm         | 5 +++--
 4 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/mumi/web/controller.scm b/mumi/web/controller.scm
index e8163bb..2acba24 100644
--- a/mumi/web/controller.scm
+++ b/mumi/web/controller.scm
@@ -130,10 +130,10 @@
                  (render-html (unknown id))))
            (render-html (unknown id)))))
     (('GET "msgid" msgid)
-     (match (search (format #false "msgid:~a" (string-hash msgid)))
+     (match (search (format #false "msgid:~a" (msgid-hash msgid)))
        ((id . rest)
         (redirect (list "issue" id)
-                  #:fragment (format #false "msgid-~a" (string-hash msgid))))
+                  #:fragment (format #false "msgid-~a" (msgid-hash msgid))))
        (_ (render-html (unknown msgid)))))
     (('POST "issue" (? string->number id) "comment")
      (if (mailer-enabled?)
diff --git a/mumi/web/util.scm b/mumi/web/util.scm
index e968432..f3312e4 100644
--- a/mumi/web/util.scm
+++ b/mumi/web/util.scm
@@ -23,6 +23,8 @@
   #:use-module (rnrs bytevectors)
   #:use-module (gcrypt hmac)
   #:use-module (gcrypt base64)
+  #:use-module (gcrypt base16)
+  #:use-module (gcrypt hash)
   #:use-module (srfi srfi-1)
   #:use-module (web request)
   #:use-module (web uri)
@@ -31,6 +33,7 @@
             file-extension
             directory?
 
+            msgid-hash
             timestamp!
             reasonable-timestamp?))
 
@@ -51,6 +54,9 @@
 (define (directory? filename)
   (string=? filename (dirname filename)))
 
+(define (msgid-hash s)
+  (bytevector->base16-string (sha1 (string->utf8 s))))
+
 (define (timestamp!)
   (let* ((seconds (current-time))
          (key-file (string-append (%config 'key-dir) "/signing-key"))
diff --git a/mumi/web/view/html.scm b/mumi/web/view/html.scm
index 4c5cb44..552d435 100644
--- a/mumi/web/view/html.scm
+++ b/mumi/web/view/html.scm
@@ -548,7 +548,7 @@ currently disabled."))
            (a (@ (class "message-anchor")
                  (id ,(number->string message-number))))
            (a (@ (class "message-anchor")
-                 (id ,(format #false "msgid-~a" (string-hash (message-id message))))))
+                 (id ,(format #false "msgid-~a" (msgid-hash (message-id message))))))
            (div
             (@ (class "avatar")
                (style ,(string-append "background-color:"
diff --git a/mumi/xapian.scm b/mumi/xapian.scm
index 9c594d6..68169e8 100644
--- a/mumi/xapian.scm
+++ b/mumi/xapian.scm
@@ -19,6 +19,7 @@
 (define-module (mumi xapian)
   #:use-module (mumi config)
   #:use-module (mumi debbugs)
+  #:use-module ((mumi web util) #:select (msgid-hash))
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 threads)
@@ -86,7 +87,7 @@ messages and index their contents in the Xapian database at DBPATH."
                   ;; Store the message ids as base64 strings of all
                   ;; messages.
                   (msgids
-                   (string-join (map (compose number->string string-hash)
+                   (string-join (map msgid-hash
                                      (filter-map (lambda (headers)
                                                    (assoc-ref headers 'message-id))
                                                  (map email-headers emails)))
@@ -279,7 +280,7 @@ intact."
                                    ((string-prefix? "msgid:" token)
                                     (let ((msgid (substring token (string-length "msgid:"))))
                                       (format #false "msgid:~a"
-                                              (string-hash msgid))))
+                                              (msgid-hash msgid))))
                                    (else token)))
                                 (tokenize querystring))))
              ;; Parse querystring passing a stemmer and suitable
-- 
cgit v1.2.3