diff --git a/scsh/scsh-interfaces.scm b/scsh/scsh-interfaces.scm index ddefcad..60ab989 100644 --- a/scsh/scsh-interfaces.scm +++ b/scsh/scsh-interfaces.scm @@ -1142,6 +1142,15 @@ (define-interface crypt-interface (export crypt)) +(define-interface uname-interface + (export uname + uname:os-name + uname:node-name + uname:release + uname:version + uname:machine + type/uname)) + (define-interface md5-interface (export make-md5-context md5-context? diff --git a/scsh/scsh-package.scm b/scsh/scsh-package.scm index c24f8c4..bfca910 100644 --- a/scsh/scsh-package.scm +++ b/scsh/scsh-package.scm @@ -167,6 +167,7 @@ string-ports-interface syslog-interface crypt-interface + uname-interface )) (scsh-level-0-internals (export set-command-line-args! init-scsh-hindbrain diff --git a/scsh/syscalls.scm b/scsh/syscalls.scm index f9072c4..df8aa4e 100644 --- a/scsh/syscalls.scm +++ b/scsh/syscalls.scm @@ -709,3 +709,14 @@ (error "illegal char in salt " salt)) (if (> (string-length key) 8) (error "key too long " (string-length key))) (%crypt key salt))) + +(define-record uname + os-name + node-name + release + version + machine) + +(define-exported-binding "uname-record-type" type/uname) + +(import-os-error-syscall uname () "scm_uname") diff --git a/scsh/syscalls1.c b/scsh/syscalls1.c index 6f04e8e..724c382 100644 --- a/scsh/syscalls1.c +++ b/scsh/syscalls1.c @@ -14,6 +14,7 @@ #include /* for O_RDWR */ #include #include /* For gethostname() */ +#include /* for uname() */ #include /* This lossage brought to you by Solaris and BIND */ @@ -1125,6 +1126,28 @@ s48_value scm_crypt(s48_value key, s48_value salt) return s48_enter_string (ret); } +static s48_value uname_record_type_binding = S48_FALSE; + +s48_value scm_uname(void) +{ + s48_value uname_record = S48_UNSPECIFIC; + struct utsname uname_struct; + S48_DECLARE_GC_PROTECT(1); + + S48_GC_PROTECT_1(uname_record); + if (uname(&uname_struct) == -1) + s48_raise_os_error(errno); + + uname_record = s48_make_record(uname_record_type_binding); + S48_RECORD_SET(uname_record, 0, s48_enter_string (uname_struct.sysname)); + S48_RECORD_SET(uname_record, 1, s48_enter_string (uname_struct.nodename)); + S48_RECORD_SET(uname_record, 2, s48_enter_string (uname_struct.release)); + S48_RECORD_SET(uname_record, 3, s48_enter_string (uname_struct.version)); + S48_RECORD_SET(uname_record, 4, s48_enter_string (uname_struct.machine)); + S48_GC_UNPROTECT(); + return uname_record; +} + void s48_init_syscalls (){ S48_EXPORT_FUNCTION(scheme_exec); S48_EXPORT_FUNCTION(scsh_exit); @@ -1190,10 +1213,13 @@ void s48_init_syscalls (){ S48_EXPORT_FUNCTION(scm_gethostname); S48_EXPORT_FUNCTION(errno_msg); S48_EXPORT_FUNCTION(scm_crypt); + S48_EXPORT_FUNCTION(scm_uname); S48_GC_PROTECT_GLOBAL(envvec_record_type_binding); S48_GC_PROTECT_GLOBAL(add_envvec_finalizerB_binding); S48_GC_PROTECT_GLOBAL(current_env); + S48_GC_PROTECT_GLOBAL(uname_record_type_binding); envvec_record_type_binding = s48_get_imported_binding("envvec-record-type"); + uname_record_type_binding = s48_get_imported_binding("uname-record-type"); add_envvec_finalizerB_binding = s48_get_imported_binding("add-envvec-finalizer!"); } diff --git a/scsh/test/test-packages.scm b/scsh/test/test-packages.scm index 4870645..3ee0f31 100644 --- a/scsh/test/test-packages.scm +++ b/scsh/test/test-packages.scm @@ -56,12 +56,27 @@ env-test) (files env-test-add)) +(define-structure system-parameter-tests (export) + (open scsh + scheme + test-base) + (begin + (add-test! 'uname 'system-parameter + (lambda () + (let ((uname-rec (uname))) + (> (string-length (uname:node-name uname-rec)) 0)))) + + (add-test! 'system-name 'system-parameter + (lambda () + (> (string-length (system-name)) 0))))) + (define-structure test-all (export test-all) (open scheme test-base add-env-test process-state-test + system-parameter-tests file-system-test))