The `org' directory is no longer necessary

1 files changed, 54 insertions, 0 deletions

diff --git a/demux.scm b/demux.scm
new file mode 100644
index 0000000..2de029d
--- /dev/null
+++ b/demux.scm
@@ -0,0 +1,54 @@
+;;; Copyright © 2019 - 2023 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/>.
+
+(use-modules (srfi srfi-1)
+             (web request)
+             (web response)
+             (web server)
+             (web uri)
+             (web client))
+
+(define static-url "http://localhost:8080")
+(define dynamic-url "http://localhost:8081")
+
+(define (main-request-handler request body)
+  "Demuxer entry-point; parse `request' and forward to the correct local service"
+  (define (wrap-response response)
+    (if (response? response)
+        (build-response
+         #:version           (response-version       response)
+         #:code              (response-code          response)
+         #:reason-phrase     (response-reason-phrase response)
+         #:headers           (remove (lambda (hdr) (eqv? 'content-length (car hdr)))
+                                     (response-headers response))
+         #:port              (response-port          response)
+         #:validate-headers? #f)
+        (cons '(Access-Control-Allow-Origin . "*") response)))
+  (let* ((path-encoded (uri-path (request-uri request)))
+         (path (split-and-decode-uri-path path-encoded)))
+    (define-values (response resp-body)
+      (let ((url (if (and (positive? (length path)) (string= "api" (first path)))
+                     (string-concatenate (list dynamic-url path-encoded))
+                     (string-concatenate (list static-url path-encoded)))))
+        (http-request url
+                      #:method (request-method request)
+                      #:body body
+                      #:version '(1 . 1)
+                      #:keep-alive? #f
+                      #:headers (request-headers request))))
+    (values (wrap-response response) resp-body)))
+
+(run-server main-request-handler 'http '(#:port 8082))