Ported to Chicken 5

This commit is contained in:
Daniel Ziltener 2020-12-29 03:29:22 +01:00
parent 4680d25561
commit 324324c4a9
8 changed files with 42 additions and 43 deletions

View File

@ -1,8 +0,0 @@
;; -*- Scheme -*-
((synopsis "Server-Sent Events module for Awful")
(author "Arthur Maciel")
(category web)
(license "BSD")
(depends awful spiffy intarweb)
(test-depends test server-test uri-common http-client))

View File

@ -1,9 +0,0 @@
;; -*- Scheme -*-
(compile -s -O2 awful-sse.scm -j awful-sse)
(compile -s -O2 awful-sse.import.scm)
(install-extension
'awful-sse
'("awful-sse.so" "awful-sse.import.so")
'((version "0.1")))

9
awful.sse.egg Normal file
View File

@ -0,0 +1,9 @@
;; -*- mode: scheme -*-
((author "Arthur Maciel")
(synopsis "Server-Sent Events module for Awful")
(category web)
(license "BSD")
(dependencies awful spiffy intarweb)
(test-dependencies test server-test uri-common http-client)
(components
(extension awful.sse)))

View File

@ -24,32 +24,37 @@
;; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(module awful-sse
(module (awful sse)
(define-page/sse send-sse-data send-sse-retry)
(import scheme chicken data-structures extras posix)
(use awful spiffy intarweb)
(import scheme
(chicken base)
(chicken keyword)
(chicken string)
;;data-structures extras posix
awful spiffy intarweb)
(define (add-sse-resource! sse-path sse-proc vhost-root-path client-path)
(add-resource! sse-path
(or vhost-root-path (root-path))
(lambda (#!optional given-path)
(let ((accept (header-values 'accept
(request-headers (current-request)))))
;; If client's EventSource (JS code) requested SSE page...
(if (memq 'text/event-stream accept)
;;...complete handshake & keep connection alive with 'sse-proc'.
(or vhost-root-path (root-path))
(lambda (#!optional given-path)
(let ((accept (header-values 'accept
(request-headers (current-request)))))
;; If client's EventSource (JS code) requested SSE page...
(if (memq 'text/event-stream accept)
;;...complete handshake & keep connection alive with 'sse-proc'.
(lambda ()
(with-headers '((content-type text/event-stream)
(cache-control no-cache)
(connection keep-alive))
(lambda ()
(write-logged-response)
(sse-proc))))
(redirect-to client-path))))
'GET))
(with-headers '((content-type text/event-stream)
(cache-control no-cache)
(connection keep-alive))
(lambda ()
(write-logged-response)
(sse-proc))))
(redirect-to client-path))))
'GET
#f))
(define (define-page/sse path contents sse-path sse-proc #!rest rest)
(apply define-page (append (list path contents) rest))
(add-sse-resource! sse-path sse-proc (get-keyword vhost-root-path: rest) path))
@ -57,13 +62,13 @@
(define (write-body data)
(display data (response-port (current-response)))
(finish-response-body (current-response)))
(define (send-sse-data data #!key event id)
(let ((msg (conc (if id (conc "id: " id "\n") "")
(if event (conc "event: " event "\n") "")
"data: " data "\n\n")))
(write-body msg)))
(define (send-sse-retry retry)
(write-body (conc "retry: " retry "\n\n")))

View File

@ -1,4 +1,4 @@
(use awful-sse)
(import (awful sse))
(define (sse-proc)
(send-sse-data "sse"))

View File

@ -1,4 +1,6 @@
(use awful http-client intarweb uri-common server-test test)
(import (chicken base)
(chicken io)
awful http-client intarweb uri-common server-test test)
(awful-apps (list "client.scm"))