From cd36a88d12992eb71199d59f70871c874e7ed48e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Mon, 31 Mar 2025 21:58:50 +0200 Subject: [PATCH 01/10] Work on request handler. --- backend/brminv.scm | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) diff --git a/backend/brminv.scm b/backend/brminv.scm index 2a3f191..51ee152 100644 --- a/backend/brminv.scm +++ b/backend/brminv.scm @@ -3,11 +3,15 @@ texts spiffy openssl - (chicken tcp)) + (chicken tcp) + intarweb + uri-common) (define -port- (make-parameter #f)) (define -certificate- (make-parameter #f)) (define -key- (make-parameter #f)) +(define -user- (make-parameter #f)) +(define -group- (make-parameter #f)) (command-line print-help @@ -48,3 +52,22 @@ (ssl-listen port) (tcp-listen port))) +(when (and (-user-) (-group-)) + (switch-user/group (-user-) (-group-))) + +(handle-not-found + (lambda (path) + (define path-lst (uri-path (request-uri (current-request)))) + (print (car path-lst)) + (define body + (cond ((equal? (car path-lst) '/) + (print "index") + (frontend-lookup "index.html" "index not found")) + (else + "error"))) + (send-response #:body body))) + +(accept-loop listener + (if ssl? + ssl-accept + tcp-accept)) From 03c744e9f1b22f04461a2cab1224d157b3e88a98 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Mon, 31 Mar 2025 22:30:28 +0200 Subject: [PATCH 02/10] Preliminary static assets serving. --- tools/schemify-tree.scm | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/tools/schemify-tree.scm b/tools/schemify-tree.scm index ee4e886..404fe25 100644 --- a/tools/schemify-tree.scm +++ b/tools/schemify-tree.scm @@ -23,10 +23,10 @@ ;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ;; (import (chicken process-context) - srfi-4 (chicken file) (chicken pathname) - (chicken format)) + (chicken format) + (chicken io)) (define (get-argv) (let* ((args (argv)) @@ -78,8 +78,11 @@ (if (null? tree) alst (let* ((fpath (car tree)) - (key (substring fpath dir-len)) - (value (with-input-from-file fpath read-u8vector))) + (key0 (substring fpath dir-len)) + (key (if (eq? (string-ref key0 0) #\/) + (substring key0 1) + key0)) + (value (with-input-from-file fpath read-string))) (loop (cdr tree) (cons (cons key value) alst))))))) From 98053754215c91c4d0d88ed91b2e3ab48ff10f53 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 1 Apr 2025 11:09:57 +0200 Subject: [PATCH 03/10] Serve all files and mime types. --- backend/brminv.scm | 67 +++++++++++++++++++++++++++++++++++------ frontend/vite.config.js | 1 - 2 files changed, 57 insertions(+), 11 deletions(-) diff --git a/backend/brminv.scm b/backend/brminv.scm index 51ee152..b6c3dbd 100644 --- a/backend/brminv.scm +++ b/backend/brminv.scm @@ -1,3 +1,28 @@ +;; +;; brminv.scm +;; +;; Main program of Brm Inventory - the server. +;; +;; ISC License +;; +;; Copyright 2023-2025 Brmlab, z.s. +;; Dominik Pantůček +;; +;; Permission to use, copy, modify, and/or distribute this software +;; for any purpose with or without fee is hereby granted, provided +;; that the above copyright notice and this permission notice appear +;; in all copies. +;; +;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL +;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED +;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE +;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR +;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, +;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +;; + (import frontend command-line texts @@ -5,7 +30,8 @@ openssl (chicken tcp) intarweb - uri-common) + uri-common + (chicken string)) (define -port- (make-parameter #f)) (define -certificate- (make-parameter #f)) @@ -55,17 +81,38 @@ (when (and (-user-) (-group-)) (switch-user/group (-user-) (-group-))) +(define (handle-request-by-path path) + (print (->string path-lst) (length path)) + (define body + (cond ((equal? path-lst '(/ "")) + (print "index") + ) + (else + "error")))) + +(define (handle-api-calls) + #f) + (handle-not-found (lambda (path) - (define path-lst (uri-path (request-uri (current-request)))) - (print (car path-lst)) - (define body - (cond ((equal? (car path-lst) '/) - (print "index") - (frontend-lookup "index.html" "index not found")) - (else - "error"))) - (send-response #:body body))) + (define upath (string-intersperse (map ->string (cdr (uri-path (request-uri (current-request))))) "/")) + (cond ((equal? upath "") + (send-response #:body (frontend-lookup "index.html"))) + (else + (let ((maybe-asset (frontend-lookup upath #f))) + (cond (maybe-asset + (send-response + #:headers (let ((ext (car (reverse (string-split upath "."))))) + (cond ((equal? ext "css") + '((content-type #("text/css" ())))) + ((equal? ext "js") + '((content-type #("text/javascript" ())))) + (else + '()))) + #:body maybe-asset)) + (else + (when (not (handle-api-calls)) + (send-response #:body (frontend-lookup "index.html")))))))))) (accept-loop listener (if ssl? diff --git a/frontend/vite.config.js b/frontend/vite.config.js index af9cc28..e878765 100644 --- a/frontend/vite.config.js +++ b/frontend/vite.config.js @@ -4,5 +4,4 @@ import react from '@vitejs/plugin-react' // https://vite.dev/config/ export default defineConfig({ plugins: [react()], - base: '/brm/inv/dist', }) From a59567d4ab5b06ed4e0f9d775c88b80de76cf1aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 1 Apr 2025 11:15:12 +0200 Subject: [PATCH 04/10] Load certificate. --- backend/brminv.scm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/backend/brminv.scm b/backend/brminv.scm index b6c3dbd..27525a6 100644 --- a/backend/brminv.scm +++ b/backend/brminv.scm @@ -78,6 +78,10 @@ (ssl-listen port) (tcp-listen port))) +(when ssl? + (ssl-load-certificate-chain! listener (-certificate-)) + (ssl-load-private-key! listener (-key-))) + (when (and (-user-) (-group-)) (switch-user/group (-user-) (-group-))) From 24e0b487c51c95a1cadc0d88cadef42a942de414 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 1 Apr 2025 11:35:11 +0200 Subject: [PATCH 05/10] Postgresql integration. --- backend/Makefile | 2 +- backend/brminv.scm | 6 +++++- install-eggs.sh | 1 + 3 files changed, 7 insertions(+), 2 deletions(-) diff --git a/backend/Makefile b/backend/Makefile index 22cfc15..f59f2a4 100644 --- a/backend/Makefile +++ b/backend/Makefile @@ -17,7 +17,7 @@ BRMINV_OBJS=brminv.o frontend.o command-line.o util-proc.o duck.o \ $(CSC) -regenerate-import-libraries -P -J $< ../brminv: $(BRMINV_OBJS) - $(CSC) -L --no-lto -L -Wl,-static -L -Wl,-lssl -L -Wl,-lcrypto -L -Wl,-Bdynamic -strip -static -o $@ $(BRMINV_OBJS) + $(CSC) -L --no-lto -L -Wl,-static -L -Wl,-lssl -L -Wl,-lcrypto -L -Wl,-Bdynamic -L -Wl,-lpq -strip -static -o $@ $(BRMINV_OBJS) frontend.o: frontend.import.scm frontend.import.scm: frontend.scm diff --git a/backend/brminv.scm b/backend/brminv.scm index 27525a6..4911524 100644 --- a/backend/brminv.scm +++ b/backend/brminv.scm @@ -31,7 +31,8 @@ (chicken tcp) intarweb uri-common - (chicken string)) + (chicken string) + postgresql) (define -port- (make-parameter #f)) (define -certificate- (make-parameter #f)) @@ -73,6 +74,9 @@ (print " Certificate:" (-certificate-)) (print " Key:" (-key-))) +(define dbconn (connect "postgresql:///brmbar")) +(print dbconn) + (define listener (if ssl? (ssl-listen port) diff --git a/install-eggs.sh b/install-eggs.sh index 1f39a84..c17213d 100644 --- a/install-eggs.sh +++ b/install-eggs.sh @@ -55,6 +55,7 @@ trap chicken_cleanup INT QUIT # Install required eggs chicken_install spiffy chicken_install openssl +chicken_install postgresql # Normal termination cleanup chicken_cleanup From 0d83aa699ba5a8c55684c385b85cb3a74ee9e073 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 1 Apr 2025 11:54:30 +0200 Subject: [PATCH 06/10] Copy install-eggs for arm adjustments. --- install-eggs-arm.sh | 61 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 install-eggs-arm.sh diff --git a/install-eggs-arm.sh b/install-eggs-arm.sh new file mode 100644 index 0000000..c17213d --- /dev/null +++ b/install-eggs-arm.sh @@ -0,0 +1,61 @@ +#!/bin/sh +# +# install-eggs.sh +# +# Local installer of CHICKEN eggs required for building. +# +# ISC License +# +# Copyright 2023 Brmlab, z.s. +# Dominik Pantůček +# +# Permission to use, copy, modify, and/or distribute this software +# for any purpose with or without fee is hereby granted, provided +# that the above copyright notice and this permission notice appear +# in all copies. +# +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL +# WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED +# WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE +# AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR +# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +# OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, +# NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +# + +# Source root directory +owd=$(pwd) +cd $(dirname "$0") +SRCDIR=$(pwd) +cd "$owd" + +# Make temporary prefix directory (eggs shared throwaway files) +TMPDIR=$(mktemp -d) + +# Installs given egg locally +chicken_install() { + echo "Installing $1 ..." + CHICKEN_INSTALL_PREFIX="$TMPDIR" \ + CHICKEN_REPOSITORY_PATH="$SRCDIR/eggs":`chicken-install -repository` \ + CHICKEN_INSTALL_REPOSITORY="$SRCDIR/eggs" \ + chicken-install "$1" 2>&1 | \ + sed -u 's/^/ /' +} + +# Removes throwaway files +chicken_cleanup() { + echo "Cleaning up ..." + rm -fr ${TMPDIR} +} + +# Always cleanup +trap chicken_cleanup INT QUIT + +# Install required eggs +chicken_install spiffy +chicken_install openssl +chicken_install postgresql + +# Normal termination cleanup +chicken_cleanup From 7546f67fbfc2dbd532b501f9ea1fcdc6c23f5f78 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 1 Apr 2025 15:06:16 +0200 Subject: [PATCH 07/10] Cross-compiling eggs. --- install-eggs-arm.sh | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/install-eggs-arm.sh b/install-eggs-arm.sh index c17213d..1b85f26 100644 --- a/install-eggs-arm.sh +++ b/install-eggs-arm.sh @@ -37,9 +37,9 @@ TMPDIR=$(mktemp -d) chicken_install() { echo "Installing $1 ..." CHICKEN_INSTALL_PREFIX="$TMPDIR" \ - CHICKEN_REPOSITORY_PATH="$SRCDIR/eggs":`chicken-install -repository` \ - CHICKEN_INSTALL_REPOSITORY="$SRCDIR/eggs" \ - chicken-install "$1" 2>&1 | \ + CHICKEN_REPOSITORY_PATH="$SRCDIR/eggs-arm":`./cross-chicken-arm/bin/arm-chicken-install -repository` \ + CHICKEN_INSTALL_REPOSITORY="$SRCDIR/eggs-arm" \ + ./cross-chicken-arm/bin/arm-chicken-install "$1" 2>&1 | \ sed -u 's/^/ /' } From b895558ca8ef2dd3bc29ea9a87c8ffa13dac706f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 1 Apr 2025 21:22:35 +0200 Subject: [PATCH 08/10] Comment-out all cross-compiling attempts for now. --- backend/Makefile | 5 ++++- install-eggs-arm.sh | 9 ++++++--- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/backend/Makefile b/backend/Makefile index f59f2a4..b06262a 100644 --- a/backend/Makefile +++ b/backend/Makefile @@ -3,7 +3,10 @@ default: ../brminv SCRP=$(shell chicken-install -repository) +#SCRP=$(shell ../cross-chicken-arm/bin/arm-chicken-install -repository) CSC=CHICKEN_REPOSITORY_PATH=../eggs:$(SCRP) csc +#CSC=CHICKEN_REPOSITORY_PATH=../eggs-arm:$(SCRP) ../cross-chicken-arm/bin/arm-csc +#CSC=../cross-chicken-arm/bin/arm-csc BRMINV_SOURCES=brminv.scm frontend.import.scm command-line.import.scm \ util-proc.import.scm duck.import.scm texts.import.scm @@ -17,7 +20,7 @@ BRMINV_OBJS=brminv.o frontend.o command-line.o util-proc.o duck.o \ $(CSC) -regenerate-import-libraries -P -J $< ../brminv: $(BRMINV_OBJS) - $(CSC) -L --no-lto -L -Wl,-static -L -Wl,-lssl -L -Wl,-lcrypto -L -Wl,-Bdynamic -L -Wl,-lpq -strip -static -o $@ $(BRMINV_OBJS) + $(CSC) -L --no-lto -L -Wl,-lssl -L -Wl,-lcrypto -L -Wl,-lpq -strip -static -o $@ $(BRMINV_OBJS) frontend.o: frontend.import.scm frontend.import.scm: frontend.scm diff --git a/install-eggs-arm.sh b/install-eggs-arm.sh index 1b85f26..fbd5da6 100644 --- a/install-eggs-arm.sh +++ b/install-eggs-arm.sh @@ -36,9 +36,12 @@ TMPDIR=$(mktemp -d) # Installs given egg locally chicken_install() { echo "Installing $1 ..." - CHICKEN_INSTALL_PREFIX="$TMPDIR" \ - CHICKEN_REPOSITORY_PATH="$SRCDIR/eggs-arm":`./cross-chicken-arm/bin/arm-chicken-install -repository` \ - CHICKEN_INSTALL_REPOSITORY="$SRCDIR/eggs-arm" \ + # CHICKEN_INSTALL_PREFIX="$TMPDIR" \ + # CHICKEN_REPOSITORY_PATH="$SRCDIR/eggs-arm":`./cross-chicken-arm/bin/arm-chicken-install -repository` \ + # CHICKEN_INSTALL_REPOSITORY="$SRCDIR/eggs-arm" \ + # ./cross-chicken-arm/bin/arm-chicken-install "$1" 2>&1 | \ + # sed -u 's/^/ /' +# CHICKEN_INSTALL_PREFIX="$TMPDIR" \ ./cross-chicken-arm/bin/arm-chicken-install "$1" 2>&1 | \ sed -u 's/^/ /' } From 1b20816e7bbfd7e0251bc10589ccfe59ea1dd1ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 4 Apr 2025 10:28:54 +0200 Subject: [PATCH 09/10] Conditional frontend build + add user/group options. --- backend/Makefile | 2 +- backend/brminv.scm | 5 ++++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/backend/Makefile b/backend/Makefile index b06262a..2581480 100644 --- a/backend/Makefile +++ b/backend/Makefile @@ -26,7 +26,7 @@ frontend.o: frontend.import.scm frontend.import.scm: frontend.scm .PHONY: frontend.scm frontend.scm: - cd ../frontend && npm run build && cd ../backend && csi -b -q ../tools/schemify-tree.scm -- ../frontend/dist frontend frontend-lookup + cd ../frontend && (if [ -d src ] ; then npm run build ; fi ) && cd ../backend && csi -b -q ../tools/schemify-tree.scm -- ../frontend/dist frontend frontend-lookup brminv.o: $(BRMINV_SOURCES) diff --git a/backend/brminv.scm b/backend/brminv.scm index 4911524..4a80137 100644 --- a/backend/brminv.scm +++ b/backend/brminv.scm @@ -62,7 +62,10 @@ (-certificate- cert)) (-k (key) "Private key" (-key- key)) - ) + (-u (user) "User to run as (if started as root)" + (-user- user)) + (-g (group) "Group to run as (if started as root)" + (-group- group))) (define ssl? (and (-certificate-) (-key-) #t)) (define port (or (-port-) (if ssl? 443 80))) From fac8d8f4f1e65f3a3c773400516fbb5be5029eea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sun, 6 Apr 2025 20:13:37 +0200 Subject: [PATCH 10/10] Connect to database using md5 auth. --- backend/brminv.scm | 27 +++++++++++++++++++++++---- 1 file changed, 23 insertions(+), 4 deletions(-) diff --git a/backend/brminv.scm b/backend/brminv.scm index 4a80137..32ae6fd 100644 --- a/backend/brminv.scm +++ b/backend/brminv.scm @@ -39,6 +39,10 @@ (define -key- (make-parameter #f)) (define -user- (make-parameter #f)) (define -group- (make-parameter #f)) +(define -db-host- (make-parameter #f)) +(define -db-user- (make-parameter #f)) +(define -db-name- (make-parameter #f)) +(define -db-pass- (make-parameter #f)) (command-line print-help @@ -65,7 +69,16 @@ (-u (user) "User to run as (if started as root)" (-user- user)) (-g (group) "Group to run as (if started as root)" - (-group- group))) + (-group- group)) + (-dh (hostname) "Database hostname" + (-db-host- hostname)) + (-dn (dbname) "Database name" + (-db-name- dbname)) + (-du (dbuser) "Database username" + (-db-user- dbuser)) + (-dp (dbpass) "Database password" + (-db-pass- dbpass)) + ) (define ssl? (and (-certificate-) (-key-) #t)) (define port (or (-port-) (if ssl? 443 80))) @@ -77,9 +90,6 @@ (print " Certificate:" (-certificate-)) (print " Key:" (-key-))) -(define dbconn (connect "postgresql:///brmbar")) -(print dbconn) - (define listener (if ssl? (ssl-listen port) @@ -92,6 +102,14 @@ (when (and (-user-) (-group-)) (switch-user/group (-user-) (-group-))) +(define dbconn + (connect + `((dbname . ,(-db-name-)) + (host . ,(-db-host-)) + (user . ,(-db-user-)) + (password . ,(-db-pass-))))) +(print dbconn) + (define (handle-request-by-path path) (print (->string path-lst) (length path)) (define body @@ -107,6 +125,7 @@ (handle-not-found (lambda (path) (define upath (string-intersperse (map ->string (cdr (uri-path (request-uri (current-request))))) "/")) + (print 'log: upath) (cond ((equal? upath "") (send-response #:body (frontend-lookup "index.html"))) (else