[elpa] externals/repology b1b585a8e2 2/4: repology-utils: Gracefully handle connectivity issues with requests

[Nicolas Goaziou]

branch: externals/repology
commit b1b585a8e2a201f7b227bd8a2db04a385e824afa
Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Commit: Nicolas Goaziou <mail@nicolasgoaziou.fr>

    repology-utils: Gracefully handle connectivity issues with requests
    
    * repology-utils.el (repology-request): Handle unreachable URL and
    empty data.
---
 repology-utils.el | 68 ++++++++++++++++++++++++++++++++-----------------------
 1 file changed, 40 insertions(+), 28 deletions(-)

diff --git a/repology-utils.el b/repology-utils.el
index 45ece3605f..0d47364c1d 100644
--- a/repology-utils.el
+++ b/repology-utils.el
@@ -326,36 +326,48 @@ Raise an error if REPOSITORY is unknown to Repology."
 ;;; Requests
 (defun repology-request (url &optional extra-headers)
   "Perform a raw HTTP request on URL.
+
 EXTRA-HEADERS is an assoc list of headers/contents to send with
-the request."
+the request.
+
+Return a property list with `:code', `:reason', `:header' and
+`:body' keywords. The value for `:reason' is either \"OK\", or
+a string explaining the issue."
   (let* ((url-request-method "GET")
-         (url-request-extra-headers extra-headers)
-         (process-buffer (url-retrieve-synchronously url t)))
-    (unwind-protect
-        (with-current-buffer process-buffer
-          (goto-char (point-min))
-          (let* ((status-line-regexp
-                  (rx bol
-                      (one-or-more (not (any " "))) " "
-                      (group (in "1-5") (= 2 digit)) " "
-                      (group (one-or-more (in "A-Z" "a-z" " ")))
-                      eol))
-                 (status
-                  (and (looking-at status-line-regexp)
-                       (list :code (string-to-number (match-string 1))
-                             :reason (match-string 2))))
-                 (header nil)
-                 (body nil))
-            (forward-line)
-            (while (looking-at (rx line-start (group (+? nonl)) ": "))
-              (push (match-string 1) header)
-              (push (buffer-substring (match-end 0) (line-end-position)) 
header)
-              (forward-line))
-            (forward-line)
-            (unless (eobp)
-              (setq body (buffer-substring (point) (point-max))))
-            (append status (list :header (nreverse header) :body body))))
-      (kill-buffer process-buffer))))
+         (url-request-extra-headers extra-headers))
+    (pcase (condition-case err
+               (url-retrieve-synchronously url t)
+             (error (error-message-string err)))
+      ('nil (list :reason "No data associated to request"))
+      ((and (pred stringp) reason) (list :reason reason))
+      ((and (pred bufferp) process-buffer)
+       (unwind-protect
+           (with-current-buffer process-buffer
+             (goto-char (point-min))
+             (let* ((status-line-regexp
+                     (rx bol
+                         (one-or-more (not (any " "))) " "
+                         (group (in "1-5") (= 2 digit)) " "
+                         (group (one-or-more (in "A-Z" "a-z" " ")))
+                         eol))
+                    (status
+                     (and (looking-at status-line-regexp)
+                          (list :code (string-to-number (match-string 1))
+                                :reason (match-string 2))))
+                    (header nil)
+                    (body nil))
+               (forward-line)
+               (while (looking-at (rx line-start (group (+? nonl)) ": "))
+                 (push (match-string 1) header)
+                 (push (buffer-substring (match-end 0) (line-end-position))
+                       header)
+                 (forward-line))
+               (forward-line)
+               (unless (eobp)
+                 (setq body (buffer-substring (point) (point-max))))
+               (append status (list :header (nreverse header) :body body))))
+         (kill-buffer process-buffer)))
+      (_ (error "This should not happen")))))
 
 
 ;;; Version Comparison