[scheme] Refactor RSVP system

1 files changed, 57 insertions, 0 deletions

diff --git a/dynamic/util.scm b/dynamic/util.scm
new file mode 100644
index 0000000..29a40db
--- /dev/null
+++ b/dynamic/util.scm
@@ -0,0 +1,57 @@
+;;; Copyright © 2019 - 2022 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (dynamic util)
+  #:use-module (ice-9 match)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (web uri)
+  #:export (base64-length
+            decode-form))
+
+(define (acons-list k v alist)
+  "Add V to K to alist as list"
+  (let ((value (assoc-ref alist k)))
+    (if value
+        (let ((alist (alist-delete k alist)))
+          (acons k (cons v value) alist))
+        (acons k (list v) alist))))
+
+(define (list->alist lst)
+  "Build a alist of list based on a list of key and values.
+
+   Multiple values can be associated with the same key"
+  (let next ((lst lst)
+             (out '()))
+    (if (null? lst)
+        out
+        (next (cdr lst) (acons-list (caar lst) (cdar lst) out)))))
+
+(define (decode-form bv)
+  "Convert BV querystring or form data to an alist"
+  (define string (if (string? bv) bv (utf8->string bv)))
+  (define pairs (map (cut string-split <> #\=)
+                     ;; semi-colon and amp can be used as pair separator
+                     (append-map (cut string-split <> #\;)
+                                 (string-split string #\&))))
+  (list->alist (map (match-lambda
+                      ((key value)
+                       (cons (uri-decode key) (uri-decode value)))) pairs)))
+
+(define (base64-length n)
+  "The length of the base64 string encoding `n' bytes."
+  (inexact->exact (* 4 (ceiling (/ n 3.0)))))