Megatest

Check-in [87f37a8dc0]
Login
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: 87f37a8dc04ac2e8ec80142ae2cd1932e3a8ace3
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
742
743
744
745
746
747
748
749
    (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
    (if (not dbexists)
	(init-proc db))
    db))


;;======================================================================
;; Ulex db
;;======================================================================

(define (ulexdb-init db inmem)
  (sqlite3:with-transaction
   db
   (lambda ()
     (for-each







|







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