42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
-
+
+
|
db:get-dbdat
db:get-inmem
db:get-ddb
db:open-dbdat
db:open-run-db
db:open-inmem-db
db:setup
db:get-main-lock
;; db:get-main-lock
db:with-lock-db
db:get-iam-server-lock
db:get-locker
db:take-lock
db:steal-lock-db
db:release-lock
db:general-sqlite-error-dump
db:first-result-default
db:generic-error-printout
db:with-db
db:set-sync
db:get-last-update-time
|
224
225
226
227
228
229
230
231
232
233
234
235
236
237
|
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
|
+
|
db:hoh-set!
db:hoh-get
db:get-cache-stmth
db:register-server
db:deregister-server
db:get-server-info
db:get-count-servers
db:get-servers-info
db:get-steps-info-by-id
make-dbr:dbdat
dbr:dbdat-db
dbr:dbdat-inmem
dbr:dbdat-last-sync
dbr:dbdat-last-write
|
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
|
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
|
-
+
-
+
-
-
+
+
-
+
-
+
-
+
+
+
+
+
+
-
+
+
+
+
+
|
;; NOTE:
;; These operate directly on the disk file, NOT on the inmemory db
;; The lockname is the filename (can have many to one, run-id to fname
;;======================================================================
;; only use for main.db - need to re-write some of this :(
;;
(define (db:get-main-lock dbfile)
#;(define (db:get-main-lock dbfile)
(db:with-lock-db dbfile
(lambda (dbh dbfile)
(db:get-iam-server-lock dbh dbfile))))
(define (db:with-lock-db dbfile proc)
(let* ((dbh (db:open-run-db dbfile db:initialize-db))
(res (proc dbh dbfile)))
;; (sqlite3:finalize! dbh)
res))
;; called before db is open?
;;
(define (db:get-iam-server-lock dbh dbfname)
(define (db:get-iam-server-lock dbh dbfname host port)
(sqlite3:with-transaction
dbh
(lambda ()
(let* ((locker (db:get-locker dbh dbfname)))
(if locker
#f
(db:take-lock dbh dbfname))))))
locker
(db:take-lock dbh dbfname port))))))
;; (exn sqlite3)
(define (db:get-locker dbh dbfname)
(condition-case
(sqlite3:first-row dbh "SELECT owner_pid,owner_host,event_time FROM locks WHERE lockname=?;" dbfname)
(sqlite3:first-row dbh "SELECT owner_pid,owner_host,owner_port,event_time FROM locks WHERE lockname=?;" dbfname)
(exn (sqlite3) #f)))
;; should never fail because it is run in a transaction with a test for the lock
;;
(define (db:take-lock dbh dbfname)
(define (db:take-lock dbh dbfname port)
;; (condition-case
;; (begin
(sqlite3:execute dbh "INSERT INTO locks (lockname,owner_pid,owner_host) VALUES (?,?,?);" dbfname (current-process-id) (get-host-name))
(sqlite3:execute dbh "INSERT INTO locks (lockname,owner_pid,owner_host,owner_port) VALUES (?,?,?,?);" dbfname (current-process-id) (get-host-name) port)
;; #t)
;; (exn (sqlite3) #f)))
#t)
(define (db:steal-lock-db dbh dbfname port)
(sqlite3:execute dbh "DELETE FROM locks WHERE lockname=?;" dbfname)
(sqlite3:execute dbh "INSERT INTO locks (lockname,owner_pid,owner_host,owner_port) VALUES (?,?,?,?);" dbfname (current-process-id) (get-host-name) port)
#t)
(define (db:release-lock dbh dbfname)
(define (db:release-lock-force dbh dbfname)
(sqlite3:execute dbh "DELETE FROM locks WHERE lockname=?;" dbfname))
;; release a lock if it matches
(define (db:release-lock dbh dbfname host port)
(sqlite3:execute dbh "DELETE FROM locks WHERE lockname=? AND owner_host=? AND owner_port=?;" dbfname host port))
;;======================================================================
;; SQLITE3 HELPERS
;;======================================================================
(define (db:general-sqlite-error-dump exn stmt . params)
(let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) ;; RADT ... how does this work?
;; check for (exn sqlite3) ((condition-property-accessor 'exn 'message) exn)
|
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
|
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
|
+
|
db
(lambda ()
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS locks
(id INTEGER PRIMARY KEY,
lockname TEXT,
owner_pid INTEGER,
owner_host TEXT,
owner_port TEXT,
event_time TIMESTAMP DEFAULT (strftime('%s','now')),
CONSTRAINT lock_constraint UNIQUE (lockname));")
;; maps to *srvpktspec* from http-transportmod
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS servers
(id INTEGER PRIMARY KEY,
host TEXT,
|
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
|
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
|
-
+
+
|
(begin
(debug:print-info 0 *default-log-port* "Server already removed for "apath", "dbname) ;; at "sinfo ", while trying to register server " host":"port)
#f) ;; server already deregistered
(begin
(sqlite3:execute db "DELETE FROM servers WHERE apath=? AND dbname=?;" ;; (host,port,servkey,pid,ipaddr,apath,dbname) VALUES (?,?,?,?,?,?,?);"
;; host port servkey pid ipaddr
apath dbname)
#;(db:get-server-info dbstruct apath dbname)))))))))
#;(db:get-server-info dbstruct apath dbname)
'done))))))))
(define (db:get-server-info dbstruct apath dbname)
(db:with-db
dbstruct
#f #f
(lambda (db)
(sqlite3:fold-row
|
5880
5881
5882
5883
5884
5885
5886
5887
5888
|
5893
5894
5895
5896
5897
5898
5899
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914
|
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
|
(sqlite3:fold-row
(lambda (res count)
(max res count))
0
db
"SELECT count(*) FROM servers WHERE apath=?;"
apath))))
(define (db:get-servers-info dbstruct apath)
(db:with-db
dbstruct
#f #f
(lambda (db)
(sqlite3:fold-row
(lambda (res . row)
(cons row res))
'()
db
"SELECT * FROM servers WHERE apath=?;"
apath))))
)
)
|