Megatest

Check-in [860e483c35]
Login
Overview
Comment:Added localmode support
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.6584-nanomsg
Files: files | file ages | folders
SHA1: 860e483c357d670790bdf9161237ffc52e843319
User & Date: matt on 2021-08-06 04:14:07
Other Links: branch diff | manifest | tags
Context
2021-08-13
16:59
Basics almost working check-in: f625c38ded user: matt tags: v1.6584-nanomsg
2021-08-06
04:14
Added localmode support check-in: 860e483c35 user: matt tags: v1.6584-nanomsg
2021-06-23
08:58
Turn off inmem and fix run-id which should have been dbfile check-in: 89e269ed33 user: matt tags: v1.6584-nanomsg
Changes

Modified configfmod.scm from [6693a9270b] to [514a742c76].

33
34
35
36
37
38
39

40
41
42
43
44
45
46
	chicken.file
	chicken.io
	chicken.pathname
	chicken.port
	chicken.pretty-print
	chicken.process
	chicken.process-context

	chicken.sort
	chicken.string
	chicken.time
	chicken.eval
	
	debugprint
	(prefix mtargs args:)







>







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
	chicken.file
	chicken.io
	chicken.pathname
	chicken.port
	chicken.pretty-print
	chicken.process
	chicken.process-context
	chicken.process-context.posix
	chicken.sort
	chicken.string
	chicken.time
	chicken.eval
	
	debugprint
	(prefix mtargs args:)
967
968
969
970
971
972
973


974
975
976
977
978
979
980
		     (cmd     (list-ref matchdat 3))
		     (poststr (list-ref matchdat 4))
		     (result  #f)
		     (start-time (current-seconds))
		     (cmdsym  (string->symbol cmdtype))
		     (fullcmd
		      (conc  configf:std-imports


			     (case cmdsym
			       ((scheme scm) (conc "(lambda (ht)" cmd ")"))
			       ((system)     (conc "(lambda (ht)(configf:system ht \"" cmd "\"))"))
			       ((shell sh)   (conc "(lambda (ht)(string-translate (shell \""  cmd "\") \"\n\" \" \"))"))
			       ((realpath rp)(conc "(lambda (ht)(common:nice-path \"" cmd "\"))"))
			       ((getenv gv)  (conc "(lambda (ht)(get-environment-variable \"" cmd "\"))"))
			       ((mtrah)      (conc "(lambda (ht)"







>
>







968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
		     (cmd     (list-ref matchdat 3))
		     (poststr (list-ref matchdat 4))
		     (result  #f)
		     (start-time (current-seconds))
		     (cmdsym  (string->symbol cmdtype))
		     (fullcmd
		      (conc  configf:std-imports
			     "(import chicken.process-context.posix)"
			     "(define setenv set-environment-variable)"
			     (case cmdsym
			       ((scheme scm) (conc "(lambda (ht)" cmd ")"))
			       ((system)     (conc "(lambda (ht)(configf:system ht \"" cmd "\"))"))
			       ((shell sh)   (conc "(lambda (ht)(string-translate (shell \""  cmd "\") \"\n\" \" \"))"))
			       ((realpath rp)(conc "(lambda (ht)(common:nice-path \"" cmd "\"))"))
			       ((getenv gv)  (conc "(lambda (ht)(get-environment-variable \"" cmd "\"))"))
			       ((mtrah)      (conc "(lambda (ht)"

Modified dbmod.scm from [b670c82b28] to [b74957e222].

228
229
230
231
232
233
234















235
236
237
238
239
240
241
;;
(define (db:open-inmem-db dbinit-proc)
  (let* ((db      (sqlite3:open-database ":memory:"))
	 (handler (sqlite3:make-busy-timeout 3600)))
    (sqlite3:set-busy-handler! db handler)
    (dbinit-proc db) ;; NOTE: inmem must always be initialized (db:initialize-db db)
    db))
















;; get and initalize dbstruct for a given run-id
;;
;;  - uses db:initialize-db to create the schema
;;
;; Make the dbstruct, call for main db at least once
;; sync disk db to inmem







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
;;
(define (db:open-inmem-db dbinit-proc)
  (let* ((db      (sqlite3:open-database ":memory:"))
	 (handler (sqlite3:make-busy-timeout 3600)))
    (sqlite3:set-busy-handler! db handler)
    (dbinit-proc db) ;; NOTE: inmem must always be initialized (db:initialize-db db)
    db))

;; for debugging we have a local mode. these routines support that mode
(define *dbcache* (make-hash-table))

(define (db:cache-get-dbstruct rid apath)
  (let* ((dbname (db:run-id->dbname rid))
	 (dbfile (db:dbname->path apath dbname)))
    (or (hash-table-ref/default *dbcache* dbfile #f)
	(let* ((dbstruct (db:setup dbfile))) ;; (db:open-dbdat apath dbfile db:initialize-db)))
	  (hash-table-set! *dbcache* dbfile dbstruct)
	  dbstruct))))

(define (db:finalize-all-cache-dbstruct)
  #f)
	  

;; get and initalize dbstruct for a given run-id
;;
;;  - uses db:initialize-db to create the schema
;;
;; Make the dbstruct, call for main db at least once
;; sync disk db to inmem

Modified megatest.scm from [8b7ce4750f] to [b3f54e302d].

whitespace changes only

Modified rmtmod.scm from [3a27177e7d] to [c58d29f4fc].

295
296
297
298
299
300
301


302
303
304
305
306
307
308
309





310
311
312
313
314
315
316
317
318
		 res))))))
     

     )))

;;======================================================================




;; Defaults to current area
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))
  (if (not *rmt:remote*)(set! *rmt:remote* (make-rmt:remote)))
  (let* ((apath *toppath*)
	 (conns *rmt:remote*)
	 (dbname (db:run-id->dbname rid)))





    (rmt:general-open-connection conns apath dbname)
    (rmt:send-receive-real conns apath dbname cmd params)))

