This is equivalent to a diff from
5dac6d2e49
to 3d39f8f19d
Modified Makefile
from [c999b5b258]
to [96b6788682].
| ︙ | | |
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
+
|
cp dashboard-transport-mode.scm.template dashboard-transport-mode.scm
megatest.scm : transport-mode.scm
dashboard.scm : dashboard-transport-mode.scm
# dbmod.import.o is just a hack here
mofiles/portlogger.o : mofiles/dbmod.o
mofiles/dbfile.o : mofiles/debugprint.o mofiles/commonmod.o
mofiles/dbfile.o : \
mofiles/debugprint.o mofiles/commonmod.o
configf.o : commonmod.import.o
mofiles/dbfile.o : mofiles/debugprint.o
mofiles/rmtmod.o mofiles/dbmod.o : mofiles/dbfile.o
|
| ︙ | | |
Modified dbfile.scm
from [133c3d1663]
to [45dd6a06ff].
| ︙ | | |
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
-
-
-
+
+
+
+
+
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(declare (unit dbfile))
(declare (uses debugprint))
(declare (uses commonmod))
(module dbfile
*
(import scheme
chicken
matchable
(prefix sqlite3 sqlite3:)
posix typed-records
srfi-18
srfi-1
srfi-69
stack
commonmod
debugprint
)
)
(define current-process-milliseconds current-milliseconds)
)
(chicken-5
(import chicken.base
chicken.condition
chicken.file
chicken.file.posix
chicken.format
chicken.io
chicken.pathname
chicken.port
chicken.process
chicken.process-context.posix
chicken.sort
chicken.string
chicken.time
chicken.time.posix
system-information
)
(define file-move move-file)
(define file-write-access? file-writable?)
))
(import (prefix sqlite3 sqlite3:))
(import typed-records)
(import srfi-18)
(import srfi-1)
(import srfi-69)
(import stack)
(import commonmod)
(import debugprint)
(import matchable)
;; parameters
;;
(define dbfile:testsuite-name (make-parameter #f))
(define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic
(define num-run-dbs (make-parameter 10)) ;; number of db's in .mtdb
(define dbfile:sync-method (make-parameter 'attach)) ;; 'attach or 'original
|
| ︙ | | |
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
|
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
|
-
+
|
readonly-slave-dbs))) -6)
(else
;; (dbfile:print-err "db:sync-tables: args are good")
(let ((stmts (make-hash-table)) ;; table-field => stmt
(all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 ))
(numrecs (make-hash-table))
(start-time (current-milliseconds))
(start-time (current-process-milliseconds))
(tot-count 0))
(for-each ;; table
(lambda (tabledat)
(let* ((tablename (car tabledat))
(fields (cdr tabledat))
(has-last-update (member "last_update" fields))
(use-last-update (cond
|
| ︙ | | |
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
|
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
|
-
+
|
(if (member "last_update" field-names)
(db:create-trigger db tablename))))
(append (list todb) slave-dbs)
)
)
)
tbls)
(let* ((runtime (- (current-milliseconds) start-time))
(let* ((runtime (- (current-process-milliseconds) start-time))
(should-print (or ;; (debug:debug-mode 12)
(common:low-noise-print 120 "db sync")
(> runtime 500)))) ;; low and high sync times treated as separate.
(for-each
(lambda (dat)
(let ((tblname (car dat))
(count (cdr dat)))
|
| ︙ | | |
Modified dbmod.scm
from [08e196df1c]
to [d4f33e15c4].
| ︙ | | |
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
-
|
(declare (uses dbfile))
(declare (uses commonmod))
(declare (uses debugprint))
(module dbmod
*
(import scheme
chicken
data-structures
extras
(prefix sqlite3 sqlite3:)
(import scheme)
(cond-expand
(chicken-4
(import chicken
data-structures
extras
posix
)
(define current-process-milliseconds current-milliseconds)
)
(chicken-5
(import chicken.base
chicken.file
chicken.sort
chicken.string
chicken.time
)))
(import (prefix sqlite3 sqlite3:))
posix
typed-records
srfi-1
srfi-18
srfi-69
commonmod
dbfile
debugprint
)
|
| ︙ | | |
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
|
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
|
-
+
|
;;
(define (dbmod:sync-tables tbls last-update fromdb todb)
(assert (sqlite3:database? fromdb) "FATAL: dbmod:sync-tables called with fromdb not a database" fromdb)
(assert (sqlite3:database? todb) "FATAL: dbmod:sync-tables called with fromdb not a database" todb)
(let ((stmts (make-hash-table)) ;; table-field => stmt
(all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 ))
(numrecs (make-hash-table))
(start-time (current-milliseconds))
(start-time (current-process-milliseconds))
(tot-count 0))
(for-each ;; table
(lambda (tabledat)
(let* ((tablename (car tabledat))
(fields (cdr tabledat))
(has-last-update (member "last_update" fields))
(use-last-update (dbmod:calc-use-last-update has-last-update fields last-update))
|
| ︙ | | |
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
|
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
|
-
+
|
fromdats)
(sqlite3:finalize! stmth)
(if (member "last_update" field-names)
(db:create-trigger db tablename)))
))
tbls)
(let* ((runtime (- (current-milliseconds) start-time))
(let* ((runtime (- (current-process-milliseconds) start-time))
(should-print (or ;; (debug:debug-mode 12)
(common:low-noise-print 120 "db sync")
(> runtime 500)))) ;; low and high sync times treated as separate.
(for-each
(lambda (dat)
(let ((tblname (car dat))
(count (cdr dat)))
|
| ︙ | | |
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
|
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
|
-
+
-
+
|
","))
(stmt1 (conc "INSERT OR IGNORE INTO "todb table
" SELECT * FROM "fromdb table";"))
(stmt8 (conc "UPDATE "todb table" SET ("no-id-fields-str") = (SELECT "no-id-fields-str" FROM "fromdb table" WHERE "todb table".id="fromdb table".id"
(if (member "last_update" fields)
(conc " AND "fromdb table".last_update > "todb table".last_update);")
");")))
(start-ms (current-milliseconds)))
(start-ms (current-process-milliseconds)))
;; (debug:print 0 *default-log-port* "stmt8="stmt8)
;; (if (sqlite3:auto-committing? dbh)
;; (begin
(mutex-lock! *db-transaction-mutex*)
(sqlite3:with-transaction
dbh
(lambda ()
(debug:print-info 0 *default-log-port* "Sync from "fromdb table" to "todb table" using "stmt1)
(sqlite3:execute dbh stmt1) ;; get all new rows
#;(if (member "last_update" fields)
(sqlite3:execute dbh stmt8)) ;; get all updated rows
;; (sqlite3:execute dbh stmt5)
;; (sqlite3:execute dbh stmt4) ;; if it worked this would be better for incremental up
;; (sqlite3:execute dbh stmt6)
))
(debug:print 0 *default-log-port* "Synced table "table
" in "(- (current-milliseconds) start-ms)"ms") ;; )
" in "(- (current-process-milliseconds) start-ms)"ms") ;; )
(mutex-unlock! *db-transaction-mutex*)))
;; (debug:print 0 *default-log-port* "Skipping sync of table "table" due to transaction in flight."))))
table-names)
(sqlite3:execute dbh "DETACH auxdb;"))))
;; FAILED ATTEMPTS
|
| ︙ | | |
508
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
|
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
|
-
+
-
+
|
;; (stmt8 (conc "UPDATE "todb table" SET ("no-id-fields-str") = (SELECT "no-id-fields-str" FROM "fromdb table " WHERE "todb table".id="fromdb table".id"
;; (if (member "last_update" fields)
;; (conc " AND "fromdb table".last_update > "todb table".last_update);")
;; ");")))
(stmt1 (conc "SELECT MAX(last_update) FROM "table";")) ;; use the highest last_update as your time reference
(stmt2 (conc "SELECT no-id-fields-str FROM "table" WHERE last_update>?;"))
(stmt3 (conc "UPDATE "table" SET ("no-id-fields-str") = ("questionmarks") WHERE id=?;"))
(start-ms (current-milliseconds)))
(start-ms (current-process-milliseconds)))
(debug:print 0 *default-log-port* "stmt3="stmt3)
(if (sqlite3:auto-committing? dbh1)
(begin
(sqlite3:with-transaction
dbh1
(lambda ()
(sqlite3:execute dbh1 stmt1) ;; get all new rows
#;(if (member "last_update" fields)
(sqlite3:execute dbh1 stmt8)) ;; get all updated rows
;; (sqlite3:execute dbh stmt5)
;; (sqlite3:execute dbh stmt4) ;; if it worked this would be better for incremental up
;; (sqlite3:execute dbh stmt6)
))
(debug:print 0 *default-log-port* "Synced table "table
" in "(- (current-milliseconds) start-ms)"ms"))
" in "(- (current-process-milliseconds) start-ms)"ms"))
(debug:print 0 *default-log-port* "Skipping sync of table "table" due to transaction in flight."))))
table-names)
(sqlite3:execute dbh1 "DETACH auxdb;"))))
|
| ︙ | | |
Modified tcp-transportmod.scm
from [2389278b99]
to [c4cf69e693].
| ︙ | | |
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
-
-
-
-
-
+
+
+
+
-
-
+
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
+
+
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
|
(declare (unit tcp-transportmod))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses dbfile))
(declare (uses dbmod))
(declare (uses portlogger))
(use address-info)
(import scheme
(prefix sqlite3 sqlite3:)
chicken
address-info
directory-utils
hostinfo
directory-utils
matchable
md5
message-digest
regex
regex-case
s11n
srfi-1
srfi-18
srfi-4
srfi-69
stack
typed-records
tcp-server
tcp
debugprint
commonmod
dbfile
dbmod
)
)
(define unsetenv unset-environment-variable!)))
(import (prefix sqlite3 sqlite3:))
(import address-info)
(import matchable)
(import md5)
(import message-digest)
(import regex)
(import regex-case)
(import s11n)
(import srfi-1)
(import srfi-18)
(import srfi-4)
(import srfi-69)
(import stack)
(import typed-records)
(import tcp-server)
(import tcp6)
(import debugprint)
(import commonmod)
(import dbfile)
(import dbmod)
;;======================================================================
;; client
;;======================================================================
;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic
;; Used ONLY for client
;;
(defstruct tt-conn
host
port
host-port
dbfname
server-id
server-start
pid
(host #f)
(port #f)
(host-port #f)
(dbfname #f)
(server-id #f)
(server-start #f)
(pid #f)
)
;; Used for BOTH clients and servers
(defstruct tt
;; client related
(conns (make-hash-table)) ;; dbfname -> conn
|
| ︙ | | |
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
|
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
|
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(message-digest-string (md5-primitive)
(with-output-to-string
(lambda ()
(write (list areapath
(current-process-id)
(argv)))))))
(let ((res #f))
(for-each
(lambda (adr)
(if (not (eq? (u8vector-ref adr 0) 127))
(set! res adr)))
;; NOTE: This can fail when there is no mention of the host in /etc/hosts. FIXME
(vector->list (hostinfo-addresses (hostname->hostinfo hostname))))
(string-intersperse
(map number->string
(u8vector->list
(if res res (hostname->ip hostname)))) ".")))
(let ((res #f))
(for-each
(lambda (adr)
(if (not (eq? (u8vector-ref adr 0) 127))
(set! res adr)))
;; NOTE: This can fail when there is no mention of the host in /etc/hosts. FIXME
(vector->list (hostinfo-addresses (hostname->hostinfo hostname))))
(string-intersperse
(map number->string
(u8vector->list
(if res res (hostname->ip hostname)))) ".")))
(chicken-5
(let* ((get-first (lambda (str) ;; "1.2.3.4" => 1, but "127.1.2.3 => 0 so it sorts last
(let* ((res (string->number (car (string-split str ".")))))
(if (eq? res 127)
0
res))))
(addresses (sort
(map address-info-host (address-infos hostname))
(lambda (a b)
(let* ((a-first (get-first a))
(b-first (get-first b)))
(> a-first b-first))))))
(car addresses)))))
(define (tt:get-servinfo-dir areapath)
(let* ((spath (conc areapath"/.servinfo")))
(if (not (file-exists? spath))
(create-directory spath #t))
spath))
;;======================================================================
|
| ︙ | | |