1 /* "net_db.c" network database support
2 * Copyright (C) 1995,1996 Free Software Foundation, Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2, or (at your option)
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this software; see the file COPYING. If not, write to
16 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
21 * The exception is that, if you link the GUILE library with other files
22 * to produce an executable, this does not by itself cause the
23 * resulting executable to be covered by the GNU General Public License.
24 * Your use of that executable is in no way restricted on account of
25 * linking the GUILE library code into it.
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
30 * This exception applies only to the code released by the
31 * Free Software Foundation under the name GUILE. If you copy
32 * code from other Free Software Foundation releases into a copy of
33 * GUILE, as the General Public License permits, the exception does
34 * not apply to the code that you add in this way. To avoid misleading
35 * anyone as to the status of such modified files, you must delete
36 * this exception notice from them.
38 * If you write modifications of your own for GUILE, it is your choice
39 * whether to permit this exception to apply to your modifications.
40 * If you do not wish that, delete this exception notice.
43 /* Written in 1994 by Aubrey Jaffer.
44 * Thanks to Hallvard.Tretteberg@si.sintef.no for inspiration and discussion.
45 * Rewritten by Gary Houston to be a closer interface to the C socket library.
46 * Split into net_db.c and socket.c.
60 #include <sys/types.h>
62 #include <netinet/in.h>
63 #include <arpa/inet.h>
69 #endif /* STDC_HEADERS */
71 extern int inet_aton ();
73 SCM_PROC (s_inet_aton
, "inet-aton", 1, 0, 0, scm_inet_aton
);
76 scm_inet_aton (address
)
81 SCM_ASSERT (SCM_NIMP (address
) && SCM_ROSTRINGP (address
), address
, SCM_ARG1
, s_inet_aton
);
82 if (SCM_SUBSTRP (address
))
83 address
= scm_makfromstr (SCM_ROCHARS (address
), SCM_ROLENGTH (address
), 0);
84 if (inet_aton (SCM_ROCHARS (address
), &soka
) == 0)
85 scm_syserror (s_inet_aton
);
86 return scm_ulong2num (ntohl (soka
.s_addr
));
90 SCM_PROC (s_inet_ntoa
, "inet-ntoa", 1, 0, 0, scm_inet_ntoa
);
93 scm_inet_ntoa (inetid
)
99 addr
.s_addr
= htonl (scm_num2ulong (inetid
, (char *) SCM_ARG1
, s_inet_ntoa
));
101 s
= inet_ntoa (addr
);
102 answer
= scm_makfromstr (s
, strlen (s
), 0);
107 SCM_PROC (s_inet_netof
, "inet-netof", 1, 0, 0, scm_inet_netof
);
110 scm_inet_netof (address
)
114 addr
.s_addr
= htonl (scm_num2ulong (address
, (char *) SCM_ARG1
, s_inet_netof
));
115 return scm_ulong2num ((unsigned long) inet_netof (addr
));
118 SCM_PROC (s_lnaof
, "lnaof", 1, 0, 0, scm_lnaof
);
125 addr
.s_addr
= htonl (scm_num2ulong (address
, (char *) SCM_ARG1
, s_lnaof
));
126 return scm_ulong2num ((unsigned long) inet_lnaof (addr
));
130 SCM_PROC (s_inet_makeaddr
, "inet-makeaddr", 2, 0, 0, scm_inet_makeaddr
);
133 scm_inet_makeaddr (net
, lna
)
138 unsigned long netnum
;
139 unsigned long lnanum
;
141 netnum
= scm_num2ulong (net
, (char *) SCM_ARG1
, s_inet_makeaddr
);
142 lnanum
= scm_num2ulong (lna
, (char *) SCM_ARG2
, s_inet_makeaddr
);
143 addr
= inet_makeaddr (netnum
, lnanum
);
144 return scm_ulong2num (ntohl (addr
.s_addr
));
148 /* !!! Doesn't take address format.
149 * Assumes hostent stream isn't reused.
152 SCM_PROC (s_gethost
, "gethost", 0, 1, 0, scm_gethost
);
158 SCM ans
= scm_make_vector (SCM_MAKINUM (5), SCM_UNSPECIFIED
, SCM_BOOL_F
);
159 SCM
*ve
= SCM_VELTS (ans
);
161 struct hostent
*entry
;
165 #ifdef HAVE_GETHOSTENT
166 if (SCM_UNBNDP (name
))
169 entry
= gethostent ();
173 if (SCM_NIMP (name
) && SCM_STRINGP (name
))
176 entry
= gethostbyname (SCM_CHARS (name
));
180 inad
.s_addr
= htonl (scm_num2ulong (name
, (char *) SCM_ARG1
, s_gethost
));
182 entry
= gethostbyaddr ((char *) &inad
, sizeof (inad
), AF_INET
);
186 scm_syserror (s_gethost
);
187 ve
[0] = scm_makfromstr (entry
->h_name
, (scm_sizet
) strlen (entry
->h_name
), 0);
188 ve
[1] = scm_makfromstrs (-1, entry
->h_aliases
);
189 ve
[2] = SCM_MAKINUM (entry
->h_addrtype
+ 0L);
190 ve
[3] = SCM_MAKINUM (entry
->h_length
+ 0L);
191 if (sizeof (struct in_addr
) != entry
->h_length
)
196 for (argv
= entry
->h_addr_list
; argv
[i
]; i
++);
199 inad
= *(struct in_addr
*) argv
[i
];
200 lst
= scm_cons (scm_ulong2num (ntohl (inad
.s_addr
)), lst
);
207 SCM_PROC (s_getnet
, "getnet", 0, 1, 0, scm_getnet
);
215 struct netent
*entry
;
217 ans
= scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED
, SCM_BOOL_F
);
218 ve
= SCM_VELTS (ans
);
219 if (SCM_UNBNDP (name
))
222 entry
= getnetent ();
224 else if (SCM_NIMP (name
) && SCM_STRINGP (name
))
227 entry
= getnetbyname (SCM_CHARS (name
));
231 unsigned long netnum
;
232 netnum
= scm_num2ulong (name
, (char *) SCM_ARG1
, s_getnet
);
234 entry
= getnetbyaddr (netnum
, AF_INET
);
238 scm_syserror (s_getnet
);
239 ve
[0] = scm_makfromstr (entry
->n_name
, (scm_sizet
) strlen (entry
->n_name
), 0);
240 ve
[1] = scm_makfromstrs (-1, entry
->n_aliases
);
241 ve
[2] = SCM_MAKINUM (entry
->n_addrtype
+ 0L);
242 ve
[3] = scm_ulong2num (entry
->n_net
+ 0L);
246 SCM_PROC (s_getproto
, "getproto", 0, 1, 0, scm_getproto
);
254 struct protoent
*entry
;
256 ans
= scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED
, SCM_BOOL_F
);
257 ve
= SCM_VELTS (ans
);
258 if (SCM_UNBNDP (name
))
261 entry
= getprotoent ();
263 else if (SCM_NIMP (name
) && SCM_STRINGP (name
))
266 entry
= getprotobyname (SCM_CHARS (name
));
270 unsigned long protonum
;
271 protonum
= scm_num2ulong (name
, (char *) SCM_ARG1
, s_getproto
);
273 entry
= getprotobynumber (protonum
);
277 scm_syserror (s_getproto
);
278 ve
[0] = scm_makfromstr (entry
->p_name
, (scm_sizet
) strlen (entry
->p_name
), 0);
279 ve
[1] = scm_makfromstrs (-1, entry
->p_aliases
);
280 ve
[2] = SCM_MAKINUM (entry
->p_proto
+ 0L);
285 static SCM scm_return_entry
SCM_P ((struct servent
*entry
));
288 scm_return_entry (entry
)
289 struct servent
*entry
;
294 ans
= scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED
, SCM_BOOL_F
);
295 ve
= SCM_VELTS (ans
);
296 ve
[0] = scm_makfromstr (entry
->s_name
, (scm_sizet
) strlen (entry
->s_name
), 0);
297 ve
[1] = scm_makfromstrs (-1, entry
->s_aliases
);
298 ve
[2] = SCM_MAKINUM (ntohs (entry
->s_port
) + 0L);
299 ve
[3] = scm_makfromstr (entry
->s_proto
, (scm_sizet
) strlen (entry
->s_proto
), 0);
304 SCM_PROC (s_getserv
, "getserv", 0, 2, 0, scm_getserv
);
307 scm_getserv (name
, proto
)
311 struct servent
*entry
;
312 if (SCM_UNBNDP (name
))
315 entry
= getservent ();
317 scm_syserror (s_getserv
);
318 return scm_return_entry (entry
);
320 SCM_ASSERT (SCM_NIMP (proto
) && SCM_STRINGP (proto
), proto
, SCM_ARG2
, s_getserv
);
321 if (SCM_NIMP (name
) && SCM_STRINGP (name
))
324 entry
= getservbyname (SCM_CHARS (name
), SCM_CHARS (proto
));
328 SCM_ASSERT (SCM_INUMP (name
), name
, SCM_ARG1
, s_getserv
);
330 entry
= getservbyport (SCM_INUM (name
), SCM_CHARS (proto
));
333 scm_syserror (s_getserv
);
334 return scm_return_entry (entry
);
337 SCM_PROC (s_sethost
, "sethost", 0, 1, 0, scm_sethost
);
343 if (SCM_UNBNDP (arg
))
346 sethostent (SCM_NFALSEP (arg
));
347 return SCM_UNSPECIFIED
;
350 SCM_PROC (s_setnet
, "setnet", 0, 1, 0, scm_setnet
);
356 if (SCM_UNBNDP (arg
))
359 setnetent (SCM_NFALSEP (arg
));
360 return SCM_UNSPECIFIED
;
363 SCM_PROC (s_setproto
, "setproto", 0, 1, 0, scm_setproto
);
369 if (SCM_UNBNDP (arg
))
372 setprotoent (SCM_NFALSEP (arg
));
373 return SCM_UNSPECIFIED
;
376 SCM_PROC (s_setserv
, "setserv", 0, 1, 0, scm_setserv
);
382 if (SCM_UNBNDP (arg
))
385 setservent (SCM_NFALSEP (arg
));
386 return SCM_UNSPECIFIED
;
394 scm_sysintern ("INADDR_ANY", scm_ulong2num (INADDR_ANY
));
396 #ifdef INADDR_BROADCAST
397 scm_sysintern ("INADDR_BROADCAST", scm_ulong2num (INADDR_BROADCAST
));
400 scm_sysintern ("INADDR_NONE", scm_ulong2num (INADDR_NONE
));
402 #ifdef INADDR_LOOPBACK
403 scm_sysintern ("INADDR_LOOPBACK", scm_ulong2num (INADDR_LOOPBACK
));
406 scm_add_feature ("net-db");