From 6a15c60d348c2652cca15b723ff72f8a6c53bb08 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 28 Dec 2015 02:46:50 +0100 Subject: [PATCH] Added basic idna encoding support * lisp/net/idna.el: New file. --- lisp/net/idna.el | 127 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 127 insertions(+) create mode 100644 lisp/net/idna.el diff --git a/lisp/net/idna.el b/lisp/net/idna.el new file mode 100644 index 00000000000..24a771b0bb8 --- /dev/null +++ b/lisp/net/idna.el @@ -0,0 +1,127 @@ +;;; idna.el --- translate non-ASCII domain names to ASCII + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Keywords: mail, net + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Written by looking at +;; http://stackoverflow.com/questions/183485/can-anyone-recommend-a-good-free-javascript-for-punycode-to-unicode-conversion + +;;; Code: + +(defun idna-encode-string (string) + (cl-destructuring-bind (ascii complex) + (cl-loop for i from 0 + for char across string + when (< char 128) + collect char into ascii + else + collect (cons i char) into complex + finally (return (list ascii complex))) + (concat (mapconcat 'string ascii "") + "-" + (idna-encode-complex (length ascii) + (sort complex + (lambda (e1 e2) + (< (cdr e1) (cdr e2)))) + string)))) + +(defconst idna-initial-n 128) +(defconst idna-initial-bias 72) +(defconst idna-base 36) +(defconst idna-damp 700) +(defconst idna-tmin 1) +(defconst idna-tmax 26) +(defconst idna-skew 28) + +(defun idna-decode-digit (cp) + (if (< (- cp 48) 10) + (- cp 22) + (if (< (- cp 65) 26) + (- cp 65) + (if (< (- cp 97) 26) + (- cp 97) + idna-base)))) + +;; 0-25 a-z +;; 26-36 0-9 +(defun idna-encode-digit (d) + (if (< d 26) + (+ ?a d) + (+ ?0 (- d 26)))) + +(defun idna-adapt (delta num-points first-time) + (let ((delta (if first-time + (/ delta idna-damp) + (/ delta 2))) + (k 0)) + (setq delta (+ delta (/ delta num-points))) + (cl-loop while (> delta (/ (* (- idna-base idna-tmin) + idna-tmax) + 2)) + do (setq delta (/ delta (- idna-base idna-tmin)) + k (+ k idna-base))) + (+ k (/ (* (1+ (- idna-base idna-tmin)) delta) + (+ delta idna-skew))))) + +(defun idna-encode-complex (insertion-points complex string) + (let ((n idna-initial-n) + (delta 0) + (bias idna-initial-bias) + (h insertion-points) + result m) + (while (< h (length string)) + (setq ijv (cl-loop for char across string + when (>= char n) + minimize char)) + (setq m ijv) + (setq delta (+ delta (* (- m n) (+ h 1))) + n m) + (cl-loop for char across string + when (< char n) + do (cl-incf delta) + when (= char ijv) + do (progn + (setq q delta) + (cl-loop with k = idna-base + for t1 = (if (<= k bias) + idna-tmin + (if (>= k (+ bias idna-tmax)) + idna-tmax + (- k bias))) + while (>= q t1) + do (push (idna-encode-digit + (+ t1 (mod (- q t1) + (- idna-base t1)))) + result) + do (setq q (/ (- q t1) (- idna-base t1)) + k (+ k idna-base))) + (push (idna-encode-digit q) result) + (setq bias (idna-adapt delta (+ h 1) (= h insertion-points)) + delta 0 + h (1+ h)))) + (cl-incf delta) + (cl-incf n)) + (nreverse result))) + +(provide 'idna) + +;;; shr.el ends here -- 2.39.5