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