diff --git a/source/mode/reduce-tracking.lisp b/source/mode/reduce-tracking.lisp index 79628c15bde..a125c13be05 100644 --- a/source/mode/reduce-tracking.lisp +++ b/source/mode/reduce-tracking.lisp @@ -56,15 +56,36 @@ still being less noticeable in the crowd.") :export nil :documentation "The timezone the system had before enabling this mode."))) +;; NB: QURI:URL-ENCODE-PARAMS is not applicable for filtering a +;; query. For example, when opening Gmail a query may look like +;; "https://accounts.google.com/ServiceLogin?service=mail&passive=XXXXXX&osid=1&continue=https://mail.google.com" +;; and quri will percent-encode it to +;; https://accounts.google.com/ServiceLogin?service=mail&passive=1209600&osid=1&continue=https%3A%2F%2Fmail.google.com +;; This is incorrect and will result in inability to load the +;; page. This function does not add an extra level of percent +;; encoding. +(serapeum:-> url-filter-params (string list) + (values string &optional)) +(defun url-filter-params (params forbidden-params) + "Accept a query parameters (as a string), remove parameters from a +black list and return them back as a string." + (format + nil "~{~a~^&~}" + (reduce + (lambda (param acc) + (if (member (car param) forbidden-params :test #'string-equal) acc + (cons (format nil "~a=~a" (car param) (cdr param)) acc))) + (quri:url-decode-params params :lenient t) + :initial-value nil + :from-end t))) + (defun strip-tracking-parameters (request-data) (let ((mode (find-submode 'reduce-tracking-mode))) (when (and mode (not (uiop:emptyp (quri:uri-query (url request-data))))) - (setf (quri:uri-query-params (url request-data)) - (remove-if (rcurry #'member (query-tracking-parameters mode) - :test #'string-equal) - (quri:url-decode-params (quri:uri-query (url request-data)) :lenient t) - :key #'first))) - request-data)) + (setf (quri:uri-query (url request-data)) + (url-filter-params (quri:uri-query (url request-data)) + (query-tracking-parameters mode))))) + request-data) (defmethod enable ((mode reduce-tracking-mode) &key) (setf (old-timezone mode) (uiop:getenv "TZ")