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

Work on input tar parsing

This commit is contained in:
Lassi Kortela 2021-09-20 12:58:53 +03:00
parent dffbe974b3
commit b29504c23e
1 changed files with 18 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
eval-server.sld
View File

@ -34,24 +34,33 @@
(let ((cmdline #f) (let ((cmdline #f)
(environ #f) (environ #f)
(cwd (string->utf8 "/")) (cwd (string->utf8 "/"))
(fd0 #f)) (stdin #f))
(parameterize ((current-input-port (request-port (current-request)))) (parameterize ((current-input-port (request-port (current-request))))
(tar-for-each (tar-for-each
(lambda (entry) (lambda (entry)
(let ((name (tar-entry-name entry))) (let* ((name (tar-entry-name entry))
(bytes (read-tar-entry-bytes entry)))
(write name)(newline) (write name)(newline)
(cond ((equal? "proc/self/cmdline" name) (cond ((or (equal? "proc/" name)
(set! cmdline (read-tar-entry-bytes))) (equal? "proc/self/" name)
(equal? "proc/self/fd/" name))
#f)
((equal? "proc/self/cmdline" name)
(set! cmdline bytes))
((equal? "proc/self/environ" name) ((equal? "proc/self/environ" name)
(set! stdin (read-tar-entry-bytes))) (set! stdin bytes))
((equal? "proc/self/cwd" name) ((equal? "proc/self/cwd" name)
(set! stdin (read-tar-entry-bytes))) (set! stdin bytes))
((equal? "proc/self/fd/0" name) ((equal? "proc/self/fd/0" name)
(set! stdin (read-tar-entry-bytes))) (set! stdin bytes))
((string-prefix? "proc/self/fd/" name) ((string-prefix? "proc/self/fd/" name)
(error "Bad file descriptor on input")) (error "Bad proc/self/fd/ on input" name))
((or (equal? "proc" name) (string-prefix? "proc/" name)) ((string-prefix? "proc/" name)
(error "Bad /proc entry on input"))))))) (error "Bad /proc entry on input")))))))
(write `(cmdline ,cmdline))(newline)
(write `(environ ,environ))(newline)
(write `(cwd ,cwd))(newline)
(write `(stdin ,stdin))(newline)
(send-response (send-response
status: 'ok status: 'ok
headers: `((content-type ,tar-content-type)) headers: `((content-type ,tar-content-type))