Support for uname.

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?

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

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")

scsh/syscalls1.c

@@ -14,6 +14,7 @@
 #include <fcntl.h>		/* for O_RDWR */
 #include <sys/stat.h>
 #include <sys/param.h> /* For gethostname() */
+#include <sys/utsname.h> /* for uname() */
 
 #include <netdb.h>
 /* 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!");
 }

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))