Megatest

Diff
Login

Differences From Artifact [965c358e86]:

To Artifact [2b64fdb8ba]:


343
344
345
346
347
348
349
350

351
352
353
354
355
356
357
358
359
360
361
362
363
364

365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
343
344
345
346
347
348
349

350














351













352
353
354
355
356
357
358







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







		" => "))
	     (common:get-disks) )
	"\n"))
      (set! *didsomething* #t)))

(if (args:get-arg "-ping")
    (let* ((run-id        (string->number (args:get-arg "-run-id")))
	   (host-port     (let ((slst (string-split   (args:get-arg "-ping") ":")))
	   (host:port     (args:get-arg "-ping")))
			    (if (eq? (length slst) 2)
				(list (car slst)(string->number (cadr slst)))
				#f)))
	   (toppath       (setup-for-run))
	   (server-db-dat (if (not host-port)(open-run-close tasks:get-server tasks:open-db run-id) #f)))
      (if (not run-id)
	  (begin
	    (debug:print 0 "ERROR: must specify run-id when doing ping, -run-id n")
	    (print "ERROR: No run-id")
	    (exit 1))
	  (if (and (not host-port)
		   (not server-db-dat))
	      (begin
		(print "ERROR: bad host:port")
      (server:ping run-id host:port)))
		(exit 1))
	      (let* ((iface      (if host-port (car host-port) (tasks:hostinfo-get-interface server-db-dat)))
		     (port       (if host-port (cadr host-port)(tasks:hostinfo-get-port      server-db-dat)))
		     (server-dat (http-transport:client-connect iface port))
		     (login-res  (rmt:login-no-auto-client-setup server-dat run-id)))
		(if (and (list? login-res)
			 (car login-res))
		    (begin
		      (print "LOGIN_OK")
		      (exit 0))
		    (begin
		      (print "LOGIN_FAILED")
		      (exit 1))))))))

;;======================================================================
;; 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")