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

fix agent execution bugs

This commit is contained in:
xenia 2020-12-26 03:23:13 -05:00
parent b05763ad5b
commit 9fc1f546c5
1 changed files with 13 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
crossfire/agent.rkt
View File

@ -179,7 +179,7 @@
(number->string (car ppe) 16) (number->string (car ppe) 16)
(number->string (cdr ppe) 16))))) (number->string (cdr ppe) 16)))))
(define-values [proc in out _] (define-values [proc out in _]
(parameterize ([current-custodian cust] [current-directory extract-dir]) (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))))
@ -189,10 +189,10 @@
(custodian-shutdown-all cust) (custodian-shutdown-all cust)
;; 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" out))
(define eof-e (eof-evt out)) (define eof-e (eof-evt out))
(let loop ([reached-eof #f] [proc-done #f]) (let loop ([reached-eof #f] [proc-done #f])
(match (sync proc line-match) (match (sync proc line-match eof-e)
[(== proc) [(== proc)
(unless reached-eof (unless reached-eof
(loop reached-eof #t))] (loop reached-eof #t))]
@ -200,14 +200,21 @@
(unless proc-done (unless proc-done
(loop #t proc-done))] (loop #t proc-done))]
[(list line) [(list line)
(define line-parts (map (lambda (x) (string->number x 16)) (define line-str (bytes->string/utf-8 line #f))
(string-split line " "))) (define line-parts
(and line-str
(map (lambda (x) (string->number x 16))
(string-split (string-trim line-str) " "))))
;; check format, if it looks correct-ish then report it ;; check format, if it looks correct-ish then report it
;; otherwise warn ;; otherwise warn
;; it will be #f if the line failed to decode as utf-8
;; theoretically since we're only dealing with 0-9a-f we could also just decode as
;; ascii but i like utf-8 so whatever potential bugs i'm introducing with this be
;; hecked tbh
(if (and ((listof integer?) line-parts) (if (and ((listof integer?) line-parts)
(= (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 ~s" aid line))
(loop reached-eof proc-done)] (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 reached-eof proc-done)]))) (loop reached-eof proc-done)])))