Megatest

Check-in [e0ef4cda9d]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-tcp-inmem
Files: files | file ages | folders
SHA1: e0ef4cda9de4fa0487e8bb4a57696a103b86326d
User & Date: matt on 2023-02-15 14:17:54
Other Links: branch diff | manifest | tags
Context
2023-02-15
15:39
Make tcp vs. http compile time configurable. check-in: 3ca4260740 user: matt tags: v1.80-tcp-inmem
14:17
wip check-in: e0ef4cda9d user: matt tags: v1.80-tcp-inmem
08:22
wip - does not compile check-in: ab238c7c30 user: matt tags: v1.80-tcp-inmem
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified megatest.scm from [44c5a97a42] to [0136625b06].

︙︙
79
80
81
82
83
84
85
86


87
88
89
90
91
92
93


(require-library mutils)

(define *usage-log-file* #f)    ;; put path to file for logging usage in this var in the ~/.megatestrc file
(define *usage-use-seconds* #t) ;; for Epoc seconds in usage logging change this to #t in ~/.megatestrc file

;; 'http or 'tcp
(rmt:transport-mode 'tcp)


(dbfile:db-init-proc db:initialize-main-db)

;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))








|
>
>








79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95


(require-library mutils)

(define *usage-log-file* #f)    ;; put path to file for logging usage in this var in the ~/.megatestrc file
(define *usage-use-seconds* #t) ;; for Epoc seconds in usage logging change this to #t in ~/.megatestrc file

;; 'http or 'tcp
;; (rmt:transport-mode 'tcp)
(rmt:transport-mode 'http)

(dbfile:db-init-proc db:initialize-main-db)

;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))
︙︙

Modified tcp-transportmod.scm from [735951d904] to [25502ac37c].

︙︙
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

	*
	
  (import scheme
	  (prefix sqlite3 sqlite3:)
	  chicken
	  data-structures

	  ;; address-info
	  directory-utils
	  extras
	  files
	  hostinfo
	  matchable
	  md5
	  message-digest








|








26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

	*
	
  (import scheme
	  (prefix sqlite3 sqlite3:)
	  chicken
	  data-structures

	  address-info
	  directory-utils
	  extras
	  files
	  hostinfo
	  matchable
	  md5
	  message-digest
︙︙
80
81
82
83
84
85
86

87
88
89
90
91
92
93

  (host         #f)
  (port         #f)
  (conn         #f)
  (cleanup-proc #f)
  socket
  thread
  host-port

  )

(define (tt:make-remote areapath)
  (make-tt area: areapath))

(define (tt:client-connect-to-server ttdat)
  #f)








>








80
81
82
83
84
85
86
87
88
89
90
91
92
93
94

  (host         #f)
  (port         #f)
  (conn         #f)
  (cleanup-proc #f)
  socket
  thread
  host-port
  (cmd-thread   #f)
  )

(define (tt:make-remote areapath)
  (make-tt area: areapath))

(define (tt:client-connect-to-server ttdat)
  #f)
︙︙
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162

(define (tt:start-tcp-server ttdat)
  #f)

(define (tt:keep-running ttdat dbfile)
  #f)

(define (tt:shutdown-server ttdat)
  (let* ((cleanproc (tt-cleanup-proc ttdat)))
    (if cleanproc (cleanproc))
    ;; close up ports here
    #f))

(define (wait-and-close uconn)
  (thread-join! (tt-srv-cmd-thread uconn))
  (tcp-close (tt-srv-socket uconn)))








|








149
150
151
152
153
154
155
156
157
158
159
160
161
162
163

(define (tt:start-tcp-server ttdat)
  #f)

(define (tt:keep-running ttdat dbfile)
  #f)

(define (tt:shutdown-server ttdat)
  (let* ((cleanproc (tt-srv-cleanup-proc ttdat)))
    (if cleanproc (cleanproc))
    ;; close up ports here
    #f))

(define (wait-and-close uconn)
  (thread-join! (tt-srv-cmd-thread uconn))
  (tcp-close (tt-srv-socket uconn)))
︙︙
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185

    (assert conn "FATAL: tt:create-server-registration-file called with no conn, dbfname="dbfname)
    (let* ((host    (tt-conn-host conn))
	   (port    (tt-conn-port conn))
	   (servinf (conc servdir"/"host":"port"-"(current-process-id)":"dbfname))
	   (serv-id (tt:mk-signature areapath))
	   (clean-proc (lambda ()
			 (delete-file* servinf))))
      (tt-cleanup-proc-set! ttdat clean-proc)
      (with-output-to-file servinf
	(lambda ()
	  (print "SERVER STARTED: "host":"port" AT "(current-seconds)" server-id: "serv-id" pid: "(current-process-id))))
      serv-id)))

;; find valid server
;; get servers listed, last part of name must match :<dbfname>








|








172
173
174
175
176
177
178
179
180
181
182
183
184
185
186

    (assert conn "FATAL: tt:create-server-registration-file called with no conn, dbfname="dbfname)
    (let* ((host    (tt-conn-host conn))
	   (port    (tt-conn-port conn))
	   (servinf (conc servdir"/"host":"port"-"(current-process-id)":"dbfname))
	   (serv-id (tt:mk-signature areapath))
	   (clean-proc (lambda ()
			 (delete-file* servinf))))
      (tt-srv-cleanup-proc-set! ttdat clean-proc)
      (with-output-to-file servinf
	(lambda ()
	  (print "SERVER STARTED: "host":"port" AT "(current-seconds)" server-id: "serv-id" pid: "(current-process-id))))
      serv-id)))

;; find valid server
;; get servers listed, last part of name must match :<dbfname>
︙︙

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