aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-08-12 15:34:55 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-08-12 15:34:55 +0200
commit89418ccb92b9389d3442be2af128c593fa362acc (patch)
tree3829b2389bb8fd46e2c26abe4ace063352a95294
parentCan create events in different calentdars, given that the calendars have simp... (diff)
downloadcalp-89418ccb92b9389d3442be2af128c593fa362acc.tar.gz
calp-89418ccb92b9389d3442be2af128c593fa362acc.tar.xz
Calendar names now encoded with modified base64
-rw-r--r--module/html/util.scm31
-rw-r--r--module/server/routes.scm14
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