Moved host/network/service/protocol-info to new FFI. Fixed some bugs
in the old implementation.
This commit is contained in:
parent
86fa3f59a4
commit
1154aad830
117
scsh/network.scm
117
scsh/network.scm
|
@ -787,47 +787,29 @@
|
|||
aliases ; Alternative names
|
||||
net) ; Network number
|
||||
|
||||
(define-exported-binding "network-info-type" type/network-info)
|
||||
|
||||
(define (network-info arg)
|
||||
(cond ((string? arg) (name->network-info arg))
|
||||
((socket-address? arg) (address->network-info arg))
|
||||
((socket-address? arg) (car (socket-address:address arg)))
|
||||
(else
|
||||
(error "network-info: string or socket-address expected ~s" arg))))
|
||||
|
||||
(define (address->network-info name)
|
||||
(if (not (integer? name))
|
||||
(error "address->network-info: integer expected ~s" name)
|
||||
(let ((name (integer->string name))
|
||||
(net (make-string 4)))
|
||||
(receive (result name aliases)
|
||||
(%net-address->network-info name net)
|
||||
(make-network-info name
|
||||
(vector->list
|
||||
(C-string-vec->Scheme aliases #f))
|
||||
(string->integer net))))))
|
||||
|
||||
(define-foreign %net-address->network-info
|
||||
(scheme_net_address2net_info (string-desc name) (string-desc net))
|
||||
(to-scheme fixnum "False_on_zero")
|
||||
static-string ; net name
|
||||
(C char**)) ; alias list
|
||||
(define (address->network-info addr)
|
||||
(if (not (byte-vector? addr))
|
||||
(error "address->network-info: byte-vector expected ~s" addr)
|
||||
(%net-address->network-info addr)))
|
||||
|
||||
(define-stubless-foreign %net-address->network-info (addr)
|
||||
"scheme_net_address2net_info")
|
||||
|
||||
(define (name->network-info name)
|
||||
(if (not (string? name))
|
||||
(error "name->network-info: string expected ~s" name)
|
||||
(let ((net (make-string 4)))
|
||||
(receive (result name aliases)
|
||||
(%net-name->network-info name net)
|
||||
(make-network-info name
|
||||
(vector->list
|
||||
(C-string-vec->Scheme aliases #f))
|
||||
(string->integer net))))))
|
||||
(%net-name->network-info name)))
|
||||
|
||||
(define-foreign %net-name->network-info
|
||||
(scheme_net_name2net_info (string name) (string-desc net))
|
||||
(to-scheme fixnum "False_on_zero")
|
||||
static-string ; net name
|
||||
(C char**)) ; alias list
|
||||
(define-stubless-foreign %net-name->network-info (name)
|
||||
"scheme_net_name2net_info")
|
||||
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
;;; service lookup
|
||||
|
@ -838,6 +820,8 @@
|
|||
port ; Port number
|
||||
protocol) ; Protocol name
|
||||
|
||||
(define-exported-binding "service-info-type" type/service-info)
|
||||
|
||||
(define (service-info . args)
|
||||
(apply (cond ((string? (car args)) name->service-info)
|
||||
((integer? (car args)) port->service-info)
|
||||
|
@ -851,35 +835,26 @@
|
|||
((not (string? proto))
|
||||
(error "port->service-info: string expected ~s" proto))
|
||||
(else
|
||||
(receive (result name aliases port protocol)
|
||||
(%service-port->service-info name proto)
|
||||
(make-service-info name
|
||||
(vector->list (C-string-vec->Scheme aliases #f))
|
||||
port
|
||||
protocol))))))
|
||||
|
||||
(define-foreign %service-port->service-info
|
||||
(scheme_serv_port2serv_info (fixnum name) (string proto))
|
||||
(to-scheme fixnum "False_on_zero")
|
||||
static-string ; service name
|
||||
(C char**) ; alias list
|
||||
fixnum ; port number
|
||||
static-string) ; protocol name
|
||||
(%service-port->service-info name (if (equal? "" proto)
|
||||
#f
|
||||
proto))))))
|
||||
|
||||
(define-stubless-foreign %service-port->service-info (port proto)
|
||||
"scheme_serv_port2serv_info")
|
||||
|
||||
(define (name->service-info name . maybe-proto)
|
||||
(receive (result name aliases port protocol)
|
||||
(%service-name->service-info name (:optional maybe-proto ""))
|
||||
(make-service-info name (vector->list (C-string-vec->Scheme aliases #f))
|
||||
port protocol)))
|
||||
(let ((proto (:optional maybe-proto "")))
|
||||
(cond ((not (string? name))
|
||||
(error "name->service-info: integer expected ~s" name))
|
||||
((not (string? proto))
|
||||
(error "name->service-info: string expected ~s" proto))
|
||||
(else
|
||||
(%service-name->service-info name (if (equal? "" proto)
|
||||
#f
|
||||
proto))))))
|
||||
|
||||
(define-foreign %service-name->service-info
|
||||
(scheme_serv_name2serv_info (string name) (string proto))
|
||||
(to-scheme fixnum "False_on_zero")
|
||||
static-string ; service name
|
||||
(C char**) ; alias list
|
||||
fixnum ; port number
|
||||
static-string) ; protocol name
|
||||
(define-stubless-foreign %service-name->service-info (name proto)
|
||||
"scheme_serv_name2serv_info")
|
||||
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
;;; protocol lookup
|
||||
|
@ -889,6 +864,8 @@
|
|||
aliases ; Alternative names
|
||||
number) ; Protocol number
|
||||
|
||||
(define-exported-binding "protocol-info-type" type/protocol-info)
|
||||
|
||||
(define (protocol-info arg)
|
||||
(cond ((string? arg) (name->protocol-info arg))
|
||||
((integer? arg) (number->protocol-info arg))
|
||||
|
@ -897,36 +874,18 @@
|
|||
(define (number->protocol-info name)
|
||||
(if (not (integer? name))
|
||||
(error "number->protocol-info: integer expected ~s" name)
|
||||
(receive (result name aliases protocol)
|
||||
(%protocol-port->protocol-info name)
|
||||
(make-protocol-info name
|
||||
(vector->list
|
||||
(C-string-vec->Scheme aliases #f))
|
||||
protocol))))
|
||||
(%protocol-port->protocol-info name)))
|
||||
|
||||
(define-foreign %protocol-port->protocol-info
|
||||
(scheme_proto_num2proto_info (fixnum name))
|
||||
(to-scheme fixnum "False_on_zero")
|
||||
static-string ; protocol name
|
||||
(C char**) ; alias list
|
||||
fixnum) ; protocol number
|
||||
(define-stubless-foreign %protocol-port->protocol-info (name)
|
||||
"scheme_proto_num2proto_info")
|
||||
|
||||
(define (name->protocol-info name)
|
||||
(if (not (string? name))
|
||||
(error "name->protocol-info: string expected ~s" name)
|
||||
(receive (result name aliases protocol)
|
||||
(%protocol-name->protocol-info name)
|
||||
(make-protocol-info name
|
||||
(vector->list
|
||||
(C-string-vec->Scheme aliases #f))
|
||||
protocol))))
|
||||
(%protocol-name->protocol-info name)))
|
||||
|
||||
(define-foreign %protocol-name->protocol-info
|
||||
(scheme_proto_name2proto_info (string name))
|
||||
(to-scheme fixnum "False_on_zero")
|
||||
static-string ; protocol name
|
||||
(C char**) ; alias list
|
||||
fixnum) ; protocol number
|
||||
(define-stubless-foreign %protocol-name->protocol-info (name)
|
||||
"scheme_proto_name2proto_info")
|
||||
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
;;; Lowlevel junk
|
||||
|
|
328
scsh/network1.c
328
scsh/network1.c
|
@ -22,12 +22,6 @@
|
|||
#include "scheme48.h"
|
||||
//extern int h_errno;
|
||||
|
||||
/* to extract a 4 byte long value from a scheme string */
|
||||
|
||||
#define GET_LONG(x,n) (*((u_long *)(S48_ADDRESS_AFTER_HEADER((x),unsigned char)+(n*4))))
|
||||
|
||||
#define SET_LONG(x,n,v) GET_LONG((x),(n))=(u_long)(v);
|
||||
|
||||
s48_value long2byte_vector (long number)
|
||||
{
|
||||
s48_value bv = s48_make_byte_vector (4, 0);
|
||||
|
@ -75,17 +69,17 @@ s48_value scheme_bind(s48_value sock, s48_value family, s48_value scheme_name)
|
|||
|
||||
u_long addr = htonl(byte_vector2long (S48_CAR (scheme_name)));
|
||||
u_short port = htons(s48_extract_fixnum (S48_CDR (scheme_name)));
|
||||
fprintf(stderr, "binding to %d %d %d \n", port, addr,s48_extract_fixnum(S48_CDR (scheme_name)));
|
||||
|
||||
name.sin_family=AF_INET;
|
||||
name.sin_addr.s_addr=addr;
|
||||
name.sin_port=port;
|
||||
if (bind(sockfd,(struct sockaddr *)&name,sizeof(name)) < 0)
|
||||
s48_raise_os_error (errno);
|
||||
fprintf(stderr, "bound to %d\n", port);
|
||||
|
||||
return S48_UNSPECIFIC;
|
||||
}
|
||||
default:
|
||||
return(-1); /* error unknown address family */
|
||||
s48_raise_argtype_error (family);
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -151,7 +145,7 @@ s48_value scheme_connect(s48_value sock, s48_value family, s48_value scheme_name
|
|||
|
||||
}
|
||||
default:
|
||||
return(-1); /* error unknown address family */
|
||||
s48_raise_argtype_error (family); /* error unknown address family */
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -377,7 +371,7 @@ ssize_t send_substring(int s,
|
|||
break;
|
||||
}
|
||||
default:
|
||||
return(-1); /* error unknown address family */
|
||||
s48_raise_argtype_error (family); /* error unknown address family */
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -471,7 +465,7 @@ static s48_value host_info_type_binding = S48_FALSE;
|
|||
s48_value host_ent2host_info (struct hostent * host)
|
||||
{
|
||||
s48_value host_info = S48_FALSE;
|
||||
s48_value temp_vector = S48_FALSE;
|
||||
s48_value list = S48_FALSE;
|
||||
long * ptr;
|
||||
int i;
|
||||
S48_DECLARE_GC_PROTECT (2);
|
||||
|
@ -487,36 +481,36 @@ s48_value host_ent2host_info (struct hostent * host)
|
|||
host_info_type_binding = s48_get_imported_binding ("host-info-type");
|
||||
}
|
||||
|
||||
S48_GC_PROTECT_2 (host_info, temp_vector);
|
||||
S48_GC_PROTECT_2 (host_info, list);
|
||||
|
||||
host_info = s48_make_record (host_info_type_binding);
|
||||
S48_RECORD_SET (host_info, 0, s48_enter_string (host->h_name));
|
||||
|
||||
ptr = (long *)host->h_aliases;
|
||||
temp_vector = S48_NULL;
|
||||
list = S48_NULL;
|
||||
i = 0;
|
||||
while (*ptr)
|
||||
{
|
||||
temp_vector = s48_cons (s48_enter_string (host->h_aliases[i]), temp_vector);
|
||||
list = s48_cons (s48_enter_string (host->h_aliases[i]), list);
|
||||
ptr++;
|
||||
i ++;
|
||||
}
|
||||
|
||||
S48_RECORD_SET (host_info, 1, temp_vector);
|
||||
S48_RECORD_SET (host_info, 1, list);
|
||||
|
||||
ptr = (long *)host->h_addr_list;
|
||||
temp_vector = S48_NULL;
|
||||
list = S48_NULL;
|
||||
i = 0;
|
||||
while (*ptr)
|
||||
{
|
||||
temp_vector =
|
||||
list =
|
||||
s48_cons (long2byte_vector (ntohl (*(long *)(host->h_addr_list[i]))),
|
||||
temp_vector);
|
||||
list);
|
||||
ptr++;
|
||||
i++;
|
||||
}
|
||||
|
||||
S48_RECORD_SET (host_info, 2, temp_vector);
|
||||
S48_RECORD_SET (host_info, 2, list);
|
||||
|
||||
S48_GC_UNPROTECT ();
|
||||
return host_info;
|
||||
|
@ -552,182 +546,200 @@ s48_value scheme_host_name2host_info(s48_value s_name)
|
|||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
/* Routines for looking up networks */
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
int scheme_net_address2net_info(s48_value scheme_name,
|
||||
s48_value scheme_net,
|
||||
char** netname,
|
||||
char*** aliases)
|
||||
static s48_value network_info_type_binding = S48_FALSE;
|
||||
|
||||
s48_value netent2net_info(struct netent *net)
|
||||
{
|
||||
struct netent *net;
|
||||
s48_value network_info = S48_FALSE;
|
||||
s48_value list = S48_FALSE;
|
||||
long * ptr;
|
||||
int i;
|
||||
S48_DECLARE_GC_PROTECT (2);
|
||||
|
||||
net=getnetbyaddr(ntohl(GET_LONG(scheme_name,0)),AF_INET);
|
||||
if (net==NULL) return S48_FALSE;
|
||||
|
||||
if(net==NULL)
|
||||
{
|
||||
*netname=NULL;
|
||||
*aliases=NULL;
|
||||
return(-1);
|
||||
}
|
||||
if (network_info_type_binding == S48_FALSE)
|
||||
{
|
||||
S48_GC_PROTECT_GLOBAL(network_info_type_binding);
|
||||
network_info_type_binding =
|
||||
s48_get_imported_binding ("network-info-type");
|
||||
}
|
||||
S48_GC_PROTECT_2 (network_info, list);
|
||||
|
||||
*netname=net->n_name;
|
||||
*aliases=net->n_aliases;
|
||||
SET_LONG(scheme_net,0,net->n_net);
|
||||
return(0);
|
||||
network_info = s48_make_record (network_info_type_binding);
|
||||
S48_RECORD_SET (network_info, 0, s48_enter_string (net->n_name));
|
||||
|
||||
ptr = (long *)net->n_aliases;
|
||||
list = S48_NULL;
|
||||
i = 0;
|
||||
while (*ptr)
|
||||
{
|
||||
list = s48_cons (s48_enter_string (net->n_aliases[i]), list);
|
||||
ptr++;
|
||||
i++;
|
||||
}
|
||||
|
||||
S48_RECORD_SET (network_info, 1, list);
|
||||
S48_RECORD_SET (network_info, 2, long2byte_vector (net->n_net));
|
||||
|
||||
S48_GC_UNPROTECT ();
|
||||
|
||||
return network_info;
|
||||
}
|
||||
|
||||
int scheme_net_name2net_info(const char* scheme_name,
|
||||
s48_value scheme_net,
|
||||
char** netname,
|
||||
char*** aliases)
|
||||
s48_value scheme_net_address2net_info(s48_value net_addr)
|
||||
{
|
||||
struct netent *net=getnetbyname(scheme_name);
|
||||
struct netent *net;
|
||||
// expects host byte order :
|
||||
net=getnetbyaddr(byte_vector2long (net_addr),AF_INET);
|
||||
|
||||
if(net==NULL)
|
||||
{
|
||||
*netname=NULL;
|
||||
*aliases=NULL;
|
||||
return(-1);
|
||||
}
|
||||
return netent2net_info (net);
|
||||
}
|
||||
|
||||
*netname=net->n_name;
|
||||
*aliases=net->n_aliases;
|
||||
SET_LONG(scheme_net,0,net->n_net); /* ??? -Olin */
|
||||
return(0);
|
||||
s48_value scheme_net_name2net_info(s48_value scheme_name)
|
||||
{
|
||||
struct netent *net = getnetbyname(s48_extract_string (scheme_name));
|
||||
return netent2net_info (net);
|
||||
}
|
||||
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
/* Routines for looking up services */
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
|
||||
/* in_port should be declared u_short, but cig doesn't know about them. */
|
||||
int scheme_serv_port2serv_info(int in_port,
|
||||
const char* in_proto,
|
||||
char** out_servname,
|
||||
char*** out_aliases,
|
||||
int* out_port,
|
||||
char** out_protocol)
|
||||
|
||||
static s48_value service_info_type_binding = S48_FALSE;
|
||||
|
||||
s48_value servent2service_info(struct servent *serv)
|
||||
{
|
||||
struct servent *serv;
|
||||
s48_value service_info = S48_FALSE;
|
||||
s48_value list = S48_FALSE;
|
||||
long * ptr;
|
||||
int i;
|
||||
S48_DECLARE_GC_PROTECT (2);
|
||||
|
||||
serv=getservbyport(ntohs(in_port),in_proto);
|
||||
if (serv==NULL) return S48_FALSE;
|
||||
|
||||
if(serv==NULL)
|
||||
{
|
||||
*out_servname=NULL;
|
||||
*out_aliases=NULL;
|
||||
*out_port=0;
|
||||
*out_protocol=NULL;
|
||||
return(-1);
|
||||
}
|
||||
if (service_info_type_binding == S48_FALSE)
|
||||
{
|
||||
S48_GC_PROTECT_GLOBAL(service_info_type_binding);
|
||||
service_info_type_binding =
|
||||
s48_get_imported_binding ("service-info-type");
|
||||
}
|
||||
S48_GC_PROTECT_2 (service_info, list);
|
||||
|
||||
*out_servname=serv->s_name;
|
||||
*out_aliases =serv->s_aliases;
|
||||
*out_port =(int)ntohs(serv->s_port);
|
||||
*out_protocol=serv->s_proto;
|
||||
return(0);
|
||||
service_info = s48_make_record (service_info_type_binding);
|
||||
|
||||
S48_RECORD_SET (service_info, 0, s48_enter_string (serv->s_name));
|
||||
|
||||
ptr = (long *)serv->s_aliases;
|
||||
list = S48_NULL;
|
||||
i = 0;
|
||||
while (*ptr)
|
||||
{
|
||||
list = s48_cons (s48_enter_string (serv->s_aliases[i]), list);
|
||||
ptr++;
|
||||
i++;
|
||||
}
|
||||
|
||||
S48_RECORD_SET (service_info, 1, list);
|
||||
S48_RECORD_SET (service_info, 2, s48_enter_fixnum (ntohs (serv->s_port)));
|
||||
S48_RECORD_SET (service_info, 3, s48_enter_string (serv->s_proto));
|
||||
|
||||
S48_GC_UNPROTECT ();
|
||||
|
||||
return service_info;
|
||||
}
|
||||
|
||||
int scheme_serv_name2serv_info(const char* in_name,
|
||||
const char* in_proto,
|
||||
char** out_servname,
|
||||
char*** out_aliases,
|
||||
int* out_port,
|
||||
char** out_protocol)
|
||||
s48_value scheme_serv_port2serv_info(s48_value in_port,
|
||||
s48_value in_proto)
|
||||
{
|
||||
struct servent *serv=getservbyname(in_name,in_proto);
|
||||
struct servent *serv;
|
||||
char * proto;
|
||||
if (in_proto == S48_FALSE) proto = NULL;
|
||||
else proto = s48_extract_string (in_proto);
|
||||
|
||||
if(serv==NULL)
|
||||
{
|
||||
*out_servname=NULL;
|
||||
*out_aliases=NULL;
|
||||
*out_port=0;
|
||||
*out_protocol=NULL;
|
||||
return(-1);
|
||||
}
|
||||
serv = getservbyport(ntohs(s48_extract_fixnum (in_port)),
|
||||
proto);
|
||||
|
||||
*out_servname=serv->s_name;
|
||||
*out_aliases =serv->s_aliases;
|
||||
*out_port =(int)ntohs(serv->s_port);
|
||||
*out_protocol=serv->s_proto;
|
||||
return(0);
|
||||
return servent2service_info (serv);
|
||||
}
|
||||
|
||||
s48_value scheme_serv_name2serv_info(s48_value in_name,
|
||||
s48_value in_proto)
|
||||
{
|
||||
struct servent *serv;
|
||||
char * proto;
|
||||
|
||||
if (in_proto == S48_FALSE) proto = NULL;
|
||||
else proto = s48_extract_string (in_proto);
|
||||
|
||||
serv = getservbyname(s48_extract_string (in_name),
|
||||
proto);
|
||||
|
||||
return servent2service_info (serv);
|
||||
}
|
||||
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
/* Routines for looking up protocols */
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
int scheme_proto_num2proto_info(int in_proto,
|
||||
char** out_protoname,
|
||||
char*** out_aliases,
|
||||
int* out_protocol)
|
||||
|
||||
static s48_value protocol_info_type_binding = S48_FALSE;
|
||||
|
||||
s48_value protoent2protocol_info(struct protoent *proto)
|
||||
{
|
||||
s48_value protocol_info = S48_FALSE;
|
||||
s48_value list = S48_FALSE;
|
||||
long * ptr;
|
||||
int i;
|
||||
S48_DECLARE_GC_PROTECT (2);
|
||||
|
||||
if (proto==NULL) return S48_FALSE;
|
||||
|
||||
if (protocol_info_type_binding == S48_FALSE)
|
||||
{
|
||||
S48_GC_PROTECT_GLOBAL(protocol_info_type_binding);
|
||||
protocol_info_type_binding =
|
||||
s48_get_imported_binding ("protocol-info-type");
|
||||
}
|
||||
S48_GC_PROTECT_2 (protocol_info, list);
|
||||
|
||||
protocol_info = s48_make_record (protocol_info_type_binding);
|
||||
|
||||
S48_RECORD_SET (protocol_info, 0, s48_enter_string (proto->p_name));
|
||||
|
||||
ptr = (long *)proto->p_aliases;
|
||||
list = S48_NULL;
|
||||
i = 0;
|
||||
while (*ptr)
|
||||
{
|
||||
list = s48_cons (s48_enter_string (proto->p_aliases[i]), list);
|
||||
ptr++;
|
||||
i++;
|
||||
}
|
||||
|
||||
S48_RECORD_SET (protocol_info, 1, list);
|
||||
S48_RECORD_SET (protocol_info, 2, s48_enter_fixnum (proto->p_proto));
|
||||
|
||||
S48_GC_UNPROTECT ();
|
||||
|
||||
return protocol_info;
|
||||
}
|
||||
|
||||
s48_value scheme_proto_num2proto_info(s48_value in_proto)
|
||||
{
|
||||
struct protoent *proto;
|
||||
|
||||
proto=getprotobynumber(in_proto);
|
||||
proto=getprotobynumber(s48_extract_fixnum (in_proto));
|
||||
|
||||
if(proto==NULL)
|
||||
{
|
||||
*out_protoname=NULL;
|
||||
*out_aliases=NULL;
|
||||
*out_protocol=0;
|
||||
return(-1);
|
||||
}
|
||||
|
||||
*out_protoname=proto->p_name;
|
||||
*out_aliases =proto->p_aliases;
|
||||
*out_protocol =proto->p_proto;
|
||||
return(0);
|
||||
return protoent2protocol_info (proto);
|
||||
}
|
||||
|
||||
int scheme_proto_name2proto_info(const char* in_name,
|
||||
char** out_protoname,
|
||||
char*** out_aliases,
|
||||
int* out_protocol)
|
||||
s48_value scheme_proto_name2proto_info(s48_value in_name)
|
||||
{
|
||||
struct protoent *proto=getprotobyname(in_name);
|
||||
struct protoent *proto=getprotobyname(s48_extract_string (in_name));
|
||||
|
||||
if(proto==NULL)
|
||||
{
|
||||
*out_protoname=NULL;
|
||||
*out_aliases=NULL;
|
||||
*out_protocol=0;
|
||||
return(-1);
|
||||
}
|
||||
|
||||
*out_protoname=proto->p_name;
|
||||
*out_aliases =proto->p_aliases;
|
||||
*out_protocol =proto->p_proto;
|
||||
return(0);
|
||||
return protoent2protocol_info (proto);
|
||||
}
|
||||
|
||||
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
/* Low Level Junk */
|
||||
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
|
||||
/* svec is a Scheme vector of C carriers. Scan over the C longs
|
||||
** in cvec, and initialise the corresponding carriers in svec.
|
||||
*/
|
||||
void set_longvec_carriers(s48_value svec, long const * const * cvec)
|
||||
{
|
||||
int svec_len = S48_VECTOR_LENGTH(svec);
|
||||
long const * const *cv = cvec;
|
||||
s48_value s = S48_VECTOR_REF(svec,0); //JMG hack
|
||||
s48_value *sv = &s;
|
||||
|
||||
for(; svec_len > 0; cv++, sv++, svec_len-- ) {
|
||||
/* *sv is a (make-string 4) */
|
||||
s48_value carrier = *sv;
|
||||
(*((u_long *)(S48_ADDRESS_AFTER_HEADER(carrier,unsigned char))))
|
||||
=(long)**cv;
|
||||
}
|
||||
}
|
||||
|
||||
/* One arg, a zero-terminated C word vec. Returns length.
|
||||
** The terminating null is not counted. Returns #f on NULL.
|
||||
*/
|
||||
|
||||
s48_value veclen(const long *vec)
|
||||
{
|
||||
const long *vptr = vec;
|
||||
if( !vptr ) return S48_FALSE;
|
||||
while( *vptr ) vptr++;
|
||||
return s48_enter_fixnum(vptr - vec);
|
||||
}
|
||||
|
|
|
@ -52,42 +52,21 @@ s48_value scheme_host_address2host_info(s48_value scheme_byte_vector);
|
|||
|
||||
s48_value scheme_host_name2host_info(s48_value scheme_name);
|
||||
|
||||
int scheme_net_address2net_info(s48_value scheme_name,
|
||||
s48_value scheme_net,
|
||||
char** netname,
|
||||
char*** aliases);
|
||||
|
||||
int scheme_net_name2net_info(const char* scheme_name,
|
||||
s48_value scheme_net,
|
||||
char** netname,
|
||||
char*** aliases);
|
||||
s48_value scheme_net_address2net_info(s48_value net_addr);
|
||||
|
||||
s48_value scheme_net_name2net_info(s48_value scheme_name);
|
||||
|
||||
/* in_port should be declared u_short, but cig doesn't know about them. */
|
||||
|
||||
int scheme_serv_port2serv_info(int in_port,
|
||||
const char* in_proto,
|
||||
char** out_servname,
|
||||
char*** out_aliases,
|
||||
int* out_port,
|
||||
char** out_protocol);
|
||||
s48_value scheme_serv_port2serv_info(s48_value in_port,
|
||||
s48_value in_proto);
|
||||
|
||||
int scheme_serv_name2serv_info(const char* in_name,
|
||||
const char* in_proto,
|
||||
char** out_servname,
|
||||
char*** out_aliases,
|
||||
int* out_port,
|
||||
char** out_protocol);
|
||||
s48_value scheme_serv_name2serv_info(s48_value in_name,
|
||||
s48_value in_proto);
|
||||
|
||||
int scheme_proto_num2proto_info(int in_proto,
|
||||
char** out_protoname,
|
||||
char*** out_aliases,
|
||||
int* out_protocol);
|
||||
s48_value scheme_proto_num2proto_info(s48_value in_proto);
|
||||
|
||||
int scheme_proto_name2proto_info(const char* in_name,
|
||||
char** out_protoname,
|
||||
char*** out_aliases,
|
||||
int* out_protocol);
|
||||
s48_value scheme_proto_name2proto_info(s48_value name);
|
||||
|
||||
void set_longvec_carriers(s48_value svec, long const * const * cvec);
|
||||
|
||||
|
|
Loading…
Reference in New Issue