From c2f77f4296c6b13eeb86067a772192b70577bca6 Mon Sep 17 00:00:00 2001
From: ckonstanski <ckonstanski@pippiandcarlos.com>
Date: Sat, 20 Jan 2018 22:07:54 -0700
Subject: initial commit

---
 core/coreutils.lisp | 190 ++++++++++++++++++++++++++++++
 core/html.lisp      | 324 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 core/httputils.lisp |  66 +++++++++++
 3 files changed, 580 insertions(+)
 create mode 100644 core/coreutils.lisp
 create mode 100644 core/html.lisp
 create mode 100644 core/httputils.lisp

(limited to 'core')

diff --git a/core/coreutils.lisp b/core/coreutils.lisp
new file mode 100644
index 0000000..72f213c
--- /dev/null
+++ b/core/coreutils.lisp
@@ -0,0 +1,190 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(defpackage #:ldapadmin
+  (:use #:cl #:cl-log #:hunchentoot)
+  (:export #:ldapadmin))
+
+(in-package #:ldapadmin)
+
+;; ========================================================================== ;;
+
+(defparameter *server-root* (namestring (asdf:system-relative-pathname (intern (package-name *package*)) "./"))
+  "The location of the web server root on the filesystem.")
+
+;; ========================================================================== ;;
+
+(defmacro with-gensyms (syms &body body)
+  `(let ,(mapcar #'(lambda (s)
+                     `(,s (gensym)))
+                 syms)
+     ,@body))
+
+(defmacro once-only ((&rest names) &body body)
+  (let ((gensyms (loop for n in names collect (gensym))))
+    `(let (,@(loop for g in gensyms collect `(,g (gensym))))
+       `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n)))
+          ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g)))
+             ,@body)))))
+
+(defun logger (output)
+  "Logs output to the cl-log log file."
+  (log-message :info (format nil "~a: ~a" (net.telent.date:universal-time-to-rfc2822-date (get-universal-time)) output)))
+
+(defun string-to-list (my-string)
+  "Converts a sequence to a list \(or whatever the sequence is a
+string representation of\)."
+  (with-input-from-string (stream my-string)
+    (read stream)))
+
+(defmacro add-to-list (output-list &rest value-to-add)
+  "Wraps the SETF...APPEND idiom in a smaller package."
+  `(setf ,output-list (append ,output-list ,@value-to-add)))
+
+(defun parse-symbol (my-symbol)
+  (let ((symbol-parts (ppcre:split "::" (symbol-name my-symbol))))
+    (if (= (length symbol-parts) 1)
+        (car symbol-parts)
+        (cadr symbol-parts))))
+
+(defun flatten (mylist)
+  (cond ((atom mylist) mylist)
+        ((listp (car mylist))
+         (append (flatten (car mylist)) (flatten (cdr mylist))))
+        (t (append (list (car mylist)) (flatten (cdr mylist))))))
+
+(defun match-it (regex field)
+  "Wraps a PCRE search in a smaller package."
+  (cl-ppcre:all-matches-as-strings regex field))
+
+(defun cast-float (string-rep)
+  "Tries to return the float representation of `string-rep'.  If
+`string-rep' cannot be parsed as a float, returns `nil'."
+  (let ((read-value (read-from-string string-rep)))
+    (cond ((floatp read-value) read-value)
+          ((integerp read-value) (float read-value))
+          (t nil))))
+
+(defun pretty-print (raw-string &optional textbox-p)
+  "Filters `nil' string values, returning `&nbsp;' instead.  But if
+`textbox-p' is t, it returns an empty string instead of `&nbsp;'."
+  (let ((trimmed-string (when raw-string (string-trim '(#\Space #\Tab) raw-string))))
+    (if (and trimmed-string (> (length trimmed-string) 0))
+        (format nil "~a" (ppcre:regex-replace-all "\"" trimmed-string "&quot;"))
+        (if textbox-p "" "&nbsp;"))))
+
+(defun strip-milliseconds (sql-datetime)
+  (subseq sql-datetime 0 (position #\. sql-datetime)))
+
+#+sbcl
+(defun map-slot-names (instance)
+  "Returns a list of the names of all the slots of any class instance
+using reflection.  The returned values are symbols.  Only works with
+SBCL."
+  (mapcar #'sb-mop:slot-definition-name
+          (sb-mop:class-slots (class-of instance))))
+
+(defun make-document-root-path (document-root relative-path)
+  "Makes a relative filesystem path into a full one, using
+`document-root' as the base."
+  (concatenate 'string document-root relative-path))
+
+(defun make-server-path (relative-path)
+  "Makes a relative filesystem path into a full one, using
+`*server-root*' as the base."
+  (make-document-root-path *server-root* relative-path))
+
+(defun null-or-empty-p (sequence)
+  (or (null sequence) (equal (length sequence) 0)))
+
+(defun xml-escape (mystring)
+  (setf mystring (ppcre:regex-replace-all "<" mystring "&lt;"))
+  (setf mystring (ppcre:regex-replace-all ">" mystring "&gt;"))
+  (setf mystring (ppcre:regex-replace-all "&" mystring "&amp;"))
+  (setf mystring (ppcre:regex-replace-all "\"" mystring "&quot;"))
+  (setf mystring (ppcre:regex-replace-all "'" mystring "&apos;"))
+  mystring)
+
+(defun xml-unescape (mystring)
+  (setf mystring (ppcre:regex-replace-all "&lt;" mystring "<"))
+  (setf mystring (ppcre:regex-replace-all "&gt;" mystring ">"))
+  (setf mystring (ppcre:regex-replace-all "&amp;" mystring "&"))
+  (setf mystring (ppcre:regex-replace-all "&quot;" mystring "\""))
+  (setf mystring (ppcre:regex-replace-all "&apos;" mystring "'"))
+  mystring)
+
+(defun trim-last-char (mystring)
+  (if (null-or-empty-p mystring)
+      ""
+      (subseq mystring 0 (- (length mystring) 1))))
+
+(defun string-to-real (string-rep)
+  "Converts a string representation of a number to a rational
+representation.  For some reason, the lisp community calls rational
+numbers `real'. If you pass this method garbage, you will get 0. It
+always returns a number."
+  (if (null-or-empty-p string-rep)
+      0
+      (let* ((string-parts (ppcre:split "\\." (string-trim '(#\Space #\Tab) string-rep)))
+             (integer-portion (parse-integer (car string-parts) :junk-allowed t))
+             (fractional-portion-string (second string-parts))
+             (fractional-divisor 1))
+        (multiple-value-bind (fractional-portion fractional-portion-length)
+            (if (> (length fractional-portion-string) 0)
+                (parse-integer fractional-portion-string :junk-allowed t)
+                (values nil 0))
+          (when (null integer-portion)
+            (setf integer-portion 0))
+          (when (null fractional-portion)
+            (setf fractional-portion 0))
+          (when (not (= fractional-portion 0))
+            (setf fractional-divisor (expt 10 fractional-portion-length)))
+          (if (>= integer-portion 0)
+              (+ integer-portion (/ fractional-portion fractional-divisor))
+              (- integer-portion (/ fractional-portion fractional-divisor)))))))
+
+(defun real-to-string (real-rep &key (places 2))
+  "Converts a rational representaion of a number into a string
+representation, rounded to `places' decimal places."
+  (when real-rep
+    (if (= places 0)
+        (format nil "~a" (parse-integer (format nil "~,2f" real-rep) :junk-allowed t))
+        (format nil
+                (format nil "~~,~af" places)
+                (coerce real-rep 'long-float)))))
+
+(defun double-to-real (double-rep &key (places 2))
+  "Converts a double to a real.  It does this by converting the double
+to a string, and then the string to a real.  Decimal place truncation
+happens when converting to a string."
+  (string-to-real (real-to-string double-rep :places places)))
+
+(defun pad-with-zeros (string-rep places)
+  "Left-pads a string representaion of a number with leading zeros to
+make it the specified length."
+  (loop for i from (+ (length string-rep) 1) to places do
+       (setf string-rep (format nil "0~a" string-rep)))
+  string-rep)
+
+(defun shell-wrapper (command)
+  "Calls a shell command and returns the output as a list, where each
+atom of the list is a string that contains one line of the output."
+  (let ((output (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t)))
+    (with-output-to-string (stream output)
+      (uffi:run-shell-command command :output stream))
+    (loop for line in (ppcre:split #\Newline output)
+       collect line)))
+
+(defun reduce-to-char-separated-string (mylist char)
+  (format nil "~a" (reduce (lambda (&optional x y)
+                             (cond ((and x y) (format nil "~a~a~a" x char y))
+                                   ((and x (not y)) (format nil "~a" x))
+                                   ((and (not x) y) (format nil "~a" y))
+                                   (t "")))
+                           mylist)))
+
+(defun reduce-to-comma-separated-string (mylist)
+  (reduce-to-char-separated-string mylist ","))
+
+(defun reduce-to-newline-separated-string (mylist)
+  (reduce-to-char-separated-string mylist #\Newline))
diff --git a/core/html.lisp b/core/html.lisp
new file mode 100644
index 0000000..c76e9cb
--- /dev/null
+++ b/core/html.lisp
@@ -0,0 +1,324 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+;; Lifted directly from araneida.
+
+(in-package :ldapadmin)
+
+;;; XXX fix this, it's not correct
+(defun html-reserved-p (c)
+  (member c '(#\< #\"  #\> #\&)))
+
+(defun html-escape (html-string)
+  (apply #'concatenate 'string
+         (loop for c across html-string
+            if (html-reserved-p c)
+            collect (format nil "&#~A;" (char-code c))
+            else if (eql c #\Newline) collect "<br>"
+            else collect (string c))))
+
+(defun s. (&rest args)
+  "Concatenate ARGS as strings"
+  (declare (optimize (speed 3)))
+  (let ((*print-pretty* nil))
+    (with-output-to-string (out)
+      (dolist (arg args)
+        (princ arg out)))))
+
+(defun html-escape-tag (tag attrs content)
+  (declare (ignore tag attrs))
+  (s. (mapcar #'html-escape content)))
+
+(setf (get 'escape 'html-converter) #'html-escape-tag)
+(setf (get 'null 'html-converter) #'princ-to-string)
+
+(macrolet ((html-attr-body ()
+             `(with-output-to-string (o)
+                (loop for (att val . rest) on attr by #'cddr do
+                     (cond
+                       #+parenscript((and (symbolp att) (equal (symbol-name 'css) (symbol-name att)))
+                                     (progn
+                                       (princ " " o)
+                                       (princ "style=\"" o)
+                                       (princ (val-printer (parenscript::css-inline-func val)) o)
+                                       (princ "\"" o)))
+                       ((symbolp att)
+                        (progn
+                          (princ " " o)
+                          (princ (symbol-name att) o)
+                          (princ "=\"" o)
+                          (princ (val-printer val) o)
+                          (princ "\"" o)))
+                       (t
+                        (error "attribute ~S is not a symbol in attribute list ~S" att attr)))))))
+  (defun html-attr (attr)
+    (macrolet ((val-printer (val)
+                 val))
+      (html-attr-body)))
+  (defun html-attr-escaped (attr)
+    (macrolet ((val-printer (val)
+                 `(html-escape ,val)))
+      (html-attr-body))))
+
+(defun empty-element-p (tag)
+  (member (intern (symbol-name tag) #.*package*) '()))
+
+(defmacro defhtmltag (tag (attributes-var content-var) &body body)
+  "Define a custom HTML tag
+Useful for custom phrases, or even special constructs.
+
+Example:
+(defhtmltag coffee (attr content)
+  (declare (ignore attr content))
+  \"c|_|\")
+
+So, saying
+(span \"Nice hot \" (coffee))
+
+Would produce:
+<span>Nice hot c|_|</span>
+
+More in-depth use would be something such as:
+(even-odd-list
+ (li \"one\")
+ (li \"two\")
+ (li \"three\"))
+
+Turning into:
+(ul
+ ((li :class \"odd\") \"one\")
+ ((li :class \"even\") \"two\")
+ ((li :class \"odd\") \"odd\"))
+
+Your custom tag is expected to return either a string or
+an html construct like you'd pass to HTML-STREAM."
+  (with-gensyms (throw-away)
+    `(setf (get ',tag :html-converter)
+      (lambda (,throw-away ,attributes-var ,content-var)
+	(declare (ignore ,throw-away))
+	(funcall 
+         (lambda (,attributes-var ,content-var)
+	   ,@body)
+	 ,attributes-var ,content-var)))))
+
+(defun htmlp (html)
+  "Returns t if html is a legal HTML list.
+NB: HTML and friends print out a superset of legal html lists.
+
+'(ul (li \"yes\") (li \"no\")) is legal
+3 is not
+
+But HTML will print both of them"
+  (and (consp html)
+       (not (stringp (car html)))))
+
+(defmacro destructure-html ((tag-sym attrs-sym content-sym) html &body body)
+  "Destructure an HTML construct.
+(destructure-html (tag attrs content) '((span :class \"strange\") \"A strange span!\")
+  (format t \"<~A ~{~A~}>~{~A~}</~A>\" tag attrs content tag))
+If the construct is invalid, it will cause an error"
+  (once-only (html)
+    `(if (htmlp ,html)
+      (let ((,tag-sym (if (consp (car ,html))
+			  (caar ,html)
+			  (car ,html)))
+	    (,attrs-sym (if (consp (car ,html))
+			    (cdar ,html)
+			    nil))
+	    (,content-sym (cdr ,html)))
+	,@body))))
+
+; I admit, this is a rather goofy way to write this. There's just so much code they have in common
+; and this lets me modify them rather easily.
+(macrolet ((html-body ()
+             `(ret-block
+               (cond ((htmlp things)
+                      (destructure-html (tag attrs content) things
+                        (let ((special-effect (get tag :html-converter)))
+                          (if special-effect
+                              (if (not (functionp special-effect))
+                                  (error "Tag ~A has :html-converter set, but NOT as a function." tag)
+                                  (call-self stream (funcall special-effect tag attrs content) inline-elements))
+                              (cond ((equal (symbol-name 'comment) (symbol-name tag))
+                                     (printing
+                                      (format-out "<!-- ~{~A ~}~%" attrs)
+                                      (iter-list (c content)
+                                                 (call-self stream c inline-elements))
+                                      (format-out " -->~%")))
+                                    #+parenscript
+                                    ((equal (symbol-name 'css) (symbol-name tag))
+                                     (printing
+                                      (format-out "<style type=\"text/css\">~%")
+                                      (format-out "<!--~%")
+                                      (iter-list (c content)
+                                                 (format-out (parenscript::css-rule-to-string (parenscript::make-css-rule (car c) (cdr c)))))
+                                      (format-out "~%-->")
+                                      (format-out "</style>")))
+                                    #+parenscript
+                                    ((equal (symbol-name 'js-script) (symbol-name tag))
+                                     (printing
+                                      (format-out "<script type=\"text/javascript\">~%")
+                                      (format-out "// <![CDATA[~%")
+                                      (format-out (parenscript:js* (cons 'progn content)))
+                                      (format-out "~%// ]]>~%")))
+                                    ((not (empty-element-p tag))
+                                     (printing
+                                      (format-out "<~A~A>" (symbol-name tag) (attr-printer attrs))
+                                      (iter-list (c content)
+                                                 (call-self stream c inline-elements))
+                                      (format-out "</~A>~:[~;~%~]"
+                                                  (symbol-name tag)
+                                                  (not (member tag inline-elements)))))
+                                    (t
+                                     (format-out "<~A~A>" (symbol-name tag) (attr-printer attrs))))))))
+                     ((consp things)
+                      (iter-list (thing things) (format-out "~A" thing)))
+                     ((functionp things)
+                      (call-function things stream))
+                     ((keywordp things)
+                      (format-out "<~A>" (symbol-name things)))
+                     (t
+                      (format-out "~A" (thing-printer things)))))))
+
+  ;; stream forms first
+  (macrolet ((ret-block (output-block)
+               `(progn
+                  ,output-block
+                  t))
+             (iter-list ((item list) func)
+               `(dolist (,item ,list)
+                  ,func))
+             (printing (&body list)
+               `(progn
+                  ,@list))
+             (format-out (&rest args)
+               `(format stream ,@args))
+             (call-function (things stream)
+               `(funcall ,things ,stream)))
+    
+    (defun html-stream (stream things &optional inline-elements)
+      "Format supplied argument as HTML.  Argument may be a string
+\(returned unchanged\) or a list of \(tag content\) where tag may be
+\(tagname attrs\).  \(\(a :href \"/ \"\) \"home\"\) is formatted as
+you'd expect it to be.  INLINE-ELEMENTS is a list of elements not to
+print a newline after.  Returns T unless broken, so can be the last
+form in a handler For special effects, set the HTML-CONVERTER property
+of a symbol for a tag to a function.  It will be called with arguments
+\(TAG ATTRS CONTENT\) and should return a string to be interpolated at
+that point."
+      (declare (optimize (speed 3))
+               (type stream stream))
+      (macrolet ((attr-printer (attrs)
+                   `(html-attr ,attrs))
+                 (call-self (stream things &optional inline-elements)
+                   `(html-stream ,stream ,things ,inline-elements))
+                 (thing-printer (things)
+                   `(princ-to-string things)))
+        (html-body)))
+
+    (defun html-escaped-stream (stream things &optional inline-elements)
+      "Format supplied argument as HTML, escaping properly.
+Just like html-stream except certain things are now html-escaped.
+Content - in '\(p \"foo\"\) \"foo\" is the content - is escaped, as
+well as the values of attributes. Please note that this CAN result in
+double escaping if calling code also escapes.  For special effects,
+set the HTML-CONVERTER property of a symbol for a tag to a function.
+It will be called with arguments \(TAG ATTRS CONTENT\) and should
+return a string to be interpolated at that point. NB that the attrs
+and content will be passed in *unescaped*"
+      (declare (optimize (speed 3))
+               (type stream stream))
+      (macrolet ((attr-printer (attrs)
+                   `(html-attr-escaped ,attrs))
+                 (call-self (stream things &optional inline-elements)
+                   `(html-escaped-stream ,stream ,things ,inline-elements))
+                 (thing-printer (things)
+                   `(html-escape (princ-to-string ,things))))
+        (html-body))))
+
+  ;; now for the string forms
+  (macrolet ((ret-block (output-block)
+               output-block)
+             (iter-list ((item list) func)
+               `(apply #'concatenate 'string (mapcar (lambda (,item) ,func) ,list)))
+             (printing (&body list)
+               `(concatenate 'string
+                             ,@list))
+             (format-out (&rest args)
+               `(format nil ,@args))
+             (call-function (things stream)
+               (declare (ignore stream))
+               `(funcall ,things)))
+    
+    (defun html (things &optional inline-elements)
+      "Format supplied argument as HTML.  Argument may be a string
+\(returned unchanged\) or a list of \(tag content\) where tag may be
+\(tagname attrs\).  \(\(a :href \"/\"\) \"home\"\) is formatted as
+you'd expect it to be.  For special effects, set the HTML-CONVERTER
+property of a symbol for a tag to a function.  It will be called with
+arguments \(TAG ATTRS CONTENT\) and should return a string to be
+interpolated at that point."
+      (declare (optimize (speed 3)))
+      (macrolet ((attr-printer (attrs)
+                   `(html-attr ,attrs))
+                 (call-self (stream things &optional inline-elements)
+                   `(html ,things ,inline-elements))
+                 (thing-printer (things)
+                   `(princ-to-string ,things)))
+        (html-body)))))
+
+(defun html5 (things &optional inline-elements)
+  (format nil "<!DOCTYPE html>~%~a" (html things inline-elements)))
+
+#||
+(search-html-tree '((string> ht :element) t (= p :element)) '((html) ((body) ((p) "foo") ((p) "bar") ((div :title "titl") "blah"))))
+||#
+
+(defun search-html-tree (search-terms tree)
+  (labels ((node-matches (term tree)
+             (or (eql term t)
+                 (destructuring-bind (op content name) term
+                   (let ((r-op (if (eql op '=) 'equal op)))
+                     (if (eql name :element)
+                         (funcall r-op content (caar tree))
+                         (funcall r-op content (getf (cdar tree) name))))))))
+    (cond ((eql (cdr search-terms) nil)
+           (and (node-matches (car search-terms) tree) tree))
+          ((null tree) nil)
+          ((node-matches (car search-terms) tree)
+           (remove-if #'null
+                      (mapcar (lambda (tr)
+                                (search-html-tree (cdr search-terms) tr))
+                              (cdr tree)))))))
+
+
+#+parenscript
+(defmacro css-file (request &rest rules)
+  "Sends CSS as a file in response to request, as specified by rules.
+  For example:
+  (defmethod handle-request-response ((handler my-handler) method request)
+    (css-file request
+	      (* :border \"1px solid black\")
+	      (div.bl0rg :font-family \"serif\")
+	      ((\"a:active\" \"a:hoover\") :color \"black\" :size \"200%\")))
+  See the documentation for Parenscript for more info on the CSS rules themselves."
+  `(progn
+     (request-send-headers ,request :content-type "text/css")
+     ,@(mapcar (lambda (rule)
+                 `(princ (parenscript::css-rule-to-string (parenscript::css-rule ,@rule)) (request-stream ,request)))
+               rules)
+     t))
+
+#+parenscript
+(defmacro js-file (request &rest body)
+  "Sends Javascript as a file in response to request, as specified by the javascript body.
+  For example:
+  (defmethod handle-request-response ((handler my-handler) method request)
+    (js-file request
+      (defun hello ()
+	     (alert \"Hello, World!\"))))
+  See the documentation for Parenscript for more info on how to do Javascript."
+  `(progn
+     (request-send-headers ,request :content-type "text/javascript")
+     (princ (parenscript:js ,@body) (request-stream ,request))
+     t))
diff --git a/core/httputils.lisp b/core/httputils.lisp
new file mode 100644
index 0000000..fbd5c36
--- /dev/null
+++ b/core/httputils.lisp
@@ -0,0 +1,66 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package #:ldapadmin)
+
+(defmacro with-cookie-jar (&rest body)
+  `(let ((cookie-jar (make-instance 'drakma:cookie-jar)))
+     ,@body))
+
+(defun drakma-request (url
+                       cookie-jar
+                       &key
+                         (method :get)
+                         (content-type "application/x-www-form-urlencoded")
+                         (content nil)
+                         (user-agent :firefox)
+                         (redirect t)
+                         (auto-referer t)
+                         (additional-headers nil)
+                         (connection-timeout 20)
+                         (proxy nil)
+                         (proxy-basic-authorization nil)
+                         (basic-authorization nil))
+  (drakma:http-request url
+                       :cookie-jar cookie-jar
+                       :method method
+                       :content-type content-type
+                       :content content
+                       :user-agent user-agent
+                       :redirect redirect
+                       :auto-referer auto-referer
+                       :connection-timeout connection-timeout
+                       :additional-headers additional-headers
+                       :proxy proxy
+                       :proxy-basic-authorization proxy-basic-authorization
+                       :basic-authorization basic-authorization
+                       :close t))
+
+(defun escape-url (url)
+  (let ((escaped-url url))
+    (setf escaped-url (ppcre:regex-replace-all "%" escaped-url "%25"))
+    (setf escaped-url (ppcre:regex-replace-all "\\?" escaped-url "%3F"))
+    (setf escaped-url (ppcre:regex-replace-all "#" escaped-url "%23"))
+    (setf escaped-url (ppcre:regex-replace-all "/" escaped-url "%2F"))
+    (setf escaped-url (ppcre:regex-replace-all "'" escaped-url "%27"))
+    (setf escaped-url (ppcre:regex-replace-all " " escaped-url "%20"))
+    (setf escaped-url (ppcre:regex-replace-all "\\(" escaped-url "%28"))
+    (setf escaped-url (ppcre:regex-replace-all "\\)" escaped-url "%29"))
+    (setf escaped-url (ppcre:regex-replace-all ":" escaped-url "%3A"))
+    escaped-url))
+
+(defun unescape-url (url)
+  (let ((unescaped-url url))
+    (setf unescaped-url (ppcre:regex-replace-all "%25" unescaped-url "%"))
+    (setf unescaped-url (ppcre:regex-replace-all "%3F" unescaped-url "?"))
+    (setf unescaped-url (ppcre:regex-replace-all "%23" unescaped-url "#"))
+    (setf unescaped-url (ppcre:regex-replace-all "%2F" unescaped-url "/"))
+    (setf unescaped-url (ppcre:regex-replace-all "%27" unescaped-url "'"))
+    (setf unescaped-url (ppcre:regex-replace-all "%20" unescaped-url " "))
+    (setf unescaped-url (ppcre:regex-replace-all "%28" unescaped-url "("))
+    (setf unescaped-url (ppcre:regex-replace-all "%29" unescaped-url ")"))
+    (setf unescaped-url (ppcre:regex-replace-all "%3A" unescaped-url ":"))
+    unescaped-url))
+
+(defun newlines-to-backslash-n (body)
+  (cl-ppcre:regex-replace-all #\Newline body "\\\\n"))
-- 
cgit v1.3