make (system-type 'machine) not depend on the secutiry guard

Allow `system-type` on non-Windows platforms to run `uname` to get
machine information, even in a sandbox or other contexts with a
limiting secutiry guard.
This commit is contained in:
Matthew Flatt 2016-04-06 10:03:26 -06:00
parent 782f5798a2
commit 6a5cecee0a
2 changed files with 22 additions and 0 deletions

View File

@ -1648,6 +1648,11 @@
(err/rt-test (udp-connect! early-udp "localhost" 40000) (net-reject? 'udp-connect! "localhost" 40000 'client))
(err/rt-test (udp-send-to early-udp "localhost" 40000 #"hi") (net-reject? 'udp-send-to "localhost" 40000 'client))))
;; Interaction with `system-type` - - - - - - - - - - - - - - - - - - -
(parameterize ([current-security-guard (make-file-sg '())])
(test #f regexp-match? "unknown machine" (system-type 'machine)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check `in-directory'

View File

@ -6063,6 +6063,19 @@ void machine_details(char *buff)
{
Scheme_Object *subprocess_proc;
int i;
Scheme_Config *config;
Scheme_Security_Guard *sg;
Scheme_Cont_Frame_Data cframe;
/* Use the root security guard so we can test for and run
executables. */
config = scheme_current_config();
sg = (Scheme_Security_Guard *)scheme_get_param(config, MZCONFIG_SECURITY_GUARD);
while (sg->parent) { sg = sg->parent; }
config = scheme_extend_config(config, MZCONFIG_SECURITY_GUARD, (Scheme_Object *)sg);
scheme_push_continuation_frame(&cframe);
scheme_install_config(config);
subprocess_proc = scheme_builtin_value("subprocess");
@ -6092,12 +6105,16 @@ void machine_details(char *buff)
buff[--c] = 0;
}
scheme_pop_continuation_frame(&cframe);
return;
}
}
}
strcpy(buff, "<unknown machine>");
scheme_pop_continuation_frame(&cframe);
}
#endif