Megatest

Check-in [47774f526e]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:main not to exit if sub-servers running
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.6584-nanomsg
Files: files | file ages | folders
SHA1: 47774f526e3bd8062b24741fcc6a982949d4c9de
User & Date: matt on 2021-06-20 16:06:31
Other Links: branch diff | manifest | tags
Context
2021-06-20
23:37
wip check-in: 5fe1888afd user: matt tags: v1.6584-nanomsg
16:06
main not to exit if sub-servers running check-in: 47774f526e user: matt tags: v1.6584-nanomsg
2021-06-19
05:00
More trimming, clean up etc. but stil finalizer bug continues check-in: 3a56e7f78c user: matt tags: v1.6584-nanomsg
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified apimod.scm from [f3c5575922] to [f9cc46260e].

︙
199
200
201
202
203
204
205

206
207
208
209
210
211
212

199
200
201
202
203
204
205
206
207
208
209
210
211
212
213








+








    
    ;; SERVERS
    ;; ((start-server)                    (apply server:kind-run params))
    ((kill-server)                       (set! *server-run* #f))
    ((get-server)                        (api:start-server dbstruct params))
    ((register-server)                   (apply db:register-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
    ((deregister-server)                 (apply db:deregister-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
    ((get-count-servers)                 (apply db:get-count-servers dbstruct params))

    ;; TESTS

    ;;((test-set-state-status-by-id)     (apply mt:test-set-state-status-by-id dbstruct params))
    ;;BB - commented out above because it was calling below, eventually, incorrectly (dbstruct passed to mt:test-set-state-status-by-id, which previosly did more, but now only passes thru to db:set-state-status-and-roll-up-items.
    ((test-set-state-status-by-id)
︙

Modified dbmod.scm from [5f7c49b44c] to [90aaabb4fa].

︙
200
201
202
203
204
205
206
207

208
209
210
211
212
213
214

200
201
202
203
204
205
206

207
208
209
210
211
212
213
214








-
+








  (let* ((parent-dir (pathname-directory dbfile)))
    (if (not (directory-exists? parent-dir))
	(create-directory parent-dir #t))
    (let* ((exists  (file-exists? dbfile))
	   (db      (sqlite3:open-database dbfile))
	   (handler (sqlite3:make-busy-timeout 3600)))
      (sqlite3:set-busy-handler! db handler)
      (db:set-sync db)
      ;; (db:set-sync db) ;; we don't mind that this is slow?
      (if (not exists)
	  (dbinit-proc db))
      db)))
    
;; open and initialize the inmem db
;; NOTE: Does NOT sync in the data from the disk db
;;
︙
5562
5563
5564
5565
5566
5567
5568
5569

5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582












5583



5562
5563
5564
5565
5566
5567
5568

5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594

5595
5596








-
+













+
+
+
+
+
+
+
+
+
+
+
+
-
+
+

		(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)))))))))
  

(define (db:get-server-info dbstruct apath dbname)
  (db:with-db
   dbstruct
   #f #f
   (lambda (db)
     (sqlite3:fold-row
      (lambda (res host port servkey pid ipaddr apath dbpath)
	(list host port servkey pid ipaddr apath dbpath))
      #f
      db
      "SELECT host,port,servkey,pid,ipaddr,apath,dbname FROM servers WHERE apath=? AND dbname=?;"
      apath dbname))))

(define (db:get-count-servers dbstruct apath)
  (db:with-db
   dbstruct
   #f #f
   (lambda (db)
     (sqlite3:fold-row
      (lambda (res count)
	(max res count))
      0
      db
      "SELECT count(*) FROM servers WHERE apath=?;"
      apath))))
)

)

Modified megatest.scm from [1f0e5a3ef0] to [8b7ce4750f].

︙
910
911
912
913
914
915
916
917
918



919
920
921
922
923
924
925

910
911
912
913
914
915
916


917
918
919
920
921
922
923
924
925
926








