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

[philip@warpmail.net (Philip K.)]

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


Robert Pluim <rpluim@gmail.com> writes:

> Sorry for my delay in getting back to you. I have one question:
>
> [...]
>
> Here you do the SRV lookup for the TCP service, but I believe thereʼs
> an HTTPS service type available as well. Could you look that up first,
> then the TCP one, then fall back to the default libravatar URL?

You're right, I missed that. This patch checks the avatar-sec and avatar
record. I rewrote it a bit, to avoid duplication, so I hope the style is
ok.

-- 
	Philip K.


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

From 45ef168f4c7b2c0195de040570fa613c89e41ae4 Mon Sep 17 00:00:00 2001
From: Philip K <philip@warpmail.net>
Date: Tue, 10 Mar 2020 10:21:08 +0100
Subject: [PATCH] Add support for multiple Gravatar services

Now supports Libravatar and Unicornify, next to Gravatar.

* lisp/image/gravatar.el (gravatar-base-url): Remove constant.
(gravatar-service-alist): List supported services.
(gravatar-service): Add user option to specify service, defaults to
Libravatar.
(gravatar--service-libravatar): Add libravatar image host resolver
implementation.
(gravatar-build-url): Use alist gravatar-service-alist instead of
gravatar-base-url.
* etc/NEWS: Add note.
---
 etc/NEWS               |  6 ++++++
 lisp/image/gravatar.el | 37 +++++++++++++++++++++++++++++++++----
 2 files changed, 39 insertions(+), 4 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 7f70d149d6..7d9f858555 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -171,6 +171,12 @@ key             binding
 / v             package-menu-filter-by-version
 / /             package-menu-filter-clear
 
+** Gravatar
+
+===
+*** New user-option 'gravatar-service' for host to query for gravatars.
+Defaults to Libravatar, with Unicornify and Gravatar as options.
+
 \f
 * New Modes and Packages in Emacs 28.1
 
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index b8542bc3c3..9b4e93275d 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 (alist-get gravatar-service gravatar-service-alist)
+                   mail-address)
           (gravatar-hash mail-address)
           (gravatar--query-string)))
 
-- 
2.20.1