lassik
/
eval-server
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Use temp directory

This commit is contained in:
Lassi Kortela 2021-09-20 14:02:09 +03:00
parent 05298fb1f0
commit 93c7ef8046
1 changed files with 27 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
eval-server.sld
View File

@ -7,6 +7,7 @@
(scheme write)
(only (chicken blob) blob->string)
(only (chicken file) create-temporary-directory)
(chicken process-context)
(chicken process)
(only (srfi 4) u8vector->blob)
(spiffy)
@ -68,6 +69,12 @@
(make-tar-header-for-regular-file filename bytes)
bytes (make-tar-padding bytes)))
(define (with-current-directory dir proc)
(let ((old-dir (current-directory)))
(dynamic-wind (lambda () (change-directory dir))
proc
(lambda () (change-directory old-dir)))))
(define (handle-the-scheme-implementation impl)
(let ((cmdline #f)
(environ #f)
@ -115,23 +122,26 @@
(error "No main.scm file in archive"))
(let ((tempdir (create-temporary-directory)))
(write tempdir)(newline)
(for-each (lambda (entry)
(let ((name (car entry))
(bytes (cdr entry)))
(call-with-port
(open-binary-output-file name)
(lambda (out) (write-bytevector bytes out)))))
files))
(let ((command (append (implementation-command-line impl)
(list "main.scm")
cmdline)))
(write command)(newline)
(let-values (((from-sub to-sub sub-pid from-sub-err)
(process* (car command) (cdr command) environ)))
(write-bytevector stdin to-sub)
(close-output-port to-sub)
(set! stdout (read-all-bytes from-sub))
(set! stderr (read-all-bytes from-sub-err))))
(with-current-directory
tempdir
(lambda ()
(for-each (lambda (entry)
(let ((name (car entry))
(bytes (cdr entry)))
(call-with-port
(open-binary-output-file name)
(lambda (out) (write-bytevector bytes out)))))
files)
(let ((command (append (implementation-command-line impl)
(list "main.scm")
cmdline)))
(write command)(newline)
(let-values (((from-sub to-sub sub-pid from-sub-err)
(process* (car command) (cdr command) environ)))
(write-bytevector stdin to-sub)
(close-output-port to-sub)
(set! stdout (read-all-bytes from-sub))
(set! stderr (read-all-bytes from-sub-err)))))))
(send-response
status: 'ok
headers: `((content-type ,tar-content-type))