Compare commits
	
		
			No commits in common. "fac8d8f4f1e65f3a3c773400516fbb5be5029eea" and "4cd4fa3bb14c37cee28cbcbf16e00d6c7501dfe7" have entirely different histories.
		
	
	
		
			fac8d8f4f1
			...
			4cd4fa3bb1
		
	
		
					 6 changed files with 8 additions and 178 deletions
				
			
		|  | @ -3,10 +3,7 @@ | |||
| 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 | ||||
|  | @ -20,13 +17,13 @@ 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,-lssl -L -Wl,-lcrypto -L -Wl,-lpq -strip -static -o $@ $(BRMINV_OBJS) | ||||
| 	$(CSC) -L --no-lto -L -Wl,-static -L -Wl,-lssl -L -Wl,-lcrypto -L -Wl,-Bdynamic -strip -static -o $@ $(BRMINV_OBJS) | ||||
| 
 | ||||
| frontend.o: frontend.import.scm | ||||
| frontend.import.scm: frontend.scm | ||||
| .PHONY: frontend.scm | ||||
| frontend.scm: | ||||
| 	cd ../frontend && (if [ -d src ] ; then npm run build ; fi ) && cd ../backend && csi -b -q ../tools/schemify-tree.scm -- ../frontend/dist frontend frontend-lookup | ||||
| 	cd ../frontend && npm run build && cd ../backend && csi -b -q ../tools/schemify-tree.scm -- ../frontend/dist frontend frontend-lookup | ||||
| 
 | ||||
| brminv.o: $(BRMINV_SOURCES) | ||||
| 
 | ||||
|  |  | |||
|  | @ -1,48 +1,13 @@ | |||
| ;; | ||||
| ;; 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 | ||||
| 	command-line | ||||
| 	texts | ||||
| 	spiffy | ||||
| 	openssl | ||||
| 	(chicken tcp) | ||||
| 	intarweb | ||||
| 	uri-common | ||||
| 	(chicken string) | ||||
| 	postgresql) | ||||
| 	(chicken tcp)) | ||||
| 
 | ||||
| (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)) | ||||
| (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 | ||||
|  | @ -66,18 +31,6 @@ | |||
|      (-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)) | ||||
|  (-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)) | ||||
|  | @ -95,56 +48,3 @@ | |||
|       (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-))) | ||||
| 
 | ||||
| (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,4 +4,5 @@ import react from '@vitejs/plugin-react' | |||
| // https://vite.dev/config/
 | ||||
| export default defineConfig({ | ||||
|     plugins: [react()], | ||||
|     base: '/brm/inv/dist', | ||||
| }) | ||||
|  |  | |||
|  | @ -1,64 +0,0 @@ | |||
| #!/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,7 +55,6 @@ trap chicken_cleanup INT QUIT | |||
| # Install required eggs | ||||
| chicken_install spiffy | ||||
| chicken_install openssl | ||||
| chicken_install postgresql | ||||
| 
 | ||||
| # Normal termination cleanup | ||||
| chicken_cleanup | ||||
|  |  | |||
|  | @ -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 io)) | ||||
| 	(chicken format)) | ||||
| 
 | ||||
| (define (get-argv) | ||||
|   (let* ((args (argv)) | ||||
|  | @ -78,11 +78,8 @@ | |||
|       (if (null? tree) | ||||
| 	  alst | ||||
| 	  (let* ((fpath (car tree)) | ||||
| 		 (key0 (substring fpath dir-len)) | ||||
| 		 (key (if (eq? (string-ref key0 0) #\/) | ||||
| 			  (substring key0 1) | ||||
| 			  key0)) | ||||
| 		 (value (with-input-from-file fpath read-string))) | ||||
| 		 (key (substring fpath dir-len)) | ||||
| 		 (value (with-input-from-file fpath read-u8vector))) | ||||
| 	    (loop (cdr tree) | ||||
| 		  (cons (cons key value) | ||||
| 			alst))))))) | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue