;;======================================================================
;; S E R V E R
;;======================================================================
;; Copyright 2006-2017, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; Run like this:
;;
;; (cd ..;make && make install) && ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0)
(import big-chicken rmtmod trace http-client apimod dbmod
launchmod)
(trace-call-sites #t)
(trace
;; db:get-dbdat
;; rmt:find-main-server
;; rmt:send-receive-real
;; rmt:send-receive
;; sexpr->string
;; server-ready?
;; rmt:register-server
;; rmt:deregister-server
;; rmt:open-main-connection
;; rmt:general-open-connection
;; rmt:get-conn
;; common:watchdog
;; rmt:find-main-server
;; get-all-server-pkts
;; get-viable-servers
;; get-best-candidate
;; api:run-server-process
;; api:process-request
;; rmt:run
;; rmt:try-start-server
)
(define *db* (db:setup ".db/main.db"))
;; these let me cut and paste from source easily
(define apath *toppath*)
(define dbname ".db/2.db")
(define remote *db-serv-info*)
(define keyvals '(("SYSTEM" "a")("RELEASE" "b")))
(test #f #t (rmt:open-main-connection remote apath))
(test #f #t (conndat? (rmt:get-conn *db-serv-info* *toppath* ".db/main.db")))
(test #f #t (conndat? (rmt:get-conn *db-serv-info* *toppath* ".db/main.db")))
(test #f 'server-started (rmt:send-receive-real *db-serv-info* *toppath* ".db/main.db"
'start-server `(,apath ,dbname)))
(thread-sleep! 2)
(test #f #t (rmt:general-open-connection *db-serv-info* *toppath* ".db/2.db"))
;; (let loop ((end-time (+ (current-seconds) 61)))
(test #f #t (list? (rmt:get-servers-info *toppath*)))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
(test #f 1 (rmt:send-receive 'register-run #f (list keyvals "run1" "new" "n/a" "justme" #f)))
;; (print "Got here.")
(test #f 1 (rmt:send-receive 'register-run 1 (list keyvals "run1" "new" "n/a" "justme" #f)))
(test #f 2 (rmt:register-run keyvals "run2" "new" "n/a" "justme" #f))
;; (test #f 2 (rmt:deregister-server *db-serv-info* *toppath* iface port server-key dbname
(test #f 2 (rmt:get-count-servers *db-serv-info* *toppath*))
(test #f "run2" (rmt:get-run-name-from-id 2))
(test #f #f (rmt:send-receive 'get-test-info-by-id 2 '(2 1)))
(test #f #t (rmt:general-call 'update-cpuload-diskfree 2 1.5 1e6 1))
;; (if (< (current-seconds) end-time)(loop end-time)))
(exit)