Initial commit

1 files changed, 232 insertions, 0 deletions

diff --git a/url-rewrite.el b/url-rewrite.el
new file mode 100644
index 0000000..119e669
--- /dev/null
+++ b/url-rewrite.el
@@ -0,0 +1,232 @@
+;;; Utility functions.
+(defun url-rw-format-filename (path queries)
+  "Format a filename from PATH and QUERIES alist."
+  (let ((formatted-queries
+         (string-join
+          (mapcar
+           (lambda (query)
+             (url-rw-join-string-pair (car query) (cdr query) "="))
+           queries)
+          "&")))
+    (concat
+     path
+     (when queries (concat "?" formatted-queries)))))
+
+(defun url-rw-join-string-pair (s1 s2 sep)
+  "Join S1 and S2 with SEP if both S1 and S2 are nonnil.
+
+Otherwise just concat the two."
+  (if (and s1 s2)
+      (format "%s%s%s" s1 sep s2)
+    (concat s1 s2)))
+
+(defun url-rw-parse-queries (queries)
+  "From QUERIES to an alist."
+  (when queries
+    (mapcar
+     (lambda (query)
+       (string-match "^\\(.*?\\)\\(=.*\\)?$" query)
+       (let ((key (match-string 1 query))
+             (value (match-string 2 query)))
+         (cons key (when value (substring value 1)))))
+     (split-string queries "&"))))
+
+(defun url-rw-random-item (xs)
+  "Returns a random item from list XS."
+  (elt xs (random (length xs))))
+
+(defun url-rw-copy-url (from to)
+  "Copy from FROM to TO, both url structs."
+  (setf
+   (url-type to) (url-type from)
+   (url-user to) (url-user from)
+   (url-password to) (url-password from)
+   (url-host to) (url-host from)
+   (url-portspec to) (url-portspec from)
+   (url-filename to) (url-filename from)
+   (url-target to) (url-target from)
+   (url-attributes to) (url-attributes from)
+   (url-fullness to) (url-fullness from)
+   (url-silent to) (url-silent from)
+   (url-use-cookies to) (url-use-cookies from)
+   (url-asynchronous to) (url-asynchronous from)))
+
+;;; Building blocks for url rewriting, used in :actions list in rules.
+(defun url-rw-put-query (urlobj key &optional value)
+  "Put query KEY=VALUE to URLOBJ.
+
+If VALUE is nil, just put KEY."
+  (pcase-let* ((`(,path . ,queries) (url-path-and-query urlobj))
+               (parsed-queries (url-rw-parse-queries queries)))
+    (setf (alist-get key parsed-queries nil nil 'equal) value)
+    (setf (url-filename urlobj)
+          (url-re-format-filename path parsed-queries))))
+
+(defun url-rw-remove-query (urlobj queries-to-remove)
+  "Remove queries in QUERIES-TO-REMOVE from URLOBJ in place.
+
+QUERIES-TO-REMOVE is a regexp."
+  (pcase-let* ((`(,path . ,queries) (url-path-and-query urlobj))
+               (parsed-queries (url-rw-parse-queries queries)))
+    (setf (url-filename urlobj)
+          (url-rw-format-filename
+           path
+           (seq-filter
+            (lambda (pair)
+              (not (string-match-p queries-to-remove (car pair))))
+            parsed-queries)))))
+
+(defun url-rw-replace-host (urlobj new-host)
+  "Replace host in URLOBJ with NEW-HOST in place."
+  (setf (url-host urlobj) new-host))
+
+(defun url-rw-replace-path (urlobj new-path)
+  "Replace the path of URLOBJ with NEW-PATH in place."
+  (pcase-let ((`(,path . ,query) (url-path-and-query urlobj)))
+    (setf (url-filename urlobj) (concat new-path (when query (concat "?" query))))))
+
+(defun url-rw-replace-random-host (urlobj hosts)
+  "Replace the host in URLOBJ with a random one from HOSTS."
+  (url-rw-replace-host urlobj (url-rw-random-item hosts)))
+
+(defun url-rw-replace-by-redirect (urlobj redirect-query)
+  "Replace URLOBJ with an unhexed value from REDIRECT-QUERY."
+  (let ((queries (url-rw-parse-queries (cdr (url-path-and-query urlobj)))))
+    (when-let* ((value (alist-get redirect-query queries nil nil 'equal))
+                (new-urlobj (url-generic-parse-url (url-unhex-string value))))
+      (url-rw-copy-url new-urlobj urlobj))))
+
+(defun url-rw-replace-type (urlobj new-type)
+  "Replace the type of URLOBJ with NEW-TYPE."
+  (setf (url-type urlobj) new-type))
+
+;;; Rewrite rules and functions
+;; TODO: This should be a defcustom
+(defvar url-rw-rules nil "Rewrite rules for url rewrite.")
+
+(defcustom url-rw-max-rewrites 100 "Maximum rewrites allowed on a url."
+  :group 'url-rewrite
+  :type 'natnum)
+
+(defcustom url-rw-extra-rewriters nil "Extra rewrite functions."
+  :group 'url-rewrite
+  :type '(repeat function))
+
+(defvar url-rw-rewriters nil
+  "List of url rewrite functions.
+
+A concatenation of rewriters generated from `url-rw-rules' and
+`url-rw-rewriters'.")
+
+(defmacro url-rw-define-rewrite (rule)
+  "Defines a rewrite function using RULE.
+
+Also add the function to `url-rw-rewriters'."
+  (let ((func-name (intern (format "url-rewrite-%s" (plist-get rule :name))))
+        (match (plist-get rule :match))
+        (actions (plist-get rule :actions))
+        (description (plist-get rule :description)))
+    `(progn
+       (defun ,func-name (url)
+         ,description
+         (if (string-match-p ,match url)
+             (let ((urlobj (url-generic-parse-url url)))
+               ,@(mapcar
+                  (lambda (action)
+                    `(,(intern (format "url-rw-%s" (car action)))
+                      urlobj ,@(cdr action)))
+                  actions)
+               (url-recreate-url urlobj))
+           url))
+       (add-to-list 'url-rw-rewriters ',func-name))))
+
+;;;###autoload
+(defun url-rw-refresh ()
+  "Refresh the list of rewriters."
+  (setq url-rw-rewriters nil)
+  (dolist (rule url-rw-rules)
+    (eval `(url-rw-define-rewrite ,rule)))
+  (dolist (rewriter url-rw-extra-rewriters)
+    (add-to-list 'url-rw-rewriters rewriter))
+  url-rw-rewriters)
+
+;;;###autoload
+(defun url-rw (url)
+  "Rewrite a URL.
+
+Try applying each function in `url-rw-rewriters'. If after one
+iteration the url does not change, or if the number of iterations
+has exceeded `url-rw-max-rewrites', stop."
+  (let ((old-url)
+        (count 0))
+    (while (and (< count url-rw-max-rewrites)
+                (not (equal url old-url)))
+      (setq old-url url)
+      (dolist (rewriter url-rw-rewriters)
+        (setq url (funcall rewriter url)))
+      (setq count (1+ count))))
+  url)
+
+;;; Examples
+(defvar url-rw-www-re "^https?://\\(www\\.\\)?")
+
+(defvar url-rw-example-rules
+  '((:name ddg-result
+           :description "duckduckgo result transform."
+           :match (concat url-rw-www-re (rx "duckduckgo.com/l/?uddg="))
+           :actions ((replace-by-redirect "uddg")))
+    (:name google-to-ddg
+           :description "Google search to duckduckgo html."
+           :match (concat url-rw-www-re (rx "google.com/search?q="))
+           :actions ((replace-host "html.duckduckgo.com")
+                     (replace-path "/html")))
+    (:name reddit-to-old
+           :description "Reddit to old Reddit"
+           :match (concat url-rw-www-re (rx "reddit.com"))
+           :actions ((replace-host "old.reddit.com")))
+    (:name strip-utm
+           :description "Strip utm_* queries."
+           :match "\\<utm_[a-z_]+="
+           :actions ((remove-query "utm_.*")))
+    (:name youtube-to-invidious
+           :description "YouTube to a random invidious instance."
+           :match (concat url-rw-www-re (rx (or "youtube.com"
+                                                "youtu.be"
+                                                "m.youtube.com")))
+           :actions ((replace-random-host url-rw-example-invidious-hosts))))
+  "Example rewrite rules")
+
+(defun url-rewrite-example-zoom-to-dial (url)
+  "Rewrite a zoom URL to a dial in number."
+  (pcase-let* ((urlobj (url-generic-parse-url url))
+               (`(,path . _) (url-path-and-query urlobj))
+               (host (url-host urlobj)))
+    (if (and host
+             (string-match "\\(^.*\\.\\)?zoom.us" host)
+             (string-match "^/j/\\([0-9]+\\)$" path))
+        (format "tel:%s,,%s#"
+                (url-rw-random-item url-rw-example-zoom-numbers)
+                (match-string 1 path))
+      url)))
+
+(defvar url-rw-example-zoom-numbers
+  '("+61731853730"
+    "+61871501149")
+  "List of zoom dial-in numbers.")
+
+(defvar url-rw-example-invidious-hosts
+  '("yewtu.be"
+    "onion.tube")
+  "Invidious hosts.
+
+For a longer list, see <https://redirect.invidious.io/>.")
+
+;; Uncomment the following to add the example rules and the zoom to
+;; dial function
+;; (dolist (rule url-rw-example-rules url-rw-rewriters)
+;;   (eval `(url-rw-define-rewrite ,rule)))
+;;
+;; (add-to-list 'url-rw-rewriters 'url-rw-example-zoom-to-dial)
+
+(provide 'url-rewrite)
+;;; url-rewrite.el ends here