21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
(use format typed-records) ;; RADT => purpose of json format??
(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(include "common_records.scm")
;;
;; 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
;;
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
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
|
(use format typed-records) ;; RADT => purpose of json format??
(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(include "common_records.scm")
(declare (uses portlogger))
(import portlogger)
(declare (uses nmsg-transport))
(import (prefix nmsg-transport nmsg:))
(use (prefix pkts pkts:) srfi-18)
;;
;; 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
;;======================================================================
;; N A N O M S G S E R V E R
;;======================================================================
(defstruct nmsg
(conn #f)
(hosts (make-hash-table))
pkt
(pktspec '((server (hostname . h)
(port . p)
(pid . i)
)))
(mutex (make-mutex))
)
;; make it a global
(define *nmsg-conndat* (make-nmsg))
;; get a port
;; start the nmsg server
;; look for other servers
;; contact other servers and compile list of servers
;; there are two types of server
;; main servers - dashboards, runners and dedicated servers - need pkt
;; passive servers - test executers, step calls, list-runs - no pkt
;;
(define (rmt:start-nmsg #!key (force-server-type #f))
(mutex-lock! (nmsg-mutex *nmsg-conndat*))
(let* ((server-type (or force-server-type
(if (args:any? "-run" "-server")
'main
'passive)))
(port-num (portlogger:open-run-close portlogger:find-port))
(nmsg-conn (nmsg:start-server port-num))
(pktspec (nmsg-pktspec *nmsg-conndat*))
(pktdir (conc (get-environment-variable "MT_RUN_AREA_HOME")
"/.server-pkts")))
;; server is started, now create pkt if needed
(if (eq? server-type 'main)
(nmsg-pkt-set! *nmsg-conndat*
(pkts:write-alist-pkt
pktdir
`((hostname . ,(get-host-name))
(port . ,port-num)
(pid . ,(current-process-id)))
pktspec)))
(nmsg-conn-set! *nmsg-conndat* nmsg-conn)
))
;;======================================================================
;; 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
;;
|