From 8872d37332619820c7f00f95867eb836fc0c3950 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 30 Apr 2020 19:01:44 +0200 Subject: Update server to use app. --- module/entry-points/server.scm | 33 +++++++++------------------------ 1 file changed, 9 insertions(+), 24 deletions(-) (limited to 'module/entry-points/server.scm') diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm index 408b00b3..6a4558a6 100644 --- a/module/entry-points/server.scm +++ b/module/entry-points/server.scm @@ -1,5 +1,6 @@ (define-module (entry-points server) :use-module (util) + :use-module (util app) :use-module (srfi srfi-1) @@ -54,7 +55,7 @@ (cddr (scandir dir)))))) -(define (make-make-routes calendar regular repeating events) +(define-method (make-make-routes) (make-routes (GET "/week/:start-date.html" (start-date) @@ -63,8 +64,8 @@ (return '((content-type text/html)) (with-output-to-string (lambda () - (html-generate calendars: calendar - events: events + (html-generate calendars: (getf app 'calendars) + events: (getf app 'event-set) start-date: start-date end-date: (date+ start-date (date day: 6)) next-start: (lambda (d) (date+ d (date day: 7))) @@ -78,8 +79,8 @@ (return '((content-type text/html)) (with-output-to-string (lambda () - (html-generate calendars: calendar - events: events + (html-generate calendars: (getf app 'calendars) + events: (getf app 'event-set) start-date: start-date end-date: (date- (month+ start-date) (date day: 1)) @@ -95,19 +96,12 @@ (return '((content-type text/calendar)) (with-output-to-string (lambda () - (ical-main calendar - regular - repeating - (parse-iso-date start) + (ical-main (parse-iso-date start) (parse-iso-date end)))))) ;; TODO this returns "invalid" events, since the surrounding VCALENDAR is missing. (GET "/calendar/:uid.ics" (uid) - ;; NOTE build an index. - (aif (or (find (lambda (ev) (equal? uid (attr ev 'UID))) - regular) - (find (lambda (ev) (equal? uid (attr ev 'UID))) - repeating)) + (aif (get-event-by-uid uid) (return '((content-type text/calendar)) (with-output-to-string (lambda () (print-components-with-fake-parent @@ -160,15 +154,6 @@ [(and addr (string-contains addr ".")) AF_INET] [else AF_INET6])) - (define-values (c regular repeating) - (cond [(option-ref opts 'file #f) => (compose load-calendars* list)] - [else (load-calendars*)])) - - (define all-events - ((@ (vcomponent load) calculate-recurrence-set) regular repeating)) - - - ;; update address if it was left blank. A bit clumsy since ;; @var{addr} & @var{family} depend on each other. ;; placed after load-calendars to keep Guile 2.2 compability. @@ -195,7 +180,7 @@ addr port (getpid) (getcwd)) - (run-server (make-make-routes c regular repeating all-events) + (run-server (make-make-routes) 'http `(family: ,family port: ,port -- cgit v1.2.3 From aa44c16ce953c090b2eb3ce580c60fa8934a7720 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 30 Apr 2020 19:17:35 +0200 Subject: Change call signature for [gs]etf. --- module/entry-points/server.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'module/entry-points/server.scm') diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm index 6a4558a6..3dab6e9c 100644 --- a/module/entry-points/server.scm +++ b/module/entry-points/server.scm @@ -64,8 +64,8 @@ (return '((content-type text/html)) (with-output-to-string (lambda () - (html-generate calendars: (getf app 'calendars) - events: (getf app 'event-set) + (html-generate calendars: (getf 'calendars) + events: (getf 'event-set) start-date: start-date end-date: (date+ start-date (date day: 6)) next-start: (lambda (d) (date+ d (date day: 7))) @@ -79,8 +79,8 @@ (return '((content-type text/html)) (with-output-to-string (lambda () - (html-generate calendars: (getf app 'calendars) - events: (getf app 'event-set) + (html-generate calendars: (getf 'calendars) + events: (getf 'event-set) start-date: start-date end-date: (date- (month+ start-date) (date day: 1)) -- cgit v1.2.3 From fd30bc3ec4fed7d150f6821693ecd3f1263a0b9c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 30 Apr 2020 23:08:48 +0200 Subject: Update error on /calendar/ endpoint. --- module/entry-points/server.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'module/entry-points/server.scm') diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm index 408b00b3..83d80c27 100644 --- a/module/entry-points/server.scm +++ b/module/entry-points/server.scm @@ -101,7 +101,7 @@ (parse-iso-date start) (parse-iso-date end)))))) - ;; TODO this returns "invalid" events, since the surrounding VCALENDAR is missing. + ;; TODO this fails if there's a period in the uid. (GET "/calendar/:uid.ics" (uid) ;; NOTE build an index. (aif (or (find (lambda (ev) (equal? uid (attr ev 'UID))) -- cgit v1.2.3 From 5ddd131b95389712e17c7d556a28dc6f1ad6719e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 1 May 2020 13:04:12 +0200 Subject: Server server any subdir under static. --- module/entry-points/server.scm | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) (limited to 'module/entry-points/server.scm') diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm index 83d80c27..3455540d 100644 --- a/module/entry-points/server.scm +++ b/module/entry-points/server.scm @@ -38,20 +38,22 @@ (with-output-to-string (lambda () (display "\n") (sxml->xml sxml)))) +(define (// . args) (string-join args file-name-separator-string )) + (define (directory-table dir) `(table (thead (tr (th "") (th "Name") (th "Perm"))) (tbody ,@(map (lambda (k) - (let* ((stat (lstat k))) + (let* ((stat (lstat (// dir k)))) `(tr (td ,(case (stat:type stat) [(directory) "📁"] [(regular) "📰"] [else "🙃"])) - (td (a (@ (href "/" ,dir ,k)) ,k)) + (td (a (@ (href "/" ,dir "/" ,k)) ,k)) (td ,(number->string (stat:perms stat) 8))))) - (cddr (scandir dir)))))) + (cdr (scandir dir)))))) (define (make-make-routes calendar regular repeating events) @@ -115,23 +117,23 @@ (return (build-response code: 404) (format #f "No component with UID=~a found." uid)))) - (GET "/static" () - (return - '((content-type text/html)) - (sxml->html-string - (directory-table "static/")))) + ;; NOTE this only handles files with extensions. Limited, but since this + ;; is mostly for development, and something like nginx should be used in + ;; production it isn't a huge problem. - (GET "/static/:filename.css" (filename) + (GET "/static/:*{.*}.:ext" (* ext) (return - `((content-type text/css)) - (call-with-input-file (string-append "static/" filename ".css") + ;; TODO actually check mimetype + `((content-type ,(string->symbol (string-append "text/" ext)))) + (call-with-input-file (string-append "static/" * "." ext) read-string))) - (GET "/static/:filename.js" (filename) + (GET "/static/:*{.*}" (*) (return - `((content-type text/javascript)) - (call-with-input-file (string-append "static/" filename ".js") - read-string))) + '((content-type text/html)) + (sxml->html-string + (directory-table (// "static" *))))) + (GET "/count" () ;; (sleep 1) -- cgit v1.2.3