*** empty log message ***
This commit is contained in:
eknauel
commit
b8e8ec9536
|
|
@ -0,0 +1,28 @@
|
|||
# CVS default ignores begin
|
||||
tags
|
||||
TAGS
|
||||
.make.state
|
||||
.nse_depinfo
|
||||
*~
|
||||
\#*
|
||||
.#*
|
||||
,*
|
||||
_$*
|
||||
*$
|
||||
*.old
|
||||
*.bak
|
||||
*.BAK
|
||||
*.orig
|
||||
*.rej
|
||||
.del-*
|
||||
*.a
|
||||
*.olb
|
||||
*.o
|
||||
*.obj
|
||||
*.so
|
||||
*.exe
|
||||
*.Z
|
||||
*.elc
|
||||
*.ln
|
||||
core
|
||||
# CVS default ignores end
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
CC = @CC@
|
||||
LIBS = @LIBS@ -lscsh
|
||||
SCSH_LIB = @scsh_libraries@
|
||||
LIB_DIRS = -L$(SCSH_LIB)
|
||||
INCLUDES = -I. -I./c
|
||||
|
||||
SCSH_INCLUDES = @scsh_includes@
|
||||
ifneq ($(SCSH_INCLUDES),)
|
||||
INCLUDES += -I$(SCSH_INCLUDES)
|
||||
endif
|
||||
|
||||
SCSH_MODULES = @scsh_modules@
|
||||
YP_VM = scshypvm
|
||||
YP_IMAGE = scsh-yp.image
|
||||
YP = scsh-yp
|
||||
|
||||
prefix = @prefix@
|
||||
exec_prefix = @exec_prefix@
|
||||
|
||||
enough: $(YP)
|
||||
|
||||
DIST_SOURCES = c/yp.c
|
||||
|
||||
OBJECTS = $(DIST_SOURCES:.c=.o)
|
||||
|
||||
SCM_FILES = scheme/yp.scm
|
||||
|
||||
SCM_CONFIG_FILES = scheme/yp-interfaces.scm scheme/yp-packages.scm
|
||||
|
||||
$(YP_VM): tmpmain.o $(OBJECTS)
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $(YP_VM) $(LIB_DIRS) tmpmain.o $(OBJECTS) $(LIBS)
|
||||
|
||||
$(OBJECTS):
|
||||
.c.o:
|
||||
$(CC) $(CFLAGS) -c $(INCLUDES) -o $@ $<
|
||||
|
||||
tmpmain.o: c/main.c
|
||||
$(CC) -c -DSCSHIMAGE=\"$(SCSH_LIB)/scsh.image\" $(INCLUDES) $(CFLAGS) -o $@ $<
|
||||
|
||||
main.o: c/main.c
|
||||
$(CC) -c -DSCSHIMAGE=\"`pwd`/scsh-yp.image\" $(INCLUDES) $(CFLAGS) -o $@ $<
|
||||
|
||||
$(YP_IMAGE): $(YP_VM) $(SCM_FILES) $(SCM_CONFIG_FILES)
|
||||
( \
|
||||
echo ",batch on"; \
|
||||
echo ",config ,load $(SCM_CONFIG_FILES)"; \
|
||||
echo ",load-package yp"; \
|
||||
echo "(dump-scsh \"$(YP_IMAGE)\")"; \
|
||||
) | ./$(YP_VM) $(SCSH_ARGS)
|
||||
|
||||
$(YP): $(YP_IMAGE) main.o $(OBJECTS)
|
||||
$(CC) $(LDFLAGS) -o $@ $(LIB_DIRS) main.o $(OBJECTS) $(LIBS)
|
||||
|
||||
clean:
|
||||
rm -f $(YP_VM) $(YP) $(YP_IMAGE) *.o c/*.o
|
||||
|
||||
distclean: clean
|
||||
rm -f configure Makefile config.log config.status
|
||||
rm -rf autom4te.cache/
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
#include "scheme48.h"
|
||||
#include "c/config.h"
|
||||
|
||||
extern void scsh_yp_main();
|
||||
|
||||
int main(int argc, char **argv)
|
||||
{
|
||||
s48_add_external_init(scsh_yp_main);
|
||||
|
||||
return s48_main(10000000, 64000,
|
||||
SCSHIMAGE,
|
||||
--argc, ++argv);
|
||||
}
|
||||
|
|
@ -0,0 +1,177 @@
|
|||
#include "scheme48.h"
|
||||
#include <sys/types.h>
|
||||
#include <rpc/rpc.h>
|
||||
#include <rpcsvc/ypclnt.h>
|
||||
#include <rpcsvc/yp_prot.h>
|
||||
|
||||
#define DECLARE_S48VALUE_STATIC(NAME) \
|
||||
static s48_value NAME = S48_FALSE;
|
||||
|
||||
#define GC_PROTECT_ENTER_INT(CNAME, SNAME, VALUE) \
|
||||
S48_GC_PROTECT_GLOBAL(CNAME); \
|
||||
CNAME = s48_enter_integer(VALUE); \
|
||||
s48_define_exported_binding(SNAME, CNAME);
|
||||
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_badargs);
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_baddb);
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_domain);
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_key);
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_map);
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_nodom);
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_nomore);
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_pmap);
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_resrc);
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_rpc);
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_vers);
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_ypbind);
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_yperr);
|
||||
DECLARE_S48VALUE_STATIC(scsh_yp_error_ypserv);
|
||||
|
||||
s48_value scsh_yp_getdefaultdomain(void)
|
||||
{
|
||||
char *buf;
|
||||
int i;
|
||||
s48_value str, res = S48_FALSE;
|
||||
S48_DECLARE_GC_PROTECT(2);
|
||||
|
||||
S48_GC_PROTECT_2(res, str);
|
||||
i = yp_get_default_domain(&buf);
|
||||
str = (i == 0) ? s48_enter_string(buf) : S48_UNSPECIFIC;
|
||||
res = s48_list_2(s48_enter_integer(i), str);
|
||||
S48_GC_UNPROTECT();
|
||||
return res;
|
||||
}
|
||||
|
||||
s48_value scsh_yp_bind(s48_value domain)
|
||||
{
|
||||
return s48_enter_integer(yp_bind(s48_extract_string(domain)));
|
||||
}
|
||||
|
||||
s48_value scsh_yp_unbind(s48_value domain)
|
||||
{
|
||||
yp_unbind(s48_extract_string(domain));
|
||||
return S48_UNSPECIFIC;
|
||||
}
|
||||
|
||||
s48_value scsh_yp_errstring(s48_value code)
|
||||
{
|
||||
return s48_enter_string(yperr_string(s48_extract_integer(code)));
|
||||
}
|
||||
|
||||
s48_value scsh_yp_proterr(s48_value code)
|
||||
{
|
||||
return s48_enter_integer(ypprot_err(s48_extract_integer(code)));
|
||||
}
|
||||
|
||||
s48_value scsh_yp_match(s48_value indomain, s48_value inmap,
|
||||
s48_value inkey)
|
||||
{
|
||||
int r, l;
|
||||
char *outval;
|
||||
s48_value str, res = S48_FALSE;
|
||||
S48_DECLARE_GC_PROTECT(5);
|
||||
|
||||
S48_GC_PROTECT_5(indomain, inmap, inkey, res, str);
|
||||
r = yp_match(s48_extract_string(indomain), s48_extract_string(inmap),
|
||||
s48_extract_string(inkey), S48_STRING_LENGTH(inkey),
|
||||
&outval, &l);
|
||||
str = (r == 0) ? s48_enter_string(outval) : S48_UNSPECIFIC;
|
||||
res = s48_list_2 (s48_enter_integer(r), str);
|
||||
S48_GC_UNPROTECT();
|
||||
return res;
|
||||
}
|
||||
|
||||
s48_value scsh_yp_order(s48_value domain, s48_value map)
|
||||
{
|
||||
int r, outorder;
|
||||
s48_value res, i;
|
||||
S48_DECLARE_GC_PROTECT(2);
|
||||
|
||||
S48_GC_PROTECT_2(domain, map);
|
||||
r = yp_order(s48_extract_string(domain), s48_extract_string(map),
|
||||
&outorder);
|
||||
i = (r == 0) ? s48_enter_integer(outorder) : S48_UNSPECIFIC;
|
||||
res = s48_list_2(s48_enter_integer(r), i);
|
||||
S48_GC_UNPROTECT();
|
||||
return res;
|
||||
}
|
||||
|
||||
s48_value scsh_yp_master(s48_value domain, s48_value map)
|
||||
{
|
||||
int r;
|
||||
char *outname;
|
||||
s48_value res, str;
|
||||
S48_DECLARE_GC_PROTECT(4);
|
||||
|
||||
S48_GC_PROTECT_4(domain, map, res, str);
|
||||
r = yp_master(s48_extract_string(domain), s48_extract_string(map),
|
||||
&outname);
|
||||
str = (r == 0) ? s48_enter_string(outname) : S48_UNSPECIFIC;
|
||||
res = s48_list_2(s48_enter_integer(r), str);
|
||||
S48_GC_UNPROTECT();
|
||||
return res;
|
||||
}
|
||||
|
||||
s48_value scsh_yp_first(s48_value domain, s48_value map)
|
||||
{
|
||||
char *key, *val;
|
||||
int keylen, vallen, r;
|
||||
s48_value res, str1, str2;
|
||||
S48_DECLARE_GC_PROTECT(5);
|
||||
|
||||
S48_GC_PROTECT_5(domain, map, res, str1, str2);
|
||||
r = yp_first(s48_extract_string(domain), s48_extract_string(map),
|
||||
&key, &keylen, &val, &vallen);
|
||||
str1 = (r == 0) ? s48_enter_string(key) : S48_UNSPECIFIC;
|
||||
str2 = (r == 0) ? s48_enter_string(val) : S48_UNSPECIFIC;
|
||||
res = s48_list_3(s48_enter_integer(r), str1, str2);
|
||||
S48_GC_UNPROTECT();
|
||||
return res;
|
||||
}
|
||||
|
||||
s48_value scsh_yp_next(s48_value domain, s48_value map, s48_value inkey)
|
||||
{
|
||||
char *key, *val;
|
||||
int keylen, vallen, r;
|
||||
s48_value res, str1, str2;
|
||||
S48_DECLARE_GC_PROTECT(6);
|
||||
|
||||
S48_GC_PROTECT_6(domain, map, inkey, res, str1, str2);
|
||||
r = yp_next(s48_extract_string(domain), s48_extract_string(map),
|
||||
s48_extract_string(inkey), S48_STRING_LENGTH(inkey),
|
||||
&key, &keylen, &val, &vallen);
|
||||
str1 = (r == 0) ? s48_enter_string(key) : S48_UNSPECIFIC;
|
||||
str2 = (r == 0) ? s48_enter_string(val) : S48_UNSPECIFIC;
|
||||
res = s48_list_3(s48_enter_integer(r), str1, str2);
|
||||
S48_GC_UNPROTECT();
|
||||
return res;
|
||||
}
|
||||
|
||||
void scsh_yp_main(void)
|
||||
{
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_badargs, "yp-error-badargs", YPERR_BADARGS);
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_baddb, "yp-error-baddb", YPERR_BADDB);
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_domain, "yp-error-domain", YPERR_DOMAIN);
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_key, "yp-error-key", YPERR_KEY);
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_map, "yp-error-map", YPERR_MAP);
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_nodom, "yp-error-nodom", YPERR_NODOM);
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_nomore, "yp-error-nomore", YPERR_NOMORE);
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_pmap, "yp-error-pmap", YPERR_PMAP);
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_resrc, "yp-error-resrc", YPERR_RESRC);
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_rpc, "yp-error-rpc", YPERR_RPC);
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_vers, "yp-error-vers", YPERR_VERS);
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_ypbind, "yp-error-bind", YPERR_YPBIND);
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_yperr, "yp-error-yperr", YPERR_YPERR);
|
||||
GC_PROTECT_ENTER_INT(scsh_yp_error_ypserv, "yp-error-ypserv", YPERR_YPSERV);
|
||||
|
||||
S48_EXPORT_FUNCTION(scsh_yp_getdefaultdomain);
|
||||
S48_EXPORT_FUNCTION(scsh_yp_bind);
|
||||
S48_EXPORT_FUNCTION(scsh_yp_unbind);
|
||||
S48_EXPORT_FUNCTION(scsh_yp_errstring);
|
||||
S48_EXPORT_FUNCTION(scsh_yp_proterr);
|
||||
S48_EXPORT_FUNCTION(scsh_yp_match);
|
||||
S48_EXPORT_FUNCTION(scsh_yp_order);
|
||||
S48_EXPORT_FUNCTION(scsh_yp_master);
|
||||
S48_EXPORT_FUNCTION(scsh_yp_first);
|
||||
S48_EXPORT_FUNCTION(scsh_yp_next);
|
||||
}
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
AC_INIT
|
||||
AC_CONFIG_HEADER(c/config.h)
|
||||
AC_PROG_CC
|
||||
|
||||
AC_ARG_WITH(scsh-includes,
|
||||
AC_HELP_STRING([--with-scsh-includes=DIR],
|
||||
[scsh include files are in DIR [/usr/local/include]]),
|
||||
scsh_includes=$withval,
|
||||
scsh_includes=/usr/local/include)
|
||||
AC_SUBST(scsh_includes)
|
||||
|
||||
AC_ARG_WITH(scsh-libraries,
|
||||
AC_HELP_STRING([--with-scsh-libraries=DIR],
|
||||
[scsh libraries are in DIR [/usr/local/lib/scsh]]),
|
||||
scsh_libraries=$withval,
|
||||
scsh_libraries=/usr/local/lib/scsh)
|
||||
AC_SUBST(scsh_libraries)
|
||||
|
||||
AC_ARG_WITH(scsh-modules,
|
||||
AC_HELP_STRING([--with-scsh-modules=DIR],
|
||||
[scsh modules are in DIR [/usr/local/lib/scsh/modules]]),
|
||||
scsh_modules=$withval,
|
||||
scsh_modules=/usr/local/lib/scsh/modules)
|
||||
AC_SUBST(scsh_modules)
|
||||
AC_CHECK_LIB(crypt, crypt)
|
||||
dnl AC_CHECK_LIB(dl, dlopen)
|
||||
AC_CHECK_LIB(m, exp)
|
||||
AC_CHECK_FUNCS(yp_get_default_domain yp_bind yp_unbind)
|
||||
AC_CHECK_FUNCS(yperr_string ypprot_err)
|
||||
AC_CHECK_FUNCS(yp_match yp_order)
|
||||
AC_CHECK_FUNCS(yp_master yp_first yp_next)
|
||||
|
||||
AC_SUBST(LIBS)
|
||||
AC_SUBST(CC)
|
||||
AC_OUTPUT(Makefile)
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
(define-interface yp-interface
|
||||
(export
|
||||
(yp-result-code :syntax)
|
||||
yp-result-code-elements
|
||||
yp-result-code-name
|
||||
yp-success?
|
||||
|
||||
yp-get-default-domain
|
||||
yp-bind
|
||||
yp-unbind
|
||||
yp-order
|
||||
yp-master
|
||||
yp-first
|
||||
yp-next
|
||||
yp-map->list
|
||||
yp-error-string
|
||||
yp-protocol-error
|
||||
yp-match))
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
(define-structure yp yp-interface
|
||||
(open
|
||||
scheme
|
||||
signals
|
||||
srfi-8
|
||||
finite-types
|
||||
let-opt
|
||||
external-calls)
|
||||
(files yp))
|
||||
|
|
@ -0,0 +1,159 @@
|
|||
(define-syntax lookup-shared-value
|
||||
(syntax-rules ()
|
||||
((lookup-shared-valued str)
|
||||
(shared-binding-ref (lookup-imported-binding str)))))
|
||||
|
||||
(define-finite-type yp-result-code :yp-result-code
|
||||
(id)
|
||||
yp-result-code?
|
||||
yp-result-code-elements
|
||||
yp-result-code-name
|
||||
yp-result-code-index
|
||||
(id yp-result-code-id)
|
||||
((success 0)
|
||||
(bad-args (lookup-shared-value "yp-error-badargs"))
|
||||
(bad-database (lookup-shared-value "yp-error-baddb"))
|
||||
(bad-domain (lookup-shared-value "yp-error-domain"))
|
||||
(unknown-key (lookup-shared-value "yp-error-key"))
|
||||
(unknown-map (lookup-shared-value "yp-error-map"))
|
||||
(no-domain (lookup-shared-value "yp-error-nodom"))
|
||||
(no-more-records (lookup-shared-value "yp-error-nomore"))
|
||||
(portmap-failure (lookup-shared-value "yp-error-pmap"))
|
||||
(allocation-failure (lookup-shared-value "yp-error-resrc"))
|
||||
(rpc-failure (lookup-shared-value "yp-error-rpc"))
|
||||
(bind-failure (lookup-shared-value "yp-error-bind"))
|
||||
(internal-error (lookup-shared-value "yp-error-yperr"))
|
||||
(server-error (lookup-shared-value "yp-error-ypserv"))))
|
||||
|
||||
(define (yp-success? code)
|
||||
(equal? (yp-result-code success) code))
|
||||
|
||||
(define (yp-error-no-more? code)
|
||||
(equal? (yp-result-code no-more-records) code))
|
||||
|
||||
(define (make-finite-type-alist elements id-proc)
|
||||
(map (lambda (e)
|
||||
(cons (id-proc e) e))
|
||||
(vector->list elements)))
|
||||
|
||||
(define translate-result-code
|
||||
(let ((alist (make-finite-type-alist
|
||||
yp-result-code-elements yp-result-code-id)))
|
||||
(lambda (id)
|
||||
(cond
|
||||
((assoc id alist) => cdr)
|
||||
(else
|
||||
(error "yp: internal error. Could not map YP result code to finite type" id))))))
|
||||
|
||||
(define (yp-get-default-domain)
|
||||
(receive (code domain)
|
||||
(apply values (yp-get-default-domain-int))
|
||||
(let ((code (translate-result-code code)))
|
||||
(if (yp-success? code)
|
||||
domain
|
||||
(error "yp: Could not get default domain."
|
||||
(yp-error-string (yp-result-code-id code)))))))
|
||||
|
||||
(define (yp-bind . domain)
|
||||
(let-optionals domain
|
||||
((domain (yp-get-default-domain)))
|
||||
(translate-result-code (yp-bind-int domain))))
|
||||
|
||||
(define (yp-unbind . domain)
|
||||
(let-optionals domain
|
||||
((domain (yp-get-default-domain)))
|
||||
(translate-result-code (yp-unbind-int domain))))
|
||||
|
||||
(define (yp-match map key . domain)
|
||||
(let-optionals domain
|
||||
((domain (yp-get-default-domain)))
|
||||
(receive (code val)
|
||||
(apply values (yp-match-int domain map key))
|
||||
(values (translate-result-code code) val))))
|
||||
|
||||
(define (yp-order map . domain)
|
||||
(let-optionals domain
|
||||
((domain (yp-get-default-domain)))
|
||||
(receive (code val)
|
||||
(apply values (yp-order-int domain map))
|
||||
(values (translate-result-code code) val))))
|
||||
|
||||
(define (yp-master map . domain)
|
||||
(let-optionals domain
|
||||
((domain (yp-get-default-domain)))
|
||||
(receive (code val)
|
||||
(apply values (yp-master-int domain map))
|
||||
(values (translate-result-code code) val))))
|
||||
|
||||
(define (yp-first map . domain)
|
||||
(let-optionals domain
|
||||
((domain (yp-get-default-domain)))
|
||||
(receive (code key val)
|
||||
(apply values (yp-first-int domain map))
|
||||
(values (translate-result-code code) key val))))
|
||||
|
||||
(define (yp-next map key . domain)
|
||||
(let-optionals domain
|
||||
((domain (yp-get-default-domain)))
|
||||
(receive (code key val)
|
||||
(apply values (yp-next-int domain map key))
|
||||
(values (translate-result-code code) key val))))
|
||||
|
||||
(define (yp-map->list map . domain)
|
||||
(let-optionals domain
|
||||
((domain (yp-get-default-domain)))
|
||||
(receive (code key val) (yp-first map domain)
|
||||
(if (yp-success? code)
|
||||
(let loop ((key key) (res (cons (cons key val) '())))
|
||||
(receive (code key val)
|
||||
(yp-next map key domain)
|
||||
(cond
|
||||
((yp-error-no-more? code) res)
|
||||
((yp-success? code)
|
||||
(loop key (cons (cons key val) res)))
|
||||
(else
|
||||
(error (yp-error-string code))))))
|
||||
(error (yp-error-string code))))))
|
||||
|
||||
(define (yp-error-string yp-result)
|
||||
(yp-error-string-int (yp-result-code-id yp-result)))
|
||||
|
||||
(import-lambda-definition yp-get-default-domain-int
|
||||
()
|
||||
"scsh_yp_getdefaultdomain")
|
||||
|
||||
(import-lambda-definition yp-bind-int
|
||||
(domain)
|
||||
"scsh_yp_bind")
|
||||
|
||||
(import-lambda-definition yp-unbind-int
|
||||
(domain)
|
||||
"scsh_yp_unbind")
|
||||
|
||||
(import-lambda-definition yp-error-string-int
|
||||
(code)
|
||||
"scsh_yp_errstring")
|
||||
|
||||
(import-lambda-definition yp-protocol-error
|
||||
(code)
|
||||
"scsh_yp_proterr")
|
||||
|
||||
(import-lambda-definition yp-match-int
|
||||
(domain map key)
|
||||
"scsh_yp_match")
|
||||
|
||||
(import-lambda-definition yp-order-int
|
||||
(domain map)
|
||||
"scsh_yp_order")
|
||||
|
||||
(import-lambda-definition yp-master-int
|
||||
(domain map)
|
||||
"scsh_yp_master")
|
||||
|
||||
(import-lambda-definition yp-first-int
|
||||
(domain map)
|
||||
"scsh_yp_first")
|
||||
|
||||
(import-lambda-definition yp-next-int
|
||||
(domain map key)
|
||||
"scsh_yp_next")
|
||||
Loading…
Reference in New Issue