Megatest

Check-in [122f376d3c]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:changed default transport to rpc
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | rpc-transport
Files: files | file ages | folders
SHA1: 122f376d3c8c14e51898383cd7e9eea7b43a732f
User & Date: bjbarcla on 2016-11-04 18:52:02
Other Links: branch diff | manifest | tags
Context
2016-11-11
15:46
wip check-in: 1d35a89202 user: bjbarcla tags: rpc-transport
2016-11-04
18:52
changed default transport to rpc check-in: 122f376d3c user: bjbarcla tags: rpc-transport
17:54
got rpc to work... at least one call from megatest -repl :) check-in: 985c43c44c user: bjbarcla tags: rpc-transport
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified megatest.scm from [7f46162c88] to [56597888dd].

︙
731
732
733
734
735
736
737
738

739
740
741
742
743



744
745
746
747


748
749
750

751
752
753
754
755
756
757

731
732
733
734
735
736
737

738
739
740



741
742
743

744


745
746
747
748

749
750
751
752
753
754
755
756








-
+


-
-
-
+
+
+
-

-
-
+
+


-
+









;;======================================================================
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;;   we start the server if not running else start the client thread
;;======================================================================

(if (args:get-arg "-server")

    
    ;; Server? Start up here.
    ;;
    (let ((tl        (launch:setup))
	  (run-id    (and (args:get-arg "-run-id")
			  (string->number (args:get-arg "-run-id"))))
    (let* ((tl        (launch:setup))
           (run-id    (and (args:get-arg "-run-id")
                           (string->number (args:get-arg "-run-id")))))
          (transport-type (string->symbol (or (args:get-arg "-transport") "http"))))
      (if run-id
	  (begin
	    (server:launch run-id transport-type)
          (begin
	    (server:launch run-id (->string *transport-type*))
	    (set! *didsomething* #t))
	  (debug:print-error 0 *default-log-port* "server requires run-id be specified with -run-id")))

    
    ;; Not a server? This section will decide how to communicate
    ;;
    ;;  Setup client for all expect listed here
    (if (null? (lset-intersection 
		equal?
		(hash-table-keys args:arg-hash)
		'("-list-servers"
︙

Modified rmt.scm from [7835a76c1e] to [a08625c798].

︙
142
143
144
145
146
147
148

149
150
151
152
153
154
155

142
143
144
145
146
147
148
149
150
151
152
153
154
155
156








+








                   #f)
                  )) ;; (vector-ref res 1)))

              ;; no success...
	      (begin ;; let ((new-connection-info (client:setup run-id)))
		(debug:print 0 *default-log-port* "WARNING: Communication failed, trying call to rmt:send-receive again.")
                (case transport-type
                  
                  ((http rpc)
                   (hash-table-delete! *runremote* run-id) ;; don't keep using the same connection
                   ;; NOTE: killing server causes this process to block forever. No idea why. Dec 2. 
                   ;; (if (eq? (modulo attemptnum 5) 0)
                   ;;     (tasks:kill-server-run-id run-id tag: "api-send-receive-failed"))
                   ;; (mutex-unlock! *send-receive-mutex*) ;; close the mutex here to allow other threads access to communications
                   (tasks:start-and-wait-for-server (tasks:open-db) run-id 15)
︙

Modified server.scm from [1d7dcc4237] to [bc89cb6e04].

︙
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

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








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











-
+
+









;; all routes though here end in exit ...
;;
;; start_server
;;
(define (server:launch run-id transport-type)
  (BB> "server:launch fired for run-id="run-id" transport-type="transport-type)
  (let ((ttype (if (symbol? transport-type) transport-type (string->symbol (->string transport-type)))))
  (case transport-type
    ((http)(http-transport:launch run-id))
    ;;((nmsg)(nmsg-transport:launch run-id))
    ((rpc)  (rpc-transport:launch run-id))
    (else (debug:print-error 0 *default-log-port* "unknown server type " transport-type))))
;;       (else   (debug:print-error 0 *default-log-port* "No known transport set, transport=" transport ", using rpc")
;; 	      (rpc-transport:launch run-id)))))
    (case ttype
      ((http)(http-transport:launch run-id))
      ;;((nmsg)(nmsg-transport:launch run-id))
      ((rpc)  (rpc-transport:launch run-id))
      (else (debug:print-error 0 *default-log-port* "unknown server type " ttype)))))
  ;;       (else   (debug:print-error 0 *default-log-port* "No known transport set, transport=" transport ", using rpc")
  ;; 	      (rpc-transport:launch run-id)))))

;;======================================================================
;; S E R V E R   U T I L I T I E S 
;;======================================================================

;; set global *transport-type* based on -transport switch and serer/transport configuration.  default http otherwise.
;; called by launch:setup
(define (server:set-transport)
  (let ((ttype (string->symbol
                (or (args:get-arg "-transport")
                    (configf:lookup *configdat* "server" "transport")
                    "http"))))
                    "rpc"))))
    (BB> "TRANSPORT IS "ttype" string?"(string? ttype)" symbol?"(symbol? ttype))
    (set! *transport-type* ttype)
    ttype))

;; Get the transport  -- DO NOT call this from client code.  In client code, this is run-id sensitive and not a global
;;   For code communicating with existing run-id with a server, use: (rmt:run-id->transport-type run-id)
 (define (server:get-transport)
   (if *transport-type*
︙

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