Megatest

Diff
Login

Differences From Artifact [041b4741e2]:

To Artifact [3d122c3c2c]:


626
627
628
629
630
631
632
633

634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
	(hostpid-rx (regexp "\\s+(\\w+)\\s+(\\d+)$"))) ;; host pid is at end of param string
    (if (null? records)
	(debug:print 0 "No run launching processes found for " target " / " run-name)
	(debug:print 0 "Found " (length records) " run(s) to kill."))
    (for-each 
     (lambda (record)
       (let* ((param-key (list-ref record 8))
	      (match-dat (string-search hostpid-rx param-key))

	      (hostname  (cadr match-dat))
	      (pid       (caddr match-dat)))
	 (debug:print 0 "Sending SIGINT to process " pid " on host " hostname)
	 (if (equal? (get-host-name) hostname)
	     (begin
	       (handle-exceptions
		exn
		(begin
		  (debug:print 0 "Kill of process " pid " on host " hostname " failed.")
		  (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
		  #t)
		(process-signal (string->number pid) signal/int)
		(thread-sleep! 5)
		(process-signal (string->number pid) signal/kill)))
	     ;;  (call-with-environment-variables
	     (let ((old-targethost (getenv "TARGETHOST")))
	       (set-environment-variable "TARGETHOST" hostname)
	       (system (conc "nbfake " kill " " pid))
	       (if old-targethost (set-environment-variable "TARGETHOST" old-targethost))))))
     records)))


;;======================================================================
;; The routines to process tasks
;;======================================================================

;; NOTE: It might be good to add one more layer of checking to ensure







|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
	(hostpid-rx (regexp "\\s+(\\w+)\\s+(\\d+)$"))) ;; host pid is at end of param string
    (if (null? records)
	(debug:print 0 "No run launching processes found for " target " / " run-name)
	(debug:print 0 "Found " (length records) " run(s) to kill."))
    (for-each 
     (lambda (record)
       (let* ((param-key (list-ref record 8))
	      (match-dat (string-search hostpid-rx param-key)))
	 (if match-dat
	     (let (((hostname  (cadr match-dat))
		    (pid       (caddr match-dat))))
	       (debug:print 0 "Sending SIGINT to process " pid " on host " hostname)
	       (if (equal? (get-host-name) hostname)
		   (begin
		     (handle-exceptions
		      exn
		      (begin
			(debug:print 0 "Kill of process " pid " on host " hostname " failed.")
			(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
			#t)
		      (process-signal (string->number pid) signal/int)
		      (thread-sleep! 5)
		      (process-signal (string->number pid) signal/kill)))
		   ;;  (call-with-environment-variables
		   (let ((old-targethost (getenv "TARGETHOST")))
		     (set-environment-variable "TARGETHOST" hostname)
		     (system (conc "nbfake " kill " " pid))
		     (if old-targethost (set-environment-variable "TARGETHOST" old-targethost))))))
	 records)))))


;;======================================================================
;; The routines to process tasks
;;======================================================================

;; NOTE: It might be good to add one more layer of checking to ensure