Megatest

adjutant.scm at trunk
Login

File adjutant.scm artifact d6c67b1549 on branch trunk


;;======================================================================
;; Copyright 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/>.

;;======================================================================

(declare (unit adjutant))

(module adjutant *

(import scheme chicken data-structures extras files)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69
	md5 message-digest matchable
	regex srfi-1)

(define (adjutant-run host-type rmt:no-sync-take-job)
  (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)
	     (system cmdline)
	     (loop 0))
	    (else
	     (thread-sleep! 10)
	     (loop (+ wait-count 1)))))
	(print "I'm bored. Exiting."))))

)