2025 version

src/brmelect.scm

@@ -0,0 +1,113 @@
+;;#!/usr/bin/env csi -s
+
+;; Import necessary modules for CGI handling
+;(use posix)
+;(use srfi-19)  ; For basic string manipulation
+
+(import scheme
+        (chicken base)
+        (chicken format)
+        ;(chicken miscmacros)
+        miscmacros
+        sqlite3
+        webgate-core
+        ;configuration
+        )
+(import-for-syntax
+  srfi-1
+  webgate-core)
+
+;(eval-when (eval)
+;(cond-expand
+;  (chicken
+;   (begin
+;    (import (only webgate-utils use-at-read-table))
+;    (use-at-read-table #:list-arguments? #t)))
+;  ;(else #f)
+;  )
+
+;; Thread-local parameter to re-use SQLite3 DB handle for subsequent queries
+(define *cached-brmelect-db* (make-parameter #f))
+(define =brmelect-db-path= "/home/brmelect/brmelect/brmelect.sqlite3")
+
+;; Returns (possibly cached) SQLite3 DB handle
+(define (brmelect-db)
+  (let ((cdb (*cached-brmelect-db*)))
+    (if cdb
+      cdb
+      (begin
+        (*cached-brmelect-db*
+          (let ((handler (make-busy-timeout 2000)))
+            (let ((db (open-database =brmelect-db-path=)))
+              (set-busy-handler! db handler)
+              db)))
+        (*cached-brmelect-db*)))))
+
+(define (initialize-db)
+  (let ((db (brmelect-db)))
+    ;; admin passwords
+    (execute db "create table if not exists admins (login text not null primary key, password text not null)")
+    ;; GA
+    (execute db "create table if not exists general_assemblies (id integer primary key, ga_date text not null, ga_open integer not null)")
+    (execute db "insert or ignore into general_assemblies (id, ga_date, ga_open) values (17, '2025-01-21', 1)")
+    ;; elections
+    (execute db "create table if not exists elections (id integer primary key autoincrement, ga_id integer not null, election_name text not null, election_running integer not null, election_file text not null, foreign key (ga_id) references general_assemblies(id))")
+    ;; candidates
+    (execute db "create table if not exists candidates (id integer primary key autoincrement, election_id integer not null, candidate_name text not null, candidate_nick text not null, foreign key (election_id) references elections(id)")
+  ))
+
+(initialize-db)
+
+(define-resource (root* parameters)
+  (make-html-response
+   200
+   ;@li{@a[(href ,(resource-uri calc "add"))]{Suspensions}}
+   ;@,common-head
+   `@html{
+      @head{
+          @title{foo}
+      }
+      @body{
+        @div[(class "navbar navbar-inverse navbar-fixed-top")]{
+          @div[(class "navbar-inner")]{
+	    @div[(class "container")]{
+	      @a[(class "brand") (href "#")]{WebGate}
+	      @div[(class "nav-collapse collapse")]{
+	        @ul[(class "nav")]{
+	          @li[(class "active")]{@a[(href "#")]{Miscellaneous}}
+	        }
+	      }
+	    }
+	  }
+        }
+      }
+    }))
+   
+(define brmelect-style
+"p, li { font-family: monospace; }
+#ballot { margin-left: auto; margin-right: auto; border: 1pt solid; width: 20em; padding: 1ex 1em; }
+.error { text-width: bold; color: red }
+#blurb { margin: 8ex 2em; }
+table { margin-left: auto; margin-right: auto; border: 1pt solid; border-collapse: collapse; }
+td { border: 1pt solid; padding: 0.5ex 0.5em; }")
+
+(define-resource (elect "elect" parameters)
+  (make-html-response
+    200
+    `@html{
+    @head{@title{brmelect Web Ballot}
+    @style[(type "text/css")]{@,brmelect-style}}
+    @body{
+
+    }}))
+
+(define-resource (elect "elect" "config" parameters)
+  (make-html-response
+    200
+`@html{
+@head{@title{brmelect web config}}
+@body{
+
+}}))
+
+(cgi-main-loop handle-request)