-
-
+
+
+








         (let ((newval (conc (args:get-arg "-testpatt") "/" (args:get-arg "-itempatt"))))
           (debug:print 0 *default-log-port* "WARNING: -itempatt has been deprecated, please use -testpatt testpatt/itempatt method, new testpatt is "newval)
           (hash-table-set! args:arg-hash "-testpatt" newval)
           (hash-table-delete! args:arg-hash "-itempatt")))
     
     (if (args:get-arg "-runtests")
         (debug:print 0 *default-log-port* "WARNING: \"-runtests\" is deprecated. Use \"-run\" with \"-testpatt\" instead"))
     
     (on-exit std-exit-procedure)

     (debug:print 0 *default-log-port* "on-exit disabled. Please re-enable")
     ;; (on-exit std-exit-procedure)
     
     ;;======================================================================
     ;; Misc general calls
     ;;======================================================================

;; TODO: Restore this functionality
︙

Modified rmtmod.scm from [431c525d1f] to [7f8aa4ba9f].

︙
1623
1624
1625
1626
1627
1628
1629

1630
1631
1632
1633
1634
1635
1636

1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637








+








			 (else    (api:process-request *dbstruct-db* data))))
	       (resdat (sexpr->string res)))
	  (if (not (eq? res 'quit))
	      (begin
		(set! *db-last-access* (current-seconds))
		(nn-send rep resdat)
		(loop (nn-recv rep)))))))
    (debug:print-info 0 *default-log-port* "After server, should never see this")
    ;; server exit stuff here
    (let* ((portnum (servdat-port *server-info*)))
      (portlogger:open-run-close portlogger:set-port portnum "released")
      (rmt:server-shutdown)
      ;; (bdat-time-to-exit-set! *bdat* #t) ;; tell on-exit to be fast as we've already cleaned up
      (portlogger:open-run-close portlogger:set-port port "released") ;; done in rmt:run
      ;; (debug:print-info 0 *default-log-port* "Max cached queries was    " *max-cache-size*)
︙
2037
2038
2039
2040
2041
2042
2043
2044

2045
2046
2047







2048
2049
2050
2051
2052
2053
2054







2055
2056
2057
2058
2059
2060
2061

2038
2039
2040
2041
2042
2043
2044

2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055







2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069








-
+



+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+








					    ,port
					    ,server-key
					    ,(current-process-id)
					    ,iface
					    ,apath
					    ,dbname)))

(define (rmt:deregister-server remote apath iface port server-key dbname)
(define (rmt:get-count-servers remote apath)
  (rmt:open-main-connection remote apath) ;; we need a channel to main.db
  (rmt:send-receive-real remote apath      ;; params: host port servkey pid ipaddr dbpath
			 (db:run-id->dbname #f)
			 'get-count-servers `(,apath
					      )))

(define (rmt:deregister-server remote apath iface port server-key dbname)
  (rmt:open-main-connection remote apath) ;; we need a channel to main.db
  (rmt:send-receive-real remote apath      ;; params: host port servkey pid ipaddr dbpath
                         (db:run-id->dbname #f)
			 'deregister-server `(,iface
					      ,port
					      ,server-key
					      ,(current-process-id)
					      ,iface
					      ,apath
					      ,dbname)))
                         'deregister-server `(,iface
                                              ,port
                                              ,server-key
                                              ,(current-process-id)
                                              ,iface
                                              ,apath
                                              ,dbname)))

