~ chicken-core (chicken-5) f2c96809de45db2bbd373301737ce006979105b3
commit f2c96809de45db2bbd373301737ce006979105b3
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Jul 27 17:13:17 2017 +0200
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Sat Aug 5 10:01:35 2017 +1200
Removed sysinfo stuff (`get-host-name' and `system-information')
Signed-off-by: Evan Hanson <evhan@foldling.org>
diff --git a/library.scm b/library.scm
index 0c296847..6cff6796 100644
--- a/library.scm
+++ b/library.scm
@@ -5744,9 +5744,6 @@ EOF
repository-path installation-repository
register-feature! unregister-feature!
software-type software-version
-
- ;;; TODO, move these from posix:
- ;; get-host-name system-information
)
(import scheme chicken chicken.fixnum chicken.foreign chicken.keyword)
diff --git a/posix.scm b/posix.scm
index ec89380d..8115bfd3 100644
--- a/posix.scm
+++ b/posix.scm
@@ -56,7 +56,7 @@
file-select file-size file-stat file-test-lock file-truncate
file-type file-unlock file-write file-write-access? fileno/stderr
fileno/stdin fileno/stdout get-environment-variables
- get-host-name local-time->seconds local-timezone-abbreviation
+ local-time->seconds local-timezone-abbreviation
open-input-file* open-input-pipe open-output-file* open-output-pipe
open/append open/binary open/creat open/excl open/fsync open/noctty
open/noinherit open/nonblock open/rdonly open/rdwr open/read
@@ -80,7 +80,7 @@
signal/usr1 signal/usr2 signal/vtalrm signal/winch signal/xcpu
signal/xfsz signals-list socket? spawn/detach spawn/nowait
spawn/nowaito spawn/overlay spawn/wait string->time symbolic-link?
- system-information terminal-name terminal-port? terminal-size
+ terminal-name terminal-port? terminal-size
time->string unset-environment-variable! user-information
utc-time->seconds with-input-from-pipe with-output-to-pipe)
diff --git a/posixunix.scm b/posixunix.scm
index 9376c2bc..170e6494 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -38,7 +38,6 @@ static C_TLS int C_wait_status;
#include <sys/time.h>
#include <sys/wait.h>
-#include <sys/utsname.h>
#include <sys/ioctl.h>
#include <fcntl.h>
#include <dirent.h>
@@ -94,7 +93,6 @@ extern char **environ;
# define FILENAME_MAX 1024
#endif
-static C_TLS struct utsname C_utsname;
static C_TLS struct flock C_flock;
static C_TLS DIR *temphandle;
static C_TLS struct passwd *C_user;
@@ -109,7 +107,6 @@ static C_TLS struct passwd *C_user;
static C_TLS int C_pipefds[ 2 ];
static C_TLS time_t C_secs;
static C_TLS struct timeval C_timeval;
-static C_TLS char C_hostbuf[ 256 ];
static C_TLS struct stat C_statbuf;
#define C_fchdir(fd) C_fix(fchdir(C_unfix(fd)))
@@ -147,7 +144,6 @@ static C_TLS struct stat C_statbuf;
#define C_pipe(d) C_fix(pipe(C_pipefds))
#define C_truncate(f, n) C_fix(truncate((char *)C_data_pointer(f), C_num_to_int(n)))
#define C_ftruncate(f, n) C_fix(ftruncate(C_unfix(f), C_num_to_int(n)))
-#define C_uname C_fix(uname(&C_utsname))
#define C_alarm alarm
#define C_test_access(fn, m) C_fix(access((char *)C_data_pointer(fn), C_unfix(m)))
#define C_close(fd) C_fix(close(C_unfix(fd)))
@@ -788,25 +784,7 @@ static C_word C_i_fifo_p(C_word name)
(posix-error #:process-error 'signal-unmask! "cannot unblock signal") ) )
-;;; Getting system-, group- and user-information:
-
-(define-foreign-variable _uname int "C_uname")
-(define-foreign-variable _uname-sysname nonnull-c-string "C_utsname.sysname")
-(define-foreign-variable _uname-nodename nonnull-c-string "C_utsname.nodename")
-(define-foreign-variable _uname-release nonnull-c-string "C_utsname.release")
-(define-foreign-variable _uname-version nonnull-c-string "C_utsname.version")
-(define-foreign-variable _uname-machine nonnull-c-string "C_utsname.machine")
-
-(define system-information
- (lambda ()
- (when (fx< _uname 0)
- (##sys#update-errno)
- (##sys#error 'system-information "cannot retrieve system information") )
- (list _uname-sysname
- _uname-nodename
- _uname-release
- _uname-version
- _uname-machine) ) )
+;;; Getting group- and user-information:
(define current-user-id
(getter-with-setter
@@ -1317,17 +1295,6 @@ static C_word C_i_fifo_p(C_word name)
(posix-error #:error 'terminal-size
"Unable to get size of terminal" port))))))
-(define get-host-name
- (let ([getit
- (foreign-lambda* c-string ()
- "if(gethostname(C_hostbuf, 256) == -1) C_return(NULL);"
- "else C_return(C_hostbuf);") ] )
- (lambda ()
- (let ([host (getit)])
- (unless host
- (posix-error #:error 'get-host-name "cannot retrieve host-name") )
- host) ) ) )
-
;;; Process handling:
diff --git a/posixwin.scm b/posixwin.scm
index b20ef2e4..a5bb6904 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -101,15 +101,8 @@ static C_TLS char C_rdbuf; /* one-char buffer for read */
static C_TLS int C_exstatus;
/* platform information; initialized for cached testing */
-static C_TLS char C_hostname[256] = "";
-static C_TLS char C_osver[16] = "";
-static C_TLS char C_osrel[16] = "";
-static C_TLS char C_processor[16] = "";
static C_TLS char C_shlcmd[256] = "";
-/* Windows NT or better */
-static int C_isNT = 0;
-
/* Current user name */
static C_TLS TCHAR C_username[255 + 1] = "";
@@ -352,127 +345,52 @@ process_wait(C_word h, C_word t)
#define C_process_wait(p, t) (process_wait(C_unfix(p), C_truep(t)) ? C_SCHEME_TRUE : C_SCHEME_FALSE)
-static int C_fcall
-get_hostname()
-{
- /* Do we already have hostname? */
- if (strlen(C_hostname))
- {
- return 1;
- }
- else
- {
- WSADATA wsa;
- if (WSAStartup(MAKEWORD(1, 1), &wsa) == 0)
- {
- int nok = gethostname(C_hostname, sizeof(C_hostname));
- WSACleanup();
- return !nok;
- }
- return 0;
- }
-}
+
+static C_TLS int C_isNT = 0;
+
static int C_fcall
-sysinfo()
+C_windows_nt()
{
- /* Do we need to build the sysinfo? */
- if (!strlen(C_osrel))
- {
- OSVERSIONINFO ovf;
- ZeroMemory(&ovf, sizeof(ovf));
- ovf.dwOSVersionInfoSize = sizeof(ovf);
- if (get_hostname() && GetVersionEx(&ovf))
- {
- SYSTEM_INFO si;
- _snprintf(C_osver, sizeof(C_osver) - 1, "%lu.%lu.%lu",
- ovf.dwMajorVersion, ovf.dwMinorVersion, ovf.dwBuildNumber);
- strncpy(C_osrel, "Win", sizeof(C_osrel) - 1);
- switch (ovf.dwPlatformId)
- {
- case VER_PLATFORM_WIN32s:
- strncpy(C_osrel, "Win32s", sizeof(C_osrel) - 1);
- break;
- case VER_PLATFORM_WIN32_WINDOWS:
- if (ovf.dwMajorVersion == 4)
- {
- if (ovf.dwMinorVersion == 0)
- strncpy(C_osrel, "Win95", sizeof(C_osrel) - 1);
- else if (ovf.dwMinorVersion == 10)
- strncpy(C_osrel, "Win98", sizeof(C_osrel) - 1);
- else if (ovf.dwMinorVersion == 90)
- strncpy(C_osrel, "WinMe", sizeof(C_osrel) - 1);
- }
- break;
- case VER_PLATFORM_WIN32_NT:
- C_isNT = 1;
- if (ovf.dwMajorVersion == 6)
- strncpy(C_osrel, "WinVista", sizeof(C_osrel) - 1);
- else if (ovf.dwMajorVersion == 5)
- {
- if (ovf.dwMinorVersion == 2)
- strncpy(C_osrel, "WinServer2003", sizeof(C_osrel) - 1);
- else if (ovf.dwMinorVersion == 1)
- strncpy(C_osrel, "WinXP", sizeof(C_osrel) - 1);
- else if ( ovf.dwMinorVersion == 0)
- strncpy(C_osrel, "Win2000", sizeof(C_osrel) - 1);
- }
- else if (ovf.dwMajorVersion <= 4)
- strncpy(C_osrel, "WinNT", sizeof(C_osrel) - 1);
- break;
- }
- GetSystemInfo(&si);
- strncpy(C_processor, "Unknown", sizeof(C_processor) - 1);
- switch (si.wProcessorArchitecture)
- {
- case PROCESSOR_ARCHITECTURE_INTEL:
- strncpy(C_processor, "x86", sizeof(C_processor) - 1);
- break;
-# ifdef PROCESSOR_ARCHITECTURE_IA64
- case PROCESSOR_ARCHITECTURE_IA64:
- strncpy(C_processor, "IA64", sizeof(C_processor) - 1);
- break;
-# endif
-# ifdef PROCESSOR_ARCHITECTURE_AMD64
- case PROCESSOR_ARCHITECTURE_AMD64:
- strncpy(C_processor, "x64", sizeof(C_processor) - 1);
- break;
-# endif
-# ifdef PROCESSOR_ARCHITECTURE_IA32_ON_WIN64
- case PROCESSOR_ARCHITECTURE_IA32_ON_WIN64:
- strncpy(C_processor, "WOW64", sizeof(C_processor) - 1);
- break;
-# endif
- }
- }
- else
- return set_last_errno();
+ static int has_info = 0;
+
+ if(!has_info) {
+ OSVERSIONINFO ovf;
+ ZeroMemory(&ovf, sizeof(ovf));
+ ovf.dwOSVersionInfoSize = sizeof(ovf);
+ has_info = 1;
+
+ if(GetVersionEx(&ovf)) {
+ SYSTEM_INFO si;
+
+ switch (ovf.dwPlatformId) {
+ case VER_PLATFORM_WIN32_NT:
+ return C_isNT = 1;
+ }
}
- return 1;
+ }
+
+ return C_isNT;
}
+
static int C_fcall
get_shlcmd()
{
/* Do we need to build the shell command pathname? */
if (!strlen(C_shlcmd))
{
- if (sysinfo()) /* for C_isNT */
- {
- char *cmdnam = C_isNT ? "\\cmd.exe" : "\\command.com";
- UINT len = GetSystemDirectory(C_shlcmd, sizeof(C_shlcmd) - strlen(cmdnam));
- if (len)
- C_strlcpy(C_shlcmd + len, cmdnam, sizeof(C_shlcmd));
- else
- return set_last_errno();
- }
- else
- return 0;
+ char *cmdnam = C_windows_nt() ? "\\cmd.exe" : "\\command.com";
+ UINT len = GetSystemDirectory(C_shlcmd, sizeof(C_shlcmd) - strlen(cmdnam));
+ if (len)
+ C_strlcpy(C_shlcmd + len, cmdnam, sizeof(C_shlcmd));
+ else
+ return set_last_errno();
}
+
return 1;
}
-#define C_get_hostname() (get_hostname() ? C_SCHEME_TRUE : C_SCHEME_FALSE)
#define C_sysinfo() (sysinfo() ? C_SCHEME_TRUE : C_SCHEME_FALSE)
#define C_get_shlcmd() (get_shlcmd() ? C_SCHEME_TRUE : C_SCHEME_FALSE)
@@ -1212,27 +1130,8 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(values pid #t _exstatus)
(values -1 #f #f) ) )
-(define-foreign-variable _hostname c-string "C_hostname")
-(define-foreign-variable _osver c-string "C_osver")
-(define-foreign-variable _osrel c-string "C_osrel")
-(define-foreign-variable _processor c-string "C_processor")
-
-(define get-host-name
- (lambda ()
- (if (##core#inline "C_get_hostname")
- _hostname
- (##sys#error 'get-host-name "cannot retrieve host-name") ) ) )
-
-;;; Getting system-, group- and user-information:
-
-(define system-information
- (lambda ()
- (if (##core#inline "C_sysinfo")
- (list "windows" _hostname _osrel _osver _processor)
- (begin
- (##sys#update-errno)
- (##sys#error 'system-information "cannot retrieve system-information") ) ) ) )
+;;; Getting group- and user-information:
(define-foreign-variable _username c-string "C_username")
diff --git a/types.db b/types.db
index 5412a33d..1338a254 100644
--- a/types.db
+++ b/types.db
@@ -1977,7 +1977,6 @@
(chicken.posix#fileno/stderr fixnum)
(chicken.posix#fileno/stdin fixnum)
(chicken.posix#fileno/stdout fixnum)
-(chicken.posix#get-host-name (#(procedure #:clean) chicken.posix#get-host-name () string))
(chicken.posix#local-time->seconds (#(procedure #:clean #:enforce) chicken.posix#local-time->seconds ((vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)) integer))
(chicken.posix#local-timezone-abbreviation (#(procedure #:clean) chicken.posix#local-timezone-abbreviation () string))
(chicken.posix#open-input-file* (#(procedure #:clean #:enforce) chicken.posix#open-input-file* (fixnum #!optional symbol) input-port))
@@ -2094,7 +2093,6 @@
(chicken.posix#socket? (#(procedure #:clean #:enforce) chicken.posix#socket? ((or string fixnum)) boolean))
(chicken.posix#string->time (#(procedure #:clean #:enforce) chicken.posix#string->time (string #!optional string) (vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)))
(chicken.posix#symbolic-link? (#(procedure #:clean #:enforce) chicken.posix#symbolic-link? ((or string fixnum)) boolean))
-(chicken.posix#system-information (#(procedure #:clean) chicken.posix#system-information () list))
(chicken.posix#terminal-name (#(procedure #:clean #:enforce) chicken.posix#terminal-name (port) string))
(chicken.posix#terminal-port? (#(procedure #:clean #:enforce) chicken.posix#terminal-port? (port) boolean))
(chicken.posix#terminal-size (#(procedure #:clean #:enforce) chicken.posix#terminal-size (port) fixnum fixnum))
Trap