Megatest

client.scm at [adbeb66c05]
Login

File client.scm artifact 58115c88ed part of check-in adbeb66c05



;; Copyright 2006-2012, 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/>.

;;======================================================================
;; C L I E N T S
;;======================================================================

(use srfi-18 extras tcp s11n srfi-1 posix regex srfi-69 hostinfo md5
     message-digest matchable spiffy uri-common intarweb http-client
     spiffy-request-vars uri-common intarweb directory-utils)

(declare (unit client))

(declare (uses common))
(declare (uses db))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.

(include "common_records.scm")
(include "db_records.scm")

;; ;; Not currently used! But, I think it *should* be used!!!
;; (define (client:logout serverdat)
;;   (let ((ok (and (socket? serverdat)
;; 		 (cdb:logout serverdat *toppath* (client:get-signature)))))
;;     ok))
;; 
;; (define (client:connect iface port)
;;   (case (server:get-transport)
;;     ((http) (http:client-connect iface port))
;;     ((zmq)  (zmq:client-connect  iface port))
;;     (else   (begin
;; 	      (debug:print 0 *default-log-port* "ERROR: no such transport " (server:get-transport) ", exiting now.")
;; 	      (exit 1)))))
;; 
;; (define (client:setup areapath #!key (remaining-tries 100) (failed-connects 0))
;;   (case (server:get-transport)
;;     ((http)(client:setup-http areapath remaining-tries: remaining-tries failed-connects: failed-connects))
;;     (else  (begin
;; 	     (debug:print 0 *default-log-port* "ERROR: no such transport " (server:get-transport) ", exiting now.")
;; 	     (exit 1)))))
;; 
;; ;; Do all the connection work, look up the transport type and set up the
;; ;; connection if required.
;; ;;
;; ;; There are two scenarios. 
;; ;;   1. We are a test manager and we received *transport-type* and *runremote* via cmdline
;; ;;   2. We are a run tests, list runs or other interactive process and we must figure out
;; ;;      *transport-type* and *runremote* from the monitor.db
;; ;;
;; ;; client:setup
;; ;;
;; ;; lookup_server, need to remove *runremote* stuff
;; ;;
;; 
;; (define (client:setup-http areapath #!key (remaining-tries 100) (failed-connects 0)(area-dat #f))
;;   (debug:print-info 2 *default-log-port* "client:setup remaining-tries=" remaining-tries)
;;   (server:start-and-wait areapath)
;;   (if (<= remaining-tries 0)
;;       (begin
;; 	(debug:print-error 0 *default-log-port* "failed to start or connect to server")
;; 	(exit 1))
;;       ;;
;;       ;; Alternatively here, we can get the list of candidate servers and work our way
;;       ;; through them searching for a good one.
;;       ;;
;;       (let* ((server-dat (server:get-rand-best areapath)) ;; (server:get-first-best areapath))
;; 	     (runremote  (or area-dat *runremote*)))
;; 	(if (not server-dat) ;; no server found
;; 	    (client:setup-http areapath remaining-tries: (- remaining-tries 1))
;; 	    (let ((host  (cadr  server-dat))
;; 		  (port  (caddr server-dat)))
;; 	      (debug:print-info 4 *default-log-port* "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
;; 	      (if (and (not area-dat)
;; 		       (not *runremote*))
;; 		  (set! *runremote* (make-remote)))
;; 	      (if (and host port)
;; 		  (let* ((start-res (case *transport-type*
;; 				      ((http)(http-transport:client-connect host port))))
;; 			 (ping-res  (case *transport-type* 
;; 				      ((http)(rmt:login-no-auto-client-setup start-res)))))
;; 		    (if (and start-res
;; 			     ping-res)
;; 			(let ((runremote (or area-dat *runremote*))) ;; it might have been generated only a few statements ago
;; 			  (remote-conndat-set! runremote start-res) ;; (hash-table-set! runremote run-id start-res)
;; 			  (debug:print-info 2 *default-log-port* "connected to " (http-transport:server-dat-make-url start-res))
;; 			  start-res)
;; 			(begin    ;; login failed but have a server record, clean out the record and try again
;; 			  (debug:print-info 0 *default-log-port* "client:setup, login failed, will attempt to start server ... start-res=" start-res ", server-dat=" server-dat) ;; had runid.  Fixes part of Randy;s ticket 1405717332
;; 			  (case *transport-type* 
;; 			    ((http)(http-transport:close-connections)))
;; 			  (remote-conndat-set! runremote #f)  ;; (hash-table-delete! runremote run-id)
;; 			  (thread-sleep! 1)
;; 			  (client:setup-http areapath remaining-tries: (- remaining-tries 1))
;; 			  )))
;; 		  (begin    ;; no server registered
;; 		    ;; (server:kind-run areapath)
;; 		    (server:start-and-wait areapath)
;; 		    (debug:print-info 0 *default-log-port* "client:setup, no server registered, remaining-tries=" remaining-tries)
;; 		    (thread-sleep! 1) ;; (+ 5 (random (- 20 remaining-tries))))  ;; give server a little time to start up, randomize a little to avoid start storms.
;; 		    (client:setup-http areapath remaining-tries: (- remaining-tries 1)))))))))
;;