aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/ref/guile.texi1
-rw-r--r--doc/ref/guile/web.texi92
-rw-r--r--module/calp/html/vcomponent.scm4
-rw-r--r--module/calp/server/routes.scm4
-rw-r--r--module/web/http/make-routes.scm1
-rw-r--r--module/web/query.scm13
-rw-r--r--module/web/uri-query.scm4
-rw-r--r--po/sv.po8
-rw-r--r--static/clock.ts31
-rw-r--r--static/script.ts6
-rwxr-xr-xtests/run-tests.scm2
-rw-r--r--tests/test/web-query.scm38
12 files changed, 189 insertions, 15 deletions
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index eb9e3bcc..2594b9e1 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -6,6 +6,7 @@
@include guile/util.texi
@include guile/util-path.texi
@include guile/util-config.texi
+@include guile/web.texi
@include guile/vcomponent.texi
@node Errors and Conditions
diff --git a/doc/ref/guile/web.texi b/doc/ref/guile/web.texi
new file mode 100644
index 00000000..69ab726f
--- /dev/null
+++ b/doc/ref/guile/web.texi
@@ -0,0 +1,92 @@
+@node Web Stuff
+@section Web Stuff
+
+@subsection (web query)
+
+@defun parse-query query-string [encoding=''UTF-8'']
+Given a string like ``?key=value&other=something'', returns
+@code{(key: "value" other: "something")}. Performs uri-decoding of
+both key and value. A key without a value decodes to that key, with
+itself as its value
+@end defun
+
+
+@subsection (web uri-query)
+
+@defun encode-query-parameters parameters
+Given the association list @var{parameter}, encode it into a query
+string on the form ``key=value&...''.
+@end defun
+
+@subsection (web http make-routes)
+
+@defun parse-endpoint-string str
+Only really public for tests.
+@end defun
+
+@defmac make-routes routes ...
+Expands a number of endpoint specifiers into a procedure suitable for
+use as a handler in @xref{Web Server,run-server,run-server,guile}.
+
+Each form conists of
+@itemize
+@item the method (``GET'', ``POST'', ...),
+@item the path, possibly with embedded parameters,
+@item a list of parameters to capture, and
+@item the body.
+@end itemize
+
+@example
+(make-routes
+ (GET "/path/:a" (a b)
+ (return '((content-type text/plain))
+ (format #f "a=~a, b=~a" a b)))
+ ...)
+@end example
+
+The paths can contain embedded variables, which start with
+colon, and their name continues until the next slash or period (or end
+of string). Each path-embedded parameter must be present in the
+parameter list.
+
+The parameter list must contain all path-embedded parameters, and can
+contain any other parameters, which will be bound from the query
+parameters, or stay @code{#f} if not supplied by the browser.
+
+The body should return one to three values, either directly, or
+through an early return by calling the procedure @code{return}.
+
+@defun return headers [body] [new-state]
+@end defun
+
+Inside the body, the following variables are bound to enable producing
+the body:
+
+@defvar request
+@defvarx body
+The raw request headers and request body.
+@end defvar
+
+@defvar state
+The optional state.
+@end defvar
+
+@defvar r:method
+@defvarx r:uri
+@defvarx r:version
+@defvarx r:headers
+@defvarx r:meta
+The requests components
+@end defvar
+
+@defvar r:scheme
+@defvarx r:userinfo
+@defvarx r:host
+@defvarx r:port
+@defvarx r:path
+@defvarx r:query
+@defvarx r:fragment
+The request uri's components.
+@end defvar
+
+@end defmac
diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm
index 574ad954..9e70f910 100644
--- a/module/calp/html/vcomponent.scm
+++ b/module/calp/html/vcomponent.scm
@@ -481,7 +481,7 @@
;; description in sidebar / tab of popup
;; Template data for <vevent-description />
(define-public (description-template)
- '(template
+ `(template
(@ (id "vevent-description"))
(div (@ (class " vevent eventtext summary-tab " ()))
(h3 ((span (@ (class "repeating"))
@@ -563,7 +563,7 @@
(dd (input-list (@ (name ,name))
(input (@ (type "number")
(min ,min) (max ,max)))))))
- '((bysecond ,(_ "By Second") 0 60)
+ `((bysecond ,(_ "By Second") 0 60)
(byminute ,(_ "By Minute") 0 59)
(byhour ,(_ "By Hour") 0 23)
(bymonthday ,(_ "By Month Day") -31 31) ; except 0
diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm
index 2e8f1131..762681d9 100644
--- a/module/calp/server/routes.scm
+++ b/module/calp/server/routes.scm
@@ -71,7 +71,7 @@
(drop-right 1)
(xcons "/static")
path-join)))
- "Return up")))
+ ,(_ "Return up"))))
,@(map (lambda (k)
(let* ((stat (lstat (path-append prefix dir k))))
`(tr (td ,(case (stat:type stat)
@@ -447,7 +447,7 @@
(lambda ()
((sxml->output html)
(xhtml-doc
- (head (title (_ "Calp directory listing for ") path)
+ (head (title ,(_ "Calp directory listing for ") path)
,(include-css
"/static/directory-listing.css"))
(body ,(directory-table (static-dir) path))))))))
diff --git a/module/web/http/make-routes.scm b/module/web/http/make-routes.scm
index 11f7dfb4..105bba50 100644
--- a/module/web/http/make-routes.scm
+++ b/module/web/http/make-routes.scm
@@ -102,6 +102,7 @@
(append
((@ (web query) parse-query) r:query)
+ ;; TODO what's happening here?
(let ((content-type (assoc-ref r:headers 'content-type)))
((@ (hnh util) when) content-type
(let ((type (car content-type))
diff --git a/module/web/query.scm b/module/web/query.scm
index e5057a24..a70903bc 100644
--- a/module/web/query.scm
+++ b/module/web/query.scm
@@ -8,9 +8,12 @@
(fold (lambda (str list)
;; only split on the first equal.
;; Does HTTP allow multiple equal signs in a data field?
- ;; NOTE that this fails if str lacks an equal sign.
- (define idx (string-index str #\=))
- (define key (uri-decode (substring str 0 idx) encoding: encoding))
- (define val (uri-decode (substring str (1+ idx)) encoding: encoding))
- (cons* (-> key string->symbol symbol->keyword) val list))
+ (let* ((key val
+ (cond ((string-index str #\=)
+ => (lambda (idx)
+ (values (uri-decode (substring str 0 idx) encoding: encoding)
+ (uri-decode (substring str (1+ idx)) encoding: encoding))))
+ (else (let ((v (uri-decode str encoding: encoding)))
+ (values v v))))))
+ (cons* (-> key string->symbol symbol->keyword) val list)))
'() (string-split query-string #\&))))
diff --git a/module/web/uri-query.scm b/module/web/uri-query.scm
index 40d89b11..56f3aef9 100644
--- a/module/web/uri-query.scm
+++ b/module/web/uri-query.scm
@@ -3,6 +3,10 @@
:use-module ((web uri) :select (uri-encode))
)
+;; TODO why this format for values?
+;; TODO why aren't we encoding the keys?
+;; TODO why isn't this in the same module as `parse-query'?
+;; TODO why isn't this on the same format as `parse-query'?
(define-public (encode-query-parameters parameters)
(string-join
diff --git a/po/sv.po b/po/sv.po
index a20fb262..12edfb4a 100644
--- a/po/sv.po
+++ b/po/sv.po
@@ -959,3 +959,11 @@ msgstr "Vilka filer att läsa in. Tar en lista av filvägar eller en ensam "
msgid "Default calendar to use for operations. Set to empty string to unset"
msgstr "Standardkalendar att utgå från. En tom sträng \"rensar\" fältet"
+
+msgid "<p><b>update-zoneinfo</b> in theory downloads and updates our local\n"
+ "zoneinfo database, but is currently broken.</p>"
+msgstr "<p><b>update-zoneinfo</b> laddar i teori ner och uppdaterar vår "
+ "lokala zoninfo-databas, men är för tillfället trasig.</p>"
+
+msgid "Return up"
+msgstr "Återvänd uppåt"
diff --git a/static/clock.ts b/static/clock.ts
index b0ddae00..bbd15de0 100644
--- a/static/clock.ts
+++ b/static/clock.ts
@@ -1,4 +1,7 @@
-export { SmallcalCellHighlight, Timebar }
+export {
+ SmallcalCellHighlight, Timebar,
+ initialize_clock_components
+}
import { makeElement, date_to_percent } from './lib'
@@ -96,15 +99,29 @@ class ClockElement extends HTMLElement {
return ['timer_id']
}
- update(now: Date) { /* noop */ }
+ update(_: Date) { /* noop */ }
}
+
class TodayButton extends ClockElement {
+ a: HTMLAnchorElement;
+
+ constructor() {
+ super();
+ this.a = document.createElement('a');
+ this.a.textContent = 'Idag';
+ this.a.classList.add('btn');
+ }
+
+ connectedCallback() {
+ super.connectedCallback();
+ this.replaceChildren(this.a);
+ }
+
update(now: Date) {
- (this.querySelector('a') as any).href = now.format("~Y-~m-~d.html")
+ this.a.href = now.format("~Y-~m-~d.html")
}
}
-customElements.define('today-button', TodayButton)
class CurrentTime extends ClockElement {
@@ -112,4 +129,8 @@ class CurrentTime extends ClockElement {
this.textContent = now.format('~H:~M:~S')
}
}
-customElements.define('current-time', CurrentTime)
+
+function initialize_clock_components() {
+ customElements.define('today-button', TodayButton)
+ customElements.define('current-time', CurrentTime)
+}
diff --git a/static/script.ts b/static/script.ts
index 650a5aa0..ec771773 100644
--- a/static/script.ts
+++ b/static/script.ts
@@ -1,5 +1,8 @@
import { VEvent, xml_to_vcal } from './vevent'
-import { SmallcalCellHighlight, Timebar } from './clock'
+import {
+ SmallcalCellHighlight, Timebar,
+ initialize_clock_components
+} from './clock'
import { vcal_objects, event_calendar_mapping } from './globals'
import { EventCreator } from './event-creator'
import { PopupElement, setup_popup_element } from './components/popup-element'
@@ -40,6 +43,7 @@ window.addEventListener('load', function() {
}
}
+ initialize_clock_components();
initialize_components();
/* A full redraw here is WAY to slow */
diff --git a/tests/run-tests.scm b/tests/run-tests.scm
index 692bf00a..008090d0 100755
--- a/tests/run-tests.scm
+++ b/tests/run-tests.scm
@@ -51,6 +51,8 @@ fi
(define (yellow s) (escaped 33 s))
(define (bold s) (escaped 1 s))
+;;; TODO handle nested grups in a better fassion
+
(define (construct-test-runner)
(define runner (test-runner-null))
;; end of individual test case
diff --git a/tests/test/web-query.scm b/tests/test/web-query.scm
new file mode 100644
index 00000000..76c0a76d
--- /dev/null
+++ b/tests/test/web-query.scm
@@ -0,0 +1,38 @@
+(define-module (test web-query)
+ :use-module (srfi srfi-64)
+ :use-module (srfi srfi-88)
+ :use-module ((web query) :select (parse-query)))
+
+(test-begin "Web Query")
+
+(test-equal "Empty query gives empty assoc list"
+ '() (parse-query ""))
+(test-equal "Simple key-value query"
+ '(key: "value") (parse-query "key=value"))
+
+;; Slightly cumbersome check, since keys aren't ordered
+(test-group
+ "Simple key-value query, with multiple keys"
+ (let ((kv-list (parse-query "k1=value&k2=1")))
+ (test-equal "value" (and=> (memv k1: kv-list) cadr))
+ (test-equal "1" (and=> (memv k2: kv-list) cadr))))
+
+(test-equal "Values are HTTP-decoded"
+ '(key: " ") (parse-query "key=%20"))
+(test-equal "Keys are HTTP-decoded"
+ '(A: "test") (parse-query "%41=test"))
+
+(test-equal "Query with only key, value becomes key"
+ '(key: "key") (parse-query "key"))
+
+(test-group
+ "Some with only key"
+ (let ((kv-list (parse-query "k1&k2=10")))
+ (test-equal "k1" (and=> (memv k1: kv-list) cadr))
+ (test-equal "10" (and=> (memv k2: kv-list) cadr))))
+
+;; I don't know if HTTP allows this, but my code works like this
+(test-equal "Value with equal in it"
+ '(key: "=") (parse-query "key=="))
+
+(test-end "Web Query")
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-19 15:37:53 +0200