From b9097188f7a6dbfd408a1fe8c6df80526d3bd944 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Mon, 28 Dec 2015 04:15:16 +0100
Subject: [PATCH] * idna.el (idna-decode-string-internal): Implement decoding.

---
 lisp/net/idna.el | 66 +++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 60 insertions(+), 6 deletions(-)

diff --git a/lisp/net/idna.el b/lisp/net/idna.el
index dfaf711c71e..052a9f62304 100644
--- a/lisp/net/idna.el
+++ b/lisp/net/idna.el
@@ -30,6 +30,9 @@
 (require 'seq)
 
 (defun idna-encode-string (string)
+  "Encode STRING according to the IDNA/punycode algorithm.
+This is used to encode non-ASCII domain names.
+For instance, \"bücher\" => \"xn--bcher-kva\"."
   (let ((ascii (seq-filter (lambda (char)
                              (< char 128))
                            string)))
@@ -37,6 +40,13 @@
         string
       (concat "xn--" ascii "-" (idna-encode-complex (length ascii) string)))))
 
+(defun idna-decode-string (string)
+  "Decode an IDNA/punycode-encoded string.
+For instance \"xn--bcher-kva\" => \"bücher\"."
+  (if (string-match "\\`xn--.*-" string)
+      (idna-decode-string-internal (substring string 4))
+    string))
+
 (defconst idna-initial-n 128)
 (defconst idna-initial-bias 72)
 (defconst idna-base 36)
@@ -47,12 +57,12 @@
 
 (defun idna-decode-digit (cp)
   (cond
-   ((< (- cp 48) 10)
-    (- cp 22))
-   ((< (- cp 65) 26)
-    (- cp 65))
-   ((< (- cp 97) 26)
-    (- cp 97))
+   ((<= cp ?9)
+    (- cp ?0))
+   ((<= cp ?Z)
+    (- cp ?A))
+   ((<= cp ?z)
+    (- cp ?a))
    (t
     idna-base)))
 
@@ -119,6 +129,50 @@
       (cl-incf n))
     (nreverse result)))
 
+(defun idna-decode-string-internal (string)
+  (with-temp-buffer
+    (insert string)
+    (goto-char (point-max))
+    (if (not (search-backward "-" nil t))
+        (error "Invalid IDNA string")
+      ;; The encoded chars are after the final dash.
+      (let ((encoded (buffer-substring (1+ (point)) (point-max)))
+            (ic 0)
+            (i 0)
+            (bias idna-initial-bias)
+            (n idna-initial-n)
+            out)
+        (delete-region (point) (point-max))
+        (while (< ic (length encoded))
+          (let ((old-i i)
+                (w 1)
+                (k idna-base)
+                digit t1)
+            (cl-loop do (progn
+                          (setq digit (idna-decode-digit (aref encoded ic)))
+                          (cl-incf ic)
+                          (cl-incf i (* digit w))
+                          (setq t1 (cond
+                                    ((<= k bias)
+                                     idna-tmin)
+                                    ((>= k (+ bias idna-tmax))
+                                     idna-tmax)
+                                    (t
+                                     (- k bias)))))
+                     while (>= digit t1)
+                     do (setq w (* w (- idna-base t1))
+                              k (+ k idna-base)))
+            (setq out (1+ (buffer-size)))
+            (setq bias (idna-adapt (- i old-i) out (= old-i 0))))
+
+          (setq n (+ n (/ i out))
+                i (mod i out))
+          (goto-char (point-min))
+          (forward-char i)
+          (insert (format "%c" n))
+          (cl-incf i))))
+    (buffer-string)))
+
 (provide 'idna)
 
 ;;; shr.el ends here
-- 
2.39.2