bug#39965: [PATCH] Add support for multiple gravatar-like services

[Philip Kaludercic <philip.kaludercic@fau.de>]

[-- Attachment #1: Type: text/plain, Size: 931 bytes --]

Robert Pluim <rpluim@gmail.com> writes:

> (please keep 39965@debbugs.gnu.org in the CC list)

Sorry for that!

>>>>>> On Mon, 09 Mar 2020 15:48:59 +0100, Philip Kaludercic <philip.kaludercic@fau.de> said:
>
>     >> 
>     >> If you make this an alist then your cond below becomes just
>     >> 'alist-get', and you have the URLS in just one place.
>
>     Philip> That's right, I had already "fixed" that in the next version of the
>     Philip> patch, but primarily because libravatar requires a bit more to work
>     Philip> correctly than just alist-get.
>
> OK
>
>     Philip> Sadly I cannot send the patch right now, because git-send-email doesn't
>     Philip> work from where I am writing.
>
> git format-patch HEAD~ + attaching the result will work as
> well, assuming your MUA doesnʼt mangle patches :-)

In that case I'm attaching the patch to this mail, I hope Gnus handels
it corretly. 


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-support-for-multiple-gravatar-like-services.patch --]
[-- Type: text/x-diff, Size: 3790 bytes --]

From 5c967bc9e2c3bc72e3803d84b23b8b121328c49c Mon Sep 17 00:00:00 2001
From: Philip K <philip@warpmail.net>
Date: Fri, 6 Mar 2020 12:40:28 +0100
Subject: [PATCH] Add support for multiple gravatar-like services

Specifically, the non-proprietary services libravatar (now default)
and unicornify have been added. The behaviour is customised via the
new variable `gravatar-service'.
---
 etc/NEWS                          |  7 ++++++
 lisp/image/gravatar.el            | 37 +++++++++++++++++++++++++++----
 test/lisp/image/gravatar-tests.el |  1 +
 3 files changed, 41 insertions(+), 4 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 7f70d149d6..24edf2de6a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -171,6 +171,13 @@ key             binding
 / v             package-menu-filter-by-version
 / /             package-menu-filter-clear
 
+** gravatar.el
+
+---
+*** New variable `gravatar-service' changes avatar service.
+Now supports Libravatar (as default) and Unicornify, next to the
+already implemented Gravatar.
+
 \f
 * New Modes and Packages in Emacs 28.1
 
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index b8542bc3c3..4ac545730a 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -118,9 +118,37 @@ gravatar-force-default
   :version "27.1"
   :group 'gravatar)
 
-(defconst gravatar-base-url
-  "https://www.gravatar.com/avatar"
-  "Base URL for getting gravatars.")
+(defconst gravatar-service-alist
+  `((gravatar . ,(lambda (_addr) "https://www.gravatar.com/avatar"))
+    (unicornify . ,(lambda (_addr) "https://unicornify.pictures/avatar/"))
+    (libravatar . ,#'gravatar--service-libravatar))
+  "Alist of supported gravatar services.")
+
+(defcustom gravatar-service 'libravatar
+  "Symbol denoting gravatar-like service to use.
+Note that certain services might ignore other options, such as
+`gravatar-default-image' or certain values as with
+`gravatar-rating'."
+  :type `(choice ,@(mapcar (lambda (s) `(const ,(car s)))
+                           gravatar-service-alist))
+  :version "28.1"
+  :link '(url-link "https://www.libravatar.org/")
+  :link '(url-link "https://unicornify.pictures/")
+  :link '(url-link "https://gravatar.com/")
+  :group 'gravatar)
+
+(defun gravatar--service-libravatar (addr)
+  "Find domain that hosts avatars for email address ADDR."
+  ;; implements https://wiki.libravatar.org/api/
+  (require 'dns)
+  (let* ((domain (save-match-data
+                   (unless (string-match ".+@\\(.+\\)" addr)
+                     (error "%s is not an email address" addr))
+                   (match-string 1 addr)))
+         (result (dns-query (concat "_avatars._tcp." domain) 'SRV)))
+    (if result
+        (concat "http://" result "/address")
+      "https://seccdn.libravatar.org/avatar")))
 
 (defun gravatar-hash (mail-address)
   "Return the Gravatar hash for MAIL-ADDRESS."
@@ -142,7 +170,8 @@ gravatar-build-url
   "Return the URL of a gravatar for MAIL-ADDRESS."
   ;; https://gravatar.com/site/implement/images/
   (format "%s/%s?%s"
-          gravatar-base-url
+          (funcall (cdr (assq gravatar-service gravatar-service-alist))
+                   mail-address)
           (gravatar-hash mail-address)
           (gravatar--query-string)))
 
diff --git a/test/lisp/image/gravatar-tests.el b/test/lisp/image/gravatar-tests.el
index e66b5c6803..31a28293fa 100644
--- a/test/lisp/image/gravatar-tests.el
+++ b/test/lisp/image/gravatar-tests.el
@@ -65,6 +65,7 @@ gravatar-build-url
   "Test `gravatar-build-url'."
   (let ((gravatar-default-image nil)
         (gravatar-force-default nil)
+        (gravatar-service 'gravatar)
         (gravatar-size nil))
     (should (equal (gravatar-build-url "foo") "\
 https://www.gravatar.com/avatar/acbd18db4cc2f85cedef654fccc4a4d8?r=g"))))
-- 
2.20.1