Megatest

Check-in [4348e8b681]
Login
Overview
Comment:Preserve the alist until the db call, still not right
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-adjutant
Files: files | file ages | folders
SHA1: 4348e8b681950fee6d71de9c87296661bda0b7d8
User & Date: matt on 2020-09-23 00:26:29
Other Links: branch diff | manifest | tags
Context
2020-09-25
21:27
list to alist for adjutant Closed-Leaf check-in: 0dc9a0f5e6 user: matt tags: v1.65-adjutant
2020-09-23
00:26
Preserve the alist until the db call, still not right check-in: 4348e8b681 user: matt tags: v1.65-adjutant
00:12
Preserve the alist until the db call check-in: b356719831 user: matt tags: v1.65-adjutant
Changes

Modified megatest.scm from [dcc9a20e0f] to [8846c3b82c].

932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947













948
949
950
951
952
953
954
932
933
934
935
936
937
938









939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958







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







    (let* ((host-type (args:get-arg "-adjutant")))
      (launch:setup) ;; dang it, wish this wasn't needed
      (print "Running the adjutant!")
      (let loop ((wait-count 0))
	(if (< wait-count 10) ;; 6 x 10 seconds = one minute
	    (let* ((dat (rmt:no-sync-take-job host-type)))
	      (match dat
		((id ht vars exekey cmdline state event-time last-update)
		 (call-with-environment-variables
		  (with-input-from-string vars read)
		  (lambda ()
		    (system cmdline)))
		 (loop 0))
		(else
		 (thread-sleep! 10)
		 (loop (+ wait-count 1)))))
		  ((id ht vars exekey cmdline state event-time last-update)
		      (let ((vars-alist (with-input-from-string vars read)
					))
			(print "Vars:")
			(pp vars-alist)
			(call-with-environment-variables
			 vars-alist
			 (lambda ()
			   (system cmdline))))
		      (loop 0))
		  (else
		   (thread-sleep! 10)
		   (loop (+ wait-count 1)))))
	    (print "I'm bored. Exiting.")))
      ;; (adjutant-run (args:get-arg "-ajutant") rmt:no-sync-take-job)
      (set! *didsomething* #t)))

(if (or (args:get-arg "-list-servers")
        (args:get-arg "-kill-servers"))
    (let ((tl (launch:setup)))