(define (http-transport:wait-for-stable-interface #!optional (num-tries-allowed 100))
  ;; wait until *server-info* stops changing
  (let* ((stime (current-seconds)))
    (let loop ((last-host  #f)
	       (last-port  #f)
	       (tries 0))
︙
2182
2183
2184
2185
2186
2187
2188
2189




2190
2191
2192
2193
2194
2195
2196




2197

2198
2199
2200
2201
2202
2203
2204

2190
2191
2192
2193
2194
2195
2196

2197
2198
2199
2200
2201
2202
2203
2204
2205

2206
2207
2208
2209
2210

2211
2212
2213
2214
2215
2216
2217
2218








-
+
+
+
+





-

+
+
+
+
-
+








	    (begin
	      (debug:print 0 *default-log-port* "Server stats:")
	      (db:print-current-query-stats)))
	(let* ((hrs-since-start  (/ (- (current-seconds) server-start-time) 3600)))
	  (cond
	   ((and *server-run*
		 (> (+ last-access server-timeout)
		    (current-seconds)))
		    (current-seconds))
		 (if is-main
		     (> (rmt:get-count-servers *rmt:remote* *toppath*) 1)
		     #t))
	    (if (common:low-noise-print 120 "server continuing")
		(debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access)))
	    (loop 0 bad-sync-count (current-milliseconds)))
	   (else
	    (set! *unclean-shutdown* #f)
	    (debug:print-info 0 *default-log-port* "Starting to shutdown the server. pid="(current-process-id))
	    (debug:print-info 0 *default-log-port* "Server timed out. seconds since last db access: " (- (current-seconds) last-access))
	    (debug:print-info 0 *default-log-port* "Starting to shutdown the server. pid="(current-process-id))
	    (rmt:server-shutdown)
	    (portlogger:open-run-close portlogger:set-port port "released")
	    (exit)
	    (debug:print-info 0 *default-log-port* "Sending 'quit to server, received: "
	    #;(debug:print-info 0 *default-log-port* "Sending 'quit to server, received: "
			      (open-send-receive-nn (conc iface":"port)      ;; do this here and not in server-shutdown
						    (sexpr->string 'quit)))
	    )))))))

;; Call this to start the actual server
;;
;; all routes though here end in exit ...
︙
2317
2318
2319
2320
2321
2322
2323
2324

2325
2326
2327
2328
2329
2330
2331

2331
2332
2333
2334
2335
2336
2337

2338
2339
2340
2341
2342
2343
2344
2345








-
+








	;;        (contacts (alist-ref 'contact attrib))
        ;; (mode (alist-ref 'mode attrib))
	) 
    (handle-exceptions
     exn
     (let ((emsg ((condition-property-accessor 'exn 'message) exn)))
       ;; Send notification      
       (debug:print 0 *default-log-port* "ERROR: Failed to connect / send to " uri " message was \"" emsg "\"" )
       (debug:print 0 *default-log-port* "ERROR: Failed to connect / send to " uri " message was \"" emsg "\", exn=" exn)
       #f)
     (nn-connect req uri)
     ;; (print "Connected to the server " )
     (nn-send req msg)
     ;; (print "Request Sent")  
     ;; receive code here
     ;;(print (nn-recv req))
︙

Modified tests/unittests/server.scm from [8206b10fe4] to [d241188a2b].

︙
30
31
32
33
34
35
36

37
38
39
40
41
42
43
44
45

46
47
48
49
50
51
52

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








+









+








 ;; db:get-dbdat
 ;; rmt:find-main-server
;;  rmt:send-receive-real
;;  rmt:send-receive
 ;; sexpr->string
 ;; server-ready?
 ;; rmt:register-server
 ;;  rmt:deregister-server
 ;; rmt:open-main-connection
 ;; rmt:general-open-connection
 ;; rmt:get-conn
 ;; common:watchdog
 ;; rmt:find-main-server
 ;; get-all-server-pkts
 ;; get-viable-servers
 ;; get-best-candidate
 ;; api:run-server-process
 api:process-request
 ;; rmt:run
 ;; rmt:try-start-server
 )

(define *db* (db:setup #f))

;; these let me cut and paste from source easily
︙
65
66
67
68
69
70
71
72


73

74

75
76
77
78
79
80
81

67
68
69
70
71
72
73

74
75
76
77

78
79
80
81
82
83
84
85








-
+
+

+
-
+









(test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
(test #f 1 (rmt:send-receive 'register-run #f (list keyvals "run1" "new" "n/a" "justme" #f)))
(print "Got here.")

(test #f 1 (rmt:send-receive 'register-run 1 (list keyvals "run1" "new" "n/a" "justme" #f)))

;; (test #f 1 (rmt:register-run keyvals "run2" "new" "n/a" "justme" #f))
(test #f 2 (rmt:register-run keyvals "run2" "new" "n/a" "justme" #f))
;; (test #f 2 (rmt:deregister-server *rmt:remote* *toppath* iface port server-key dbname

(test #f 2 (rmt:get-count-servers *rmt:remote* *toppath*))
(thread-sleep! 5)

(exit)


;; (delete-file* "logs/1.log")
;; (define run-id 1)

;; (test "setup for run" #t (begin (launch:setup)
︙

This page was generated in about 0.122s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00