From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 1 Nov 1997 07:19:26 +0000 (+0000)
Subject: Add new primitives GET-HOST-NAME and CANONICAL-HOST-NAME.
X-Git-Tag: 20090517-FFI~4953
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9cc8a4ad255ec765d7e360e5fd80d77f7778c95f;p=mit-scheme.git

Add new primitives GET-HOST-NAME and CANONICAL-HOST-NAME.
---

diff --git a/v7/src/microcode/ntapi.h b/v7/src/microcode/ntapi.h
index 2b095e0f7..b760826df 100644
--- a/v7/src/microcode/ntapi.h
+++ b/v7/src/microcode/ntapi.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: ntapi.h,v 1.7 1997/10/26 08:04:41 cph Exp $
+$Id: ntapi.h,v 1.8 1997/11/01 07:17:50 cph Exp $
 
 Copyright (c) 1997 Massachusetts Institute of Technology
 
@@ -80,6 +80,8 @@ enum syscall_names
   apicall_bind,
   apicall_closesocket,
   apicall_connect,
+  apicall_gethostbyname,
+  apicall_gethostname,
   apicall_ioctlsocket,
   apicall_listen,
   apicall_recv,
@@ -924,6 +926,8 @@ static char * syscall_names_table [] =
   "BIND",
   "CLOSE-SOCKET",
   "CONNECT",
+  "GET-HOST-BY-NAME",
+  "GET-HOST-NAME",
   "IOCTL-SOCKET",
   "LISTEN",
   "RECV",
diff --git a/v7/src/microcode/ntsock.c b/v7/src/microcode/ntsock.c
index a7971e658..f4d875228 100644
--- a/v7/src/microcode/ntsock.c
+++ b/v7/src/microcode/ntsock.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: ntsock.c,v 1.1 1997/10/26 08:03:37 cph Exp $
+$Id: ntsock.c,v 1.2 1997/11/01 07:18:46 cph Exp $
 
 Copyright (c) 1997 Massachusetts Institute of Technology
 
@@ -127,6 +127,42 @@ OS_get_host_by_name (const char * host_name)
   struct hostent * entry = (gethostbyname (host_name));
   return ((entry == 0) ? 0 : (entry -> h_addr_list));
 }
+
+const char *
+OS_get_host_name (void)
+{
+  unsigned int name_length = 128;
+  char * name = (OS_malloc (name_length));
+  while (1)
+    {
+      if ((gethostname (name, name_length)) != SOCKET_ERROR)
+	break;
+      {
+	DWORD code = (WSAGetLastError ());
+	if (code != WSAEFAULT)
+	  {
+	    OS_free (name);
+	    NT_error_api_call (code, apicall_gethostname);
+	  }
+      }
+      name_length *= 2;
+      name = (OS_realloc (name, name_length));
+    }
+  return (OS_realloc (name, ((strlen (name)) + 1)));
+}
+
+const char *
+OS_canonical_host_name (const char * host_name)
+{
+  struct hostent * entry = (gethostbyname (host_name));
+  if (entry == 0)
+    return (0);
+  {
+    char * result = (OS_malloc ((strlen (entry -> h_name)) + 1));
+    strcpy (result, (entry -> h_name));
+    return (result);
+  }
+}
 
 #ifndef SOCKET_LISTEN_BACKLOG
 #define SOCKET_LISTEN_BACKLOG 5
diff --git a/v7/src/microcode/os2api.h b/v7/src/microcode/os2api.h
index 7830ca427..688a28c84 100644
--- a/v7/src/microcode/os2api.h
+++ b/v7/src/microcode/os2api.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: os2api.h,v 1.9 1996/05/10 18:47:42 cph Exp $
+$Id: os2api.h,v 1.10 1997/11/01 07:18:13 cph Exp $
 
-Copyright (c) 1994-96 Massachusetts Institute of Technology
+Copyright (c) 1994-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -117,6 +117,8 @@ enum syscall_names
   syscall_accept,
   syscall_bind,
   syscall_connect,
+  syscall_gethostbyname,
+  syscall_gethostname,
   syscall_listen,
   syscall_recv,
   syscall_send,
@@ -971,6 +973,8 @@ static char * syscall_names_table [] =
   "accept",
   "bind",
   "connect",
+  "get-host-by-name",
+  "get-host-name",
   "listen",
   "recv",
   "send",
diff --git a/v7/src/microcode/os2sock.c b/v7/src/microcode/os2sock.c
index e899829d9..3964f81ae 100644
--- a/v7/src/microcode/os2sock.c
+++ b/v7/src/microcode/os2sock.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: os2sock.c,v 1.3 1996/05/18 06:10:25 cph Exp $
+$Id: os2sock.c,v 1.4 1997/11/01 07:18:06 cph Exp $
 
