diff --git a/CHANGELOG.md b/CHANGELOG.md index 9005d294..e0537afe 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,22 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add `os/posix-chroot` +- Fix `ev/deadline` with interrupt race condition bug on Windows. +- Improve `flycheck` by allowing functions and macros to define their own flycheck behavior via the metadata `:flycheck`. +- Add `*flychecking*` dynamic binding to check if inside flycheck evalutation +- Add `gcperthread` callback for abstract types. This lets threaded abstracts have a finalizer that is called per thread, as well as a global finalizer. +- Add `JANET_DO_ERROR_*` flags to describe the return value of `janet_dobytes` and `janet_dostring`. + +## 1.39.1 - 2025-08-30 +- Add support for chdir in os/spawn on older macOS versions +- Expose channels properly in C API + +## 1.39.0 - 2025-08-24 +- Various bug fixes +- Add `net/socket` +- Add support for illumos OS +- Raise helpful errors for incorrect arguments to `import`. - Allow configuring `JANET_THREAD_LOCAL` during builds to allow multi-threading on unknown compilers. - Make `ffi/write` append to a buffer instead of insert at 0 by default. - Add `os/getpid` to get the current process id. diff --git a/Makefile b/Makefile index d5d1de32..950e3f5e 100644 --- a/Makefile +++ b/Makefile @@ -47,6 +47,7 @@ SPORK_TAG?=master HAS_SHARED?=1 DEBUGGER=gdb SONAME_SETTER=-Wl,-soname, +STRIPFLAGS=-x -S # For cross compilation HOSTCC?=$(CC) @@ -54,7 +55,7 @@ HOSTAR?=$(AR) # Symbols are (optionally) removed later, keep -g as default! CFLAGS?=-O0 -g LDFLAGS?=-rdynamic -LIBJANET_LDFLAGS?=$(LD_FLAGS) +LIBJANET_LDFLAGS?=$(LDFLAGS) RUN:=$(RUN) @@ -80,6 +81,12 @@ ifeq ($(UNAME), Darwin) LDCONFIG:=true else ifeq ($(UNAME), Linux) CLIBS:=$(CLIBS) -lrt -ldl +else ifeq ($(UNAME), SunOS) + BUILD_CFLAGS+=-D__EXTENSIONS__ -DJANET_NO_NANBOX + BOOT_CFLAGS+=-D__EXTENSIONS__ -DJANET_NO_NANBOX + CLIBS:=-lsocket -lm + STRIPFLAGS=-x + LDCONFIG:=false endif # For other unix likes, add flags here! @@ -217,9 +224,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile ######################## ifeq ($(UNAME), Darwin) -SONAME=libjanet.1.38.dylib +SONAME=libjanet.1.40.dylib else -SONAME=libjanet.so.1.38 +SONAME=libjanet.so.1.40 endif ifeq ($(MINGW_COMPILER), clang) @@ -293,7 +300,7 @@ build/janet-%.tar.gz: $(JANET_TARGET) \ README.md build/c/janet.c build/c/shell.c mkdir -p build/$(JANET_DIST_DIR)/bin cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/ - strip -x -S 'build/$(JANET_DIST_DIR)/bin/janet' + strip $(STRIPFLAGS) 'build/$(JANET_DIST_DIR)/bin/janet' mkdir -p build/$(JANET_DIST_DIR)/include cp build/janet.h build/$(JANET_DIST_DIR)/include/ mkdir -p build/$(JANET_DIST_DIR)/lib/ @@ -340,7 +347,7 @@ build/janet.pc: $(JANET_TARGET) install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h mkdir -p '$(DESTDIR)$(BINDIR)' cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet' - strip -x -S '$(DESTDIR)$(BINDIR)/janet' + strip $(STRIPFLAGS) '$(DESTDIR)$(BINDIR)/janet' mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet' cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet' ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h' diff --git a/README.md b/README.md index 72c25d40..8324e1dd 100644 --- a/README.md +++ b/README.md @@ -213,6 +213,10 @@ gmake install-jpm-git NetBSD build instructions are the same as the FreeBSD build instructions. Alternatively, install the package directly with `pkgin install janet`. +### illumos + +Building on illumos is exactly the same as building on FreeBSD. + ### Windows 1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#). diff --git a/build_win.bat b/build_win.bat index 5d4f23d6..bb7747bc 100644 --- a/build_win.bat +++ b/build_win.bat @@ -49,6 +49,7 @@ for %%f in (src\boot\*.c) do ( ) %JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj @if errorlevel 1 goto :BUILDFAIL +@rem note that there is no default sysroot being baked in build\janet_boot . > build\c\janet.c @if errorlevel 1 goto :BUILDFAIL diff --git a/examples/abstract-unix-socket.janet b/examples/abstract-unix-socket.janet new file mode 100644 index 00000000..e583e7a7 --- /dev/null +++ b/examples/abstract-unix-socket.janet @@ -0,0 +1,6 @@ +# Linux only - uses abstract unix domain sockets +(ev/spawn (net/server :unix "@abc123" (fn [conn] (print (:read conn 1024)) (:close conn)))) +(ev/sleep 1) +(def s (net/connect :unix "@abc123" :stream)) +(:write s "hello") +(:close s) diff --git a/examples/sample-dep1/bundle/info.jdn b/examples/sample-dep1/bundle/info.jdn index 0f61a3c1..600d99bc 100644 --- a/examples/sample-dep1/bundle/info.jdn +++ b/examples/sample-dep1/bundle/info.jdn @@ -1,4 +1,4 @@ @{ :name "sample-dep1" - :dependencies ["sample-dep2"] + :dependencies [{:name "sample-dep2"}] } diff --git a/janet.1 b/janet.1 index 9e7c0ae2..b2afd7c4 100644 --- a/janet.1 +++ b/janet.1 @@ -214,7 +214,7 @@ Don't execute a script, only compile it to check for errors. Useful for linting .BR \-m\ syspath Set the dynamic binding :syspath to the string syspath so that Janet will load system modules from a directory different than the default. The default is set when Janet is built, and defaults to -/usr/local/lib/janet on Linux/Posix, and C:/Janet/Library on Windows. This option supersedes JANET_PATH. +/usr/local/lib/janet on Linux/Posix. On Windows, there is no default value. This option supersedes JANET_PATH. .TP .BR \-c\ source\ output @@ -255,8 +255,7 @@ and then arguments to the script. .RS The location to look for Janet libraries. This is the only environment variable Janet needs to find native and source code modules. If no JANET_PATH is set, Janet will look in -the default location set at compile time. This should be a list of as well as a colon -separate list of such directories. +the default location set at compile time. This should be a colon-separated list of directory names on Linux/Posix, and a semicolon-separated list on Windows. Note that a typical setup (i.e. not NixOS / Guix) will only use a single directory. .RE .B JANET_PROFILE diff --git a/meson.build b/meson.build index 75f577bc..e5eab3ff 100644 --- a/meson.build +++ b/meson.build @@ -20,7 +20,7 @@ project('janet', 'c', default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'], - version : '1.38.0') + version : '1.40.0') # Global settings janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') @@ -285,6 +285,7 @@ test_files = [ 'test/suite-corelib.janet', 'test/suite-debug.janet', 'test/suite-ev.janet', + 'test/suite-ev2.janet', 'test/suite-ffi.janet', 'test/suite-filewatch.janet', 'test/suite-inttypes.janet', diff --git a/src/boot/boot.janet b/src/boot/boot.janet index f1e8fb8b..8e25aa38 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -7,7 +7,7 @@ ### ### -(def defn :macro +(def defn :macro :flycheck ``` (defn name & more) @@ -43,7 +43,7 @@ # Build return value ~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start))))) -(defn defmacro :macro +(defn defmacro :macro :flycheck "Define a macro." [name & more] (setdyn name @{}) # override old macro definitions in the case of a recursive macro @@ -57,12 +57,12 @@ [f & args] (f ;args)) -(defmacro defmacro- +(defmacro defmacro- :flycheck "Define a private macro that will not be exported." [name & more] (apply defn name :macro :private more)) -(defmacro defn- +(defmacro defn- :flycheck "Define a private function that will not be exported." [name & more] (apply defn name :private more)) @@ -144,7 +144,7 @@ (defmacro /= "Shorthand for (set x (/ x n))." [x & ns] ~(set ,x (,/ ,x ,;ns))) (defmacro %= "Shorthand for (set x (% x n))." [x & ns] ~(set ,x (,% ,x ,;ns))) -(defmacro assert +(defmacro assert :flycheck # should top level assert flycheck? "Throw an error if x is not truthy. Will not evaluate `err` if x is truthy." [x &opt err] (def v (gensym)) @@ -154,7 +154,7 @@ ,v (,error ,(if err err (string/format "assert failure in %j" x)))))) -(defmacro defdyn +(defmacro defdyn :flycheck ``Define an alias for a keyword that is used as a dynamic binding. The alias is a normal, lexically scoped binding that can be used instead of a keyword to prevent typos. `defdyn` does not set dynamic bindings or otherwise @@ -171,6 +171,9 @@ (defdyn *macro-form* "Inside a macro, is bound to the source form that invoked the macro") +(defdyn *flychecking* + "Check if the current form is being evaluated inside `flycheck`. Will be `true` while flychecking.") + (defdyn *lint-error* "The current lint error level. The error level is the lint level at which compilation will exit with an error and not continue.") @@ -290,22 +293,6 @@ (array/concat accum body) (tuple/slice accum 0)) -(defmacro try - ``Try something and catch errors. `body` is any expression, - and `catch` should be a form, the first element of which is a tuple. This tuple - should contain a binding for errors and an optional binding for - the fiber wrapping the body. Returns the result of `body` if no error, - or the result of `catch` if an error.`` - [body catch] - (let [[[err fib]] catch - f (gensym) - r (gensym)] - ~(let [,f (,fiber/new (fn :try [] ,body) :ie) - ,r (,resume ,f)] - (if (,= (,fiber/status ,f) :error) - (do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1)) - ,r)))) - (defmacro protect `Evaluate expressions, while capturing any errors. Evaluates to a tuple of two elements. The first element is true if successful, false if an @@ -352,6 +339,23 @@ (tuple 'if $fi $fi ret)))))) ret) +(defmacro try + ``Try something and catch errors. `body` is any expression, + and `catch` should be a form, the first element of which is a tuple. This tuple + should contain a binding for errors and an optional binding for + the fiber wrapping the body. Returns the result of `body` if no error, + or the result of `catch` if an error.`` + [body catch] + (assert (and (not (empty? catch)) (indexed? (catch 0))) "the first element of `catch` must be a tuple or array") + (let [[err fib] (catch 0) + r (or err (gensym)) + f (or fib (gensym))] + ~(let [,f (,fiber/new (fn :try [] ,body) :ie) + ,r (,resume ,f)] + (if (,= (,fiber/status ,f) :error) + (do ,;(tuple/slice catch 1)) + ,r)))) + (defmacro with-syms "Evaluates `body` with each symbol in `syms` bound to a generated, unique symbol." [syms & body] @@ -2353,7 +2357,7 @@ (set macexvar macex) -(defmacro varfn +(defmacro varfn :flycheck ``Create a function that can be rebound. `varfn` has the same signature as `defn`, but defines functions in the environment as vars. If a var `name` already exists in the environment, it is rebound to the new function. Returns @@ -3180,12 +3184,17 @@ use the name of the module as a prefix. One can also use "`:export true`" to re-export the imported symbols. If "`:exit true`" is given as an argument, any errors encountered at the top level in the module will cause `(os/exit 1)` - to be called. Dynamic bindings will NOT be imported. Use :fresh to bypass the - module cache. Use `:only [foo bar baz]` to only import select bindings into the - current environment.`` + to be called. Dynamic bindings will NOT be imported. Use :fresh with a truthy + value to bypass the module cache. Use `:only [foo bar baz]` to only import + select bindings into the current environment.`` [path & args] + (assertf (even? (length args)) "args should have even length: %n" args) (def ps (partition 2 args)) - (def argm (mapcat (fn [[k v]] [k (case k :as (string v) :only ~(quote ,v) v)]) ps)) + (def argm + (mapcat (fn [[k v]] + (assertf (keyword? k) "expected keyword, got %s: %n" (type k) k) + [k (case k :as (string v) :only ~(quote ,v) v)]) + ps)) (tuple import* (string path) ;argm)) (defmacro use @@ -3913,8 +3922,14 @@ (compwhen (dyn 'net/listen) (defn net/server - "Start a server asynchronously with `net/listen` and `net/accept-loop`. Returns the new server stream." + `` + Starts a server with `net/listen`. Runs `net/accept-loop` asynchronously if + `handler` is set and `type` is `:stream` (the default). It is invalid to set + `handler` if `type` is `:datagram`. Returns the new server stream. + `` [host port &opt handler type no-reuse] + (assert (not (and (= type :datagram) handler)) + "handler not supported for :datagram servers") (def s (net/listen host port type no-reuse)) (if handler (ev/go (fn [] (net/accept-loop s handler)))) @@ -3933,7 +3948,7 @@ [& forms] (def state (gensym)) (def loaded (gensym)) - ~((fn [] + ~((fn :delay [] (var ,state nil) (var ,loaded nil) (fn [] @@ -3965,7 +3980,7 @@ :lazy lazy :map-symbols map-symbols})) - (defmacro ffi/defbind-alias + (defmacro ffi/defbind-alias :flycheck "Generate bindings for native functions in a convenient manner. Similar to defbind but allows for the janet function name to be different than the FFI function." @@ -3976,6 +3991,8 @@ (def formal-args (map 0 arg-pairs)) (def type-args (map 1 arg-pairs)) (def computed-type-args (eval ~[,;type-args])) + (if (dyn *flychecking*) + (break ~(defn ,alias ,;meta [,;formal-args] nil))) (def {:native lib :lazy lazy :native-lazy llib @@ -3991,7 +4008,7 @@ ~(defn ,alias ,;meta [,;formal-args] (,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))) - (defmacro ffi/defbind + (defmacro ffi/defbind :flycheck "Generate bindings for native functions in a convenient manner." [name ret-type & body] ~(ffi/defbind-alias ,name ,name ,ret-type ,;body))) @@ -4002,6 +4019,51 @@ ### ### +(def- flycheck-specials @{}) + +(defn- flycheck-evaluator + `` + An evaluator function that is passed to `run-context` that lints + (flychecks) code for `flycheck`. This means code will be parsed, + compiled, and have macros expanded, but the code will not be + evaluated. + `` + [thunk source env where] + (when (and (tuple? source) (= (tuple/type source) :parens)) + (def head (source 0)) + (def entry (get env head {})) + (def fc (get flycheck-specials head (get entry :flycheck))) + (cond + # Sometimes safe form + (function? fc) + (fc thunk source env where) + # Always safe form + fc + (thunk)))) + +(defn flycheck + ``` + Check a file for errors without running the file. Found errors + will be printed to stderr in the usual format. Top level functions + and macros that have the metadata `:flycheck` will also be evaluated + during flychecking. For full control, the `:flycheck` metadata can + also be a function that takes 4 arguments - `thunk`, `source`, `env`, + and `where`, the same as the `:evaluator` argument to `run-context`. + Other arguments to `flycheck` are the same as `dofile`. Returns nil. + ``` + [path &keys kwargs] + (def mc @{}) + (def new-env (make-env (get kwargs :env))) + (put new-env *flychecking* true) + (put new-env *module-cache* @{}) + (put new-env *module-loading* @{}) + (put new-env *module-make-env* (fn :make-flycheck-env [&] (make-env new-env))) + (try + (dofile path :evaluator flycheck-evaluator ;(kvs kwargs) :env new-env) + ([e f] + (debug/stacktrace f e ""))) + nil) + (defn- no-side-effects `Check if form may have side effects. If returns true, then the src must not have side effects, such as calling a C function.` @@ -4017,59 +4079,29 @@ (all no-side-effects (values src))) true)) -(defn- is-safe-def [x] (no-side-effects (last x))) +(defn- is-safe-def [thunk source env where] + (if (no-side-effects (last source)) + (thunk))) -(def- safe-forms {'defn true 'varfn true 'defn- true 'defmacro true 'defmacro- true - 'def is-safe-def 'var is-safe-def 'def- is-safe-def 'var- is-safe-def - 'defglobal is-safe-def 'varglobal is-safe-def 'defdyn true}) - -(def- importers {'import true 'import* true 'dofile true 'require true}) -(defn- use-2 [evaluator args] - (each a args (import* (string a) :prefix "" :evaluator evaluator))) - -(defn- flycheck-evaluator - ``An evaluator function that is passed to `run-context` that lints (flychecks) code. - This means code will parsed and compiled, macros executed, but the code will not be run. - Used by `flycheck`.`` +(defn- flycheck-importer [thunk source env where] - (when (tuple? source) - (def head (source 0)) - (def safe-check - (or - (safe-forms head) - (if (symbol? head) - (if (string/has-prefix? "define-" head) is-safe-def)))) - (cond - # Sometimes safe form - (function? safe-check) - (if (safe-check source) (thunk)) - # Always safe form - safe-check - (thunk) - # Use - (= 'use head) - (use-2 flycheck-evaluator (tuple/slice source 1)) - # Import-like form - (importers head) - (let [[l c] (tuple/sourcemap source) - newtup (tuple/setmap (tuple ;source :evaluator flycheck-evaluator) l c)] - ((compile newtup env where)))))) + (let [[l c] (tuple/sourcemap source) + newtup (tuple/setmap (tuple ;source :evaluator flycheck-evaluator) l c)] + ((compile newtup env where)))) -(defn flycheck - ``Check a file for errors without running the file. Found errors will be printed to stderr - in the usual format. Macros will still be executed, however, so - arbitrary execution is possible. Other arguments are the same as `dofile`. `path` can also be - a file value such as stdin. Returns nil.`` - [path &keys kwargs] - (def old-modcache (table/clone module/cache)) - (table/clear module/cache) - (try - (dofile path :evaluator flycheck-evaluator ;(kvs kwargs)) - ([e f] - (debug/stacktrace f e ""))) - (table/clear module/cache) - (merge-into module/cache old-modcache) - nil) +(defn- flycheck-use + [thunk source env where] + (each a (drop 1 source) (import* (string a) :prefix "" :evaluator flycheck-evaluator))) + +# Add metadata to defs and import macros for flychecking +(each sym ['def 'var] + (put flycheck-specials sym is-safe-def)) +(each sym ['def- 'var- 'defglobal 'varglobal] + (put (dyn sym) :flycheck is-safe-def)) +(each sym ['import 'import* 'dofile 'require] + (put (dyn sym) :flycheck flycheck-importer)) +(each sym ['use] + (put (dyn sym) :flycheck flycheck-use)) ### ### @@ -4293,20 +4325,14 @@ "Install a bundle from the local filesystem. The name of the bundle will be inferred from the bundle, or passed as a parameter :name in `config`." [path &keys config] (def path (bundle-rpath path)) - (def clean (get config :clean)) - (def check (get config :check)) (def s (sep)) - # Check meta file for dependencies and default name - (def infofile-pre-1 (string path s "bundle" s "info.jdn")) - (def infofile-pre (if (fexists infofile-pre-1) infofile-pre-1 (string path s "info.jdn"))) # allow for alias - (var default-bundle-name nil) - (when (os/stat infofile-pre :mode) - (def info (-> infofile-pre slurp parse)) - (def deps (get info :dependencies @[])) - (set default-bundle-name (get info :name)) - (def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d))) - (when (next missing) (errorf "missing dependencies %s" (string/join missing ", ")))) - (def bundle-name (get config :name default-bundle-name)) + # Detect bundle name + (def infofile-src1 (string path s "bundle" s "info.jdn")) + (def infofile-src2 (string path s "info.jdn")) + (def infofile-src (cond (fexists infofile-src1) infofile-src1 + (fexists infofile-src2) infofile-src2)) + (def info (-?> infofile-src slurp parse)) + (def bundle-name (get config :name (get info :name))) (assertf bundle-name "unable to infer bundle name for %v, use :name argument" path) (assertf (not (string/check-set "\\/" bundle-name)) "bundle name %v cannot contain path separators" bundle-name) @@ -4316,28 +4342,32 @@ # Setup installed paths (prime-bundle-paths) (os/mkdir (bundle-dir bundle-name)) - # Aliases for common bundle/ files - (def bundle.janet (string path s "bundle.janet")) - (when (fexists bundle.janet) (copyfile bundle.janet (bundle-file bundle-name "init.janet"))) - (when (fexists infofile-pre) (copyfile infofile-pre (bundle-file bundle-name "info.jdn"))) + # Copy infofile + (def infofile-dest (bundle-file bundle-name "info.jdn")) + (when infofile-src (copyfile infofile-src infofile-dest)) + # Copy aliased initfile + (def initfile-alias (string path s "bundle.janet")) + (def initfile-dest (bundle-file bundle-name "init.janet")) + (when (fexists initfile-alias) (copyfile initfile-alias initfile-dest)) # Copy some files into the new location unconditionally (def implicit-sources (string path s "bundle")) (when (= :directory (os/stat implicit-sources :mode)) (copyrf implicit-sources (bundle-dir bundle-name))) (def man @{:name bundle-name :local-source path :files @[]}) (merge-into man config) - (def infofile (bundle-file bundle-name "info.jdn")) - (put man :auto-remove (get config :auto-remove)) (sync-manifest man) (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) - (when (os/stat infofile :mode) - (def info (-> infofile slurp parse)) - (def deps (get info :dependencies @[])) + (when (os/stat infofile-dest :mode) + (def info (-> infofile-dest slurp parse)) + (def deps (seq [d :in (get info :dependencies @[])] + (string (if (dictionary? d) (get d :name) d)))) (def missing (filter (complement bundle/installed?) deps)) (when (next missing) (error (string "missing dependencies " (string/join missing ", ")))) (put man :dependencies deps) (put man :info info)) + (def clean (get config :clean)) + (def check (get config :check)) (def module (get-bundle-module bundle-name)) (def all-hooks (seq [[k v] :pairs module :when (symbol? k) :unless (get v :private)] (keyword k))) (put man :hooks all-hooks) @@ -4628,7 +4658,7 @@ --reinstall (-B) name : Reinstall a bundle by bundle name --uninstall (-u) name : Uninstall a bundle by bundle name --update-all (-U) : Reinstall all installed bundles - --prune (-P) : Uninstalled all bundles that are orphaned + --prune (-P) : Uninstall all bundles that are orphaned --list (-L) : List all installed bundles -- : Stop handling options ```) diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index 4accbf18..66c7284f 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -4,10 +4,10 @@ #define JANETCONF_H #define JANET_VERSION_MAJOR 1 -#define JANET_VERSION_MINOR 38 +#define JANET_VERSION_MINOR 40 #define JANET_VERSION_PATCH 0 #define JANET_VERSION_EXTRA "" -#define JANET_VERSION "1.38.0" +#define JANET_VERSION "1.40.0" /* #define JANET_BUILD "local" */ diff --git a/src/core/corelib.c b/src/core/corelib.c index 9c03f51c..4f2b5237 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -66,7 +66,7 @@ JanetModule janet_native(const char *name, const uint8_t **error) { JanetBuildConfig modconf = getter(); JanetBuildConfig host = janet_config_current(); if (host.major != modconf.major || - host.minor < modconf.minor || + host.minor != modconf.minor || host.bits != modconf.bits) { char errbuf[128]; snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)", @@ -746,6 +746,7 @@ typedef struct SandboxOption { static const SandboxOption sandbox_options[] = { {"all", JANET_SANDBOX_ALL}, + {"chroot", JANET_SANDBOX_CHROOT}, {"env", JANET_SANDBOX_ENV}, {"ffi", JANET_SANDBOX_FFI}, {"ffi-define", JANET_SANDBOX_FFI_DEFINE}, @@ -771,6 +772,7 @@ JANET_CORE_FN(janet_core_sandbox, "Disable feature sets to prevent the interpreter from using certain system resources. " "Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n" "* :all - disallow all (except IO to stdout, stderr, and stdin)\n" + "* :chroot - disallow calling `os/posix-chroot`\n" "* :env - disallow reading and write env variables\n" "* :ffi - disallow FFI (recommended if disabling anything else)\n" "* :ffi-define - disallow loading new FFI modules and binding new functions\n" diff --git a/src/core/ev.c b/src/core/ev.c index 96154731..5e2b1044 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -117,6 +117,9 @@ typedef struct { double sec; JanetVM *vm; JanetFiber *fiber; +#ifdef JANET_WINDOWS + HANDLE cancel_event; +#endif } JanetThreadedTimeout; #define JANET_MAX_Q_CAPACITY 0x7FFFFFF @@ -604,12 +607,7 @@ void janet_ev_init_common(void) { #endif } -#ifdef JANET_WINDOWS -static VOID CALLBACK janet_timeout_stop(ULONG_PTR ptr) { - UNREFERENCED_PARAMETER(ptr); - ExitThread(0); -} -#elif JANET_ANDROID +#if JANET_ANDROID static void janet_timeout_stop(int sig_num) { if (sig_num == SIGUSR1) { pthread_exit(0); @@ -620,9 +618,14 @@ static void janet_timeout_stop(int sig_num) { static void handle_timeout_worker(JanetTimeout to, int cancel) { if (!to.has_worker) return; #ifdef JANET_WINDOWS - QueueUserAPC(janet_timeout_stop, to.worker, 0); + if (cancel && to.worker_event) { + SetEvent(to.worker_event); + } WaitForSingleObject(to.worker, INFINITE); CloseHandle(to.worker); + if (to.worker_event) { + CloseHandle(to.worker_event); + } #else #ifdef JANET_ANDROID if (cancel) janet_assert(!pthread_kill(to.worker, SIGUSR1), "pthread_kill"); @@ -692,10 +695,20 @@ static void janet_timeout_cb(JanetEVGenericMessage msg) { static DWORD WINAPI janet_timeout_body(LPVOID ptr) { JanetThreadedTimeout tto = *(JanetThreadedTimeout *)ptr; janet_free(ptr); - SleepEx((DWORD)(tto.sec * 1000), TRUE); - JanetEVGenericMessage msg = {0}; - janet_ev_post_event(tto.vm, janet_timeout_cb, msg); - janet_interpreter_interrupt(tto.vm); + JanetTimestamp wait_begin = ts_now(); + DWORD duration = (DWORD)round(tto.sec * 1000); + DWORD res = WAIT_TIMEOUT; + JanetTimestamp wait_end = ts_now(); + for (size_t i = 1; res == WAIT_TIMEOUT && (wait_end - wait_begin) < duration; i++) { + res = WaitForSingleObject(tto.cancel_event, (duration + i)); + wait_end = ts_now(); + } + /* only send interrupt message if result is WAIT_TIMEOUT */ + if (res == WAIT_TIMEOUT) { + janet_interpreter_interrupt(tto.vm); + JanetEVGenericMessage msg = {0}; + janet_ev_post_event(tto.vm, janet_timeout_cb, msg); + } return 0; } #else @@ -716,9 +729,9 @@ static void *janet_timeout_body(void *ptr) { ? (long)((tto.sec - ((uint32_t)tto.sec)) * 1000000000) : 0; nanosleep(&ts, &ts); + janet_interpreter_interrupt(tto.vm); JanetEVGenericMessage msg = {0}; janet_ev_post_event(tto.vm, janet_timeout_cb, msg); - janet_interpreter_interrupt(tto.vm); return NULL; } #endif @@ -838,6 +851,34 @@ static int janet_chanat_gc(void *p, size_t s) { return 0; } +static void janet_chanat_remove_vmref(JanetQueue *fq) { + JanetChannelPending *pending = fq->data; + if (fq->head <= fq->tail) { + for (int32_t i = fq->head; i < fq->tail; i++) { + if (pending[i].thread == &janet_vm) pending[i].thread = NULL; + } + } else { + for (int32_t i = fq->head; i < fq->capacity; i++) { + if (pending[i].thread == &janet_vm) pending[i].thread = NULL; + } + for (int32_t i = 0; i < fq->tail; i++) { + if (pending[i].thread == &janet_vm) pending[i].thread = NULL; + } + } +} + +static int janet_chanat_gcperthread(void *p, size_t s) { + (void) s; + JanetChannel *chan = p; + janet_chan_lock(chan); + /* Make sure that the internals of the threaded channel no longer reference _this_ thread. Replace + * those references with NULL. */ + janet_chanat_remove_vmref(&chan->read_pending); + janet_chanat_remove_vmref(&chan->write_pending); + janet_chan_unlock(chan); + return 0; +} + static void janet_chanat_mark_fq(JanetQueue *fq) { JanetChannelPending *pending = fq->data; if (fq->head <= fq->tail) { @@ -920,8 +961,9 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) { int is_read = (mode == JANET_CP_MODE_CHOICE_READ) || (mode == JANET_CP_MODE_READ); if (is_read) { JanetChannelPending reader; - if (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) { + while (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) { JanetVM *vm = reader.thread; + if (!vm) continue; JanetEVGenericMessage msg; msg.tag = reader.mode; msg.fiber = reader.fiber; @@ -929,11 +971,13 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) { msg.argp = channel; msg.argj = x; janet_ev_post_event(vm, janet_thread_chan_cb, msg); + break; } } else { JanetChannelPending writer; - if (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) { + while (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) { JanetVM *vm = writer.thread; + if (!vm) continue; JanetEVGenericMessage msg; msg.tag = writer.mode; msg.fiber = writer.fiber; @@ -941,6 +985,7 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) { msg.argp = channel; msg.argj = janet_wrap_nil(); janet_ev_post_event(vm, janet_thread_chan_cb, msg); + break; } } } @@ -1004,7 +1049,9 @@ static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode msg.argi = (int32_t) reader.sched_id; msg.argp = channel; msg.argj = x; - janet_ev_post_event(vm, janet_thread_chan_cb, msg); + if (vm) { + janet_ev_post_event(vm, janet_thread_chan_cb, msg); + } } else { if (reader.mode == JANET_CP_MODE_CHOICE_READ) { janet_schedule(reader.fiber, make_read_result(channel, x)); @@ -1059,7 +1106,9 @@ static int janet_channel_pop_with_lock(JanetChannel *channel, Janet *item, int i msg.argi = (int32_t) writer.sched_id; msg.argp = channel; msg.argj = janet_wrap_nil(); - janet_ev_post_event(vm, janet_thread_chan_cb, msg); + if (vm) { + janet_ev_post_event(vm, janet_thread_chan_cb, msg); + } } else { if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) { janet_schedule(writer.fiber, make_write_result(channel)); @@ -1323,7 +1372,9 @@ JANET_CORE_FN(cfun_channel_close, msg.tag = JANET_CP_MODE_CLOSE; msg.argi = (int32_t) writer.sched_id; msg.argj = janet_wrap_nil(); - janet_ev_post_event(vm, janet_thread_chan_cb, msg); + if (vm) { + janet_ev_post_event(vm, janet_thread_chan_cb, msg); + } } else { if (janet_fiber_can_resume(writer.fiber)) { if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) { @@ -1344,7 +1395,9 @@ JANET_CORE_FN(cfun_channel_close, msg.tag = JANET_CP_MODE_CLOSE; msg.argi = (int32_t) reader.sched_id; msg.argj = janet_wrap_nil(); - janet_ev_post_event(vm, janet_thread_chan_cb, msg); + if (vm) { + janet_ev_post_event(vm, janet_thread_chan_cb, msg); + } } else { if (janet_fiber_can_resume(reader.fiber)) { if (reader.mode == JANET_CP_MODE_CHOICE_READ) { @@ -1437,7 +1490,10 @@ const JanetAbstractType janet_channel_type = { NULL, /* compare */ NULL, /* hash */ janet_chanat_next, - JANET_ATEND_NEXT + NULL, /* call */ + NULL, /* length */ + NULL, /* bytes */ + janet_chanat_gcperthread }; /* Main event loop */ @@ -1690,7 +1746,7 @@ void janet_stream_level_triggered(JanetStream *stream) { static JanetTimestamp ts_now(void) { struct timespec now; - janet_assert(-1 != clock_gettime(CLOCK_MONOTONIC, &now), "failed to get time"); + janet_assert(-1 != janet_gettime(&now, JANET_TIME_MONOTONIC), "failed to get time"); uint64_t res = 1000 * now.tv_sec; res += now.tv_nsec / 1000000; return res; @@ -1848,7 +1904,7 @@ JanetTimestamp to_interval(const JanetTimestamp ts) { static JanetTimestamp ts_now(void) { struct timespec now; - janet_assert(-1 != clock_gettime(CLOCK_MONOTONIC, &now), "failed to get time"); + janet_assert(-1 != janet_gettime(&now, JANET_TIME_MONOTONIC), "failed to get time"); uint64_t res = 1000 * now.tv_sec; res += now.tv_nsec / 1000000; return res; @@ -2002,7 +2058,7 @@ void janet_ev_deinit(void) { static JanetTimestamp ts_now(void) { struct timespec now; - janet_assert(-1 != clock_gettime(CLOCK_REALTIME, &now), "failed to get time"); + janet_assert(-1 != janet_gettime(&now, JANET_TIME_MONOTONIC), "failed to get time"); uint64_t res = 1000 * now.tv_sec; res += now.tv_nsec / 1000000; return res; @@ -2174,7 +2230,7 @@ void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGenericMessage ms event.cb = cb; int fd = vm->selfpipe[1]; /* handle a bit of back pressure before giving up. */ - int tries = 4; + int tries = 20; while (tries > 0) { int status; do { @@ -3226,7 +3282,13 @@ JANET_CORE_FN(cfun_ev_deadline, tto->vm = &janet_vm; tto->fiber = tocheck; #ifdef JANET_WINDOWS - HANDLE worker = CreateThread(NULL, 0, janet_timeout_body, tto, 0, NULL); + HANDLE cancel_event = CreateEvent(NULL, TRUE, FALSE, NULL); + if (NULL == cancel_event) { + janet_free(tto); + janet_panic("failed to create cancel event"); + } + tto->cancel_event = cancel_event; + HANDLE worker = CreateThread(NULL, 0, janet_timeout_body, tto, CREATE_SUSPENDED, NULL); if (NULL == worker) { janet_free(tto); janet_panic("failed to create thread"); @@ -3241,6 +3303,10 @@ JANET_CORE_FN(cfun_ev_deadline, #endif to.has_worker = 1; to.worker = worker; +#ifdef JANET_WINDOWS + to.worker_event = cancel_event; + ResumeThread(worker); +#endif } else { to.has_worker = 0; } @@ -3535,8 +3601,6 @@ void janet_lib_ev(JanetTable *env) { janet_register_abstract_type(&janet_channel_type); janet_register_abstract_type(&janet_mutex_type); janet_register_abstract_type(&janet_rwlock_type); - - janet_lib_filewatch(env); } #endif diff --git a/src/core/filewatch.c b/src/core/filewatch.c index 7f719400..104ac832 100644 --- a/src/core/filewatch.c +++ b/src/core/filewatch.c @@ -633,7 +633,7 @@ JANET_CORE_FN(cfun_filewatch_add, "* `:modified`\n\n" "* `:renamed-old`\n\n" "* `:renamed-new`\n\n" - "On Linux, events will a `:type` corresponding to the possible flags, excluding `:all`.\n" + "On Linux, events will have a `:type` corresponding to the possible flags, excluding `:all`.\n" "") { janet_arity(argc, 2, -1); JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at); diff --git a/src/core/gc.c b/src/core/gc.c index 038c9106..028d9b2a 100644 --- a/src/core/gc.c +++ b/src/core/gc.c @@ -346,6 +346,9 @@ static void janet_deinit_block(JanetGCObject *mem) { break; case JANET_MEMORY_ABSTRACT: { JanetAbstractHead *head = (JanetAbstractHead *)mem; + if (head->type->gcperthread) { + janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed"); + } if (head->type->gc) { janet_assert(!head->type->gc(head->data, head->size), "finalizer failed"); } @@ -497,10 +500,12 @@ void janet_sweep() { /* If not visited... */ if (!janet_truthy(items[i].value)) { void *abst = janet_unwrap_abstract(items[i].key); - + JanetAbstractHead *head = janet_abstract_head(abst); + if (head->type->gcperthread) { + janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed"); + } if (0 == janet_abstract_decref(abst)) { /* Run finalizer */ - JanetAbstractHead *head = janet_abstract_head(abst); if (head->type->gc) { janet_assert(!head->type->gc(head->data, head->size), "finalizer failed"); } @@ -673,8 +678,11 @@ void janet_clear_memory(void) { for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) { if (janet_checktype(items[i].key, JANET_ABSTRACT)) { void *abst = janet_unwrap_abstract(items[i].key); + JanetAbstractHead *head = janet_abstract_head(abst); + if (head->type->gcperthread) { + janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed"); + } if (0 == janet_abstract_decref(abst)) { - JanetAbstractHead *head = janet_abstract_head(abst); if (head->type->gc) { janet_assert(!head->type->gc(head->data, head->size), "finalizer failed"); } diff --git a/src/core/net.c b/src/core/net.c index e3d3e247..a8cdf47e 100644 --- a/src/core/net.c +++ b/src/core/net.c @@ -341,7 +341,7 @@ static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) { /* Needs argc >= offset + 2 */ /* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1, * otherwise 0. Also, ignores is_bind when is a unix socket. */ -static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int socktype, int passive, int *is_unix) { +static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int socktype, int passive, int *is_unix, socklen_t *sizeout) { /* Unix socket support - not yet supported on windows. */ #ifndef JANET_WINDOWS if (janet_keyeq(argv[offset], "unix")) { @@ -352,15 +352,14 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock } saddr->sun_family = AF_UNIX; size_t path_size = sizeof(saddr->sun_path); + snprintf(saddr->sun_path, path_size, "%s", path); + *sizeout = sizeof(struct sockaddr_un); #ifdef JANET_LINUX if (path[0] == '@') { saddr->sun_path[0] = '\0'; - snprintf(saddr->sun_path + 1, path_size - 1, "%s", path + 1); - } else -#endif - { - snprintf(saddr->sun_path, path_size, "%s", path); + *sizeout = offsetof(struct sockaddr_un, sun_path) + janet_string_length(path); } +#endif *is_unix = 1; return (struct addrinfo *) saddr; } @@ -385,6 +384,11 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock janet_panicf("could not get address info: %s", gai_strerror(status)); } *is_unix = 0; +#ifdef JANET_WINDOWS + *sizeout = 0; +#else + *sizeout = sizeof(struct sockaddr_un); +#endif return ai; } @@ -405,12 +409,13 @@ JANET_CORE_FN(cfun_net_sockaddr, int socktype = janet_get_sockettype(argv, argc, 2); int is_unix = 0; int make_arr = (argc >= 3 && janet_truthy(argv[3])); - struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix); + socklen_t addrsize = 0; + struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix, &addrsize); #ifndef JANET_WINDOWS /* no unix domain socket support on windows yet */ if (is_unix) { - void *abst = janet_abstract(&janet_address_type, sizeof(struct sockaddr_un)); - memcpy(abst, ai, sizeof(struct sockaddr_un)); + void *abst = janet_abstract(&janet_address_type, addrsize); + memcpy(abst, ai, addrsize); Janet ret = janet_wrap_abstract(abst); return make_arr ? janet_wrap_array(janet_array_n(&ret, 1)) : ret; } @@ -461,7 +466,8 @@ JANET_CORE_FN(cfun_net_connect, } /* Where we're connecting to */ - struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix); + socklen_t addrlen = 0; + struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix, &addrlen); /* Check if we're binding address */ struct addrinfo *binding = NULL; @@ -486,7 +492,6 @@ JANET_CORE_FN(cfun_net_connect, /* Create socket */ JSock sock = JSOCKDEFAULT; void *addr = NULL; - socklen_t addrlen = 0; #ifndef JANET_WINDOWS if (is_unix) { sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0); @@ -496,7 +501,6 @@ JANET_CORE_FN(cfun_net_connect, janet_panicf("could not create socket: %V", v); } addr = (void *) ai; - addrlen = sizeof(struct sockaddr_un); } else #endif { @@ -543,7 +547,9 @@ JANET_CORE_FN(cfun_net_connect, } /* Wrap socket in abstract type JanetStream */ - JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE); + uint32_t udp_flag = 0; + if (socktype == SOCK_DGRAM) udp_flag = JANET_STREAM_UDPSERVER; + JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE | udp_flag); /* Set up the socket for non-blocking IO before connecting */ janet_net_socknoblock(sock); @@ -581,6 +587,56 @@ JANET_CORE_FN(cfun_net_connect, net_sched_connect(stream); } +JANET_CORE_FN(cfun_net_socket, + "(net/socket &opt type)", + "Creates a new unbound socket. Type is an optional keyword, " + "either a :stream (usually tcp), or :datagram (usually udp). The default is :stream.") { + janet_arity(argc, 0, 1); + + int socktype = janet_get_sockettype(argv, argc, 0); + + /* Create socket */ + JSock sfd = JSOCKDEFAULT; + struct addrinfo *ai = NULL; + struct addrinfo hints; + memset(&hints, 0, sizeof(hints)); + hints.ai_family = AF_UNSPEC; + hints.ai_socktype = socktype; + hints.ai_flags = 0; + int status = getaddrinfo(NULL, "0", &hints, &ai); + if (status) { + janet_panicf("could not get address info: %s", gai_strerror(status)); + } + + struct addrinfo *rp = NULL; + for (rp = ai; rp != NULL; rp = rp->ai_next) { +#ifdef JANET_WINDOWS + sfd = WSASocketW(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED); +#else + sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol); +#endif + if (JSOCKVALID(sfd)) { + break; + } + } + freeaddrinfo(ai); + + if (!JSOCKVALID(sfd)) { + Janet v = janet_ev_lasterr(); + janet_panicf("could not create socket: %V", v); + } + + /* Wrap socket in abstract type JanetStream */ + uint32_t udp_flag = 0; + if (socktype == SOCK_DGRAM) udp_flag = JANET_STREAM_UDPSERVER; + JanetStream *stream = make_stream(sfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE | udp_flag); + + /* Set up the socket for non-blocking IO */ + janet_net_socknoblock(sfd); + + return janet_wrap_abstract(stream); +} + static const char *serverify_socket(JSock sfd, int reuse_addr, int reuse_port) { /* Set various socket options */ int enable = 1; @@ -664,7 +720,8 @@ JANET_CORE_FN(cfun_net_listen, /* Get host, port, and handler*/ int socktype = janet_get_sockettype(argv, argc, 2); int is_unix = 0; - struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix); + socklen_t addrlen = 0; + struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix, &addrlen); int reuse = !(argc >= 4 && janet_truthy(argv[3])); JSock sfd = JSOCKDEFAULT; @@ -676,7 +733,7 @@ JANET_CORE_FN(cfun_net_listen, janet_panicf("could not create socket: %V", janet_ev_lasterr()); } const char *err = serverify_socket(sfd, reuse, 0); - if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) { + if (NULL != err || bind(sfd, (struct sockaddr *)ai, addrlen)) { JSOCKCLOSE(sfd); janet_free(ai); if (err) { @@ -1080,6 +1137,7 @@ void janet_lib_net(JanetTable *env) { JanetRegExt net_cfuns[] = { JANET_CORE_REG("net/address", cfun_net_sockaddr), JANET_CORE_REG("net/listen", cfun_net_listen), + JANET_CORE_REG("net/socket", cfun_net_socket), JANET_CORE_REG("net/accept", cfun_stream_accept), JANET_CORE_REG("net/accept-loop", cfun_stream_accept_loop), JANET_CORE_REG("net/read", cfun_stream_read), diff --git a/src/core/os.c b/src/core/os.c index 82a99aec..885b7b33 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -66,6 +66,8 @@ #ifdef JANET_APPLE #include #define environ (*_NSGetEnviron()) +#include +int chroot(const char *dirname); #else extern char **environ; #endif @@ -81,8 +83,14 @@ extern char **environ; #ifndef JANET_SPAWN_NO_CHDIR #ifdef __GLIBC__ #define JANET_SPAWN_CHDIR -#elif defined(JANET_APPLE) /* Some older versions may not work here. */ +#elif defined(JANET_APPLE) +/* The posix_spawn_file_actions_addchdir_np function + * has only been implemented since macOS 10.15 */ +#if defined(MAC_OS_X_VERSION_10_15) && (MAC_OS_X_VERSION_MIN_REQUIRED >= MAC_OS_X_VERSION_10_15) #define JANET_SPAWN_CHDIR +#else +#define JANET_SPAWN_NO_CHDIR +#endif #elif defined(__FreeBSD__) /* Not all BSDs work, for example openBSD doesn't seem to support this */ #define JANET_SPAWN_CHDIR #endif @@ -173,6 +181,8 @@ JANET_CORE_FN(os_which, return janet_ckeywordv("dragonfly"); #elif defined(JANET_BSD) return janet_ckeywordv("bsd"); +#elif defined(JANET_ILLUMOS) + return janet_ckeywordv("illumos"); #else return janet_ckeywordv("posix"); #endif @@ -312,6 +322,13 @@ JANET_CORE_FN(os_cpu_count, return dflt; } return janet_wrap_integer(result); +#elif defined(JANET_ILLUMOS) + (void) dflt; + long result = sysconf(_SC_NPROCESSORS_CONF); + if (result < 0) { + return dflt; + } + return janet_wrap_integer(result); #else return dflt; #endif @@ -1525,6 +1542,27 @@ JANET_CORE_FN(os_posix_fork, #endif } +JANET_CORE_FN(os_posix_chroot, + "(os/posix-chroot dirname)", + "Call `chroot` to change the root directory to `dirname`. " + "Not supported on all systems (POSIX only).") { + janet_sandbox_assert(JANET_SANDBOX_CHROOT); + janet_fixarity(argc, 1); +#ifdef JANET_WINDOWS + janet_panic("not supported on Windows"); +#else + const char *root = janet_getcstring(argv, 0); + int result; + do { + result = chroot(root); + } while (result == -1 && errno == EINTR); + if (result == -1) { + janet_panic(janet_strerror(errno)); + } + return janet_wrap_nil(); +#endif +} + #ifdef JANET_EV /* Runs in a separate thread */ static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) { @@ -2833,6 +2871,7 @@ void janet_lib_os(JanetTable *env) { JANET_CORE_REG("os/touch", os_touch), JANET_CORE_REG("os/realpath", os_realpath), JANET_CORE_REG("os/cd", os_cd), + JANET_CORE_REG("os/posix-chroot", os_posix_chroot), #ifndef JANET_NO_UMASK JANET_CORE_REG("os/umask", os_umask), #endif @@ -2863,6 +2902,9 @@ void janet_lib_os(JanetTable *env) { JANET_CORE_REG("os/proc-kill", os_proc_kill), JANET_CORE_REG("os/proc-close", os_proc_close), JANET_CORE_REG("os/getpid", os_proc_getpid), +#ifdef JANET_EV + JANET_CORE_REG("os/sigaction", os_sigaction), +#endif #endif /* high resolution timers */ @@ -2871,7 +2913,6 @@ void janet_lib_os(JanetTable *env) { #ifdef JANET_EV JANET_CORE_REG("os/open", os_open), /* fs read and write */ JANET_CORE_REG("os/pipe", os_pipe), - JANET_CORE_REG("os/sigaction", os_sigaction), #endif #endif JANET_REG_END diff --git a/src/core/pp.c b/src/core/pp.c index 618f7515..3b000f41 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -1060,19 +1060,11 @@ void janet_buffer_format( break; } case 's': { - JanetByteView bytes = janet_getbytes(argv, arg); - const uint8_t *s = bytes.bytes; - int32_t l = bytes.len; + const char *s = janet_getcbytes(argv, arg); if (form[2] == '\0') - janet_buffer_push_bytes(b, s, l); + janet_buffer_push_cstring(b, s); else { - if (l != (int32_t) strnlen((const char *) s, l)) - janet_panic("string contains zeros"); - if (!strchr(form, '.') && l >= 100) { - janet_panic("no precision and string is too long to be formatted"); - } else { - nb = snprintf(item, MAX_ITEM, form, s); - } + nb = snprintf(item, MAX_ITEM, form, s); } break; } diff --git a/src/core/run.c b/src/core/run.c index 0be7f6db..b6a78847 100644 --- a/src/core/run.c +++ b/src/core/run.c @@ -26,7 +26,8 @@ #include "state.h" #endif -/* Run a string */ +/* Run a string of code. The return value is a set of error flags, JANET_DO_ERROR_RUNTIME, JANET_DO_ERROR_COMPILE, and JANET_DOR_ERROR_PARSE if + * any errors were encountered in those phases. More information is printed to stderr. */ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) { JanetParser *parser; int errflags = 0, done = 0; @@ -55,7 +56,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret); if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) { janet_stacktrace_ext(fiber, ret, ""); - errflags |= 0x01; + errflags |= JANET_DO_ERROR_RUNTIME; done = 1; } } else { @@ -75,7 +76,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath, line, col, (const char *)cres.error); } - errflags |= 0x02; + errflags |= JANET_DO_ERROR_COMPILE; done = 1; } } @@ -89,7 +90,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char break; case JANET_PARSE_ERROR: { const char *e = janet_parser_error(parser); - errflags |= 0x04; + errflags |= JANET_DO_ERROR_PARSE; ret = janet_cstringv(e); int32_t line = (int32_t) parser->line; int32_t col = (int32_t) parser->column; diff --git a/src/core/state.h b/src/core/state.h index 918c1ade..86cc8a72 100644 --- a/src/core/state.h +++ b/src/core/state.h @@ -23,8 +23,11 @@ #ifndef JANET_STATE_H_defined #define JANET_STATE_H_defined +#ifndef JANET_AMALG +#include "features.h" #include #include +#endif #ifdef JANET_EV #ifdef JANET_WINDOWS @@ -65,6 +68,7 @@ typedef struct { int has_worker; #ifdef JANET_WINDOWS HANDLE worker; + HANDLE worker_event; #else pthread_t worker; #endif diff --git a/src/core/util.c b/src/core/util.c index db65deb2..f239d38e 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -931,27 +931,24 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source) { #include #include int janet_gettime(struct timespec *spec, enum JanetTimeSource source) { - if (source == JANET_TIME_REALTIME) { + if (source == JANET_TIME_CPUTIME) { + clock_t tmp = clock(); + spec->tv_sec = tmp / CLOCKS_PER_SEC; + spec->tv_nsec = ((tmp - (spec->tv_sec * CLOCKS_PER_SEC)) * 1000000000) / CLOCKS_PER_SEC; + } else { clock_serv_t cclock; mach_timespec_t mts; - host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock); + clock_id_t cid = CALENDAR_CLOCK; + if (source == JANET_TIME_REALTIME) { + cid = CALENDAR_CLOCK; + } else if (source == JANET_TIME_MONOTONIC) { + cid = SYSTEM_CLOCK; + } + host_get_clock_service(mach_host_self(), cid, &cclock); clock_get_time(cclock, &mts); mach_port_deallocate(mach_task_self(), cclock); spec->tv_sec = mts.tv_sec; spec->tv_nsec = mts.tv_nsec; - } else if (source == JANET_TIME_MONOTONIC) { - clock_serv_t cclock; - int nsecs; - mach_msg_type_number_t count; - host_get_clock_service(mach_host_self(), clock, &cclock); - clock_get_attributes(cclock, CLOCK_GET_TIME_RES, (clock_attr_t)&nsecs, &count); - mach_port_deallocate(mach_task_self(), cclock); - clock_getres(CLOCK_MONOTONIC, spec); - } - if (source == JANET_TIME_CPUTIME) { - clock_t tmp = clock(); - spec->tv_sec = tmp; - spec->tv_nsec = (tmp - spec->tv_sec) * 1.0e9; } return 0; } diff --git a/src/include/janet.h b/src/include/janet.h index 74d0661f..2084418a 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -77,6 +77,11 @@ extern "C" { #define JANET_CYGWIN 1 #endif +/* Check for Illumos */ +#if defined(__illumos__) +#define JANET_ILLUMOS 1 +#endif + /* Check Unix */ #if defined(_AIX) \ || defined(__APPLE__) /* Darwin */ \ @@ -162,7 +167,7 @@ extern "C" { #endif /* Check sun */ -#ifdef __sun +#if defined(__sun) && !defined(JANET_ILLUMOS) #define JANET_NO_UTC_MKTIME #endif @@ -1183,6 +1188,7 @@ struct JanetAbstractType { Janet(*call)(void *p, int32_t argc, Janet *argv); size_t (*length)(void *p, size_t len); JanetByteView(*bytes)(void *p, size_t len); + int (*gcperthread)(void *data, size_t len); }; /* Some macros to let us add extra types to JanetAbstract types without @@ -1202,7 +1208,8 @@ struct JanetAbstractType { #define JANET_ATEND_NEXT NULL,JANET_ATEND_CALL #define JANET_ATEND_CALL NULL,JANET_ATEND_LENGTH #define JANET_ATEND_LENGTH NULL,JANET_ATEND_BYTES -#define JANET_ATEND_BYTES +#define JANET_ATEND_BYTES NULL,JANET_ATEND_GCPERTHREAD +#define JANET_ATEND_GCPERTHREAD struct JanetReg { const char *name; @@ -1460,10 +1467,10 @@ JANET_API int32_t janet_abstract_incref(void *abst); JANET_API int32_t janet_abstract_decref(void *abst); /* Expose channel utilities */ -JanetChannel *janet_channel_make(uint32_t limit); -JanetChannel *janet_channel_make_threaded(uint32_t limit); -JanetChannel *janet_getchannel(const Janet *argv, int32_t n); -JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, JanetChannel *dflt); +JANET_API JanetChannel *janet_channel_make(uint32_t limit); +JANET_API JanetChannel *janet_channel_make_threaded(uint32_t limit); +JANET_API JanetChannel *janet_getchannel(const Janet *argv, int32_t n); +JANET_API JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, JanetChannel *dflt); JANET_API int janet_channel_give(JanetChannel *channel, Janet x); JANET_API int janet_channel_take(JanetChannel *channel, Janet *out); @@ -1611,6 +1618,9 @@ JANET_API JanetTable *janet_core_env(JanetTable *replacements); JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements); /* Execute strings */ +#define JANET_DO_ERROR_RUNTIME 0x01 +#define JANET_DO_ERROR_COMPILE 0x02 +#define JANET_DO_ERROR_PARSE 0x04 JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out); JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out); @@ -1889,6 +1899,7 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr #define JANET_SANDBOX_FFI_USE 2048 #define JANET_SANDBOX_FFI_JIT 4096 #define JANET_SANDBOX_SIGNAL 8192 +#define JANET_SANDBOX_CHROOT 16384 #define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT) #define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP) #define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN) diff --git a/test/suite-boot.janet b/test/suite-boot.janet index c1fb8460..b5909d31 100644 --- a/test/suite-boot.janet +++ b/test/suite-boot.janet @@ -865,6 +865,13 @@ (assert (deep= ~(,import* "a" :as "b" :fresh maybe) (macex '(import a :as b :fresh maybe))) "import macro 2") +# 2af3f21d +(assert-error "import macro 2" (macex '(import a :fresh))) +(assert-error "import macro 3" (macex '(import a :as b :fresh))) +(assert-error "import macro 4" (macex '(import b "notakeyword" value))) +(assert (deep= ~(,import* "a" :fresh nil) + (macex '(import a :fresh nil))) "import macro 5") + # #477 walk preserving bracket type # 0a1d902f4 (assert (= :brackets (tuple/type (postwalk identity '[]))) diff --git a/test/suite-ev2.janet b/test/suite-ev2.janet new file mode 100644 index 00000000..1d774b85 --- /dev/null +++ b/test/suite-ev2.janet @@ -0,0 +1,58 @@ +# Copyright (c) 2025 Calvin Rose & contributors +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to +# deal in the Software without restriction, including without limitation the +# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +# sell copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +# IN THE SOFTWARE. + +(import ./helper :prefix "" :exit true) +(start-suite) + +# Issue #1629 +(def thread-channel (ev/thread-chan 100)) +(def super (ev/thread-chan 10)) +(defn worker [] + (while true + (def item (ev/take thread-channel)) + (when (= item :deadline) + (ev/deadline 0.1 nil (fiber/current) true)))) +(ev/thread worker nil :n super) +(ev/give thread-channel :item) +(ev/sleep 0.05) +(ev/give thread-channel :item) +(ev/sleep 0.05) +(ev/give thread-channel :deadline) +(ev/sleep 0.05) +(ev/give thread-channel :item) +(ev/sleep 0.05) +(ev/give thread-channel :item) +(ev/sleep 0.15) +(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion") + +# Another variant +(def thread-channel (ev/thread-chan 100)) +(def super (ev/thread-chan 10)) +(defn worker [] + (while true + (def item (ev/take thread-channel)) + (when (= item :deadline) + (ev/deadline 0.1)))) +(ev/thread worker nil :n super) +(ev/give thread-channel :deadline) +(ev/sleep 0.2) +(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion") + +(end-suite) diff --git a/test/suite-string.janet b/test/suite-string.janet index 49c67120..a92b0eb6 100644 --- a/test/suite-string.janet +++ b/test/suite-string.janet @@ -136,5 +136,8 @@ "keyword slice") (assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice") +# Check string formatting, #1600 +(assert (= "" (string/format "%.99s" @"")) "string/format %s buffer") + (end-suite) diff --git a/tools/msi/janet.wxs b/tools/msi/janet.wxs index 1d2f60d5..d14cfa5a 100644 --- a/tools/msi/janet.wxs +++ b/tools/msi/janet.wxs @@ -37,6 +37,12 @@ Version="$(var.Version)" Manufacturer="$(var.Manufacturer)" UpgradeCode="$(var.UpgradeCode)"> +