bug#49033: 28.0.50; [PATCH] Feature suggestion, url-cache-expiry-alist to override expire time for cache pruning

[Alex Bochannek <alex@bochannek.com>]

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

Hello!

I was looking at the Gravatar code and noticed Larsi's change last year
to disable the URL caching and instead use a hash table. I would like to
see the timeout for the hash table configurable again and this sent me
to the `url-cache-expired' and `url-cache-prune-cache' functions. It
appears that `url-cache-expired' is no longer used after the Gravatar
caching change, so I was wondering if maybe it could be useful to have a
more general, URL-specific expiry policy in the URL caching code. This
way, on-disk caching for, e.g., gravatar.com could be longer than for
the in-memory hash - right now expiry for the Gravatar memory cache is
12 hours, for the global disk cache it is 1 hour.

I wrote up the below and I am asking for feedback on it. I was
particularly concerned about back-forming the URL based on the cache
path and there really should be some test cases around that. I have done
minimal testing and I am open to suggestions to do this differently.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 1932 bytes --]

diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 830e6ba9dc..1bf5abcb51 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -38,6 +38,12 @@ url-cache-expire-time
   :type 'integer
   :group 'url-cache)
 
+(defcustom url-cache-expiry-alist nil
+  "Alist of URL regular expressions to override the `url-cache-expire-time'."
+  :version "28.1"
+  :type 'alist
+  :group 'url-cache)
+
 ;; Cache manager
 (defun url-cache-file-writable-p (file)
   "Follows the documentation of `file-writable-p', unlike `file-writable-p'."
@@ -186,6 +192,27 @@ url-cache-create-filename
             (if (url-p url) url
               (url-generic-parse-url url)))))
 
+(defun url-cache-create-url-from-file (file)
+  (if (file-exists-p file)
+      (let* ((url-path-list
+	     (split-string
+	      (string-trim-right
+	       (string-trim-left
+		file
+		(concat "^.*/" (user-real-login-name)))
+	       "/[^/]+$") "/" t))
+	     (url-access-method
+	      (pop url-path-list))
+	     (url-domain-name
+	      (string-join
+	       (reverse url-path-list)
+	       "."))
+	     (url
+	      (string-join
+	       (list url-access-method url-domain-name)
+	       "://")))
+	url)))
+
 ;;;###autoload
 (defun url-cache-extract (fnam)
   "Extract FNAM from the local disk cache."
@@ -226,7 +253,22 @@ url-cache-prune-cache
 	   ((time-less-p
 	     (time-add
 	      (file-attribute-modification-time (file-attributes file))
-	      url-cache-expire-time)
+	      (or
+		(let ((expire-time
+		       (remove
+			nil
+			(mapcar
+			 (lambda (alist)
+			   (let ((key (car alist))
+				(value (cdr alist)))
+			     (if
+				 (string-match
+				  key
+				  (url-cache-create-url-from-file file))
+				  value)))
+			url-cache-expiry-alist))))
+		 (if (consp expire-time) (apply 'min expire-time) nil))
+	       url-cache-expire-time))
 	     now)
 	    (delete-file file)
 	    (setq deleted-files (1+ deleted-files))))))


[-- Attachment #3: Type: text/plain, Size: 208 bytes --]

I also didn't really like the way the code ended up being formatted. Is
there some guidance around splitting functions and their arguments
across multiple lines?

For the Gravatar change, I had this in mind.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: Type: text/x-patch, Size: 1209 bytes --]

diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index f6f056a2ba..6fea19d942 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -41,15 +41,14 @@ gravatar-automatic-caching
   :group 'gravatar)
 (make-obsolete-variable 'gravatar-automatic-caching nil "28.1")
 
-(defcustom gravatar-cache-ttl 2592000
+(defcustom gravatar-cache-ttl 43200
   "Time to live in seconds for gravatar cache entries.
 If a requested gravatar has been cached for longer than this, it
-is retrieved anew.  The default value is 30 days."
+is retrieved anew.  The default value is 12 hours."
   :type 'integer
   ;; Restricted :type to number of seconds.
   :version "27.1"
   :group 'gravatar)
-(make-obsolete-variable 'gravatar-cache-ttl nil "28.1")
 
 (defcustom gravatar-rating "g"
   "Most explicit Gravatar rating level to allow.
@@ -287,8 +286,7 @@ gravatar-retrieve
 (defun gravatar--prune-cache ()
   (let ((expired nil)
         (time (- (time-convert (current-time) 'integer)
-                 ;; Twelve hours.
-                 (* 12 60 60))))
+                 gravatar-cache-ttl)))
     (maphash (lambda (key val)
                (when (< (car val) time)
                  (push key expired)))

[-- Attachment #5: Type: text/plain, Size: 19 bytes --]

Thanks!

-- 
Alex.