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