fix: l command infinite loop, in-place data loss, range semantics, q/Q commit, octal format, undefined labels
ober
7d480d1b0a1faf9252d8005355f9adeb2e250ce8
--- a/lib/sed/engine.sls +++ b/lib/sed/engine.sls @@ -291,15 +291,19 @@ (hashtable-set! range-states pc (cons #f #t)) (hashtable-set! range-states pc (cons #t #f))) #t) - (let ([start-m? - (if (and (sed-addr-line? start) (fx= 0 (sed-addr-line-n start))) - (fx<= (sed-state-line-num state) 1) - (addr-primitive-matches? start state))]) + (let* ([start-zero? + (and (sed-addr-line? start) (fx= 0 (sed-addr-line-n start)))] + [start-m? + (if start-zero? + (fx<= (sed-state-line-num state) 1) + (addr-primitive-matches? start state))]) (when start-m? - (let ([end-m? (addr-primitive-matches? end state)]) - (if end-m? - (hashtable-set! range-states pc (cons #f #t)) - (hashtable-set! range-states pc (cons #t #f))))) + (if (and (sed-addr-regex? end) (not start-zero?)) + (hashtable-set! range-states pc (cons #t #f)) + (let ([end-m? (addr-primitive-matches? end state)]) + (if end-m? + (hashtable-set! range-states pc (cons #f #t)) + (hashtable-set! range-states pc (cons #t #f)))))) start-m?))]) (if (sed-range-addr-negated? addr) (not result) result))] [else #f])) @@ -475,7 +479,8 @@ ;;; l command: print unambiguously (define (do-l-cmd! state width out-port) - (let ([ps (sed-state-pattern-space state)]) + (let ([width (max 3 width)] + [ps (sed-state-pattern-space state)]) (let loop ([i 0] [col 0] [line-buf (open-output-string)]) (define (flush-line!) (put-string out-port (get-output-string line-buf)) @@ -493,14 +498,14 @@ [(char=? c (integer->char 13)) "\\r"] [(fx< (char->integer c) 32) (let ([n (char->integer c)]) - (string-append "\\0" + (string-append "\\" (number->string (fxquotient n 64)) (number->string (fxquotient (fxmod n 64) 8)) (number->string (fxmod n 8))))] [(fx= (char->integer c) 127) "\\177"] [else (string c)])] [rlen (string-length repr)]) - (if (fx>= (fx+ col rlen) (fx- width 1)) + (if (and (fx> col 0) (fx>= (fx+ col rlen) (fx- width 1))) (begin (flush-line!) (loop i 0 (open-output-string))) @@ -796,7 +801,9 @@ (if (string=? label "") 'end-cycle (let ([target (hashtable-ref labels label #f)]) - (if target (cons 'branch target) 'end-cycle))))] + (if target + (cons 'branch target) + (error 'sed "can't find label for jump" label)))))] ;; t: branch if sub succeeded [(sed-cmd-t? cmd) (if (sed-state-sub-succeeded? state) @@ -806,7 +813,9 @@ (if (string=? label "") 'end-cycle (let ([target (hashtable-ref labels label #f)]) - (if target (cons 'branch target) 'end-cycle))))) + (if target + (cons 'branch target) + (error 'sed "can't find label for jump" label)))))) 'continue)] ;; T: branch if sub NOT succeeded [(sed-cmd-T? cmd) @@ -815,7 +824,9 @@ (if (string=? label "") 'end-cycle (let ([target (hashtable-ref labels label #f)]) - (if target (cons 'branch target) 'end-cycle)))) + (if target + (cons 'branch target) + (error 'sed "can't find label for jump" label))))) 'continue)] ;; s [(sed-cmd-s? cmd) --- a/lib/sed/main.sls +++ b/lib/sed/main.sls @@ -111,8 +111,6 @@ (loop rest scripts files suppress? #t in-place sandbox? null-data? separate?)] [(string=? arg "--sandbox") (loop rest scripts files suppress? extended? in-place #t null-data? separate?)] - [(or (string=? arg "--null-data") (string=? arg "-z")) - (loop rest scripts files suppress? extended? in-place sandbox? #t separate?)] [(or (string=? arg "--separate") (string=? arg "-s")) (loop rest scripts files suppress? extended? in-place sandbox? null-data? #t)] [(or (string=? arg "--posix") (string=? arg "--follow-symlinks")) @@ -158,8 +156,6 @@ (re-parse rest scripts files suppress? #t in-place sandbox? null-data? separate? tail)] [(#\s) (re-parse rest scripts files suppress? extended? in-place sandbox? null-data? #t tail)] - [(#\z) - (re-parse rest scripts files suppress? extended? in-place sandbox? #t separate? tail)] [(#\e) (if (string=? tail "") (if (null? rest) @@ -223,8 +219,6 @@ (loop rest scripts files suppress? #t in-place sandbox? null-data? separate?)] [(string=? arg "--sandbox") (loop rest scripts files suppress? extended? in-place #t null-data? separate?)] - [(or (string=? arg "--null-data") (string=? arg "-z")) - (loop rest scripts files suppress? extended? in-place sandbox? #t separate?)] [(or (string=? arg "--separate") (string=? arg "-s")) (loop rest scripts files suppress? extended? in-place sandbox? null-data? #t)] [(or (string=? arg "--posix") (string=? arg "--follow-symlinks")) @@ -288,8 +282,6 @@ edit files in-place (makes backup if SUFFIX supplied) -s, --separate consider files as separate rather than as a single continuous stream - -z, --null-data - separate lines by NUL characters --sandbox operate in sandbox mode --help display this help and exit --version output version information and exit @@ -329,72 +321,89 @@ (process-one-file! state prog (car lst) (fx= i (fx- n 1)) out-port) (loop (cdr lst) (fx+ i 1))))))) + (define (process-port! state prog port close-port? is-last-file? out-port) + (dynamic-wind + (lambda () #t) + (lambda () + (let ([first (read-line-or-eof port)]) + (if (eq? first 'eof) + 'done + (let ([nxt (box (read-line-or-eof port))]) + (let main-loop ([cur first]) + (if (eq? cur 'eof) + 'done + (begin + (sed-state-line-num-set! state (fx+ (sed-state-line-num state) 1)) + (sed-state-last-line?-set! state + (and (eq? (unbox nxt) 'eof) is-last-file?)) + (sed-state-pattern-space-set! state cur) + (sed-state-sub-succeeded?-set! state #f) + (let cycle-loop ([start-pc 0]) + (let ([sig (run-sed-cycle-from! state prog out-port start-pc)]) + (cond + [(eq? sig 'next) + (let ([new-cur (unbox nxt)]) + (unless (eq? new-cur 'eof) + (set-box! nxt (read-line-or-eof port))) + (main-loop new-cur))] + [(eq? sig 'restart) + (cycle-loop 0)] + [(and (pair? sig) (eq? (car sig) 'append-next)) + (let ([resume-pc (fx+ (cdr sig) 1)] + [next-line (unbox nxt)]) + (if (eq? next-line 'eof) + (begin + (unless (sed-state-suppress? state) + (put-string out-port (sed-state-pattern-space state)) + (newline out-port)) + (flush-append-queue! state out-port) + 'done) + (begin + (sed-state-line-num-set! state + (fx+ (sed-state-line-num state) 1)) + (set-box! nxt (read-line-or-eof port)) + (sed-state-last-line?-set! state + (and (eq? (unbox nxt) 'eof) is-last-file?)) + (sed-state-pattern-space-set! state + (string-append (sed-state-pattern-space state) + "\n" next-line)) + (cycle-loop resume-pc))))] + [(and (pair? sig) (eq? (car sig) 'read-next)) + (let ([resume-pc (fx+ (cdr sig) 1)] + [next-line (unbox nxt)]) + (if (eq? next-line 'eof) + 'done + (begin + (sed-state-line-num-set! state + (fx+ (sed-state-line-num state) 1)) + (set-box! nxt (read-line-or-eof port)) + (sed-state-last-line?-set! state + (and (eq? (unbox nxt) 'eof) is-last-file?)) + (sed-state-pattern-space-set! state next-line) + (sed-state-sub-succeeded?-set! state #f) + (cycle-loop resume-pc))))] + [(and (pair? sig) (eq? (car sig) 'quit)) sig] + [else + (let ([new-cur (unbox nxt)]) + (unless (eq? new-cur 'eof) + (set-box! nxt (read-line-or-eof port))) + (main-loop new-cur))])))))))))) + (lambda () + (when close-port? + (guard (e [else (void)]) + (close-input-port port)))))) + + (define (quit-signal? result) + (and (pair? result) (eq? (car result) 'quit))) + (define (process-one-file! state prog filename is-last-file? out-port) (sed-state-filename-set! state filename) (let ([port (open-file-or-stdin filename)]) (when port - (let ([first (read-line-or-eof port)]) - (unless (eq? first 'eof) - (let ([nxt (box (read-line-or-eof port))]) - (let main-loop ([cur first]) - (unless (eq? cur 'eof) - (sed-state-line-num-set! state (fx+ (sed-state-line-num state) 1)) - (sed-state-last-line?-set! state - (and (eq? (unbox nxt) 'eof) is-last-file?)) - (sed-state-pattern-space-set! state cur) - (sed-state-sub-succeeded?-set! state #f) - (let cycle-loop ([start-pc 0]) - (let ([sig (run-sed-cycle-from! state prog out-port start-pc)]) - (cond - [(eq? sig 'next) - (let ([new-cur (unbox nxt)]) - (unless (eq? new-cur 'eof) - (set-box! nxt (read-line-or-eof port))) - (main-loop new-cur))] - [(eq? sig 'restart) - (cycle-loop 0)] - [(and (pair? sig) (eq? (car sig) 'append-next)) - (let ([resume-pc (fx+ (cdr sig) 1)] - [next-line (unbox nxt)]) - (if (eq? next-line 'eof) - (begin - (unless (sed-state-suppress? state) - (put-string out-port (sed-state-pattern-space state)) - (newline out-port)) - (flush-append-queue! state out-port)) - (begin - (sed-state-line-num-set! state - (fx+ (sed-state-line-num state) 1)) - (set-box! nxt (read-line-or-eof port)) - (sed-state-last-line?-set! state - (and (eq? (unbox nxt) 'eof) is-last-file?)) - (sed-state-pattern-space-set! state - (string-append (sed-state-pattern-space state) - "\n" next-line)) - (cycle-loop resume-pc))))] - [(and (pair? sig) (eq? (car sig) 'read-next)) - (let ([resume-pc (fx+ (cdr sig) 1)] - [next-line (unbox nxt)]) - (unless (eq? next-line 'eof) - (sed-state-line-num-set! state - (fx+ (sed-state-line-num state) 1)) - (set-box! nxt (read-line-or-eof port)) - (sed-state-last-line?-set! state - (and (eq? (unbox nxt) 'eof) is-last-file?)) - (sed-state-pattern-space-set! state next-line) - (sed-state-sub-succeeded?-set! state #f) - (cycle-loop resume-pc)))] - [(and (pair? sig) (eq? (car sig) 'quit)) - (unless (string=? filename "-") - (close-input-port port)) - (exit (cdr sig))] - [else - (let ([new-cur (unbox nxt)]) - (unless (eq? new-cur 'eof) - (set-box! nxt (read-line-or-eof port))) - (main-loop new-cur))])))))))) - (when (and port (not (string=? filename "-"))) - (close-input-port port))))) + (let ([result (process-port! state prog port (not (string=? filename "-")) + is-last-file? out-port)]) + (when (quit-signal? result) + (exit (cdr result))))))) ;;; In-place editing @@ -406,9 +415,13 @@ (lambda (filename) (unless (string=? filename "-") (let ([filename (check-sed-path! 'process-in-place filename)]) - (call-with-secure-inplace-output filename suffix - (lambda (out-port) - (process-one-file! state prog filename #t out-port)))))) + (sed-state-filename-set! state filename) + (let ([result + (call-with-secure-inplace-output filename suffix + (lambda (out-port in-port) + (process-port! state prog in-port #t #t out-port)))]) + (when (quit-signal? result) + (exit (cdr result))))))) files)) ;;; Utilities --- a/lib/sed/secure-file.sls +++ b/lib/sed/secure-file.sls @@ -9,6 +9,7 @@ (define native-ready? (and (foreign-entry? "jsed_secure_inplace_begin") (foreign-entry? "jsed_secure_inplace_dup_fd") + (foreign-entry? "jsed_secure_inplace_dup_source_fd") (foreign-entry? "jsed_secure_inplace_finish") (foreign-entry? "jsed_secure_inplace_abort") (foreign-entry? "jsed_secure_inplace_close_fd"))) @@ -19,6 +20,9 @@ (define c-dup-fd (and native-ready? (foreign-procedure "jsed_secure_inplace_dup_fd" (uptr) int))) + (define c-dup-source-fd + (and native-ready? + (foreign-procedure "jsed_secure_inplace_dup_source_fd" (uptr) int))) (define c-finish (and native-ready? (foreign-procedure "jsed_secure_inplace_finish" (uptr string) int))) @@ -39,34 +43,47 @@ (dynamic-wind (lambda () #t) (lambda () - (let ([fd (c-dup-fd ctx)]) - (when (< fd 0) - (error 'jsed "cannot duplicate secure temporary descriptor" path)) - (let ([port + (let ([in-fd (c-dup-source-fd ctx)]) + (when (< in-fd 0) + (error 'jsed "cannot duplicate secure source descriptor" path)) + (let ([in-port (guard (e [else - (c-close fd) + (c-close in-fd) (raise e)]) - (open-fd-output-port fd + (open-fd-input-port in-fd (buffer-mode block) - (make-transcoder (utf-8-codec))))] - [port-open? #t] - [result #f]) - (dynamic-wind - (lambda () #t) - (lambda () - (set! result (proc port)) - (flush-output-port port)) - (lambda () - (when port-open? - ;; close(2) ownership transfers to the port exactly once. - (set! port-open? #f) - (close-port port)))) - (let ([rc (c-finish ctx (or suffix ""))]) - ;; c-finish consumes CTX on success and failure. - (set! finished? #t) - (when (< rc 0) - (error 'jsed "secure in-place commit failed" path rc))) - result))) + (make-transcoder (utf-8-codec))))]) + (let ([out-fd (c-dup-fd ctx)]) + (when (< out-fd 0) + (close-port in-port) + (error 'jsed "cannot duplicate secure temporary descriptor" path)) + (let ([out-port + (guard (e [else + (c-close out-fd) + (close-port in-port) + (raise e)]) + (open-fd-output-port out-fd + (buffer-mode block) + (make-transcoder (utf-8-codec))))] + [ports-open? #t] + [result #f]) + (dynamic-wind + (lambda () #t) + (lambda () + (set! result (proc out-port in-port)) + (flush-output-port out-port)) + (lambda () + (when ports-open? + ;; close(2) ownership transfers to the ports exactly once. + (set! ports-open? #f) + (close-port out-port) + (close-port in-port)))) + (let ([rc (c-finish ctx (or suffix ""))]) + ;; c-finish consumes CTX on success and failure. + (set! finished? #t) + (when (< rc 0) + (error 'jsed "secure in-place commit failed" path rc))) + result))))) (lambda () (unless finished? (c-abort ctx)))))) ) --- a/main.ss +++ b/main.ss @@ -106,8 +106,6 @@ (loop rest scripts files suppress? #t in-place sandbox? null-data? separate?)] [(string=? arg "--sandbox") (loop rest scripts files suppress? extended? in-place #t null-data? separate?)] - [(or (string=? arg "--null-data") (string=? arg "-z")) - (loop rest scripts files suppress? extended? in-place sandbox? #t separate?)] [(or (string=? arg "--separate") (string=? arg "-s")) (loop rest scripts files suppress? extended? in-place sandbox? null-data? #t)] [(or (string=? arg "--posix") (string=? arg "--follow-symlinks")) @@ -153,8 +151,6 @@ (re-parse rest scripts files suppress? #t in-place sandbox? null-data? separate? tail)] [(#\s) (re-parse rest scripts files suppress? extended? in-place sandbox? null-data? #t tail)] - [(#\z) - (re-parse rest scripts files suppress? extended? in-place sandbox? #t separate? tail)] [(#\e) (if (string=? tail "") (if (null? rest) @@ -218,8 +214,6 @@ (loop rest scripts files suppress? #t in-place sandbox? null-data? separate?)] [(string=? arg "--sandbox") (loop rest scripts files suppress? extended? in-place #t null-data? separate?)] - [(or (string=? arg "--null-data") (string=? arg "-z")) - (loop rest scripts files suppress? extended? in-place sandbox? #t separate?)] [(or (string=? arg "--separate") (string=? arg "-s")) (loop rest scripts files suppress? extended? in-place sandbox? null-data? #t)] [(or (string=? arg "--posix") (string=? arg "--follow-symlinks")) @@ -283,8 +277,6 @@ edit files in-place (makes backup if SUFFIX supplied) -s, --separate consider files as separate rather than as a single continuous stream - -z, --null-data - separate lines by NUL characters --sandbox operate in sandbox mode --help display this help and exit --version output version information and exit @@ -324,72 +316,89 @@ (process-one-file! state prog (car lst) (fx= i (fx- n 1)) out-port) (loop (cdr lst) (fx+ i 1))))))) +(define (process-port! state prog port close-port? is-last-file? out-port) + (dynamic-wind + (lambda () #t) + (lambda () + (let ([first (read-line-or-eof port)]) + (if (eq? first 'eof) + 'done + (let ([nxt (box (read-line-or-eof port))]) + (let main-loop ([cur first]) + (if (eq? cur 'eof) + 'done + (begin + (sed-state-line-num-set! state (fx+ (sed-state-line-num state) 1)) + (sed-state-last-line?-set! state + (and (eq? (unbox nxt) 'eof) is-last-file?)) + (sed-state-pattern-space-set! state cur) + (sed-state-sub-succeeded?-set! state #f) + (let cycle-loop ([start-pc 0]) + (let ([sig (run-sed-cycle-from! state prog out-port start-pc)]) + (cond + [(eq? sig 'next) + (let ([new-cur (unbox nxt)]) + (unless (eq? new-cur 'eof) + (set-box! nxt (read-line-or-eof port))) + (main-loop new-cur))] + [(eq? sig 'restart) + (cycle-loop 0)] + [(and (pair? sig) (eq? (car sig) 'append-next)) + (let ([resume-pc (fx+ (cdr sig) 1)] + [next-line (unbox nxt)]) + (if (eq? next-line 'eof) + (begin + (unless (sed-state-suppress? state) + (put-string out-port (sed-state-pattern-space state)) + (newline out-port)) + (flush-append-queue! state out-port) + 'done) + (begin + (sed-state-line-num-set! state + (fx+ (sed-state-line-num state) 1)) + (set-box! nxt (read-line-or-eof port)) + (sed-state-last-line?-set! state + (and (eq? (unbox nxt) 'eof) is-last-file?)) + (sed-state-pattern-space-set! state + (string-append (sed-state-pattern-space state) + "\n" next-line)) + (cycle-loop resume-pc))))] + [(and (pair? sig) (eq? (car sig) 'read-next)) + (let ([resume-pc (fx+ (cdr sig) 1)] + [next-line (unbox nxt)]) + (if (eq? next-line 'eof) + 'done + (begin + (sed-state-line-num-set! state + (fx+ (sed-state-line-num state) 1)) + (set-box! nxt (read-line-or-eof port)) + (sed-state-last-line?-set! state + (and (eq? (unbox nxt) 'eof) is-last-file?)) + (sed-state-pattern-space-set! state next-line) + (sed-state-sub-succeeded?-set! state #f) + (cycle-loop resume-pc))))] + [(and (pair? sig) (eq? (car sig) 'quit)) sig] + [else + (let ([new-cur (unbox nxt)]) + (unless (eq? new-cur 'eof) + (set-box! nxt (read-line-or-eof port))) + (main-loop new-cur))])))))))))) + (lambda () + (when close-port? + (guard (e [else (void)]) + (close-input-port port)))))) + +(define (quit-signal? result) + (and (pair? result) (eq? (car result) 'quit))) + (define (process-one-file! state prog filename is-last-file? out-port) (sed-state-filename-set! state filename) (let ([port (open-file-or-stdin filename)]) (when port - (let ([first (read-line-or-eof port)]) - (unless (eq? first 'eof) - (let ([nxt (box (read-line-or-eof port))]) - (let main-loop ([cur first]) - (unless (eq? cur 'eof) - (sed-state-line-num-set! state (fx+ (sed-state-line-num state) 1)) - (sed-state-last-line?-set! state - (and (eq? (unbox nxt) 'eof) is-last-file?)) - (sed-state-pattern-space-set! state cur) - (sed-state-sub-succeeded?-set! state #f) - (let cycle-loop ([start-pc 0]) - (let ([sig (run-sed-cycle-from! state prog out-port start-pc)]) - (cond - [(eq? sig 'next) - (let ([new-cur (unbox nxt)]) - (unless (eq? new-cur 'eof) - (set-box! nxt (read-line-or-eof port))) - (main-loop new-cur))] - [(eq? sig 'restart) - (cycle-loop 0)] - [(and (pair? sig) (eq? (car sig) 'append-next)) - (let ([resume-pc (fx+ (cdr sig) 1)] - [next-line (unbox nxt)]) - (if (eq? next-line 'eof) - (begin - (unless (sed-state-suppress? state) - (put-string out-port (sed-state-pattern-space state)) - (newline out-port)) - (flush-append-queue! state out-port)) - (begin - (sed-state-line-num-set! state - (fx+ (sed-state-line-num state) 1)) - (set-box! nxt (read-line-or-eof port)) - (sed-state-last-line?-set! state - (and (eq? (unbox nxt) 'eof) is-last-file?)) - (sed-state-pattern-space-set! state - (string-append (sed-state-pattern-space state) - "\n" next-line)) - (cycle-loop resume-pc))))] - [(and (pair? sig) (eq? (car sig) 'read-next)) - (let ([resume-pc (fx+ (cdr sig) 1)] - [next-line (unbox nxt)]) - (unless (eq? next-line 'eof) - (sed-state-line-num-set! state - (fx+ (sed-state-line-num state) 1)) - (set-box! nxt (read-line-or-eof port)) - (sed-state-last-line?-set! state - (and (eq? (unbox nxt) 'eof) is-last-file?)) - (sed-state-pattern-space-set! state next-line) - (sed-state-sub-succeeded?-set! state #f) - (cycle-loop resume-pc)))] - [(and (pair? sig) (eq? (car sig) 'quit)) - (unless (string=? filename "-") - (close-input-port port)) - (exit (cdr sig))] - [else - (let ([new-cur (unbox nxt)]) - (unless (eq? new-cur 'eof) - (set-box! nxt (read-line-or-eof port))) - (main-loop new-cur))])))))))) - (when (and port (not (string=? filename "-"))) - (close-input-port port))))) + (let ([result (process-port! state prog port (not (string=? filename "-")) + is-last-file? out-port)]) + (when (quit-signal? result) + (exit (cdr result))))))) ;;; In-place editing @@ -401,9 +410,13 @@ (lambda (filename) (unless (string=? filename "-") (let ([filename (check-sed-path! 'process-in-place filename)]) - (call-with-secure-inplace-output filename suffix - (lambda (out-port) - (process-one-file! state prog filename #t out-port)))))) + (sed-state-filename-set! state filename) + (let ([result + (call-with-secure-inplace-output filename suffix + (lambda (out-port in-port) + (process-port! state prog in-port #t #t out-port)))]) + (when (quit-signal? result) + (exit (cdr result))))))) files)) ;;; Utilities --- a/support/ffi-symbols.list +++ b/support/ffi-symbols.list @@ -1,6 +1,7 @@ # Native in-place-edit helper linked by .jerbuild. jsed_secure_inplace_begin jsed_secure_inplace_dup_fd +jsed_secure_inplace_dup_source_fd jsed_secure_inplace_finish jsed_secure_inplace_abort jsed_secure_inplace_close_fd --- a/support/secure-inplace.c +++ b/support/secure-inplace.c @@ -258,6 +258,23 @@ int jsed_secure_inplace_dup_fd(uintptr_t handle) { return fd < 0 ? -errno : fd; } +int jsed_secure_inplace_dup_source_fd(uintptr_t handle) { + jsed_inplace_ctx *ctx = (jsed_inplace_ctx *)handle; + if (!ctx || ctx->source_fd < 0) return -EINVAL; +#ifdef F_DUPFD_CLOEXEC + int fd = fcntl(ctx->source_fd, F_DUPFD_CLOEXEC, 3); +#else + int fd = dup(ctx->source_fd); + if (fd >= 0 && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) { + int saved = errno; + (void)close_once(fd); + errno = saved; + fd = -1; + } +#endif + return fd < 0 ? -errno : fd; +} + static int suffix_valid(const char *suffix) { return suffix && !strchr(suffix, '/'); }