Compare commits
10 commits
4cd4fa3bb1
...
fac8d8f4f1
Author | SHA1 | Date | |
---|---|---|---|
fac8d8f4f1 | |||
1b20816e7b | |||
b895558ca8 | |||
7546f67fbf | |||
0d83aa699b | |||
24e0b487c5 | |||
a59567d4ab | |||
9805375421 | |||
03c744e9f1 | |||
cd36a88d12 |
6 changed files with 178 additions and 8 deletions
|
@ -3,7 +3,10 @@
|
||||||
default: ../brminv
|
default: ../brminv
|
||||||
|
|
||||||
SCRP=$(shell chicken-install -repository)
|
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:$(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 \
|
BRMINV_SOURCES=brminv.scm frontend.import.scm command-line.import.scm \
|
||||||
util-proc.import.scm duck.import.scm texts.import.scm
|
util-proc.import.scm duck.import.scm texts.import.scm
|
||||||
|
@ -17,13 +20,13 @@ BRMINV_OBJS=brminv.o frontend.o command-line.o util-proc.o duck.o \
|
||||||
$(CSC) -regenerate-import-libraries -P -J $<
|
$(CSC) -regenerate-import-libraries -P -J $<
|
||||||
|
|
||||||
../brminv: $(BRMINV_OBJS)
|
../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,-lssl -L -Wl,-lcrypto -L -Wl,-lpq -strip -static -o $@ $(BRMINV_OBJS)
|
||||||
|
|
||||||
frontend.o: frontend.import.scm
|
frontend.o: frontend.import.scm
|
||||||
frontend.import.scm: frontend.scm
|
frontend.import.scm: frontend.scm
|
||||||
.PHONY: frontend.scm
|
.PHONY: frontend.scm
|
||||||
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)
|
brminv.o: $(BRMINV_SOURCES)
|
||||||
|
|
||||||
|
|
|
@ -1,13 +1,48 @@
|
||||||
|
;;
|
||||||
|
;; brminv.scm
|
||||||
|
;;
|
||||||
|
;; Main program of Brm Inventory - the server.
|
||||||
|
;;
|
||||||
|
;; ISC License
|
||||||
|
;;
|
||||||
|
;; Copyright 2023-2025 Brmlab, z.s.
|
||||||
|
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
|
||||||
|
;;
|
||||||
|
;; 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
|
(import frontend
|
||||||
command-line
|
command-line
|
||||||
texts
|
texts
|
||||||
spiffy
|
spiffy
|
||||||
openssl
|
openssl
|
||||||
(chicken tcp))
|
(chicken tcp)
|
||||||
|
intarweb
|
||||||
|
uri-common
|
||||||
|
(chicken string)
|
||||||
|
postgresql)
|
||||||
|
|
||||||
(define -port- (make-parameter #f))
|
(define -port- (make-parameter #f))
|
||||||
(define -certificate- (make-parameter #f))
|
(define -certificate- (make-parameter #f))
|
||||||
(define -key- (make-parameter #f))
|
(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
|
(command-line
|
||||||
print-help
|
print-help
|
||||||
|
@ -31,6 +66,18 @@
|
||||||
(-certificate- cert))
|
(-certificate- cert))
|
||||||
(-k (key) "Private key"
|
(-k (key) "Private key"
|
||||||
(-key- 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))
|
||||||
|
(-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 ssl? (and (-certificate-) (-key-) #t))
|
||||||
|
@ -48,3 +95,56 @@
|
||||||
(ssl-listen port)
|
(ssl-listen port)
|
||||||
(tcp-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-)))
|
||||||
|
|
||||||
|
(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
|
||||||
|
(cond ((equal? path-lst '(/ ""))
|
||||||
|
(print "index")
|
||||||
|
)
|
||||||
|
(else
|
||||||
|
"error"))))
|
||||||
|
|
||||||
|
(define (handle-api-calls)
|
||||||
|
#f)
|
||||||
|
|
||||||
|
(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
|
||||||
|
(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?
|
||||||
|
ssl-accept
|
||||||
|
tcp-accept))
|
||||||
|
|
|
@ -4,5 +4,4 @@ import react from '@vitejs/plugin-react'
|
||||||
// https://vite.dev/config/
|
// https://vite.dev/config/
|
||||||
export default defineConfig({
|
export default defineConfig({
|
||||||
plugins: [react()],
|
plugins: [react()],
|
||||||
base: '/brm/inv/dist',
|
|
||||||
})
|
})
|
||||||
|
|
64
install-eggs-arm.sh
Normal file
64
install-eggs-arm.sh
Normal file
|
@ -0,0 +1,64 @@
|
||||||
|
#!/bin/sh
|
||||||
|
#
|
||||||
|
# install-eggs.sh
|
||||||
|
#
|
||||||
|
# Local installer of CHICKEN eggs required for building.
|
||||||
|
#
|
||||||
|
# ISC License
|
||||||
|
#
|
||||||
|
# Copyright 2023 Brmlab, z.s.
|
||||||
|
# Dominik Pantůček <dominik.pantucek@trustica.cz>
|
||||||
|
#
|
||||||
|
# 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-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/^/ /'
|
||||||
|
}
|
||||||
|
|
||||||
|
# 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
|
|
@ -55,6 +55,7 @@ trap chicken_cleanup INT QUIT
|
||||||
# Install required eggs
|
# Install required eggs
|
||||||
chicken_install spiffy
|
chicken_install spiffy
|
||||||
chicken_install openssl
|
chicken_install openssl
|
||||||
|
chicken_install postgresql
|
||||||
|
|
||||||
# Normal termination cleanup
|
# Normal termination cleanup
|
||||||
chicken_cleanup
|
chicken_cleanup
|
||||||
|
|
|
@ -23,10 +23,10 @@
|
||||||
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||||
;;
|
;;
|
||||||
(import (chicken process-context)
|
(import (chicken process-context)
|
||||||
srfi-4
|
|
||||||
(chicken file)
|
(chicken file)
|
||||||
(chicken pathname)
|
(chicken pathname)
|
||||||
(chicken format))
|
(chicken format)
|
||||||
|
(chicken io))
|
||||||
|
|
||||||
(define (get-argv)
|
(define (get-argv)
|
||||||
(let* ((args (argv))
|
(let* ((args (argv))
|
||||||
|
@ -78,8 +78,11 @@
|
||||||
(if (null? tree)
|
(if (null? tree)
|
||||||
alst
|
alst
|
||||||
(let* ((fpath (car tree))
|
(let* ((fpath (car tree))
|
||||||
(key (substring fpath dir-len))
|
(key0 (substring fpath dir-len))
|
||||||
(value (with-input-from-file fpath read-u8vector)))
|
(key (if (eq? (string-ref key0 0) #\/)
|
||||||
|
(substring key0 1)
|
||||||
|
key0))
|
||||||
|
(value (with-input-from-file fpath read-string)))
|
||||||
(loop (cdr tree)
|
(loop (cdr tree)
|
||||||
(cons (cons key value)
|
(cons (cons key value)
|
||||||
alst)))))))
|
alst)))))))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue