scsh-ldap/scheme/ldap-constants.scm

129 lines
3.4 KiB
Scheme

(define-interface ldap-constants-interface
(export
make-c-files
make-scm-files))
(define-structure ldap-constants ldap-constants-interface
(open
scheme signals
ffi-import-constants)
(begin
(define ldap-return-codes
(map make-constant-from-c-name-integer
'("LDAP_SUCCESS"
"LDAP_OPERATIONS_ERROR"
"LDAP_PROTOCOL_ERROR"
"LDAP_TIMELIMIT_EXCEEDED"
"LDAP_SIZELIMIT_EXCEEDED"
"LDAP_COMPARE_FALSE"
"LDAP_COMPARE_TRUE"
"LDAP_STRONG_AUTH_NOT_SUPPORTED"
"LDAP_STRONG_AUTH_REQUIRED"
"LDAP_REFERRAL"
"LDAP_ADMINLIMIT_EXCEEDED"
"LDAP_UNAVAILABLE_CRITICAL_EXTENSION"
"LDAP_CONFIDENTIALITY_REQUIRED"
"LDAP_SASL_BIND_IN_PROGRESS"
"LDAP_NO_SUCH_ATTRIBUTE"
"LDAP_UNDEFINED_TYPE"
"LDAP_INAPPROPRIATE_MATCHING"
"LDAP_CONSTRAINT_VIOLATION"
"LDAP_TYPE_OR_VALUE_EXISTS"
"LDAP_INVALID_SYNTAX"
"LDAP_NO_SUCH_OBJECT"
"LDAP_ALIAS_PROBLEM"
"LDAP_INVALID_DN_SYNTAX"
"LDAP_IS_LEAF"
"LDAP_ALIAS_DEREF_PROBLEM"
"LDAP_INAPPROPRIATE_AUTH"
"LDAP_INVALID_CREDENTIALS"
"LDAP_INSUFFICIENT_ACCESS"
"LDAP_BUSY"
"LDAP_UNAVAILABLE"
"LDAP_UNWILLING_TO_PERFORM"
"LDAP_LOOP_DETECT"
"LDAP_NAMING_VIOLATION"
"LDAP_OBJECT_CLASS_VIOLATION"
"LDAP_NOT_ALLOWED_ON_NONLEAF"
"LDAP_NOT_ALLOWED_ON_RDN"
"LDAP_ALREADY_EXISTS"
"LDAP_NO_OBJECT_CLASS_MODS"
"LDAP_RESULTS_TOO_LARGE"
"LDAP_AFFECTS_MULTIPLE_DSAS"
"LDAP_OTHER"
"LDAP_SERVER_DOWN"
"LDAP_LOCAL_ERROR"
"LDAP_ENCODING_ERROR"
"LDAP_DECODING_ERROR"
"LDAP_TIMEOUT"
"LDAP_AUTH_UNKNOWN"
"LDAP_FILTER_ERROR"
"LDAP_USER_CANCELLED"
"LDAP_PARAM_ERROR"
"LDAP_NO_MEMORY"
"LDAP_CONNECT_ERROR"
"LDAP_NOT_SUPPORTED"
"LDAP_CONTROL_NOT_FOUND"
"LDAP_NO_RESULTS_RETURNED"
"LDAP_MORE_RESULTS_TO_RETURN"
"LDAP_CLIENT_LOOP"
"LDAP_REFERRAL_LIMIT_EXCEEDED")))
(define ldap-opt-protocol-version
(map make-constant-from-c-name-integer
'("LDAP_VERSION" "LDAP_VERSION3")))
(define ldap-all-constants
(append ldap-return-codes
ldap-opt-protocol-version))
(define (write-source-file name string)
(call-with-output-file name
(lambda (port)
(display string port))))
(define (generate-ldap-consts-c path)
(write-source-file
(string-append path "/ldap-consts.c")
(string-append
"#include \"scheme48.h\"\n"
"#include <ldap.h>\n"
(generate-c-declarations ldap-all-constants)
(generate-c-enter-values-function
"scsh_ldap_enter_ldap_constants"
ldap-all-constants)
(generate-c-gc-protect-globals-function
"scsh_ldap_gc_protect_globals"
ldap-all-constants))))
(define (generate-const-gen-scm path)
(write-source-file
(string-append path "/const-gen.scm")
(string-append
(generate-finite-type-definition
"ldap-return" (make-drop-common-prefix-name-converter "LDAP_")
ldap-return-codes)
(generate-finite-type-definition
"ldap-option-version" (make-drop-common-prefix-name-converter "LDAP_")
ldap-opt-protocol-version))))
(define (make-c-files args)
(if (null? args)
(error "missing parameter")
(let ((path (car args)))
(generate-ldap-consts-c path))))
(define (make-scm-files args)
(if (null? args)
(error "missing parameter")
(let ((path (car args)))
(generate-const-gen-scm path))))
))