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

implement stdio mode on agent

This commit is contained in:
xenia 2021-01-10 01:22:58 -05:00
parent 1a66ff29f3
commit d08892d6e9
1 changed files with 19 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
crossfire/agent.rkt
View File

@ -17,8 +17,8 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(require file/untgz (only-in file/sha1 bytes->hex-string) racket/async-channel racket/bool
racket/cmdline racket/contract racket/fasl racket/file racket/function racket/match
racket/path racket/port racket/string racket/unit
racket/cmdline racket/contract racket/fasl racket/file racket/function racket/list
racket/match racket/path racket/port racket/string racket/unit
"comms.rkt" "info.rkt" "logging.rkt" "not-crypto.rkt" "manifest.rkt" "protocol.rkt"
"pattern.rkt" "static-support.rkt"
(submod "static-support.rkt" misc-calls))
@ -27,6 +27,7 @@
(define-logger agent #:parent global-logger)
(define *default-cg-cmd* "./crossfire-generator")
(define *max-cache-age* (* 3600 24 7))
(define *ping-secs* 30)
(define *subproc-kill-delay* 10)
@ -190,7 +191,9 @@
(define cmd (manifest-data-ref manifest 'command))
(define num-cpus (count-cpus))
(define smp? (first (manifest-data-ref manifest 'smp)))
;; TODO : handle smp
(define mode (first (manifest-data-ref manifest 'mode)))
(define pattern (manifest-pattern manifest))
@ -204,15 +207,26 @@
(number->string (car ppe) 16)
(number->string (cdr ppe) 16)))))
;; TODO : handle stdio mode lol
(define-values [proc out in _]
(define-values [proc input-proc out]
(parameterize ([current-custodian cust] [current-directory extract-dir])
(apply subprocess #f #f (current-error-port) 'new (append cmd args))))
(match mode
['callback
(define-values [proc out in err]
(apply subprocess #f #f (current-error-port) 'new (append cmd args)))
(values proc #f out)]
['stdio
(define-values [ig-proc ig-out ig-in ig-err]
(apply subprocess #f #f (current-error-port) 'new *default-cg-cmd* args))
(define-values [proc out in err]
(apply subprocess #f ig-out (current-error-port) 'new cmd))
(values proc ig-proc out)])))
(with-handlers ([exn:break? (lambda (_)
(log-agent-info "killing process for ~a" aid)
;; nicely ask the process to stop
(subprocess-kill proc #f)
(when input-proc
(subprocess-kill input-proc))
(sync/timeout *subproc-kill-delay* proc)
;; will handle killing for us :P
(custodian-shutdown-all cust)