bug#40354: [PATCH] Fix Libravatar federation handling

[Philip K]

Previous implementation didn't correctly handle the result of
dns-query, and didn't implement the necessary record selection
algorithm as specified on the wiki (https://wiki.libravatar.org/api/,
"Federated servers").

* lisp/image/gravatar.el (gravatar--service-libravatar): Fix
libravatar image host resolver algorithm.
---
 lisp/image/gravatar.el | 34 +++++++++++++++++++++++++++++-----
 1 file changed, 29 insertions(+), 5 deletions(-)

diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index ff59a72ac8..a2207af962 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -149,13 +149,36 @@ gravatar--service-libravatar
           (dolist (record '(("_avatars-sec" . "https")
                             ("_avatars" . "http")))
             (let* ((query (concat (car record) "._tcp." domain))
-                   (result (dns-query query 'SRV)))
+                   (result (dns-query query 'SRV t)))
               (when result
-                (throw 'found (format "%s://%s/avatar"
-                                      (cdr record)
-                                      result)))))
-          "https://seccdn.libravatar.org/avatar";)))))
+                (let* ((res (mapcar (lambda (rec)
+                                         (dns-get 'data (cdr rec)))
+                                    (dns-get 'answers result)))
+                       (prio
+                        (mapcar (lambda (r) (dns-get 'priority r)) res))
+                       (max (apply #'max prio))
+                       (sum 0) top)
+                  ;; Attempt to find all records with the same maximal
+                  ;; priority, and calculate the sum of their weights.
+                  (dolist (rec res)
+                    (when (= max (dns-get 'priority rec))
+                      (setq sum (+ sum (dns-get 'weight rec)))
+                      (push rec top)))
+                  ;; In case there is more than one maximal priority
+                  ;; record, choose one at random, while taking the
+                  ;; individual record weights into consideration.
+                  (dolist (rec top)
+                    (when (and (<= (if (= 0 sum) -1 (random sum))
+                                   (dns-get 'weight rec))
+                               (<= 1 (dns-get 'port rec) 65535)
+                               (string-match-p "\\`[-.0-9A-Za-z]+\\'"
+                                               (dns-get 'target rec)))
+                      (throw 'found (format "%s://%s:%s/avatar"
+                                            (cdr record)
+                                            (dns-get 'target rec)
+                                            (dns-get 'port rec))))
+                    (setq sum (- sum (dns-get 'weight rec)))))))
+            "https://seccdn.libravatar.org/avatar";))))))
 
 (defun gravatar-hash (mail-address)
   "Return the Gravatar hash for MAIL-ADDRESS."
-- 
2.20.1