-Copyright (c) 1990-96 Massachusetts Institute of Technology
+Copyright (c) 1990-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -149,6 +149,33 @@ OS_get_host_by_name (const char * host_name)
   struct hostent * entry = (gethostbyname ((char *) host_name));
   return ((entry == 0) ? 0 : (entry -> h_addr_list));
 }
+
+#define HOSTNAMESIZE 1024
+
+const char *
+OS_get_host_name (void)
+{
+  char host_name [HOSTNAMESIZE];
+  VOID_SOCKET_CALL (gethostname, (host_name, HOSTNAMESIZE));
+  {
+    char * result = (OS_malloc ((strlen (host_name)) + 1));
+    strcpy (result, host_name);
+    return (result);
+  }
+}
+
+const char *
+OS_canonical_host_name (const char * host_name)
+{
+  struct hostent * entry = (gethostbyname (this_host_name));
+  if (entry == 0)
+    return (0);
+  {
+    char * result = (OS_malloc ((strlen (entry -> h_name)) + 1));
+    strcpy (result, (entry -> h_name));
+    return (result);
+  }
+}
 
 #ifndef SOCKET_LISTEN_BACKLOG
 #define SOCKET_LISTEN_BACKLOG 5
diff --git a/v7/src/microcode/pruxsock.c b/v7/src/microcode/pruxsock.c
index 6e0a14431..1a860b6c1 100644
--- a/v7/src/microcode/pruxsock.c
+++ b/v7/src/microcode/pruxsock.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: pruxsock.c,v 1.12 1997/11/01 07:10:30 cph Exp $
+$Id: pruxsock.c,v 1.13 1997/11/01 07:19:15 cph Exp $
 
 Copyright (c) 1990-97 Massachusetts Institute of Technology
 
@@ -146,7 +146,7 @@ DEFINE_PRIMITIVE ("CANONICAL-HOST-NAME", Prim_canonical_host_name, 1, 1, 0)
   PRIMITIVE_HEADER (1);
   SOCKET_CODE
     ({
-      CONST char * host_name = (OS_full_host_name (STRING_ARG (1)));
+      CONST char * host_name = (OS_canonical_host_name (STRING_ARG (1)));
       if (host_name == 0)
 	PRIMITIVE_RETURN (SHARP_F);
       {
diff --git a/v7/src/microcode/uxsock.c b/v7/src/microcode/uxsock.c
index 2d7758574..c7c75cb82 100644
--- a/v7/src/microcode/uxsock.c
+++ b/v7/src/microcode/uxsock.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: uxsock.c,v 1.14 1996/05/18 06:09:25 cph Exp $
+$Id: uxsock.c,v 1.15 1997/11/01 07:19:03 cph Exp $
 
-Copyright (c) 1990-96 Massachusetts Institute of Technology
+Copyright (c) 1990-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -121,6 +121,32 @@ DEFUN (OS_get_host_by_name, (host_name), CONST char * host_name)
 #endif
 }
 
+CONST char *
+DEFUN_VOID (OS_get_host_name)
+{
+  char host_name [HOSTNAMESIZE];
+  STD_VOID_SYSTEM_CALL
+    (syscall_gethostname, (UX_gethostname (host_name, HOSTNAMESIZE)));
+  {
+    char * result = (OS_malloc ((strlen (host_name)) + 1));
+    strcpy (result, host_name);
+    return (result);
+  }
+}
+
+CONST char *
+DEFUN (OS_canonical_host_name, (host_name), CONST char * host_name)
+{
+  struct hostent * entry = (gethostbyname (this_host_name));
+  if (entry == 0)
+    return (0);
+  {
+    char * result = (OS_malloc ((strlen (entry -> h_name)) + 1));
+    strcpy (result, (entry -> h_name));
+    return (result);
+  }
+}
+
 Tchannel
 DEFUN (OS_open_unix_stream_socket, (filename), CONST char * filename)
 {
diff --git a/v7/src/microcode/uxsock.h b/v7/src/microcode/uxsock.h
index cdec7b85f..451f3f54f 100644
--- a/v7/src/microcode/uxsock.h
+++ b/v7/src/microcode/uxsock.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: uxsock.h,v 1.5 1993/06/24 07:10:15 gjr Exp $
+$Id: uxsock.h,v 1.6 1997/11/01 07:19:26 cph Exp $
 
-Copyright (c) 1990-92 Massachusetts Institute of Technology
+Copyright (c) 1990-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -43,6 +43,8 @@ extern int EXFUN
    (CONST char * service_name, CONST char * protocol_name));
 extern unsigned int EXFUN (OS_host_address_length, (void));
 extern char ** EXFUN (OS_get_host_by_name, (CONST char * host_name));
+CONST char * EXFUN (OS_get_host_name, (void));
+CONST char * EXFUN (OS_canonical_host_name, (CONST char *));
 
 #ifdef HAVE_UNIX_SOCKETS
 extern Tchannel EXFUN (OS_open_unix_stream_socket, (CONST char * filename));