1 /*
2 * Copyright (c) 2021 Calvin Rose and contributors.
3 *
4 * Permission is hereby granted, free of charge, to any person obtaining a copy
5 * of this software and associated documentation files (the "Software"), to
6 * deal in the Software without restriction, including without limitation the
7 * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
8 * sell copies of the Software, and to permit persons to whom the Software is
9 * furnished to do so, subject to the following conditions:
10 *
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
13 *
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20 * IN THE SOFTWARE.
21 */
22
23 #ifndef JANET_AMALG
24 #include "features.h"
25 #include <janet.h>
26 #include "util.h"
27 #include "gc.h"
28 #endif
29
30 #ifndef JANET_REDUCED_OS
31
32 #include <stdlib.h>
33 #include <time.h>
34 #include <fcntl.h>
35 #include <errno.h>
36 #include <limits.h>
37 #include <stdio.h>
38 #include <string.h>
39 #include <sys/stat.h>
40 #include <signal.h>
41
42 #ifdef JANET_APPLE
43 #include <AvailabilityMacros.h>
44 #endif
45
46 #ifdef JANET_WINDOWS
47 #include <windows.h>
48 #include <direct.h>
49 #include <sys/utime.h>
50 #include <io.h>
51 #include <process.h>
52 #else
53 #include <spawn.h>
54 #include <utime.h>
55 #include <unistd.h>
56 #include <dirent.h>
57 #include <sys/types.h>
58 #include <sys/wait.h>
59 #ifdef JANET_APPLE
60 #include <crt_externs.h>
61 #define environ (*_NSGetEnviron())
62 #else
63 extern char **environ;
64 #endif
65 #ifdef JANET_THREADS
66 #include <pthread.h>
67 #endif
68 #endif
69
70 /* For macos */
71 #ifdef __MACH__
72 #include <mach/clock.h>
73 #include <mach/mach.h>
74 #endif
75
76 /* Not POSIX, but all Unixes but Solaris have this function. */
77 #if defined(JANET_POSIX) && !defined(__sun)
78 time_t timegm(struct tm *tm);
79 #elif defined(JANET_WINDOWS)
80 #define timegm _mkgmtime
81 #endif
82
83 /* Access to some global variables should be synchronized if not in single threaded mode, as
84 * setenv/getenv are not thread safe. */
85 #ifdef JANET_THREADS
86 # ifdef JANET_WINDOWS
87 static CRITICAL_SECTION env_lock;
janet_lock_environ(void)88 static void janet_lock_environ(void) {
89 EnterCriticalSection(&env_lock);
90 }
janet_unlock_environ(void)91 static void janet_unlock_environ(void) {
92 LeaveCriticalSection(&env_lock);
93 }
94 # else
95 static pthread_mutex_t env_lock = PTHREAD_MUTEX_INITIALIZER;
janet_lock_environ(void)96 static void janet_lock_environ(void) {
97 pthread_mutex_lock(&env_lock);
98 }
janet_unlock_environ(void)99 static void janet_unlock_environ(void) {
100 pthread_mutex_unlock(&env_lock);
101 }
102 # endif
103 #else
janet_lock_environ(void)104 static void janet_lock_environ(void) {
105 }
janet_unlock_environ(void)106 static void janet_unlock_environ(void) {
107 }
108 #endif
109
110 #endif /* JANET_REDCUED_OS */
111
112 /* Core OS functions */
113
114 /* Full OS functions */
115
116 #define janet_stringify1(x) #x
117 #define janet_stringify(x) janet_stringify1(x)
118
119 JANET_CORE_FN(os_which,
120 "(os/which)",
121 "Check the current operating system. Returns one of:\n\n"
122 "* :windows\n\n"
123 "* :macos\n\n"
124 "* :web - Web assembly (emscripten)\n\n"
125 "* :linux\n\n"
126 "* :freebsd\n\n"
127 "* :openbsd\n\n"
128 "* :netbsd\n\n"
129 "* :posix - A POSIX compatible system (default)\n\n"
130 "May also return a custom keyword specified at build time.") {
131 janet_fixarity(argc, 0);
132 (void) argv;
133 #if defined(JANET_OS_NAME)
134 return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
135 #elif defined(JANET_WINDOWS)
136 return janet_ckeywordv("windows");
137 #elif defined(JANET_APPLE)
138 return janet_ckeywordv("macos");
139 #elif defined(__EMSCRIPTEN__)
140 return janet_ckeywordv("web");
141 #elif defined(JANET_LINUX)
142 return janet_ckeywordv("linux");
143 #elif defined(__FreeBSD__)
144 return janet_ckeywordv("freebsd");
145 #elif defined(__NetBSD__)
146 return janet_ckeywordv("netbsd");
147 #elif defined(__OpenBSD__)
148 return janet_ckeywordv("openbsd");
149 #elif defined(JANET_BSD)
150 return janet_ckeywordv("bsd");
151 #else
152 return janet_ckeywordv("posix");
153 #endif
154 }
155
156 /* Detect the ISA we are compiled for */
157 JANET_CORE_FN(os_arch,
158 "(os/arch)",
159 "Check the ISA that janet was compiled for. Returns one of:\n\n"
160 "* :x86\n\n"
161 "* :x64\n\n"
162 "* :arm\n\n"
163 "* :aarch64\n\n"
164 "* :sparc\n\n"
165 "* :wasm\n\n"
166 "* :unknown\n") {
167 janet_fixarity(argc, 0);
168 (void) argv;
169 /* Check 64-bit vs 32-bit */
170 #if defined(JANET_ARCH_NAME)
171 return janet_ckeywordv(janet_stringify(JANET_ARCH_NAME));
172 #elif defined(__EMSCRIPTEN__)
173 return janet_ckeywordv("wasm");
174 #elif (defined(__x86_64__) || defined(_M_X64))
175 return janet_ckeywordv("x64");
176 #elif defined(__i386) || defined(_M_IX86)
177 return janet_ckeywordv("x86");
178 #elif defined(_M_ARM64) || defined(__aarch64__)
179 return janet_ckeywordv("aarch64");
180 #elif defined(_M_ARM) || defined(__arm__)
181 return janet_ckeywordv("arm");
182 #elif (defined(__sparc__))
183 return janet_ckeywordv("sparc");
184 #elif (defined(__ppc__))
185 return janet_ckeywordv("ppc");
186 #else
187 return janet_ckeywordv("unknown");
188 #endif
189 }
190
191 #undef janet_stringify1
192 #undef janet_stringify
193
194 JANET_CORE_FN(os_exit,
195 "(os/exit &opt x)",
196 "Exit from janet with an exit code equal to x. If x is not an integer, "
197 "the exit with status equal the hash of x.") {
198 janet_arity(argc, 0, 1);
199 int status;
200 if (argc == 0) {
201 status = EXIT_SUCCESS;
202 } else if (janet_checkint(argv[0])) {
203 status = janet_unwrap_integer(argv[0]);
204 } else {
205 status = EXIT_FAILURE;
206 }
207 janet_deinit();
208 exit(status);
209 return janet_wrap_nil();
210 }
211
212 #ifndef JANET_REDUCED_OS
213
214 #ifndef JANET_NO_PROCESSES
215
216 /* Get env for os_execute */
217 #ifdef JANET_WINDOWS
218 typedef char *EnvBlock;
219 #else
220 typedef char **EnvBlock;
221 #endif
222
223 /* Get env for os_execute */
os_execute_env(int32_t argc,const Janet * argv)224 static EnvBlock os_execute_env(int32_t argc, const Janet *argv) {
225 if (argc <= 2) return NULL;
226 JanetDictView dict = janet_getdictionary(argv, 2);
227 #ifdef JANET_WINDOWS
228 JanetBuffer *temp = janet_buffer(10);
229 for (int32_t i = 0; i < dict.cap; i++) {
230 const JanetKV *kv = dict.kvs + i;
231 if (!janet_checktype(kv->key, JANET_STRING)) continue;
232 if (!janet_checktype(kv->value, JANET_STRING)) continue;
233 const uint8_t *keys = janet_unwrap_string(kv->key);
234 const uint8_t *vals = janet_unwrap_string(kv->value);
235 janet_buffer_push_bytes(temp, keys, janet_string_length(keys));
236 janet_buffer_push_u8(temp, '=');
237 janet_buffer_push_bytes(temp, vals, janet_string_length(vals));
238 janet_buffer_push_u8(temp, '\0');
239 }
240 janet_buffer_push_u8(temp, '\0');
241 char *ret = janet_smalloc(temp->count);
242 memcpy(ret, temp->data, temp->count);
243 return ret;
244 #else
245 char **envp = janet_smalloc(sizeof(char *) * ((size_t)dict.len + 1));
246 int32_t j = 0;
247 for (int32_t i = 0; i < dict.cap; i++) {
248 const JanetKV *kv = dict.kvs + i;
249 if (!janet_checktype(kv->key, JANET_STRING)) continue;
250 if (!janet_checktype(kv->value, JANET_STRING)) continue;
251 const uint8_t *keys = janet_unwrap_string(kv->key);
252 const uint8_t *vals = janet_unwrap_string(kv->value);
253 int32_t klen = janet_string_length(keys);
254 int32_t vlen = janet_string_length(vals);
255 /* Check keys has no embedded 0s or =s. */
256 int skip = 0;
257 for (int32_t k = 0; k < klen; k++) {
258 if (keys[k] == '\0' || keys[k] == '=') {
259 skip = 1;
260 break;
261 }
262 }
263 if (skip) continue;
264 char *envitem = janet_smalloc((size_t) klen + (size_t) vlen + 2);
265 memcpy(envitem, keys, klen);
266 envitem[klen] = '=';
267 memcpy(envitem + klen + 1, vals, vlen);
268 envitem[klen + vlen + 1] = 0;
269 envp[j++] = envitem;
270 }
271 envp[j] = NULL;
272 return envp;
273 #endif
274 }
275
os_execute_cleanup(EnvBlock envp,const char ** child_argv)276 static void os_execute_cleanup(EnvBlock envp, const char **child_argv) {
277 #ifdef JANET_WINDOWS
278 (void) child_argv;
279 if (NULL != envp) janet_sfree(envp);
280 #else
281 janet_sfree((void *)child_argv);
282 if (NULL != envp) {
283 char **envitem = envp;
284 while (*envitem != NULL) {
285 janet_sfree(*envitem);
286 envitem++;
287 }
288 }
289 janet_sfree(envp);
290 #endif
291 }
292
293 #ifdef JANET_WINDOWS
294 /* Windows processes created via CreateProcess get only one command line argument string, and
295 * must parse this themselves. Each processes is free to do this however they like, but the
296 * standard parsing method is CommandLineToArgvW. We need to properly escape arguments into
297 * a single string of this format. Returns a buffer that can be cast into a c string. */
os_exec_escape(JanetView args)298 static JanetBuffer *os_exec_escape(JanetView args) {
299 JanetBuffer *b = janet_buffer(0);
300 for (int32_t i = 0; i < args.len; i++) {
301 const char *arg = janet_getcstring(args.items, i);
302
303 /* Push leading space if not first */
304 if (i) janet_buffer_push_u8(b, ' ');
305
306 /* Find first special character */
307 const char *first_spec = arg;
308 while (*first_spec) {
309 switch (*first_spec) {
310 case ' ':
311 case '\t':
312 case '\v':
313 case '\n':
314 case '"':
315 goto found;
316 case '\0':
317 janet_panic("embedded 0 not allowed in command line string");
318 default:
319 first_spec++;
320 break;
321 }
322 }
323 found:
324
325 /* Check if needs escape */
326 if (*first_spec == '\0') {
327 /* No escape needed */
328 janet_buffer_push_cstring(b, arg);
329 } else {
330 /* Escape */
331 janet_buffer_push_u8(b, '"');
332 for (const char *c = arg; ; c++) {
333 unsigned numBackSlashes = 0;
334 while (*c == '\\') {
335 c++;
336 numBackSlashes++;
337 }
338 if (*c == '"') {
339 /* Escape all backslashes and double quote mark */
340 int32_t n = 2 * numBackSlashes + 1;
341 janet_buffer_extra(b, n + 1);
342 memset(b->data + b->count, '\\', n);
343 b->count += n;
344 janet_buffer_push_u8(b, '"');
345 } else if (*c) {
346 /* Don't escape backslashes. */
347 int32_t n = numBackSlashes;
348 janet_buffer_extra(b, n + 1);
349 memset(b->data + b->count, '\\', n);
350 b->count += n;
351 janet_buffer_push_u8(b, *c);
352 } else {
353 /* we finished Escape all backslashes */
354 int32_t n = 2 * numBackSlashes;
355 janet_buffer_extra(b, n + 1);
356 memset(b->data + b->count, '\\', n);
357 b->count += n;
358 break;
359 }
360 }
361 janet_buffer_push_u8(b, '"');
362 }
363 }
364 janet_buffer_push_u8(b, 0);
365 return b;
366 }
367 #endif
368
369 /* Process type for when running a subprocess and not immediately waiting */
370 static const JanetAbstractType ProcAT;
371 #define JANET_PROC_CLOSED 1
372 #define JANET_PROC_WAITED 2
373 #define JANET_PROC_WAITING 4
374 #define JANET_PROC_ERROR_NONZERO 8
375 #define JANET_PROC_OWNS_STDIN 16
376 #define JANET_PROC_OWNS_STDOUT 32
377 #define JANET_PROC_OWNS_STDERR 64
378 #define JANET_PROC_ALLOW_ZOMBIE 128
379 typedef struct {
380 int flags;
381 #ifdef JANET_WINDOWS
382 HANDLE pHandle;
383 HANDLE tHandle;
384 #else
385 pid_t pid;
386 #endif
387 int return_code;
388 #ifdef JANET_EV
389 JanetStream *in;
390 JanetStream *out;
391 JanetStream *err;
392 #else
393 JanetFile *in;
394 JanetFile *out;
395 JanetFile *err;
396 #endif
397 } JanetProc;
398
399 #ifdef JANET_EV
400
401 #ifdef JANET_WINDOWS
402
janet_proc_wait_subr(JanetEVGenericMessage args)403 static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
404 JanetProc *proc = (JanetProc *) args.argp;
405 WaitForSingleObject(proc->pHandle, INFINITE);
406 GetExitCodeProcess(proc->pHandle, &args.argi);
407 return args;
408 }
409
410 #else /* windows check */
411
proc_get_status(JanetProc * proc)412 static int proc_get_status(JanetProc *proc) {
413 /* Use POSIX shell semantics for interpreting signals */
414 int status = 0;
415 pid_t result;
416 do {
417 result = waitpid(proc->pid, &status, 0);
418 } while (result == -1 && errno == EINTR);
419 if (WIFEXITED(status)) {
420 status = WEXITSTATUS(status);
421 } else if (WIFSTOPPED(status)) {
422 status = WSTOPSIG(status) + 128;
423 } else {
424 status = WTERMSIG(status) + 128;
425 }
426 return status;
427 }
428
429 /* Function that is called in separate thread to wait on a pid */
janet_proc_wait_subr(JanetEVGenericMessage args)430 static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
431 JanetProc *proc = (JanetProc *) args.argp;
432 #ifdef WNOWAIT
433 pid_t result;
434 int status = 0;
435 do {
436 result = waitpid(proc->pid, &status, WNOWAIT);
437 } while (result == -1 && errno == EINTR);
438 #else
439 args.tag = proc_get_status(proc);
440 #endif
441 return args;
442 }
443
444 #endif /* End windows check */
445
446 /* Callback that is called in main thread when subroutine completes. */
janet_proc_wait_cb(JanetEVGenericMessage args)447 static void janet_proc_wait_cb(JanetEVGenericMessage args) {
448 janet_ev_dec_refcount();
449 JanetProc *proc = (JanetProc *) args.argp;
450 if (NULL != proc) {
451 #ifdef WNOWAIT
452 int status = proc_get_status(proc);
453 #else
454 int status = args.tag;
455 #endif
456 proc->return_code = (int32_t) status;
457 proc->flags |= JANET_PROC_WAITED;
458 proc->flags &= ~JANET_PROC_WAITING;
459 janet_gcunroot(janet_wrap_abstract(proc));
460 janet_gcunroot(janet_wrap_fiber(args.fiber));
461 if ((status != 0) && (proc->flags & JANET_PROC_ERROR_NONZERO)) {
462 JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
463 janet_cancel(args.fiber, janet_wrap_string(s));
464 } else {
465 janet_schedule(args.fiber, janet_wrap_integer(status));
466 }
467 }
468 }
469
470 #endif /* End ev check */
471
janet_proc_gc(void * p,size_t s)472 static int janet_proc_gc(void *p, size_t s) {
473 (void) s;
474 JanetProc *proc = (JanetProc *) p;
475 #ifdef JANET_WINDOWS
476 if (!(proc->flags & JANET_PROC_CLOSED)) {
477 if (!(proc->flags & JANET_PROC_ALLOW_ZOMBIE)) {
478 TerminateProcess(proc->pHandle, 1);
479 }
480 CloseHandle(proc->pHandle);
481 CloseHandle(proc->tHandle);
482 }
483 #else
484 if (!(proc->flags & (JANET_PROC_WAITED | JANET_PROC_ALLOW_ZOMBIE))) {
485 /* Kill and wait to prevent zombies */
486 kill(proc->pid, SIGKILL);
487 int status;
488 if (!(proc->flags & JANET_PROC_WAITING)) {
489 waitpid(proc->pid, &status, 0);
490 }
491 }
492 #endif
493 return 0;
494 }
495
janet_proc_mark(void * p,size_t s)496 static int janet_proc_mark(void *p, size_t s) {
497 (void) s;
498 JanetProc *proc = (JanetProc *)p;
499 if (NULL != proc->in) janet_mark(janet_wrap_abstract(proc->in));
500 if (NULL != proc->out) janet_mark(janet_wrap_abstract(proc->out));
501 if (NULL != proc->err) janet_mark(janet_wrap_abstract(proc->err));
502 return 0;
503 }
504
505 #ifdef JANET_EV
506 static JANET_NO_RETURN void
507 #else
508 static Janet
509 #endif
os_proc_wait_impl(JanetProc * proc)510 os_proc_wait_impl(JanetProc *proc) {
511 if (proc->flags & (JANET_PROC_WAITED | JANET_PROC_WAITING)) {
512 janet_panicf("cannot wait twice on a process");
513 }
514 #ifdef JANET_EV
515 /* Event loop implementation - threaded call */
516 proc->flags |= JANET_PROC_WAITING;
517 JanetEVGenericMessage targs;
518 memset(&targs, 0, sizeof(targs));
519 targs.argp = proc;
520 targs.fiber = janet_root_fiber();
521 janet_gcroot(janet_wrap_abstract(proc));
522 janet_gcroot(janet_wrap_fiber(targs.fiber));
523 janet_ev_threaded_call(janet_proc_wait_subr, targs, janet_proc_wait_cb);
524 janet_await();
525 #else
526 /* Non evented implementation */
527 proc->flags |= JANET_PROC_WAITED;
528 int status = 0;
529 #ifdef JANET_WINDOWS
530 WaitForSingleObject(proc->pHandle, INFINITE);
531 GetExitCodeProcess(proc->pHandle, &status);
532 if (!(proc->flags & JANET_PROC_CLOSED)) {
533 proc->flags |= JANET_PROC_CLOSED;
534 CloseHandle(proc->pHandle);
535 CloseHandle(proc->tHandle);
536 }
537 #else
538 waitpid(proc->pid, &status, 0);
539 #endif
540 proc->return_code = (int32_t) status;
541 return janet_wrap_integer(proc->return_code);
542 #endif
543 }
544
545 JANET_CORE_FN(os_proc_wait,
546 "(os/proc-wait proc)",
547 "Block until the subprocess completes. Returns the subprocess return code.") {
548 janet_fixarity(argc, 1);
549 JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
550 #ifdef JANET_EV
551 os_proc_wait_impl(proc);
552 return janet_wrap_nil();
553 #else
554 return os_proc_wait_impl(proc);
555 #endif
556 }
557
558 JANET_CORE_FN(os_proc_kill,
559 "(os/proc-kill proc &opt wait)",
560 "Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
561 "handle on windows. If wait is truthy, will wait for the process to finish and "
562 "returns the exit code. Otherwise, returns proc.") {
563 janet_arity(argc, 1, 2);
564 JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
565 if (proc->flags & JANET_PROC_WAITED) {
566 janet_panicf("cannot kill process that has already finished");
567 }
568 #ifdef JANET_WINDOWS
569 if (proc->flags & JANET_PROC_CLOSED) {
570 janet_panicf("cannot close process handle that is already closed");
571 }
572 proc->flags |= JANET_PROC_CLOSED;
573 TerminateProcess(proc->pHandle, 1);
574 CloseHandle(proc->pHandle);
575 CloseHandle(proc->tHandle);
576 #else
577 int status = kill(proc->pid, SIGKILL);
578 if (status) {
579 janet_panic(strerror(errno));
580 }
581 #endif
582 /* After killing process we wait on it. */
583 if (argc > 1 && janet_truthy(argv[1])) {
584 #ifdef JANET_EV
585 os_proc_wait_impl(proc);
586 return janet_wrap_nil();
587 #else
588 return os_proc_wait_impl(proc);
589 #endif
590 } else {
591 return argv[0];
592 }
593 }
594
595 JANET_CORE_FN(os_proc_close,
596 "(os/proc-close proc)",
597 "Wait on a process if it has not been waited on, and close pipes created by `os/spawn` "
598 "if they have not been closed. Returns nil.") {
599 janet_fixarity(argc, 1);
600 JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
601 #ifdef JANET_EV
602 if (proc->flags & JANET_PROC_OWNS_STDIN) janet_stream_close(proc->in);
603 if (proc->flags & JANET_PROC_OWNS_STDOUT) janet_stream_close(proc->out);
604 if (proc->flags & JANET_PROC_OWNS_STDERR) janet_stream_close(proc->err);
605 #else
606 if (proc->flags & JANET_PROC_OWNS_STDIN) janet_file_close(proc->in);
607 if (proc->flags & JANET_PROC_OWNS_STDOUT) janet_file_close(proc->out);
608 if (proc->flags & JANET_PROC_OWNS_STDERR) janet_file_close(proc->err);
609 #endif
610 proc->flags &= ~(JANET_PROC_OWNS_STDIN | JANET_PROC_OWNS_STDOUT | JANET_PROC_OWNS_STDERR);
611 if (proc->flags & (JANET_PROC_WAITED | JANET_PROC_WAITING)) {
612 return janet_wrap_nil();
613 }
614 #ifdef JANET_EV
615 os_proc_wait_impl(proc);
616 return janet_wrap_nil();
617 #else
618 return os_proc_wait_impl(proc);
619 #endif
620 }
621
swap_handles(JanetHandle * handles)622 static void swap_handles(JanetHandle *handles) {
623 JanetHandle temp = handles[0];
624 handles[0] = handles[1];
625 handles[1] = temp;
626 }
627
close_handle(JanetHandle handle)628 static void close_handle(JanetHandle handle) {
629 #ifdef JANET_WINDOWS
630 CloseHandle(handle);
631 #else
632 close(handle);
633 #endif
634 }
635
636 /* Create piped file for os/execute and os/spawn. Need to be careful that we mark
637 the error flag if we can't create pipe and don't leak handles. *handle will be cleaned
638 up by the calling function. If everything goes well, *handle is owned by the calling function,
639 (if it is set) and the returned handle owns the other end of the pipe, which will be closed
640 on GC or fclose. */
make_pipes(JanetHandle * handle,int reverse,int * errflag)641 static JanetHandle make_pipes(JanetHandle *handle, int reverse, int *errflag) {
642 JanetHandle handles[2];
643 #ifdef JANET_EV
644
645 /* non-blocking pipes */
646 if (janet_make_pipe(handles, reverse ? 2 : 1)) goto error;
647 if (reverse) swap_handles(handles);
648 #ifdef JANET_WINDOWS
649 if (!SetHandleInformation(handles[0], HANDLE_FLAG_INHERIT, 0)) goto error;
650 #endif
651 *handle = handles[1];
652 return handles[0];
653
654 #else
655
656 /* Normal blocking pipes */
657 #ifdef JANET_WINDOWS
658 SECURITY_ATTRIBUTES saAttr;
659 memset(&saAttr, 0, sizeof(saAttr));
660 saAttr.nLength = sizeof(saAttr);
661 saAttr.bInheritHandle = TRUE;
662 if (!CreatePipe(handles, handles + 1, &saAttr, 0)) goto error;
663 if (reverse) swap_handles(handles);
664 /* Don't inherit the side of the pipe owned by this process */
665 if (!SetHandleInformation(handles[0], HANDLE_FLAG_INHERIT, 0)) goto error;
666 *handle = handles[1];
667 return handles[0];
668 #else
669 if (pipe(handles)) goto error;
670 if (reverse) swap_handles(handles);
671 *handle = handles[1];
672 return handles[0];
673 #endif
674
675 #endif
676 error:
677 *errflag = 1;
678 return JANET_HANDLE_NONE;
679 }
680
681 static const JanetMethod proc_methods[] = {
682 {"wait", os_proc_wait},
683 {"kill", os_proc_kill},
684 {"close", os_proc_close},
685 /* dud methods for janet_proc_next */
686 {"in", NULL},
687 {"out", NULL},
688 {"err", NULL},
689 {NULL, NULL}
690 };
691
janet_proc_get(void * p,Janet key,Janet * out)692 static int janet_proc_get(void *p, Janet key, Janet *out) {
693 JanetProc *proc = (JanetProc *)p;
694 if (janet_keyeq(key, "in")) {
695 *out = (NULL == proc->in) ? janet_wrap_nil() : janet_wrap_abstract(proc->in);
696 return 1;
697 }
698 if (janet_keyeq(key, "out")) {
699 *out = (NULL == proc->out) ? janet_wrap_nil() : janet_wrap_abstract(proc->out);
700 return 1;
701 }
702 if (janet_keyeq(key, "err")) {
703 *out = (NULL == proc->err) ? janet_wrap_nil() : janet_wrap_abstract(proc->err);
704 return 1;
705 }
706 #ifndef JANET_WINDOWS
707 if (janet_keyeq(key, "pid")) {
708 *out = janet_wrap_number(proc->pid);
709 return 1;
710 }
711 #endif
712 if ((-1 != proc->return_code) && janet_keyeq(key, "return-code")) {
713 *out = janet_wrap_integer(proc->return_code);
714 return 1;
715 }
716 if (!janet_checktype(key, JANET_KEYWORD)) return 0;
717 return janet_getmethod(janet_unwrap_keyword(key), proc_methods, out);
718 }
719
janet_proc_next(void * p,Janet key)720 static Janet janet_proc_next(void *p, Janet key) {
721 (void) p;
722 return janet_nextmethod(proc_methods, key);
723 }
724
725 static const JanetAbstractType ProcAT = {
726 "core/process",
727 janet_proc_gc,
728 janet_proc_mark,
729 janet_proc_get,
730 NULL, /* put */
731 NULL, /* marshal */
732 NULL, /* unmarshal */
733 NULL, /* tostring */
734 NULL, /* compare */
735 NULL, /* hash */
736 janet_proc_next,
737 JANET_ATEND_NEXT
738 };
739
janet_getjstream(Janet * argv,int32_t n,void ** orig)740 static JanetHandle janet_getjstream(Janet *argv, int32_t n, void **orig) {
741 #ifdef JANET_EV
742 JanetStream *stream = janet_checkabstract(argv[n], &janet_stream_type);
743 if (stream != NULL) {
744 if (stream->flags & JANET_STREAM_CLOSED)
745 janet_panic("stream is closed");
746 *orig = stream;
747 return stream->handle;
748 }
749 #endif
750 JanetFile *f = janet_checkabstract(argv[n], &janet_file_type);
751 if (f != NULL) {
752 if (f->flags & JANET_FILE_CLOSED) {
753 janet_panic("file is closed");
754 }
755 *orig = f;
756 #ifdef JANET_WINDOWS
757 return (HANDLE) _get_osfhandle(_fileno(f->file));
758 #else
759 return fileno(f->file);
760 #endif
761 }
762 janet_panicf("expected file|stream, got %v", argv[n]);
763 }
764
765 #ifdef JANET_EV
get_stdio_for_handle(JanetHandle handle,void * orig,int iswrite)766 static JanetStream *get_stdio_for_handle(JanetHandle handle, void *orig, int iswrite) {
767 if (orig == NULL) {
768 return janet_stream(handle, iswrite ? JANET_STREAM_WRITABLE : JANET_STREAM_READABLE, NULL);
769 } else if (janet_abstract_type(orig) == &janet_file_type) {
770 JanetFile *jf = (JanetFile *)orig;
771 uint32_t flags = 0;
772 if (jf->flags & JANET_FILE_WRITE) {
773 flags |= JANET_STREAM_WRITABLE;
774 }
775 if (jf->flags & JANET_FILE_READ) {
776 flags |= JANET_STREAM_READABLE;
777 }
778 /* duplicate handle when converting file to stream */
779 #ifdef JANET_WINDOWS
780 HANDLE prochandle = GetCurrentProcess();
781 HANDLE newHandle = INVALID_HANDLE_VALUE;
782 if (!DuplicateHandle(prochandle, handle, prochandle, &newHandle, 0, FALSE, DUPLICATE_SAME_ACCESS)) {
783 return NULL;
784 }
785 #else
786 int newHandle = dup(handle);
787 if (newHandle < 0) {
788 return NULL;
789 }
790 #endif
791 return janet_stream(newHandle, flags, NULL);
792 } else {
793 return orig;
794 }
795 }
796 #else
get_stdio_for_handle(JanetHandle handle,void * orig,int iswrite)797 static JanetFile *get_stdio_for_handle(JanetHandle handle, void *orig, int iswrite) {
798 if (NULL != orig) return (JanetFile *) orig;
799 #ifdef JANET_WINDOWS
800 int fd = _open_osfhandle((intptr_t) handle, iswrite ? _O_WRONLY : _O_RDONLY);
801 if (-1 == fd) return NULL;
802 FILE *f = _fdopen(fd, iswrite ? "w" : "r");
803 if (NULL == f) {
804 _close(fd);
805 return NULL;
806 }
807 #else
808 FILE *f = fdopen(handle, iswrite ? "w" : "r");
809 if (NULL == f) return NULL;
810 #endif
811 return janet_makejfile(f, iswrite ? JANET_FILE_WRITE : JANET_FILE_READ);
812 }
813 #endif
814
os_execute_impl(int32_t argc,Janet * argv,int is_spawn)815 static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
816 janet_arity(argc, 1, 3);
817
818 /* Get flags */
819 uint64_t flags = 0;
820 if (argc > 1) {
821 flags = janet_getflags(argv, 1, "epxd");
822 }
823
824 /* Get environment */
825 int use_environ = !janet_flag_at(flags, 0);
826 EnvBlock envp = os_execute_env(argc, argv);
827
828 /* Get arguments */
829 JanetView exargs = janet_getindexed(argv, 0);
830 if (exargs.len < 1) {
831 janet_panic("expected at least 1 command line argument");
832 }
833
834 /* Optional stdio redirections */
835 JanetAbstract orig_in = NULL, orig_out = NULL, orig_err = NULL;
836 JanetHandle new_in = JANET_HANDLE_NONE, new_out = JANET_HANDLE_NONE, new_err = JANET_HANDLE_NONE;
837 JanetHandle pipe_in = JANET_HANDLE_NONE, pipe_out = JANET_HANDLE_NONE, pipe_err = JANET_HANDLE_NONE;
838 int pipe_errflag = 0; /* Track errors setting up pipes */
839 int pipe_owner_flags = (is_spawn && (flags & 0x8)) ? JANET_PROC_ALLOW_ZOMBIE : 0;
840
841 /* Get optional redirections */
842 if (argc > 2) {
843 JanetDictView tab = janet_getdictionary(argv, 2);
844 Janet maybe_stdin = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("in"));
845 Janet maybe_stdout = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("out"));
846 Janet maybe_stderr = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("err"));
847 if (janet_keyeq(maybe_stdin, "pipe")) {
848 new_in = make_pipes(&pipe_in, 1, &pipe_errflag);
849 pipe_owner_flags |= JANET_PROC_OWNS_STDIN;
850 } else if (!janet_checktype(maybe_stdin, JANET_NIL)) {
851 new_in = janet_getjstream(&maybe_stdin, 0, &orig_in);
852 }
853 if (janet_keyeq(maybe_stdout, "pipe")) {
854 new_out = make_pipes(&pipe_out, 0, &pipe_errflag);
855 pipe_owner_flags |= JANET_PROC_OWNS_STDOUT;
856 } else if (!janet_checktype(maybe_stdout, JANET_NIL)) {
857 new_out = janet_getjstream(&maybe_stdout, 0, &orig_out);
858 }
859 if (janet_keyeq(maybe_stderr, "pipe")) {
860 new_err = make_pipes(&pipe_err, 0, &pipe_errflag);
861 pipe_owner_flags |= JANET_PROC_OWNS_STDERR;
862 } else if (!janet_checktype(maybe_stderr, JANET_NIL)) {
863 new_err = janet_getjstream(&maybe_stderr, 0, &orig_err);
864 }
865 }
866
867 /* Clean up if any of the pipes have any issues */
868 if (pipe_errflag) {
869 if (pipe_in != JANET_HANDLE_NONE) close_handle(pipe_in);
870 if (pipe_out != JANET_HANDLE_NONE) close_handle(pipe_out);
871 if (pipe_err != JANET_HANDLE_NONE) close_handle(pipe_err);
872 janet_panic("failed to create pipes");
873 }
874
875 /* Result */
876 int status = 0;
877
878 #ifdef JANET_WINDOWS
879
880 HANDLE pHandle, tHandle;
881 SECURITY_ATTRIBUTES saAttr;
882 PROCESS_INFORMATION processInfo;
883 STARTUPINFO startupInfo;
884 memset(&saAttr, 0, sizeof(saAttr));
885 memset(&processInfo, 0, sizeof(processInfo));
886 memset(&startupInfo, 0, sizeof(startupInfo));
887 startupInfo.cb = sizeof(startupInfo);
888 startupInfo.dwFlags |= STARTF_USESTDHANDLES;
889 saAttr.nLength = sizeof(saAttr);
890
891 JanetBuffer *buf = os_exec_escape(exargs);
892 if (buf->count > 8191) {
893 if (pipe_in != JANET_HANDLE_NONE) CloseHandle(pipe_in);
894 if (pipe_out != JANET_HANDLE_NONE) CloseHandle(pipe_out);
895 if (pipe_err != JANET_HANDLE_NONE) CloseHandle(pipe_err);
896 janet_panic("command line string too long (max 8191 characters)");
897 }
898 const char *path = (const char *) janet_unwrap_string(exargs.items[0]);
899
900 /* Do IO redirection */
901
902 if (pipe_in != JANET_HANDLE_NONE) {
903 startupInfo.hStdInput = pipe_in;
904 } else if (new_in != JANET_HANDLE_NONE) {
905 startupInfo.hStdInput = new_in;
906 } else {
907 startupInfo.hStdInput = (HANDLE) _get_osfhandle(0);
908 }
909
910
911 if (pipe_out != JANET_HANDLE_NONE) {
912 startupInfo.hStdOutput = pipe_out;
913 } else if (new_out != JANET_HANDLE_NONE) {
914 startupInfo.hStdOutput = new_out;
915 } else {
916 startupInfo.hStdOutput = (HANDLE) _get_osfhandle(1);
917 }
918
919 if (pipe_err != JANET_HANDLE_NONE) {
920 startupInfo.hStdError = pipe_err;
921 } else if (new_err != NULL) {
922 startupInfo.hStdError = new_err;
923 } else {
924 startupInfo.hStdError = (HANDLE) _get_osfhandle(2);
925 }
926
927 int cp_failed = 0;
928 if (!CreateProcess(janet_flag_at(flags, 1) ? NULL : path,
929 (char *) buf->data, /* Single CLI argument */
930 &saAttr, /* no proc inheritance */
931 &saAttr, /* no thread inheritance */
932 TRUE, /* handle inheritance */
933 0, /* flags */
934 use_environ ? NULL : envp, /* pass in environment */
935 NULL, /* use parents starting directory */
936 &startupInfo,
937 &processInfo)) {
938 cp_failed = 1;
939 }
940
941 if (pipe_in != JANET_HANDLE_NONE) CloseHandle(pipe_in);
942 if (pipe_out != JANET_HANDLE_NONE) CloseHandle(pipe_out);
943 if (pipe_err != JANET_HANDLE_NONE) CloseHandle(pipe_err);
944
945 os_execute_cleanup(envp, NULL);
946
947 if (cp_failed) {
948 janet_panic("failed to create process");
949 }
950
951 pHandle = processInfo.hProcess;
952 tHandle = processInfo.hThread;
953
954 #else
955
956 const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1));
957 for (int32_t i = 0; i < exargs.len; i++)
958 child_argv[i] = janet_getcstring(exargs.items, i);
959 child_argv[exargs.len] = NULL;
960 /* Coerce to form that works for spawn. I'm fairly confident no implementation
961 * of posix_spawn would modify the argv array passed in. */
962 char *const *cargv = (char *const *)child_argv;
963
964 /* Use posix_spawn to spawn new process */
965
966 if (use_environ) {
967 janet_lock_environ();
968 }
969
970 /* Posix spawn setup */
971 posix_spawn_file_actions_t actions;
972 posix_spawn_file_actions_init(&actions);
973 if (pipe_in != JANET_HANDLE_NONE) {
974 posix_spawn_file_actions_adddup2(&actions, pipe_in, 0);
975 posix_spawn_file_actions_addclose(&actions, pipe_in);
976 } else if (new_in != JANET_HANDLE_NONE) {
977 posix_spawn_file_actions_adddup2(&actions, new_in, 0);
978 posix_spawn_file_actions_addclose(&actions, new_in);
979 }
980 if (pipe_out != JANET_HANDLE_NONE) {
981 posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
982 posix_spawn_file_actions_addclose(&actions, pipe_out);
983 } else if (new_out != JANET_HANDLE_NONE) {
984 posix_spawn_file_actions_adddup2(&actions, new_out, 1);
985 posix_spawn_file_actions_addclose(&actions, new_out);
986 }
987 if (pipe_err != JANET_HANDLE_NONE) {
988 posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
989 posix_spawn_file_actions_addclose(&actions, pipe_err);
990 } else if (new_err != JANET_HANDLE_NONE) {
991 posix_spawn_file_actions_adddup2(&actions, new_err, 2);
992 posix_spawn_file_actions_addclose(&actions, new_err);
993 }
994
995 pid_t pid;
996 if (janet_flag_at(flags, 1)) {
997 status = posix_spawnp(&pid,
998 child_argv[0], &actions, NULL, cargv,
999 use_environ ? environ : envp);
1000 } else {
1001 status = posix_spawn(&pid,
1002 child_argv[0], &actions, NULL, cargv,
1003 use_environ ? environ : envp);
1004 }
1005
1006 posix_spawn_file_actions_destroy(&actions);
1007
1008 if (pipe_in != JANET_HANDLE_NONE) close(pipe_in);
1009 if (pipe_out != JANET_HANDLE_NONE) close(pipe_out);
1010 if (pipe_err != JANET_HANDLE_NONE) close(pipe_err);
1011
1012 if (use_environ) {
1013 janet_unlock_environ();
1014 }
1015
1016 os_execute_cleanup(envp, child_argv);
1017 if (status) {
1018 janet_panicf("%p: %s", argv[0], strerror(errno));
1019 }
1020
1021 #endif
1022 JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
1023 proc->return_code = -1;
1024 #ifdef JANET_WINDOWS
1025 proc->pHandle = pHandle;
1026 proc->tHandle = tHandle;
1027 #else
1028 proc->pid = pid;
1029 #endif
1030 proc->in = NULL;
1031 proc->out = NULL;
1032 proc->err = NULL;
1033 proc->flags = pipe_owner_flags;
1034 if (janet_flag_at(flags, 2)) {
1035 proc->flags |= JANET_PROC_ERROR_NONZERO;
1036 }
1037 if (is_spawn) {
1038 /* Only set up pointers to stdin, stdout, and stderr if os/spawn. */
1039 if (new_in != JANET_HANDLE_NONE) {
1040 proc->in = get_stdio_for_handle(new_in, orig_in, 1);
1041 if (NULL == proc->in) janet_panic("failed to construct proc");
1042 }
1043 if (new_out != JANET_HANDLE_NONE) {
1044 proc->out = get_stdio_for_handle(new_out, orig_out, 0);
1045 if (NULL == proc->out) janet_panic("failed to construct proc");
1046 }
1047 if (new_err != JANET_HANDLE_NONE) {
1048 proc->err = get_stdio_for_handle(new_err, orig_err, 0);
1049 if (NULL == proc->err) janet_panic("failed to construct proc");
1050 }
1051 return janet_wrap_abstract(proc);
1052 } else {
1053 #ifdef JANET_EV
1054 os_proc_wait_impl(proc);
1055 #else
1056 return os_proc_wait_impl(proc);
1057 #endif
1058 }
1059 }
1060
1061 JANET_CORE_FN(os_execute,
1062 "(os/execute args &opt flags env)",
1063 "Execute a program on the system and pass it string arguments. `flags` "
1064 "is a keyword that modifies how the program will execute.\n"
1065 "* :e - enables passing an environment to the program. Without :e, the "
1066 "current environment is inherited.\n"
1067 "* :p - allows searching the current PATH for the binary to execute. "
1068 "Without this flag, binaries must use absolute paths.\n"
1069 "* :x - raise error if exit code is non-zero.\n"
1070 "* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n"
1071 "`env` is a table or struct mapping environment variables to values. It can also "
1072 "contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
1073 "These arguments should be core/file values. "
1074 "One can also pass in the :pipe keyword "
1075 "for these arguments to create files that will read (for :err and :out) or write (for :in) "
1076 "to the file descriptor of the subprocess. This is only useful in `os/spawn`, which takes "
1077 "the same parameters as `os/execute`, but will return an object that contains references to these "
1078 "files via (return-value :in), (return-value :out), and (return-value :err). "
1079 "Returns the exit status of the program.") {
1080 return os_execute_impl(argc, argv, 0);
1081 }
1082
1083 JANET_CORE_FN(os_spawn,
1084 "(os/spawn args &opt flags env)",
1085 "Execute a program on the system and return a handle to the process. Otherwise, the "
1086 "same arguments as os/execute. Does not wait for the process. "
1087 "The returned value has the fields :in, :out, :err, :return-code and "
1088 "the additional field :pid on unix like platforms.") {
1089 return os_execute_impl(argc, argv, 1);
1090 }
1091
1092 #ifdef JANET_EV
1093 /* Runs in a separate thread */
os_shell_subr(JanetEVGenericMessage args)1094 static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
1095 int stat = system((const char *) args.argp);
1096 janet_free(args.argp);
1097 if (args.argi) {
1098 args.tag = JANET_EV_TCTAG_INTEGER;
1099 } else {
1100 args.tag = JANET_EV_TCTAG_BOOLEAN;
1101 }
1102 args.argi = stat;
1103 return args;
1104 }
1105 #endif
1106
1107 JANET_CORE_FN(os_shell,
1108 "(os/shell str)",
1109 "Pass a command string str directly to the system shell.") {
1110 janet_arity(argc, 0, 1);
1111 const char *cmd = argc
1112 ? janet_getcstring(argv, 0)
1113 : NULL;
1114 #ifdef JANET_EV
1115 janet_ev_threaded_await(os_shell_subr, 0, argc, cmd ? strdup(cmd) : NULL);
1116 #else
1117 int stat = system(cmd);
1118 return argc
1119 ? janet_wrap_integer(stat)
1120 : janet_wrap_boolean(stat);
1121 #endif
1122 }
1123
1124 #endif /* JANET_NO_PROCESSES */
1125
1126 JANET_CORE_FN(os_environ,
1127 "(os/environ)",
1128 "Get a copy of the os environment table.") {
1129 (void) argv;
1130 janet_fixarity(argc, 0);
1131 int32_t nenv = 0;
1132 janet_lock_environ();
1133 char **env = environ;
1134 while (*env++)
1135 nenv += 1;
1136 JanetTable *t = janet_table(nenv);
1137 for (int32_t i = 0; i < nenv; i++) {
1138 char *e = environ[i];
1139 char *eq = strchr(e, '=');
1140 if (!eq) {
1141 janet_unlock_environ();
1142 janet_panic("no '=' in environ");
1143 }
1144 char *v = eq + 1;
1145 int32_t full_len = (int32_t) strlen(e);
1146 int32_t val_len = (int32_t) strlen(v);
1147 janet_table_put(
1148 t,
1149 janet_stringv((const uint8_t *)e, full_len - val_len - 1),
1150 janet_stringv((const uint8_t *)v, val_len)
1151 );
1152 }
1153 janet_unlock_environ();
1154 return janet_wrap_table(t);
1155 }
1156
1157 JANET_CORE_FN(os_getenv,
1158 "(os/getenv variable &opt dflt)",
1159 "Get the string value of an environment variable.") {
1160 janet_arity(argc, 1, 2);
1161 const char *cstr = janet_getcstring(argv, 0);
1162 const char *res = getenv(cstr);
1163 janet_lock_environ();
1164 Janet ret = res
1165 ? janet_cstringv(res)
1166 : argc == 2
1167 ? argv[1]
1168 : janet_wrap_nil();
1169 janet_unlock_environ();
1170 return ret;
1171 }
1172
1173 JANET_CORE_FN(os_setenv,
1174 "(os/setenv variable value)",
1175 "Set an environment variable.") {
1176 #ifdef JANET_WINDOWS
1177 #define SETENV(K,V) _putenv_s(K, V)
1178 #define UNSETENV(K) _putenv_s(K, "")
1179 #else
1180 #define SETENV(K,V) setenv(K, V, 1)
1181 #define UNSETENV(K) unsetenv(K)
1182 #endif
1183 janet_arity(argc, 1, 2);
1184 const char *ks = janet_getcstring(argv, 0);
1185 const char *vs = janet_optcstring(argv, argc, 1, NULL);
1186 janet_lock_environ();
1187 if (NULL == vs) {
1188 UNSETENV(ks);
1189 } else {
1190 SETENV(ks, vs);
1191 }
1192 janet_unlock_environ();
1193 return janet_wrap_nil();
1194 }
1195
1196 JANET_CORE_FN(os_time,
1197 "(os/time)",
1198 "Get the current time expressed as the number of whole seconds since "
1199 "January 1, 1970, the Unix epoch. Returns a real number.") {
1200 janet_fixarity(argc, 0);
1201 (void) argv;
1202 double dtime = (double)(time(NULL));
1203 return janet_wrap_number(dtime);
1204 }
1205
1206 JANET_CORE_FN(os_clock,
1207 "(os/clock)",
1208 "Return the number of whole + fractional seconds since some fixed point in time. The clock "
1209 "is guaranteed to be non decreasing in real time.") {
1210 janet_fixarity(argc, 0);
1211 (void) argv;
1212 struct timespec tv;
1213 if (janet_gettime(&tv)) janet_panic("could not get time");
1214 double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
1215 return janet_wrap_number(dtime);
1216 }
1217
1218 JANET_CORE_FN(os_sleep,
1219 "(os/sleep n)",
1220 "Suspend the program for n seconds. 'nsec' can be a real number. Returns "
1221 "nil.") {
1222 janet_fixarity(argc, 1);
1223 double delay = janet_getnumber(argv, 0);
1224 if (delay < 0) janet_panic("invalid argument to sleep");
1225 #ifdef JANET_WINDOWS
1226 Sleep((DWORD)(delay * 1000));
1227 #else
1228 int rc;
1229 struct timespec ts;
1230 ts.tv_sec = (time_t) delay;
1231 ts.tv_nsec = (delay <= UINT32_MAX)
1232 ? (long)((delay - ((uint32_t)delay)) * 1000000000)
1233 : 0;
1234 RETRY_EINTR(rc, nanosleep(&ts, &ts));
1235 #endif
1236 return janet_wrap_nil();
1237 }
1238
1239 JANET_CORE_FN(os_cwd,
1240 "(os/cwd)",
1241 "Returns the current working directory.") {
1242 janet_fixarity(argc, 0);
1243 (void) argv;
1244 char buf[FILENAME_MAX];
1245 char *ptr;
1246 #ifdef JANET_WINDOWS
1247 ptr = _getcwd(buf, FILENAME_MAX);
1248 #else
1249 ptr = getcwd(buf, FILENAME_MAX);
1250 #endif
1251 if (NULL == ptr) janet_panic("could not get current directory");
1252 return janet_cstringv(ptr);
1253 }
1254
1255 JANET_CORE_FN(os_cryptorand,
1256 "(os/cryptorand n &opt buf)",
1257 "Get or append n bytes of good quality random data provided by the OS. Returns a new buffer or buf.") {
1258 JanetBuffer *buffer;
1259 janet_arity(argc, 1, 2);
1260 int32_t offset;
1261 int32_t n = janet_getinteger(argv, 0);
1262 if (n < 0) janet_panic("expected positive integer");
1263 if (argc == 2) {
1264 buffer = janet_getbuffer(argv, 1);
1265 offset = buffer->count;
1266 } else {
1267 offset = 0;
1268 buffer = janet_buffer(n);
1269 }
1270 /* We could optimize here by adding setcount_uninit */
1271 janet_buffer_setcount(buffer, offset + n);
1272
1273 if (janet_cryptorand(buffer->data + offset, n) != 0)
1274 janet_panic("unable to get sufficient random data");
1275
1276 return janet_wrap_buffer(buffer);
1277 }
1278
1279 JANET_CORE_FN(os_date,
1280 "(os/date &opt time local)",
1281 "Returns the given time as a date struct, or the current time if `time` is not given. "
1282 "Returns a struct with following key values. Note that all numbers are 0-indexed. "
1283 "Date is given in UTC unless `local` is truthy, in which case the date is formatted for "
1284 "the local timezone.\n\n"
1285 "* :seconds - number of seconds [0-61]\n\n"
1286 "* :minutes - number of minutes [0-59]\n\n"
1287 "* :hours - number of hours [0-23]\n\n"
1288 "* :month-day - day of month [0-30]\n\n"
1289 "* :month - month of year [0, 11]\n\n"
1290 "* :year - years since year 0 (e.g. 2019)\n\n"
1291 "* :week-day - day of the week [0-6]\n\n"
1292 "* :year-day - day of the year [0-365]\n\n"
1293 "* :dst - if Day Light Savings is in effect") {
1294 janet_arity(argc, 0, 2);
1295 (void) argv;
1296 time_t t;
1297 struct tm t_infos;
1298 struct tm *t_info = NULL;
1299 if (argc) {
1300 int64_t integer = janet_getinteger64(argv, 0);
1301 t = (time_t) integer;
1302 } else {
1303 time(&t);
1304 }
1305 if (argc >= 2 && janet_truthy(argv[1])) {
1306 /* local time */
1307 #ifdef JANET_WINDOWS
1308 localtime_s(&t_infos, &t);
1309 t_info = &t_infos;
1310 #else
1311 tzset();
1312 t_info = localtime_r(&t, &t_infos);
1313 #endif
1314 } else {
1315 /* utc time */
1316 #ifdef JANET_WINDOWS
1317 gmtime_s(&t_infos, &t);
1318 t_info = &t_infos;
1319 #else
1320 t_info = gmtime_r(&t, &t_infos);
1321 #endif
1322 }
1323 JanetKV *st = janet_struct_begin(9);
1324 janet_struct_put(st, janet_ckeywordv("seconds"), janet_wrap_number(t_info->tm_sec));
1325 janet_struct_put(st, janet_ckeywordv("minutes"), janet_wrap_number(t_info->tm_min));
1326 janet_struct_put(st, janet_ckeywordv("hours"), janet_wrap_number(t_info->tm_hour));
1327 janet_struct_put(st, janet_ckeywordv("month-day"), janet_wrap_number(t_info->tm_mday - 1));
1328 janet_struct_put(st, janet_ckeywordv("month"), janet_wrap_number(t_info->tm_mon));
1329 janet_struct_put(st, janet_ckeywordv("year"), janet_wrap_number(t_info->tm_year + 1900));
1330 janet_struct_put(st, janet_ckeywordv("week-day"), janet_wrap_number(t_info->tm_wday));
1331 janet_struct_put(st, janet_ckeywordv("year-day"), janet_wrap_number(t_info->tm_yday));
1332 janet_struct_put(st, janet_ckeywordv("dst"), janet_wrap_boolean(t_info->tm_isdst));
1333 return janet_wrap_struct(janet_struct_end(st));
1334 }
1335
entry_getdst(Janet env_entry)1336 static int entry_getdst(Janet env_entry) {
1337 Janet v;
1338 if (janet_checktype(env_entry, JANET_TABLE)) {
1339 JanetTable *entry = janet_unwrap_table(env_entry);
1340 v = janet_table_get(entry, janet_ckeywordv("dst"));
1341 } else if (janet_checktype(env_entry, JANET_STRUCT)) {
1342 const JanetKV *entry = janet_unwrap_struct(env_entry);
1343 v = janet_struct_get(entry, janet_ckeywordv("dst"));
1344 } else {
1345 v = janet_wrap_nil();
1346 }
1347 if (janet_checktype(v, JANET_NIL)) {
1348 return -1;
1349 } else {
1350 return janet_truthy(v);
1351 }
1352 }
1353
1354 #ifdef JANET_WINDOWS
1355 typedef int32_t timeint_t;
1356 #else
1357 typedef int64_t timeint_t;
1358 #endif
1359
entry_getint(Janet env_entry,char * field)1360 static timeint_t entry_getint(Janet env_entry, char *field) {
1361 Janet i;
1362 if (janet_checktype(env_entry, JANET_TABLE)) {
1363 JanetTable *entry = janet_unwrap_table(env_entry);
1364 i = janet_table_get(entry, janet_ckeywordv(field));
1365 } else if (janet_checktype(env_entry, JANET_STRUCT)) {
1366 const JanetKV *entry = janet_unwrap_struct(env_entry);
1367 i = janet_struct_get(entry, janet_ckeywordv(field));
1368 } else {
1369 return 0;
1370 }
1371
1372 if (janet_checktype(i, JANET_NIL)) {
1373 return 0;
1374 }
1375
1376 #ifdef JANET_WINDOWS
1377 if (!janet_checkint(i)) {
1378 janet_panicf("bad slot #%s, expected 32 bit signed integer, got %v",
1379 field, i);
1380 }
1381 #else
1382 if (!janet_checkint64(i)) {
1383 janet_panicf("bad slot #%s, expected 64 bit signed integer, got %v",
1384 field, i);
1385 }
1386 #endif
1387
1388 return (timeint_t)janet_unwrap_number(i);
1389 }
1390
1391 JANET_CORE_FN(os_mktime,
1392 "(os/mktime date-struct &opt local)",
1393 "Get the broken down date-struct time expressed as the number "
1394 " of seconds since January 1, 1970, the Unix epoch. "
1395 "Returns a real number. "
1396 "Date is given in UTC unless local is truthy, in which case the "
1397 "date is computed for the local timezone.\n\n"
1398 "Inverse function to os/date.") {
1399 janet_arity(argc, 1, 2);
1400 time_t t;
1401 struct tm t_info;
1402
1403 /* Use memset instead of = {0} to silence paranoid warning in macos */
1404 memset(&t_info, 0, sizeof(t_info));
1405
1406 if (!janet_checktype(argv[0], JANET_TABLE) &&
1407 !janet_checktype(argv[0], JANET_STRUCT))
1408 janet_panic_type(argv[0], 0, JANET_TFLAG_DICTIONARY);
1409
1410 t_info.tm_sec = entry_getint(argv[0], "seconds");
1411 t_info.tm_min = entry_getint(argv[0], "minutes");
1412 t_info.tm_hour = entry_getint(argv[0], "hours");
1413 t_info.tm_mday = entry_getint(argv[0], "month-day") + 1;
1414 t_info.tm_mon = entry_getint(argv[0], "month");
1415 t_info.tm_year = entry_getint(argv[0], "year") - 1900;
1416 t_info.tm_isdst = entry_getdst(argv[0]);
1417
1418 if (argc >= 2 && janet_truthy(argv[1])) {
1419 /* local time */
1420 t = mktime(&t_info);
1421 } else {
1422 /* utc time */
1423 #ifdef JANET_NO_UTC_MKTIME
1424 janet_panic("os/mktime UTC not supported on this platform");
1425 return janet_wrap_nil();
1426 #else
1427 t = timegm(&t_info);
1428 #endif
1429 }
1430
1431 if (t == (time_t) -1) {
1432 janet_panicf("%s", strerror(errno));
1433 }
1434
1435 return janet_wrap_number((double)t);
1436 }
1437
1438 #ifdef JANET_NO_SYMLINKS
1439 #define j_symlink link
1440 #else
1441 #define j_symlink symlink
1442 #endif
1443
1444 JANET_CORE_FN(os_link,
1445 "(os/link oldpath newpath &opt symlink)",
1446 "Create a link at newpath that points to oldpath and returns nil. "
1447 "Iff symlink is truthy, creates a symlink. "
1448 "Iff symlink is falsey or not provided, "
1449 "creates a hard link. Does not work on Windows.") {
1450 janet_arity(argc, 2, 3);
1451 #ifdef JANET_WINDOWS
1452 (void) argc;
1453 (void) argv;
1454 janet_panic("os/link not supported on Windows");
1455 return janet_wrap_nil();
1456 #else
1457 const char *oldpath = janet_getcstring(argv, 0);
1458 const char *newpath = janet_getcstring(argv, 1);
1459 int res = ((argc == 3 && janet_truthy(argv[2])) ? j_symlink : link)(oldpath, newpath);
1460 if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
1461 return janet_wrap_nil();
1462 #endif
1463 }
1464
1465 JANET_CORE_FN(os_symlink,
1466 "(os/symlink oldpath newpath)",
1467 "Create a symlink from oldpath to newpath, returning nil. Same as (os/link oldpath newpath true).") {
1468 janet_fixarity(argc, 2);
1469 #ifdef JANET_WINDOWS
1470 (void) argc;
1471 (void) argv;
1472 janet_panic("os/symlink not supported on Windows");
1473 return janet_wrap_nil();
1474 #else
1475 const char *oldpath = janet_getcstring(argv, 0);
1476 const char *newpath = janet_getcstring(argv, 1);
1477 int res = j_symlink(oldpath, newpath);
1478 if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
1479 return janet_wrap_nil();
1480 #endif
1481 }
1482
1483 #undef j_symlink
1484
1485 JANET_CORE_FN(os_mkdir,
1486 "(os/mkdir path)",
1487 "Create a new directory. The path will be relative to the current directory if relative, otherwise "
1488 "it will be an absolute path. Returns true if the directory was created, false if the directory already exists, and "
1489 "errors otherwise.") {
1490 janet_fixarity(argc, 1);
1491 const char *path = janet_getcstring(argv, 0);
1492 #ifdef JANET_WINDOWS
1493 int res = _mkdir(path);
1494 #else
1495 int res = mkdir(path, S_IRUSR | S_IWUSR | S_IXUSR | S_IRGRP | S_IWGRP | S_IXGRP | S_IROTH | S_IXOTH);
1496 #endif
1497 if (res == 0) return janet_wrap_true();
1498 if (errno == EEXIST) return janet_wrap_false();
1499 janet_panicf("%s: %s", strerror(errno), path);
1500 }
1501
1502 JANET_CORE_FN(os_rmdir,
1503 "(os/rmdir path)",
1504 "Delete a directory. The directory must be empty to succeed.") {
1505 janet_fixarity(argc, 1);
1506 const char *path = janet_getcstring(argv, 0);
1507 #ifdef JANET_WINDOWS
1508 int res = _rmdir(path);
1509 #else
1510 int res = rmdir(path);
1511 #endif
1512 if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
1513 return janet_wrap_nil();
1514 }
1515
1516 JANET_CORE_FN(os_cd,
1517 "(os/cd path)",
1518 "Change current directory to path. Returns nil on success, errors on failure.") {
1519 janet_fixarity(argc, 1);
1520 const char *path = janet_getcstring(argv, 0);
1521 #ifdef JANET_WINDOWS
1522 int res = _chdir(path);
1523 #else
1524 int res = chdir(path);
1525 #endif
1526 if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
1527 return janet_wrap_nil();
1528 }
1529
1530 JANET_CORE_FN(os_touch,
1531 "(os/touch path &opt actime modtime)",
1532 "Update the access time and modification times for a file. By default, sets "
1533 "times to the current time.") {
1534 janet_arity(argc, 1, 3);
1535 const char *path = janet_getcstring(argv, 0);
1536 struct utimbuf timebuf, *bufp;
1537 if (argc >= 2) {
1538 bufp = &timebuf;
1539 timebuf.actime = (time_t) janet_getnumber(argv, 1);
1540 if (argc >= 3) {
1541 timebuf.modtime = (time_t) janet_getnumber(argv, 2);
1542 } else {
1543 timebuf.modtime = timebuf.actime;
1544 }
1545 } else {
1546 bufp = NULL;
1547 }
1548 int res = utime(path, bufp);
1549 if (-1 == res) janet_panic(strerror(errno));
1550 return janet_wrap_nil();
1551 }
1552
1553 JANET_CORE_FN(os_remove,
1554 "(os/rm path)",
1555 "Delete a file. Returns nil.") {
1556 janet_fixarity(argc, 1);
1557 const char *path = janet_getcstring(argv, 0);
1558 int status = remove(path);
1559 if (-1 == status) janet_panicf("%s: %s", strerror(errno), path);
1560 return janet_wrap_nil();
1561 }
1562
1563 #ifndef JANET_NO_SYMLINKS
1564 JANET_CORE_FN(os_readlink,
1565 "(os/readlink path)",
1566 "Read the contents of a symbolic link. Does not work on Windows.\n") {
1567 janet_fixarity(argc, 1);
1568 #ifdef JANET_WINDOWS
1569 (void) argc;
1570 (void) argv;
1571 janet_panic("os/readlink not supported on Windows");
1572 return janet_wrap_nil();
1573 #else
1574 static char buffer[PATH_MAX];
1575 const char *path = janet_getcstring(argv, 0);
1576 ssize_t len = readlink(path, buffer, sizeof buffer);
1577 if (len < 0 || (size_t)len >= sizeof buffer)
1578 janet_panicf("%s: %s", strerror(errno), path);
1579 return janet_stringv((const uint8_t *)buffer, len);
1580 #endif
1581 }
1582 #endif
1583
1584 #ifdef JANET_WINDOWS
1585
1586 typedef struct _stat jstat_t;
1587 typedef unsigned short jmode_t;
1588
janet_perm_to_unix(unsigned short m)1589 static int32_t janet_perm_to_unix(unsigned short m) {
1590 int32_t ret = 0;
1591 if (m & S_IEXEC) ret |= 0111;
1592 if (m & S_IWRITE) ret |= 0222;
1593 if (m & S_IREAD) ret |= 0444;
1594 return ret;
1595 }
1596
janet_perm_from_unix(int32_t x)1597 static unsigned short janet_perm_from_unix(int32_t x) {
1598 unsigned short m = 0;
1599 if (x & 111) m |= S_IEXEC;
1600 if (x & 222) m |= S_IWRITE;
1601 if (x & 444) m |= S_IREAD;
1602 return m;
1603 }
1604
janet_decode_mode(unsigned short m)1605 static const uint8_t *janet_decode_mode(unsigned short m) {
1606 const char *str = "other";
1607 if (m & _S_IFREG) str = "file";
1608 else if (m & _S_IFDIR) str = "directory";
1609 else if (m & _S_IFCHR) str = "character";
1610 return janet_ckeyword(str);
1611 }
1612
janet_decode_permissions(jmode_t mode)1613 static int32_t janet_decode_permissions(jmode_t mode) {
1614 return (int32_t)(mode & (S_IEXEC | S_IWRITE | S_IREAD));
1615 }
1616
1617 #else
1618
1619 typedef struct stat jstat_t;
1620 typedef mode_t jmode_t;
1621
janet_perm_to_unix(mode_t m)1622 static int32_t janet_perm_to_unix(mode_t m) {
1623 return (int32_t) m;
1624 }
1625
janet_perm_from_unix(int32_t x)1626 static mode_t janet_perm_from_unix(int32_t x) {
1627 return (mode_t) x;
1628 }
1629
janet_decode_mode(mode_t m)1630 static const uint8_t *janet_decode_mode(mode_t m) {
1631 const char *str = "other";
1632 if (S_ISREG(m)) str = "file";
1633 else if (S_ISDIR(m)) str = "directory";
1634 else if (S_ISFIFO(m)) str = "fifo";
1635 else if (S_ISBLK(m)) str = "block";
1636 else if (S_ISSOCK(m)) str = "socket";
1637 else if (S_ISLNK(m)) str = "link";
1638 else if (S_ISCHR(m)) str = "character";
1639 return janet_ckeyword(str);
1640 }
1641
janet_decode_permissions(jmode_t mode)1642 static int32_t janet_decode_permissions(jmode_t mode) {
1643 return (int32_t)(mode & 0777);
1644 }
1645
1646 #endif
1647
os_parse_permstring(const uint8_t * perm)1648 static int32_t os_parse_permstring(const uint8_t *perm) {
1649 int32_t m = 0;
1650 if (perm[0] == 'r') m |= 0400;
1651 if (perm[1] == 'w') m |= 0200;
1652 if (perm[2] == 'x') m |= 0100;
1653 if (perm[3] == 'r') m |= 0040;
1654 if (perm[4] == 'w') m |= 0020;
1655 if (perm[5] == 'x') m |= 0010;
1656 if (perm[6] == 'r') m |= 0004;
1657 if (perm[7] == 'w') m |= 0002;
1658 if (perm[8] == 'x') m |= 0001;
1659 return m;
1660 }
1661
os_make_permstring(int32_t permissions)1662 static Janet os_make_permstring(int32_t permissions) {
1663 uint8_t bytes[9] = {0};
1664 bytes[0] = (permissions & 0400) ? 'r' : '-';
1665 bytes[1] = (permissions & 0200) ? 'w' : '-';
1666 bytes[2] = (permissions & 0100) ? 'x' : '-';
1667 bytes[3] = (permissions & 0040) ? 'r' : '-';
1668 bytes[4] = (permissions & 0020) ? 'w' : '-';
1669 bytes[5] = (permissions & 0010) ? 'x' : '-';
1670 bytes[6] = (permissions & 0004) ? 'r' : '-';
1671 bytes[7] = (permissions & 0002) ? 'w' : '-';
1672 bytes[8] = (permissions & 0001) ? 'x' : '-';
1673 return janet_stringv(bytes, sizeof(bytes));
1674 }
1675
os_get_unix_mode(const Janet * argv,int32_t n)1676 static int32_t os_get_unix_mode(const Janet *argv, int32_t n) {
1677 int32_t unix_mode;
1678 if (janet_checkint(argv[n])) {
1679 /* Integer mode */
1680 int32_t x = janet_unwrap_integer(argv[n]);
1681 if (x < 0 || x > 0777) {
1682 janet_panicf("bad slot #%d, expected integer in range [0, 8r777], got %v", n, argv[n]);
1683 }
1684 unix_mode = x;
1685 } else {
1686 /* Bytes mode */
1687 JanetByteView bytes = janet_getbytes(argv, n);
1688 if (bytes.len != 9) {
1689 janet_panicf("bad slot #%d: expected byte sequence of length 9, got %v", n, argv[n]);
1690 }
1691 unix_mode = os_parse_permstring(bytes.bytes);
1692 }
1693 return unix_mode;
1694 }
1695
os_getmode(const Janet * argv,int32_t n)1696 static jmode_t os_getmode(const Janet *argv, int32_t n) {
1697 return janet_perm_from_unix(os_get_unix_mode(argv, n));
1698 }
1699
1700 /* Getters */
os_stat_dev(jstat_t * st)1701 static Janet os_stat_dev(jstat_t *st) {
1702 return janet_wrap_number(st->st_dev);
1703 }
os_stat_inode(jstat_t * st)1704 static Janet os_stat_inode(jstat_t *st) {
1705 return janet_wrap_number(st->st_ino);
1706 }
os_stat_mode(jstat_t * st)1707 static Janet os_stat_mode(jstat_t *st) {
1708 return janet_wrap_keyword(janet_decode_mode(st->st_mode));
1709 }
os_stat_int_permissions(jstat_t * st)1710 static Janet os_stat_int_permissions(jstat_t *st) {
1711 return janet_wrap_integer(janet_perm_to_unix(janet_decode_permissions(st->st_mode)));
1712 }
os_stat_permissions(jstat_t * st)1713 static Janet os_stat_permissions(jstat_t *st) {
1714 return os_make_permstring(janet_perm_to_unix(janet_decode_permissions(st->st_mode)));
1715 }
os_stat_uid(jstat_t * st)1716 static Janet os_stat_uid(jstat_t *st) {
1717 return janet_wrap_number(st->st_uid);
1718 }
os_stat_gid(jstat_t * st)1719 static Janet os_stat_gid(jstat_t *st) {
1720 return janet_wrap_number(st->st_gid);
1721 }
os_stat_nlink(jstat_t * st)1722 static Janet os_stat_nlink(jstat_t *st) {
1723 return janet_wrap_number(st->st_nlink);
1724 }
os_stat_rdev(jstat_t * st)1725 static Janet os_stat_rdev(jstat_t *st) {
1726 return janet_wrap_number(st->st_rdev);
1727 }
os_stat_size(jstat_t * st)1728 static Janet os_stat_size(jstat_t *st) {
1729 return janet_wrap_number(st->st_size);
1730 }
os_stat_accessed(jstat_t * st)1731 static Janet os_stat_accessed(jstat_t *st) {
1732 return janet_wrap_number((double) st->st_atime);
1733 }
os_stat_modified(jstat_t * st)1734 static Janet os_stat_modified(jstat_t *st) {
1735 return janet_wrap_number((double) st->st_mtime);
1736 }
os_stat_changed(jstat_t * st)1737 static Janet os_stat_changed(jstat_t *st) {
1738 return janet_wrap_number((double) st->st_ctime);
1739 }
1740 #ifdef JANET_WINDOWS
os_stat_blocks(jstat_t * st)1741 static Janet os_stat_blocks(jstat_t *st) {
1742 return janet_wrap_number(0);
1743 }
os_stat_blocksize(jstat_t * st)1744 static Janet os_stat_blocksize(jstat_t *st) {
1745 return janet_wrap_number(0);
1746 }
1747 #else
os_stat_blocks(jstat_t * st)1748 static Janet os_stat_blocks(jstat_t *st) {
1749 return janet_wrap_number(st->st_blocks);
1750 }
os_stat_blocksize(jstat_t * st)1751 static Janet os_stat_blocksize(jstat_t *st) {
1752 return janet_wrap_number(st->st_blksize);
1753 }
1754 #endif
1755
1756 struct OsStatGetter {
1757 const char *name;
1758 Janet(*fn)(jstat_t *st);
1759 };
1760
1761 static const struct OsStatGetter os_stat_getters[] = {
1762 {"dev", os_stat_dev},
1763 {"inode", os_stat_inode},
1764 {"mode", os_stat_mode},
1765 {"int-permissions", os_stat_int_permissions},
1766 {"permissions", os_stat_permissions},
1767 {"uid", os_stat_uid},
1768 {"gid", os_stat_gid},
1769 {"nlink", os_stat_nlink},
1770 {"rdev", os_stat_rdev},
1771 {"size", os_stat_size},
1772 {"blocks", os_stat_blocks},
1773 {"blocksize", os_stat_blocksize},
1774 {"accessed", os_stat_accessed},
1775 {"modified", os_stat_modified},
1776 {"changed", os_stat_changed},
1777 {NULL, NULL}
1778 };
1779
os_stat_or_lstat(int do_lstat,int32_t argc,Janet * argv)1780 static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
1781 janet_arity(argc, 1, 2);
1782 const char *path = janet_getcstring(argv, 0);
1783 JanetTable *tab = NULL;
1784 int getall = 1;
1785 const uint8_t *key;
1786 if (argc == 2) {
1787 if (janet_checktype(argv[1], JANET_KEYWORD)) {
1788 getall = 0;
1789 key = janet_getkeyword(argv, 1);
1790 } else {
1791 tab = janet_gettable(argv, 1);
1792 }
1793 } else {
1794 tab = janet_table(0);
1795 }
1796
1797 /* Build result */
1798 jstat_t st;
1799 #ifdef JANET_WINDOWS
1800 (void) do_lstat;
1801 int res = _stat(path, &st);
1802 #else
1803 int res;
1804 if (do_lstat) {
1805 res = lstat(path, &st);
1806 } else {
1807 res = stat(path, &st);
1808 }
1809 #endif
1810 if (-1 == res) {
1811 return janet_wrap_nil();
1812 }
1813
1814 if (getall) {
1815 /* Put results in table */
1816 for (const struct OsStatGetter *sg = os_stat_getters; sg->name != NULL; sg++) {
1817 janet_table_put(tab, janet_ckeywordv(sg->name), sg->fn(&st));
1818 }
1819 return janet_wrap_table(tab);
1820 } else {
1821 /* Get one result */
1822 for (const struct OsStatGetter *sg = os_stat_getters; sg->name != NULL; sg++) {
1823 if (janet_cstrcmp(key, sg->name)) continue;
1824 return sg->fn(&st);
1825 }
1826 janet_panicf("unexpected keyword %v", janet_wrap_keyword(key));
1827 return janet_wrap_nil();
1828 }
1829 }
1830
1831 JANET_CORE_FN(os_stat,
1832 "(os/stat path &opt tab|key)",
1833 "Gets information about a file or directory. Returns a table if the second argument is a keyword, returns "
1834 " only that information from stat. If the file or directory does not exist, returns nil. The keys are:\n\n"
1835 "* :dev - the device that the file is on\n\n"
1836 "* :mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n\n"
1837 "* :int-permissions - A Unix permission integer like 8r744\n\n"
1838 "* :permissions - A Unix permission string like \"rwxr--r--\"\n\n"
1839 "* :uid - File uid\n\n"
1840 "* :gid - File gid\n\n"
1841 "* :nlink - number of links to file\n\n"
1842 "* :rdev - Real device of file. 0 on windows.\n\n"
1843 "* :size - size of file in bytes\n\n"
1844 "* :blocks - number of blocks in file. 0 on windows\n\n"
1845 "* :blocksize - size of blocks in file. 0 on windows\n\n"
1846 "* :accessed - timestamp when file last accessed\n\n"
1847 "* :changed - timestamp when file last changed (permissions changed)\n\n"
1848 "* :modified - timestamp when file last modified (content changed)\n") {
1849 return os_stat_or_lstat(0, argc, argv);
1850 }
1851
1852 JANET_CORE_FN(os_lstat,
1853 "(os/lstat path &opt tab|key)",
1854 "Like os/stat, but don't follow symlinks.\n") {
1855 return os_stat_or_lstat(1, argc, argv);
1856 }
1857
1858 JANET_CORE_FN(os_chmod,
1859 "(os/chmod path mode)",
1860 "Change file permissions, where mode is a permission string as returned by "
1861 "os/perm-string, or an integer as returned by os/perm-int. "
1862 "When mode is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
1863 "8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.") {
1864 janet_fixarity(argc, 2);
1865 const char *path = janet_getcstring(argv, 0);
1866 #ifdef JANET_WINDOWS
1867 int res = _chmod(path, os_getmode(argv, 1));
1868 #else
1869 int res = chmod(path, os_getmode(argv, 1));
1870 #endif
1871 if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
1872 return janet_wrap_nil();
1873 }
1874
1875 #ifndef JANET_NO_UMASK
1876 JANET_CORE_FN(os_umask,
1877 "(os/umask mask)",
1878 "Set a new umask, returns the old umask.") {
1879 janet_fixarity(argc, 1);
1880 int mask = (int) os_getmode(argv, 0);
1881 #ifdef JANET_WINDOWS
1882 int res = _umask(mask);
1883 #else
1884 int res = umask(mask);
1885 #endif
1886 return janet_wrap_integer(janet_perm_to_unix(res));
1887 }
1888 #endif
1889
1890 JANET_CORE_FN(os_dir,
1891 "(os/dir dir &opt array)",
1892 "Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
1893 "with only the file name or directory name and no prefix.") {
1894 janet_arity(argc, 1, 2);
1895 const char *dir = janet_getcstring(argv, 0);
1896 JanetArray *paths = (argc == 2) ? janet_getarray(argv, 1) : janet_array(0);
1897 #ifdef JANET_WINDOWS
1898 /* Read directory items with FindFirstFile / FindNextFile / FindClose */
1899 struct _finddata_t afile;
1900 char pattern[MAX_PATH + 1];
1901 if (strlen(dir) > (sizeof(pattern) - 3))
1902 janet_panicf("path too long: %s", dir);
1903 sprintf(pattern, "%s/*", dir);
1904 intptr_t res = _findfirst(pattern, &afile);
1905 if (-1 == res) janet_panicv(janet_cstringv(strerror(errno)));
1906 do {
1907 if (strcmp(".", afile.name) && strcmp("..", afile.name)) {
1908 janet_array_push(paths, janet_cstringv(afile.name));
1909 }
1910 } while (_findnext(res, &afile) != -1);
1911 _findclose(res);
1912 #else
1913 /* Read directory items with opendir / readdir / closedir */
1914 struct dirent *dp;
1915 DIR *dfd = opendir(dir);
1916 if (dfd == NULL) janet_panicf("cannot open directory %s", dir);
1917 while ((dp = readdir(dfd)) != NULL) {
1918 if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) {
1919 continue;
1920 }
1921 janet_array_push(paths, janet_cstringv(dp->d_name));
1922 }
1923 closedir(dfd);
1924 #endif
1925 return janet_wrap_array(paths);
1926 }
1927
1928 JANET_CORE_FN(os_rename,
1929 "(os/rename oldname newname)",
1930 "Rename a file on disk to a new path. Returns nil.") {
1931 janet_fixarity(argc, 2);
1932 const char *src = janet_getcstring(argv, 0);
1933 const char *dest = janet_getcstring(argv, 1);
1934 int status = rename(src, dest);
1935 if (status) {
1936 janet_panic(strerror(errno));
1937 }
1938 return janet_wrap_nil();
1939 }
1940
1941 JANET_CORE_FN(os_realpath,
1942 "(os/realpath path)",
1943 "Get the absolute path for a given path, following ../, ./, and symlinks. "
1944 "Returns an absolute path as a string. Will raise an error on Windows.") {
1945 janet_fixarity(argc, 1);
1946 const char *src = janet_getcstring(argv, 0);
1947 #ifdef JANET_NO_REALPATH
1948 janet_panic("os/realpath not enabled for this platform");
1949 #else
1950 #ifdef JANET_WINDOWS
1951 char *dest = _fullpath(NULL, src, _MAX_PATH);
1952 #else
1953 char *dest = realpath(src, NULL);
1954 #endif
1955 if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
1956 Janet ret = janet_cstringv(dest);
1957 janet_free(dest);
1958 return ret;
1959 #endif
1960 }
1961
1962 JANET_CORE_FN(os_permission_string,
1963 "(os/perm-string int)",
1964 "Convert a Unix octal permission value from a permission integer as returned by os/stat "
1965 "to a human readable string, that follows the formatting "
1966 "of unix tools like ls. Returns the string as a 9 character string of r, w, x and - characters. Does not "
1967 "include the file/directory/symlink character as rendered by `ls`.") {
1968 janet_fixarity(argc, 1);
1969 return os_make_permstring(os_get_unix_mode(argv, 0));
1970 }
1971
1972 JANET_CORE_FN(os_permission_int,
1973 "(os/perm-int bytes)",
1974 "Parse a 9 character permission string and return an integer that can be used by chmod.") {
1975 janet_fixarity(argc, 1);
1976 return janet_wrap_integer(os_get_unix_mode(argv, 0));
1977 }
1978
1979 #ifdef JANET_EV
1980
1981 /*
1982 * Define a few functions on streams the require JANET_EV to be defined.
1983 */
1984
os_optmode(int32_t argc,const Janet * argv,int32_t n,int32_t dflt)1985 static jmode_t os_optmode(int32_t argc, const Janet *argv, int32_t n, int32_t dflt) {
1986 if (argc > n) return os_getmode(argv, n);
1987 return janet_perm_from_unix(dflt);
1988 }
1989
1990 JANET_CORE_FN(os_open,
1991 "(os/open path &opt flags mode)",
1992 "Create a stream from a file, like the POSIX open system call. Returns a new stream. "
1993 "mode should be a file mode as passed to os/chmod, but only if the create flag is given. "
1994 "The default mode is 8r666. "
1995 "Allowed flags are as follows:\n\n"
1996 " * :r - open this file for reading\n"
1997 " * :w - open this file for writing\n"
1998 " * :c - create a new file (O_CREATE)\n"
1999 " * :e - fail if the file exists (O_EXCL)\n"
2000 " * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
2001 "Posix only flags:\n\n"
2002 " * :a - append to a file (O_APPEND)\n"
2003 " * :x - O_SYNC\n"
2004 " * :C - O_NOCTTY\n\n"
2005 "Windows only flags:\n\n"
2006 " * :R - share reads (FILE_SHARE_READ)\n"
2007 " * :W - share writes (FILE_SHARE_WRITE)\n"
2008 " * :D - share deletes (FILE_SHARE_DELETE)\n"
2009 " * :H - FILE_ATTRIBUTE_HIDDEN\n"
2010 " * :O - FILE_ATTRIBUTE_READONLY\n"
2011 " * :F - FILE_ATTRIBUTE_OFFLINE\n"
2012 " * :T - FILE_ATTRIBUTE_TEMPORARY\n"
2013 " * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
2014 " * :b - FILE_FLAG_NO_BUFFERING\n") {
2015 janet_arity(argc, 1, 3);
2016 const char *path = janet_getcstring(argv, 0);
2017 const uint8_t *opt_flags = janet_optkeyword(argv, argc, 1, (const uint8_t *) "r");
2018 jmode_t mode = os_optmode(argc, argv, 2, 0666);
2019 uint32_t stream_flags = 0;
2020 JanetHandle fd;
2021 #ifdef JANET_WINDOWS
2022 DWORD desiredAccess = 0;
2023 DWORD shareMode = 0;
2024 DWORD creationDisp = 0;
2025 DWORD flagsAndAttributes = FILE_FLAG_OVERLAPPED;
2026 /* We map unix-like open flags to the creationDisp parameter */
2027 int creatUnix = 0;
2028 #define OCREAT 1
2029 #define OEXCL 2
2030 #define OTRUNC 4
2031 for (const uint8_t *c = opt_flags; *c; c++) {
2032 switch (*c) {
2033 default:
2034 break;
2035 case 'r':
2036 desiredAccess |= GENERIC_READ;
2037 stream_flags |= JANET_STREAM_READABLE;
2038 break;
2039 case 'w':
2040 desiredAccess |= GENERIC_WRITE;
2041 stream_flags |= JANET_STREAM_WRITABLE;
2042 break;
2043 case 'c':
2044 creatUnix |= OCREAT;
2045 break;
2046 case 'e':
2047 creatUnix |= OEXCL;
2048 break;
2049 case 't':
2050 creatUnix |= OTRUNC;
2051 break;
2052 /* Windows only flags */
2053 case 'D':
2054 shareMode |= FILE_SHARE_DELETE;
2055 break;
2056 case 'R':
2057 shareMode |= FILE_SHARE_READ;
2058 break;
2059 case 'W':
2060 shareMode |= FILE_SHARE_WRITE;
2061 break;
2062 case 'H':
2063 flagsAndAttributes |= FILE_ATTRIBUTE_HIDDEN;
2064 break;
2065 case 'O':
2066 flagsAndAttributes |= FILE_ATTRIBUTE_READONLY;
2067 break;
2068 case 'F':
2069 flagsAndAttributes |= FILE_ATTRIBUTE_OFFLINE;
2070 break;
2071 case 'T':
2072 flagsAndAttributes |= FILE_ATTRIBUTE_TEMPORARY;
2073 break;
2074 case 'd':
2075 flagsAndAttributes |= FILE_FLAG_DELETE_ON_CLOSE;
2076 break;
2077 case 'b':
2078 flagsAndAttributes |= FILE_FLAG_NO_BUFFERING;
2079 break;
2080 /* we could potentially add more here -
2081 * https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilea
2082 */
2083 }
2084 }
2085 switch (creatUnix) {
2086 default:
2087 janet_panic("invalid creation flags");
2088 case 0:
2089 creationDisp = OPEN_EXISTING;
2090 break;
2091 case OCREAT:
2092 creationDisp = OPEN_ALWAYS;
2093 break;
2094 case OCREAT + OEXCL:
2095 creationDisp = CREATE_NEW;
2096 break;
2097 case OCREAT + OTRUNC:
2098 creationDisp = CREATE_ALWAYS;
2099 break;
2100 case OTRUNC:
2101 creationDisp = TRUNCATE_EXISTING;
2102 break;
2103 }
2104 fd = CreateFileA(path, desiredAccess, shareMode, NULL, creationDisp, flagsAndAttributes, NULL);
2105 if (fd == INVALID_HANDLE_VALUE) janet_panicv(janet_ev_lasterr());
2106 #else
2107 int open_flags = O_NONBLOCK;
2108 #ifdef JANET_LINUX
2109 open_flags |= O_CLOEXEC;
2110 #endif
2111 for (const uint8_t *c = opt_flags; *c; c++) {
2112 switch (*c) {
2113 default:
2114 break;
2115 case 'r':
2116 open_flags = (open_flags & O_WRONLY)
2117 ? ((open_flags & ~O_WRONLY) | O_RDWR)
2118 : (open_flags | O_RDONLY);
2119 stream_flags |= JANET_STREAM_READABLE;
2120 break;
2121 case 'w':
2122 open_flags = (open_flags & O_RDONLY)
2123 ? ((open_flags & ~O_RDONLY) | O_RDWR)
2124 : (open_flags | O_WRONLY);
2125 stream_flags |= JANET_STREAM_WRITABLE;
2126 break;
2127 case 'c':
2128 open_flags |= O_CREAT;
2129 break;
2130 case 'e':
2131 open_flags |= O_EXCL;
2132 break;
2133 case 't':
2134 open_flags |= O_TRUNC;
2135 break;
2136 /* posix only */
2137 case 'x':
2138 open_flags |= O_SYNC;
2139 break;
2140 case 'C':
2141 open_flags |= O_NOCTTY;
2142 break;
2143 case 'a':
2144 open_flags |= O_APPEND;
2145 break;
2146 }
2147 }
2148 do {
2149 fd = open(path, open_flags, mode);
2150 } while (fd == -1 && errno == EINTR);
2151 if (fd == -1) janet_panicv(janet_ev_lasterr());
2152 #endif
2153 return janet_wrap_abstract(janet_stream(fd, stream_flags, NULL));
2154 }
2155
2156 JANET_CORE_FN(os_pipe,
2157 "(os/pipe)",
2158 "Create a readable stream and a writable stream that are connected. Returns a two element "
2159 "tuple where the first element is a readable stream and the second element is the writable "
2160 "stream.") {
2161 (void) argv;
2162 janet_fixarity(argc, 0);
2163 JanetHandle fds[2];
2164 if (janet_make_pipe(fds, 0)) janet_panicv(janet_ev_lasterr());
2165 JanetStream *reader = janet_stream(fds[0], JANET_STREAM_READABLE, NULL);
2166 JanetStream *writer = janet_stream(fds[1], JANET_STREAM_WRITABLE, NULL);
2167 Janet tup[2] = {janet_wrap_abstract(reader), janet_wrap_abstract(writer)};
2168 return janet_wrap_tuple(janet_tuple_n(tup, 2));
2169 }
2170
2171 #endif
2172
2173 #endif /* JANET_REDUCED_OS */
2174
2175 /* Module entry point */
janet_lib_os(JanetTable * env)2176 void janet_lib_os(JanetTable *env) {
2177 #if !defined(JANET_REDUCED_OS) && defined(JANET_WINDOWS) && defined(JANET_THREADS)
2178 /* During start up, the top-most abstract machine (thread)
2179 * in the thread tree sets up the critical section. */
2180 static volatile long env_lock_initializing = 0;
2181 static volatile long env_lock_initialized = 0;
2182 if (!InterlockedExchange(&env_lock_initializing, 1)) {
2183 InitializeCriticalSection(&env_lock);
2184 InterlockedOr(&env_lock_initialized, 1);
2185 } else {
2186 while (!InterlockedOr(&env_lock_initialized, 0)) {
2187 Sleep(0);
2188 }
2189 }
2190
2191 #endif
2192 #ifndef JANET_NO_PROCESSES
2193 #endif
2194 JanetRegExt os_cfuns[] = {
2195 JANET_CORE_REG("os/exit", os_exit),
2196 JANET_CORE_REG("os/which", os_which),
2197 JANET_CORE_REG("os/arch", os_arch),
2198 #ifndef JANET_REDUCED_OS
2199 JANET_CORE_REG("os/environ", os_environ),
2200 JANET_CORE_REG("os/getenv", os_getenv),
2201 JANET_CORE_REG("os/dir", os_dir),
2202 JANET_CORE_REG("os/stat", os_stat),
2203 JANET_CORE_REG("os/lstat", os_lstat),
2204 JANET_CORE_REG("os/chmod", os_chmod),
2205 JANET_CORE_REG("os/touch", os_touch),
2206 JANET_CORE_REG("os/cd", os_cd),
2207 #ifndef JANET_NO_UMASK
2208 JANET_CORE_REG("os/umask", os_umask),
2209 #endif
2210 JANET_CORE_REG("os/mkdir", os_mkdir),
2211 JANET_CORE_REG("os/rmdir", os_rmdir),
2212 JANET_CORE_REG("os/rm", os_remove),
2213 JANET_CORE_REG("os/link", os_link),
2214 #ifndef JANET_NO_SYMLINKS
2215 JANET_CORE_REG("os/symlink", os_symlink),
2216 JANET_CORE_REG("os/readlink", os_readlink),
2217 #endif
2218 #ifndef JANET_NO_PROCESSES
2219 JANET_CORE_REG("os/execute", os_execute),
2220 JANET_CORE_REG("os/spawn", os_spawn),
2221 JANET_CORE_REG("os/shell", os_shell),
2222 JANET_CORE_REG("os/proc-wait", os_proc_wait),
2223 JANET_CORE_REG("os/proc-kill", os_proc_kill),
2224 JANET_CORE_REG("os/proc-close", os_proc_close),
2225 #endif
2226 JANET_CORE_REG("os/setenv", os_setenv),
2227 JANET_CORE_REG("os/time", os_time),
2228 JANET_CORE_REG("os/mktime", os_mktime),
2229 JANET_CORE_REG("os/clock", os_clock),
2230 JANET_CORE_REG("os/sleep", os_sleep),
2231 JANET_CORE_REG("os/cwd", os_cwd),
2232 JANET_CORE_REG("os/cryptorand", os_cryptorand),
2233 JANET_CORE_REG("os/date", os_date),
2234 JANET_CORE_REG("os/rename", os_rename),
2235 JANET_CORE_REG("os/realpath", os_realpath),
2236 JANET_CORE_REG("os/perm-string", os_permission_string),
2237 JANET_CORE_REG("os/perm-int", os_permission_int),
2238 #ifdef JANET_EV
2239 JANET_CORE_REG("os/open", os_open),
2240 JANET_CORE_REG("os/pipe", os_pipe),
2241 #endif
2242 #endif
2243 JANET_REG_END
2244 };
2245 janet_core_cfuns_ext(env, NULL, os_cfuns);
2246 }
2247