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