From dac88129b1f071397d215f098e259e78cc836734 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Sat, 28 Oct 2023 07:56:30 +0000 Subject: [PATCH] More docs --- doc/reference/std/cli/print-exit.md | 11 +++-- doc/reference/std/cli/shell.md | 65 +++++++++++++++++++++++++ doc/reference/std/errors.md | 53 ++++++++++++++++++++- src/std/cli/getopt.ss | 73 ++++++++++++++--------------- src/std/cli/shell-test.ss | 3 +- src/std/error.ss | 42 ++++++++++------- 6 files changed, 186 insertions(+), 61 deletions(-) diff --git a/doc/reference/std/cli/print-exit.md b/doc/reference/std/cli/print-exit.md index c5aa75af88..4bd75fdb0f 100644 --- a/doc/reference/std/cli/print-exit.md +++ b/doc/reference/std/cli/print-exit.md @@ -4,15 +4,15 @@ The `:std/cli/print-exit` module helps you write functions that can be invoked either from the Scheme REPL or the Unix CLI, and in either case will print their computation results after their invocation. +::: tip usage +(import :std/cli/print-exit) +::: + The facilities are named in a way reminiscent of REPL (Read-Eval-Print-Loop), except that instead of a form being Read and Eval'ed, a function is called or a body is evaluated as in `begin`, and after the Print part we Exit rather than Loop. -::: tip usage -(import :std/cli/print-exit) -::: - ## Interface ### value-printer @@ -86,7 +86,8 @@ and `(values)` is the silent false exit returned if it is false. Call a function, print the resulting values (if applicable), and exit with an according exit code, as per `print-exit`. If an error occurs during execution, -abort with an error code as per `with-abort-on-error`. +exit with an error code as per +[`with-exit-on-error`](../misc/error.md#with-exit-on-error). ### begin-print-exit ```scheme diff --git a/doc/reference/std/cli/shell.md b/doc/reference/std/cli/shell.md index b854ad35d9..8947547eca 100644 --- a/doc/reference/std/cli/shell.md +++ b/doc/reference/std/cli/shell.md @@ -24,4 +24,69 @@ This include alphanumeric characters and those in `"@%-_=+:,./"` All other ASCII characters may require the string to be quoted. For good measure we also quote strings containing non-ASCII characters. +::: tip Examples: +``` scheme +> (string-for-each (lambda (c) (or (easy-shell-character? c) (error "foo"))) + "abcdefghijklmnopqrstuvwxzABCDEFGHIJKLMNOPQRSTUVWXZ012345678@%-_=+:,./") ;; no error +> (string-for-each (lambda (c) (or (not (easy-shell-character? c)) (error "foo"))) + "!`~#$^&*()[{]}\\|;'\"<>? \r\n\t\v") ;; no error either +``` +::: + +### needs-shell-escape? +```scheme +(needs-shell-escape? string) => bool +``` +Returns true if the `string` is known not to require quoting in a Unix shell. + +The current implementation only trusts strings where every character +satisfies `easy-shell-character?` to not require quoting. +::: tip Examples: +``` scheme +> (map needs-shell-escape ["foo?" "~user" "$1" "*.*" "!1" "ab\\cd" "{}" "a;b" "&" "|" "a b c"]) +(#t #t #t #t #t #t #t #t #t #t #t) +> (map needs-shell-escape ["foo" "%-_=+:,./" "1" "..." "abcd" "x=y:z,t.z/u+v_w"]) +(#f #f #f #f #f #f) +``` +::: + +### escape-shell-token +```scheme +(escape-shell-token string) => shell-escaped-string +``` +Given a `string`, returns a shell-escaped-string that, +when included in a Unix shell command, will expand into the input `string`. + +::: tip Examples: +``` scheme +> (map escape-shell-token ["foo?" "~user" "$1" "*.*" "!1" "ab\\cd" "{}" "a;b" "&" "|" "a b c"]) +("\"foo?\"" "\"~user\"" "\"\\$1\"" "\"*.*\"" "\"!1\"" "\"ab\\\\cd\"" "\"{}\"" "\"a;b\"" "\"&\"" "\"|\"" "\"a b c\"") +> (let (l ["foo" "%-_=+:,./" "1" "..." "abcd" "x=y:z,t.z/u+v_w"]) + (equal? l (map escape-shell-token l))) +#t +``` +::: + +### ->envvar +```scheme +(->envvar . str) => environment-variable-name +``` +Given a list of arguments `str`, return a string to be used as +a shell environment variable name following the convention of having +only upper-case ASCII letters and digits and underscores. + +The arguments are passed to `as-string` then uppercased, and +any non-empty sequence of characters other than letters and digits +are replaced by a single underscore. + +::: tip Examples: +``` scheme +> (->envvar "foo") +"FOO" +> (->envvar "bar baz") +"BAR_BAZ" +> (->envvar '("bar " "+!@#$") #(#\@ #\! "#") "baz") +"BAR_BAZ" +``` +::: diff --git a/doc/reference/std/errors.md b/doc/reference/std/errors.md index 9c5aee9a1a..93f9c92139 100644 --- a/doc/reference/std/errors.md +++ b/doc/reference/std/errors.md @@ -426,7 +426,23 @@ displaying the exception with `display-exception`). ``` Invokes `thunk` with an exception handler that dumps the exception -stack trace with `dump-stack-trace!`. +stack trace with `dump-stack-trace!` +if `(dump-stack-trace?)` is true (the default). + +### dump-stack-trace? +```scheme +(define dump-stack-trace? (make-parameter #t)) +``` +A parameter that controls whether `with-exception-stack-trace` +will actually dump a stack trace to standard error. + +You can `(dump-stack-trace? #f)` +or locally `(parameterize ((dump-stack-trace? #f)) ...)` +to disable this stack trace dump, +in case you are building a program for end-users rather than for developers, +and want to control what limited error output they see. +Or you can re-enable them based on a debug flag at the CLI +in cases you want them to provide you with extra debugging information. ### dump-stack-trace! ```scheme @@ -435,3 +451,38 @@ stack trace with `dump-stack-trace!`. Displays the exception `exn`, dumping the stack trace of continuation `cont` if there is no stack trace information in the exception itself. + +### exit-with-error +```scheme +(exit-with-error exception) => [exit] +``` +Display the `exception` to current error port and exit with error code 2. + +### exit-on-error? +```scheme +(def exit-on-error? (make-parameter #t)) +``` +This parameter controls whether `call-with-exit-on-error`, `with-exit-on-error`, +`call-with-getopt`, and any function that indirectly uses them, +will exit if an error is caught, rather than pass on the error +and return to the REPL (or let a more fundamental function exit). + +### call-with-exit-on-error +```scheme +(call-with-exit-on-error thunk) +``` +Calls the `thunk` in an environment wherein if an error is caught and +`(exit-on-error)` is true, `exit-with-error` will be called, +causing an error message to be printed and the process to exit with exit code 2. +If `(exit-on-error)` is false, the error will simply be raised again. + +This mechanism enables users to modify the parameter +(e.g. via a flag passed at the Unix CLI or a change made at the Scheme REPL) +and control whether to exit with an error (e.g. for end-users) +or enter a debugger REPL (e.g. for developers). + +### with-exit-on-error +```scheme +(with-exit-on-error body ...) +``` +Evaluates the `body` as in a `thunk` passed to `call-with-exit-on-error`. diff --git a/src/std/cli/getopt.ss b/src/std/cli/getopt.ss index 05e5251dff..a646bd9d81 100644 --- a/src/std/cli/getopt.ss +++ b/src/std/cli/getopt.ss @@ -378,49 +378,46 @@ (def (call-with-getopt proc args program: program help: (help #f) - exit-on-error: (exit-on-error? #t) + exit-on-error: (exit? (exit-on-error?)) . gopts) (def (parse! gopt return) (try (getopt-parse gopt args) - (catch (getopt-error? exn) - (getopt-display-help exn program (current-error-port)) - (if exit-on-error? - (exit 1) - (return 'error))) (catch (e) - (display-exception e (current-error-port)) - (if exit-on-error? - (exit 2) - (return 'error))))) - - (let/cc return - (let* ((gopt (apply getopt help: help gopts)) - (cmds (!getopt-cmds gopt))) - (if (null? cmds) - ;; it only has options; add -h/--help - (let ((help-flag - (flag 'help "-h" "--help" - help: "display help")) - (opts (!getopt-opts gopt))) - (if (null? opts) - (set! (!getopt-opts gopt) - [help-flag]) - (set-cdr! (last-pair opts) - [help-flag])) - (let (opt (parse! gopt return)) - (if (hash-get opt 'help) - (getopt-display-help gopt program) - (proc opt)))) - ;; it has commands; add help - (let (help-cmd - (command 'help help: "display help; help for command help" - (optional-argument 'command value: string->symbol))) - (set-cdr! (last-pair cmds) [help-cmd]) - (let ((values cmd opt) (parse! gopt return)) - (if (eq? cmd 'help) - (getopt-display-help-topic gopt (hash-get opt 'command) program) - (proc cmd opt)))))))) + (cond + ((not exit?) (raise e)) + ((getopt-error? exn) + (getopt-display-help exn program (current-error-port)) + (exit 1)) + (else + (exit-with-error e)))))) + + (let* ((gopt (apply getopt help: help gopts)) + (cmds (!getopt-cmds gopt))) + (if (null? cmds) + ;; it only has options; add -h/--help + (let ((help-flag + (flag 'help "-h" "--help" + help: "display help")) + (opts (!getopt-opts gopt))) + (if (null? opts) + (set! (!getopt-opts gopt) + [help-flag]) + (set-cdr! (last-pair opts) + [help-flag])) + (let (opt (parse! gopt)) + (if (hash-get opt 'help) + (getopt-display-help gopt program) + (proc opt)))) + ;; it has commands; add help + (let (help-cmd + (command 'help help: "display help; help for command help" + (optional-argument 'command value: string->symbol))) + (set-cdr! (last-pair cmds) [help-cmd]) + (let ((values cmd opt) (parse! gopt)) + (if (eq? cmd 'help) + (getopt-display-help-topic gopt (hash-get opt 'command) program) + (proc cmd opt))))))) (def (getopt-parse->positional-arguments! gopt h) (defvalues (names rest-name) (getopt->positional-names gopt)) diff --git a/src/std/cli/shell-test.ss b/src/std/cli/shell-test.ss index 0c218a3ebe..ff0a952b77 100644 --- a/src/std/cli/shell-test.ss +++ b/src/std/cli/shell-test.ss @@ -32,4 +32,5 @@ (defrule (checks (s e) ...) (begin (check (->envvar s) => e) ...)) (checks ("foo" "FOO") - ("bar baz" "BAR_BAZ"))))) + ("bar baz" "BAR_BAZ")) + (check (->envvar '("bar " "+!@#$") #(#\@ #\! "#") "baz") => "BAR_BAZ")))) diff --git a/src/std/error.ss b/src/std/error.ss index d9c1b568d5..89276f8864 100644 --- a/src/std/error.ss +++ b/src/std/error.ss @@ -31,9 +31,10 @@ with-exception-stack-trace dump-stack-trace? dump-stack-trace! - abort-on-error? - call-with-abort-on-error - with-abort-on-error) + exit-with-error + exit-on-error? + call-with-exit-on-error + with-exit-on-error) ;; utility macro for definint error classes (defsyntax (deferror-class stx) @@ -357,21 +358,30 @@ (wrong-processor-c-return-exception?)) -(def abort-on-error? (make-parameter #t)) - -(def (call-with-abort-on-error thunk) +(def exit-on-error? (make-parameter #t)) + +(def (exit-with-error e) + (def port (current-error-port)) + (ignore-errors (force-output port)) + (ignore-errors (display-build-manifest build-manifest port)) + (ignore-errors (newline port)) + (ignore-errors (display-exception e port)) + ;; If the stack trace was printed, making the message out of reach of the user, + ;; then redundantly print the error message at the bottom without the stack trace. + (ignore-errors + (when (and (dump-stack-trace?) (StackTrace? e)) + (parameterize ((dump-stack-trace? #f)) + (display-exception e port)))) + (ignore-errors (force-output port)) + (exit 2)) + +(def (call-with-exit-on-error thunk) (with-catch (lambda (e) - (if (abort-on-error?) - (let (port (current-error-port)) - (with-catch void (cut force-output port)) - ;;(show-build-manifest all?: #t port: port) - (parameterize ((dump-stack-trace? #f)) - (display-exception e port)) - (force-output port) - (exit 2)) + (if (exit-on-error?) + (exit-with-error e) (raise e))) thunk)) -(defrules with-abort-on-error () - ((_ body ...) (call-with-abort-on-error (lambda () body ...)))) +(defrules with-exit-on-error () + ((_ body ...) (call-with-exit-on-error (lambda () body ...))))