Overview
Comment: | Beginnings of captain ulex db |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.66-captain-ulex |
Files: | files | file ages | folders |
SHA1: |
87f37a8dc04ac2e8ec80142ae2cd1932 |
User & Date: | matt on 2020-07-21 09:57:27 |
Other Links: | branch diff | manifest | tags |
Context
2020-07-22
| ||
14:29 | couple whitespace changes check-in: eacf2f6fae user: mrwellan tags: v1.66-captain-ulex | |
2020-07-21
| ||
09:57 | Beginnings of captain ulex db check-in: 87f37a8dc0 user: matt tags: v1.66-captain-ulex | |
2020-07-19
| ||
23:45 | start of do-over of ulex check-in: ce91ddc6d7 user: matt tags: v1.66-captain-ulex | |
Changes
Modified ulex/ulex.scm from [1a0de3294a] to [42b648b50c].
︙ | ︙ | |||
244 245 246 247 248 249 250 251 252 253 254 255 256 257 | (define (remote-request udata uconn rtype dbname prockey procparam data) (let* ((cookie (make-cookie udata))) (send-receive udata uconn rtype cookie data `(,prockey procparam)))) (define (ulex-open-db udata dbname) #f) ;;====================================================================== ;; network utilities ;;====================================================================== (define (rate-ip ipaddr) (regex-case ipaddr ( "^127\\..*" _ 0 ) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 | (define (remote-request udata uconn rtype dbname prockey procparam data) (let* ((cookie (make-cookie udata))) (send-receive udata uconn rtype cookie data `(,prockey procparam)))) (define (ulex-open-db udata dbname) #f) ;;====================================================================== ;; Ulex db ;; ;; - track who is captain, lease expire time ;; - track who owns what db, lease ;; ;;====================================================================== ;; ;; (define (ulex-dbfname) (let ((dbdir (conc (get-environment-variable "HOME") "/.ulex"))) (if (not (file-exists? dbdir)) (create-directory dbdir #t)) (conc dbdir "/network.db"))) ;; always goes in ~/.ulex/network.db ;; role is captain, adjutant, node ;; (define (ulexdb-setup) (let* ((dbfname (ulex-dbfname)) (have-db (file-exists? dbfname)) (db (sqlite3:open-database dbfname))) (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000)) (sqlite3:execute db "PRAGMA synchronous = 0;") (if (not have-db) (sqlite3:with-transaction db (lambda () (for-each (lambda (stmt) (if stmt (sqlite3:execute db stmt))) `("CREATE TABLE IF NOT EXISTS nodes (id INTEGER PRIMARY KEY, role TEXT NOT NULL, host TEXT NOT NULL, port TEXT NOT NULL, ipadr TEXT NOT NULL, pid INTEGER NOT NULL, zcard TEXT NOT NULL, regtime INTEGER DEFAULT (strftime('%s','now')), lease_thru INTEGER DEFAULT (strftime('%s','now')), last_update INTEGER DEFAULT (strftime('%s','now')));" "CREATE TRIGGER IF NOT EXISTS update_nodes_trigger AFTER UPDATE ON nodes FOR EACH ROW BEGIN UPDATE nodes SET last_update=(strftime('%s','now')) WHERE id=old.id; END;" "CREATE TABLE IF NOT EXISTS dbs (id INTEGER PRIMARY KEY, dbname TEXT NOT NULL, dbfile TEXT NOT NULL, dbtype TEXT NOT NULL, host_port TEXT NOT NULL, regtime INTEGER DEFAULT (strftime('%s','now')), lease_thru INTEGER DEFAULT (strftime('%s','now')), last_update INTEGER DEFAULT (strftime('%s','now')));" "CREATE TRIGGER IF NOT EXISTS update_dbs_trigger AFTER UPDATE ON dbs FOR EACH ROW BEGIN UPDATE dbs SET last_update=(strftime('%s','now')) WHERE id=old.id; END;"))))) db)) (define (get-host-port-lease db dbfname) (sqlite3:fold-row (lambda (rem host-port lease-thru) (list host-port lease-thru)) #f db "SELECT host_port,lease_thru FROM dbs WHERE dbfile = ?" dbfname)) (define (register-captain db host ipadr port pid zcard #!key (lease 20)) (let* ((dbfname (ulex-dbfname)) (host-port (conc host ":" port))) (sqlite3:with-transaction db (lambda () (match (get-host-port-lease db dbfname) ((host-port lease-thru) (if (> (current-seconds) lease-thru) (begin (sqlite3:execute db "UPDATE dbs SET host_port=?,lease_thru=? WHERE dbname=?" (conc host ":" port) (+ (current-seconds) lease) dbfname) #t) #f)) (#f (sqlite3:execute db "INSERT INTO dbs (dbname,dbfile,dbtype,host_port,lease_thru) VALUES (?,?,?,?,?)" "captain" dbfname "captain" host-port (+ (current-seconds) lease))) (else (print "ERROR: Unrecognised result from fold-row") (exit 1))))))) ;;====================================================================== ;; network utilities ;;====================================================================== (define (rate-ip ipaddr) (regex-case ipaddr ( "^127\\..*" _ 0 ) |
︙ | ︙ | |||
735 736 737 738 739 740 741 | (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000)) (if (not dbexists) (init-proc db)) db)) ;;====================================================================== | | | 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 | (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000)) (if (not dbexists) (init-proc db)) db)) ;;====================================================================== ;; Previous Ulex db stuff ;;====================================================================== (define (ulexdb-init db inmem) (sqlite3:with-transaction db (lambda () (for-each |
︙ | ︙ |