#;(define (rmt:send-receive-setup conn)
  (if (not (rmt:conn-inport conn))
      (let-values (((i o) (tcp-connect (rmt:conn-ipaddr conn)
				       (rmt:conn-port conn))))
	(rmt:conn-inport-set! conn i)
	(rmt:conn-outport-set! conn o))))







>
>








>
>
>
>
>

|







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

     )))

;;======================================================================

;; FOR DEBUGGING SET TO #t
(define *localmode* #t)

;; Defaults to current area
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))
  (if (not *rmt:remote*)(set! *rmt:remote* (make-rmt:remote)))
  (let* ((apath *toppath*)
	 (conns *rmt:remote*)
	 (dbname (db:run-id->dbname rid)))
    (if *localmode*
	(let* ((dbstruct (db:cache-get-dbstruct rid apath))
	       (indat    `((cmd . ,cmd)(params . ,params))))
	  (api:process-request dbstruct indat))
	(begin
    (rmt:general-open-connection conns apath dbname)
	  (rmt:send-receive-real conns apath dbname cmd params)))))

#;(define (rmt:send-receive-setup conn)
  (if (not (rmt:conn-inport conn))
      (let-values (((i o) (tcp-connect (rmt:conn-ipaddr conn)
				       (rmt:conn-port conn))))
	(rmt:conn-inport-set! conn i)
	(rmt:conn-outport-set! conn o))))
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
	 (ipaddrstr       (let ((ipstr (if (string=? "-" hostn)
					   ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
					   (server:get-best-guess-address hostname)
					   #f)))
			    (if ipstr ipstr hostn))) ;; hostname))) 
	 (port            (portlogger:open-run-close portlogger:find-port))
	 (link-tree-path  (common:get-linktree))
	 (tmp-area        (common:get-db-tmp-area))
	 #;(start-file      (conc tmp-area "/.server-start")))
    (debug:print-info 0 *default-log-port* "portlogger recommended port: " port)
    (if *server-info*
	(begin
	  (servdat-host-set! *server-info* ipaddrstr)
	  (servdat-port-set! *server-info* port)
	  (servdat-status-set! *server-info* 'trying-port)







|







1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
	 (ipaddrstr       (let ((ipstr (if (string=? "-" hostn)
					   ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
					   (server:get-best-guess-address hostname)
					   #f)))
			    (if ipstr ipstr hostn))) ;; hostname))) 
	 (port            (portlogger:open-run-close portlogger:find-port))
	 (link-tree-path  (common:get-linktree))
	 ;; (tmp-area        (common:get-db-tmp-area))
	 #;(start-file      (conc tmp-area "/.server-start")))
    (debug:print-info 0 *default-log-port* "portlogger recommended port: " port)
    (if *server-info*
	(begin
	  (servdat-host-set! *server-info* ipaddrstr)
	  (servdat-port-set! *server-info* port)
	  (servdat-status-set! *server-info* 'trying-port)