From 4850ffaef859a3f33f03c5500602881e30b1039c Mon Sep 17 00:00:00 2001
From: ckonstanski <ckonstanski@pippiandcarlos.com>
Date: Tue, 22 Dec 2020 20:57:44 -0700
Subject: Moved core to its own library

---
 core/core.lisp      |   8 ++
 core/coreutils.lisp | 186 ------------------------------
 core/html.lisp      | 324 ----------------------------------------------------
 core/httputils.lisp |  66 -----------
 4 files changed, 8 insertions(+), 576 deletions(-)
 create mode 100644 core/core.lisp
 delete mode 100644 core/coreutils.lisp
 delete mode 100644 core/html.lisp
 delete mode 100644 core/httputils.lisp

(limited to 'core')

diff --git a/core/core.lisp b/core/core.lisp
new file mode 100644
index 0000000..259e15b
--- /dev/null
+++ b/core/core.lisp
@@ -0,0 +1,8 @@
+;;; -*- 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)
diff --git a/core/coreutils.lisp b/core/coreutils.lisp
deleted file mode 100644
index e7362d8..0000000
--- a/core/coreutils.lisp
+++ /dev/null
@@ -1,186 +0,0 @@
-;;; -*- 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
deleted file mode 100644
index c76e9cb..0000000
--- a/core/html.lisp
+++ /dev/null
@@ -1,324 +0,0 @@
-;;; -*- 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
deleted file mode 100644
index fbd5c36..0000000
--- a/core/httputils.lisp
+++ /dev/null
@@ -1,66 +0,0 @@
-;;; -*- 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