| ︙ | | |
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
|
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
|
+
-
+
+
+
+
+
|
(rmt:send-receive 'get-num-runs #f (list runpatt)))
(define (rmt:get-runs-cnt-by-patt runpatt targetpatt keys)
(rmt:send-receive 'get-runs-cnt-by-patt #f (list runpatt targetpatt keys)))
;; Use the special run-id == #f scenario here since there is no run yet
(define (rmt:register-run keyvals runname state status user contour)
;; first register in main.db (thus the #f)
(rmt:send-receive 'register-run #f (list keyvals runname state status user contour)))
(let* ((run-id (rmt:send-receive 'register-run #f (list keyvals runname state status user contour))))
;; now register in the run db itself
(rmt:send-receive 'register-run run-id (list keyvals runname state status user contour))
run-id))
(define (rmt:get-run-name-from-id run-id)
(rmt:send-receive 'get-run-name-from-id run-id (list run-id)))
(define (rmt:delete-run run-id)
(rmt:send-receive 'delete-run run-id (list run-id)))
|
| ︙ | | |
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
|
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
|
-
-
-
+
|
;; (exit 1))))
(define (common:run-sync?)
;; (and (common:on-homehost?)
(args:get-arg "-server"))
(define (server:start-and-wait areapath #!key (timeout 60))
#;(define (server:start-and-wait areapath #!key (timeout 60))
(let ((give-up-time (+ (current-seconds) timeout)))
(let loop ((server-info (server:check-if-running areapath))
(try-num 0))
(if (or server-info
(> (current-seconds) give-up-time)) ;; server-url will be #f if no server available.
(server:record->url server-info)
(let ((num-ok (length (server:get-best (server:get-list areapath)))))
|
| ︙ | | |
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
|
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
|
+
+
-
+
+
+
-
+
|
(if res
server-url
#f)))
;; no longer care if multiple servers are started by accident. older
;; servers will drop off in time.
;;
;; defunct
;;
(define (server:check-if-running areapath) ;; #!key (numservers "2"))
#;(define (server:check-if-running areapath) ;; #!key (numservers "2"))
(let* ((ns (server:get-num-servers))
(servers (server:get-best (server:get-list areapath))))
(if (or (and servers
(null? servers))
(not servers)
(and (list? servers)
(< (length servers) (pseudo-random-integer ns)))) ;; somewhere between 0 and numservers
#f
(let loop ((hed (car servers))
(tal (cdr servers)))
(let ((res (server:check-server hed)))
(if res
hed
(if (null? tal)
#f
(loop (car tal)(cdr tal)))))))))
;; kind start up of servers, wait 40 seconds before allowing another server for a given
;; run-id to be launched
;;
;; defunct
;;
(define (server:kind-run areapath)
#;(define (server:kind-run areapath)
;; look for $MT_RUN_AREA_HOME/logs/server-start-last
;; and wait for it to be at least 3 seconds old
;; (server:wait-for-server-start-last-flag areapath)
(if (not (server:check-if-running areapath)) ;; why try if there is already a server running?
(let* ((last-run-dat (hash-table-ref/default *server-kind-run* areapath '(0 0))) ;; callnum, whenrun
(call-num (car last-run-dat))
(when-run (cadr last-run-dat))
|
| ︙ | | |
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
|
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
|
+
+
+
-
+
|
(http-transport:client-connect iface port)
#;(case (server:get-transport)
((rpc) (rpc:client-connect iface port))
((http) (http:client-connect iface port))
((zmq) (zmq:client-connect iface port))
(else (rpc:client-connect iface port))))
;;
;; defunct
;;
(define (client:setup areapath #!key (remaining-tries 100) (failed-connects 0))
#;(define (client:setup areapath #!key (remaining-tries 100) (failed-connects 0))
(print "got here")
;; (client:setup-http areapath remaining-tries: remaining-tries failed-connects: failed-connects)
#;(case (server:get-transport)
((rpc) (rpc-transport:client-setup remaining-tries: remaining-tries failed-connects: failed-connects)) ;;(client:setup-rpc run-id))
((http)(client:setup-http areapath remaining-tries: remaining-tries failed-connects: failed-connects))
(else (rpc-transport:client-setup remaining-tries: remaining-tries failed-connects: failed-connects)))) ;; (client:setup-rpc run-id))))
|
| ︙ | | |