From 8bd46721aaf7a99d117ea9e538700387f72504b5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Sun, 13 Apr 2025 10:21:46 +0200
Subject: [PATCH] Work on setuid/setgid, add raw-data-parser for the brmbar
 disaster.

---
 backend/api-servlets.scm |  5 ++-
 backend/bar-db.scm       |  2 +-
 backend/brminv.scm       | 11 ++++--
 raw-data-parse.rkt       | 81 ++++++++++++++++++++++++++++++++++++++++
 4 files changed, 93 insertions(+), 6 deletions(-)
 create mode 100644 raw-data-parse.rkt

diff --git a/backend/api-servlets.scm b/backend/api-servlets.scm
index ee98559..3b8f8d8 100644
--- a/backend/api-servlets.scm
+++ b/backend/api-servlets.scm
@@ -36,7 +36,8 @@
 	  (chicken format)
 	  bar-db
 	  json
-	  (chicken port))
+	  (chicken port)
+	  (chicken base))
 
   (define-syntax try-match-lambda1
     (syntax-rules ()
@@ -82,7 +83,7 @@
 	(json-write
 	 (list->vector alst)))))
 
-  (define-try-match (account-barcode-info "barcode" (barcode string->number))
+  (define-try-match (account-barcode-info "barcode" (barcode identity))
     (send-response
      #:body (alist->json-string
 	     `((amount . ,(bd-barcode-lookup barcode))))))
diff --git a/backend/bar-db.scm b/backend/bar-db.scm
index 84486c1..13f748b 100644
--- a/backend/bar-db.scm
+++ b/backend/bar-db.scm
@@ -58,7 +58,7 @@
       (row-values
        (query
 	(bd-conn)
-	"select sum(amount*case side when 'credit' then -1 else 1 end) amt from transaction_splits where account=$1"
+	"select sum(amount*case side when 'credit' then -1 else 1 end) amt from transaction_splits where account=(select account from barcodes where barcode=$1)"
 	bc)))))
 
   )
diff --git a/backend/brminv.scm b/backend/brminv.scm
index 1a029ea..93db340 100644
--- a/backend/brminv.scm
+++ b/backend/brminv.scm
@@ -33,7 +33,8 @@
 	uri-common
 	(chicken string)
 	api-servlets
-	bar-db)
+	bar-db
+	(chicken process-context posix))
 
 (define -port- (make-parameter #f))
 (define -certificate- (make-parameter #f))
@@ -98,8 +99,12 @@
 		   private-key: (-key-))
       (tcp-listen port)))
 
-(when (and (-user-) (-group-))
-  (switch-user/group (-user-) (-group-)))
+(when (or (-user-) (-group-))
+  (print "current user id: " (current-user-id))
+  (print "current effective user id: " (current-effective-user-id))
+  (switch-user/group (-user-) (-group-))
+  (print "current user id: " (current-user-id))
+  (print "current effective user id: " (current-effective-user-id)))
 
 (bar-db-init! (-db-name-) (-db-host-) (-db-user-) (-db-pass-))
 
diff --git a/raw-data-parse.rkt b/raw-data-parse.rkt
new file mode 100644
index 0000000..c01002b
--- /dev/null
+++ b/raw-data-parse.rkt
@@ -0,0 +1,81 @@
+#lang racket
+
+(require racket/cmdline)
+
+(define dirname
+  (command-line
+   #:args
+   (dn) dn))
+
+;;(displayln dirname)
+
+(define files
+  (sort
+   (for/list ((fn (in-directory dirname)))
+     fn)
+   (lambda (a b)
+     (string<? (path->string a)
+               (path->string b)))))
+
+(define (load-balances fn)
+  (define slst
+    (with-input-from-file fn
+      (thunk
+       (for/list ((l (in-lines))
+                  #:when (not (string-prefix? l "---")))
+         (map string-trim (string-split l "|"))))))
+  (define header (car slst))
+  ;(writeln header)
+  (define data0 (filter (lambda (l) (> (length l) 1)) (cdr slst)))
+  (define data
+    (for/list ((row (in-list data0)))
+      (match-define (list id name acctype crbalance) row)
+      (cons (string->number id)
+            (string->number crbalance))))
+  (define name (car (reverse (explode-path fn))))
+  (cons name
+        (make-immutable-hash
+         (sort data (lambda (a b) (< (car a) (car b)))))))
+
+;;(displayln (length files))
+
+(define balances
+  (time
+   (for/list ((fn (in-list files)))
+     (load-balances fn))))
+
+;;(displayln (length balances))
+
+;;(displayln "================")
+
+(define (calc-difference prev0 next0)
+  (define prev (cdr prev0))
+  (define next (cdr next0))
+  (define pname (car prev0))
+  (define nname (car next0))
+  (define keys
+    (set-union
+     (list->set (hash-keys prev))
+     (list->set (hash-keys next))))
+  (define all
+    (for/hash ((key (in-set keys)))
+      (values key
+              (- (hash-ref next key 0)
+                 (hash-ref prev key 0)))))
+  (cons (cons pname nname)
+        (for/hash (((k v) (in-hash all))
+                   #:when (not (zero? v)))
+          (values k v))))
+
+(define (print-difference prev next)
+  (define diff0 (calc-difference prev next))
+  (define diff (cdr diff0))
+  (define dname (car diff0))
+  (when (> (hash-count diff) 0)
+    (displayln (format ":: ~a -> ~a" (car dname) (cdr dname)))
+    (for (((k v) (in-hash diff)))
+      (displayln (format "~a ~a" k (real->decimal-string v))))))
+
+(for ((prev (in-list balances))
+      (next (in-list (cdr balances))))
+  (print-difference prev next))