Megatest

Check-in [9f479c2454]
Login
Overview
Comment:wip-no-compile
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-reshape
Files: files | file ages | folders
SHA1: 9f479c2454eda9c715efead307c08771dd47f085
User & Date: matt on 2023-01-29 22:01:00
Other Links: branch diff | manifest | tags
Context
2023-01-30
20:20
wip check-in: a51a5d6058 user: matt tags: v1.80-reshape
2023-01-29
22:01
wip-no-compile check-in: 9f479c2454 user: matt tags: v1.80-reshape
21:32
Beginnings of client implemented check-in: bd65c3fcb5 user: matt tags: v1.80-reshape
Changes

Modified clientmod.scm from [8950d17727] to [dc86555194].

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
(module clientmod
*

(import scheme
	posix
	data-structures
	srfi-18


	artifacts
	servermod
	)









(define (client:find-server areapath)
  (let* ((sdir  (conc areapath"/.server"))
	 (sarfs (glob (conc sdir"/*.artifact")))) ;; server artifacts
    (if (null? sarfs)
	(begin
	  (server:launch areapath)
	  (thread-sleep! 1)
	  (client:find-server areapath))
	(let* ((sarf (car sarfs))
	       (sdat (read-artifact->alist sarf))
	       (srvdir (alist-ref 'd sdat)))

	  srvdir))))








	  

	  



)








>




>
>
>
>
>
>
>
>











|
>
|
>
>
>
>
>
>
>
>
|
>
|
>
>
>


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
(module clientmod
*

(import scheme
	posix
	data-structures
	srfi-18
	typed-records

	artifacts
	servermod
	)

(defstruct con ;; client connection
  (hdir       #f)
  (obj-to-str #f)
  (host       #f)
  (pid        #f)
  (sdat       #f) ;; server artifact data
  )

(define (client:find-server areapath)
  (let* ((sdir  (conc areapath"/.server"))
	 (sarfs (glob (conc sdir"/*.artifact")))) ;; server artifacts
    (if (null? sarfs)
	(begin
	  (server:launch areapath)
	  (thread-sleep! 1)
	  (client:find-server areapath))
	(let* ((sarf (car sarfs))
	       (sdat (read-artifact->alist sarf))
	       (hdir (alist-ref 'd sdat)))
	  (make-con hdir: hdir sdat: sdat)))))

(define (client:send-receive con cmd params)
  (let* ((obj->string (con-obj-to-str con))
	 (arf  `((c . ,cmd)
		 (p . ,(obj->string params))
		 (h . ,(con-host con))
		 (i . ,(con-pid  con))))
	 (hdir  (con-hdir con))
	 (uuid  (write-alist->artifact hdir arf ptype: 'Q)))
    
    ;; wait for a response here

    #f
    ))

)

Modified rmtmod.scm from [7009453b29] to [68caa1e403].

17
18
19
20
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
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

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

(declare (unit rmtmod))
(declare (uses commonmod))
(declare (uses clientmod))


(module rmtmod
*

(import scheme







	
	clientmod

	)

;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;

;; generate entries for ~/.megatestrc with the following
;;
;;  grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u

;;======================================================================
;;  S U P P O R T   F U N C T I O N S
;;======================================================================

;; if a server is either running or in the process of starting call client:setup
;; else return #f to let the calling proc know that there is no server available
;;
(define (rmt:get-connection-info areapath runremote) ;; TODO: push areapath down.



  (client:find-server areapath)





  #;(let* ((cinfo     (if (remote? runremote)
			(remote-conndat runremote)
			#f)))
	  (if cinfo
	      cinfo
	      (if (server:check-if-running areapath)
		  (client:setup areapath runremote)
		  #f))))

(define (rmt:on-homehost? runremote)
  #t
  )
  #;(let* ((hh-dat (remote-hh-dat runremote)))
    (if (pair? hh-dat)
	(cdr hh-dat)
	(begin
	  (debug:print-info 0 *default-log-port* "hh-dat="hh-dat)
	  #f))))


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

(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id

(define (rmt:send-receive cmd rid params #!key (attemptnum 1)) ;; start attemptnum at 1 so the modulo below works as expected




  
;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;
;; (define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
;;   #;(common:telemetry-log (conc "rmt:"(->string cmd))
;;                         payload: `((rid . ,rid)
;;                                    (params . ,params)))







>





>
>
>
>
>
>
>


>

















|
>
>
>
|
>
>
>
>
>







|



<













>
>
>
>







17
18
19
20
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
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

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

(declare (unit rmtmod))
(declare (uses commonmod))
(declare (uses clientmod))
(declare (uses dbmod))

(module rmtmod
*

(import scheme
	chicken
	data-structures
	posix
	srfi-1
	srfi-18
	srfi-69
	extras
	
	clientmod
	dbmod
	)

;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;

;; generate entries for ~/.megatestrc with the following
;;
;;  grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u

;;======================================================================
;;  S U P P O R T   F U N C T I O N S
;;======================================================================

;; if a server is either running or in the process of starting call client:setup
;; else return #f to let the calling proc know that there is no server available
;;
(define (rmt:get-connection-info areapath) ;; TODO: push areapath down.
  (if *runremote*
      *runremote*
      (begin
	(set! *runremote* (client:find-server areapath))
	(con-obj-to-str-set! *runremote* db:obj->str)
	(con-host-set! *runremote* (get-host-name))
	(con-pid-set!  *runremote* (current-process-id))
	*runremote*)))
      
  #;(let* ((cinfo     (if (remote? runremote)
			(remote-conndat runremote)
			#f)))
	  (if cinfo
	      cinfo
	      (if (server:check-if-running areapath)
		  (client:setup areapath runremote)
		  #f)))

(define (rmt:on-homehost? runremote)
  #t

  #;(let* ((hh-dat (remote-hh-dat runremote)))
    (if (pair? hh-dat)
	(cdr hh-dat)
	(begin
	  (debug:print-info 0 *default-log-port* "hh-dat="hh-dat)
	  #f))))


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

(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id

(define (rmt:send-receive cmd rid params #!key (attemptnum 1)) ;; start attemptnum at 1 so the modulo below works as expected
  (let* ((con (rmt:get-connection-info areapath)))
    (client:send-receive con cmd params)))
    

  
;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;
;; (define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
;;   #;(common:telemetry-log (conc "rmt:"(->string cmd))
;;                         payload: `((rid . ,rid)
;;                                    (params . ,params)))