haskal
/
crossfire
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

complete agent state reporting

This commit is contained in:
xenia 2020-12-26 02:38:27 -05:00
parent 6607dcb78a
commit ad92a73a38
1 changed files with 17 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
crossfire/agent.rkt
View File

@ -140,7 +140,7 @@
(define (execute-assignment assignment extract-dir) (define (execute-assignment assignment extract-dir)
(define aid (assignment-id assignment)) (define aid (assignment-id assignment))
(log-agent-info "starting execution of ~a" aid) (log-agent-info "starting execution of ~a in ~a" aid extract-dir)
(define cust (make-custodian)) (define cust (make-custodian))
(current-subprocess-custodian-mode 'kill) (current-subprocess-custodian-mode 'kill)
@ -180,7 +180,7 @@
(number->string (cdr ppe) 16))))) (number->string (cdr ppe) 16)))))
(define-values [proc in out _] (define-values [proc in out _]
(parameterize ([current-custodian cust]) (parameterize ([current-custodian cust] [current-directory extract-dir])
(apply subprocess #f #f (current-error-port) 'new (append cmd args)))) (apply subprocess #f #f (current-error-port) 'new (append cmd args))))
(with-handlers ([exn:break? (lambda (_) (subprocess-kill proc #f) (with-handlers ([exn:break? (lambda (_) (subprocess-kill proc #f)
@ -190,13 +190,15 @@
;; exit without reporting status ;; exit without reporting status
(kill-thread (current-thread)))]) (kill-thread (current-thread)))])
(define line-match (regexp-match-evt #px"^[^\n]*\n" in)) (define line-match (regexp-match-evt #px"^[^\n]*\n" in))
(let loop () (define eof-e (eof-evt out))
(let loop ([reached-eof #f] [proc-done #f])
(match (sync proc line-match) (match (sync proc line-match)
[(== proc) [(== proc)
;; error if it's nonzero, otherwise stop looping (unless reached-eof
(unless (zero? (subprocess-status proc)) (loop reached-eof #t))]
;; TODO : report stderr i guess [(? eof-object?)
(error "got nonzero return status" (subprocess-status proc)))] (unless proc-done
(loop #t proc-done))]
[(list line) [(list line)
(define line-parts (map (lambda (x) (string->number x 16)) (define line-parts (map (lambda (x) (string->number x 16))
(string-split line " "))) (string-split line " ")))
@ -206,9 +208,15 @@
(= (length line-parts) (vector-length (manifest-pattern manifest)))) (= (length line-parts) (vector-length (manifest-pattern manifest))))
(report-success/retry aid line-parts) (report-success/retry aid line-parts)
(log-agent-warning "assignment ~a input loop got unparseable line ~a" aid line)) (log-agent-warning "assignment ~a input loop got unparseable line ~a" aid line))
(loop)] (loop reached-eof proc-done)]
[x (log-agent-warning "assignment ~a input loop got unexpected value ~a" aid x) [x (log-agent-warning "assignment ~a input loop got unexpected value ~a" aid x)
(loop)]))))) (loop reached-eof proc-done)])))
(define errcode (subprocess-status proc))
(log-agent-info "assignment ~a process exited with code ~a" aid errcode)
;; report error if it's a nonzero exit code
(unless (zero? errcode)
(error "process exited with nonzero code" errcode))))
(cleanup) (cleanup)
(void)) (void))