From 89418ccb92b9389d3442be2af128c593fa362acc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Wed, 12 Aug 2020 15:34:55 +0200
Subject: Calendar names now encoded with modified base64

---
 module/html/util.scm     | 31 +++++++++++++++++++++++++++++--
 module/server/routes.scm | 14 ++++++++++----
 2 files changed, 39 insertions(+), 6 deletions(-)

diff --git a/module/html/util.scm b/module/html/util.scm
index 36b1d929..edbcf756 100644
--- a/module/html/util.scm
+++ b/module/html/util.scm
@@ -1,10 +1,37 @@
 (define-module (html util)
+  :use-module ((util base64)
+               :select (base64encode base64decode))
   :use-module (util))
 
+;;; @var{html-attr} & @var{html-unattr} used to just strip any
+;;; attributes not valid in css. That allowed a human reader to
+;;; quickly see what data it was. The downside was that it was one
+;;; way. The new base64 based system supports both an encode and a
+;;; decode without problem.
+;;;
+;;; The encoded string substitutes { + => å, / => ä, = => ö } to be
+;;; valid CSS selector names.
+
 ;; Retuns an HTML-safe version of @var{str}.
 (define-public (html-attr str)
-  (define cs (char-set-adjoin char-set:letter+digit #\- #\_))
-  (string-filter (lambda (c) (char-set-contains? cs c)) str))
+  (string-map (lambda (c)
+                (case c
+                  ((#\+) #\å)
+                  ((#\/) #\ä)
+                  ((#\=) #\ö)
+                  (else c)))
+              (base64encode str)))
+
+(define-public (html-unattr str)
+  (base64decode
+    (string-map (lambda (c)
+                  (case c
+                    ((#\å) #\+)
+                    ((#\ä) #\/)
+                    ((#\ö) #\=)
+                    (else c)))
+                str)))
+
 
 (define-public (date-link date)
   ((@ (datetime) date->string) date "~Y-~m-~d"))
diff --git a/module/server/routes.scm b/module/server/routes.scm
index bf5165a9..552c43ef 100644
--- a/module/server/routes.scm
+++ b/module/server/routes.scm
@@ -16,6 +16,9 @@
   :use-module (sxml xpath)
   :use-module (sxml namespace)
 
+
+  :use-module ((html util) :select (html-unattr))
+
   :use-module (server util)
   :use-module (server macro)
 
@@ -158,6 +161,8 @@
                       (format #f "No event with UID '~a'" uid))))
 
    ;; TODO this fails when dtstart is <date>.
+   ;; @var{cal} should be the name of the calendar encoded with
+   ;; modified base64. See (html util).
    (POST "/insert" (cal data)
 
          (unless (and cal data)
@@ -168,13 +173,14 @@
          ;; NOTE that this leaks which calendar exists,
          ;; but you can only query for existance.
          ;; also, the calendar view already show all calendars.
-         (let ((calendar
-                (find (lambda (c) (string=? cal (prop c 'NAME)))
-                      (get-calendars global-event-object))))
+         (let* ((calendar-name (html-unattr cal))
+                (calendar
+                  (find (lambda (c) (string=? calendar-name (prop c 'NAME)))
+                        (get-calendars global-event-object))))
 
            (unless calendar
              (return (build-response code: 400)
-                     (format #f "No calendar with name [~a]\r\n" cal)))
+                     (format #f "No calendar with name [~a]\r\n" calendar-name)))
 
            ;; Expected form of data (but in XML) is:
            ;; @example
-- 
cgit v1.2.3