173 lines
4.7 KiB
Scheme
173 lines
4.7 KiB
Scheme
(define-interface ldap-constants-interface
|
|
(export
|
|
make-c-files
|
|
make-scm-files))
|
|
|
|
(define-structure ldap-constants ldap-constants-interface
|
|
(open
|
|
scheme signals srfi-13
|
|
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-scope-arguments
|
|
(map make-constant-from-c-name-integer
|
|
'("LDAP_SCOPE_BASE" "LDAP_SCOPE_ONELEVEL" "LDAP_SCOPE_SUBTREE")))
|
|
|
|
(define ldap-session-options
|
|
(map make-constant-from-c-name-integer
|
|
'("LDAP_OPT_API_INFO"
|
|
"LDAP_OPT_DEREF"
|
|
"LDAP_OPT_SIZELIMIT"
|
|
"LDAP_OPT_TIMELIMIT"
|
|
"LDAP_OPT_REFERRALS"
|
|
"LDAP_OPT_RESTART"
|
|
"LDAP_OPT_PROTOCOL_VERSION"
|
|
"LDAP_OPT_SERVER_CONTROLS"
|
|
"LDAP_OPT_CLIENT_CONTROLS"
|
|
"LDAP_OPT_API_FEATURE_INFO"
|
|
"LDAP_OPT_HOST_NAME"
|
|
"LDAP_OPT_ERROR_NUMBER"
|
|
"LDAP_OPT_ERROR_STRING"
|
|
"LDAP_OPT_MATCHED_DN")))
|
|
|
|
(define ldap-attribute-selectors
|
|
(list
|
|
(make-string-constant
|
|
"LDAP_NO_ATTRS" "ldap-attributes-no-attribute")
|
|
(make-string-constant
|
|
"LDAP_ALL_USER_ATTRIBUTES" "ldap-attributes-all-user-attributes")))
|
|
|
|
(define ldap-all-constants
|
|
(append ldap-return-codes
|
|
ldap-opt-protocol-version
|
|
ldap-scope-arguments
|
|
ldap-attribute-selectors
|
|
ldap-session-options))
|
|
|
|
(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)
|
|
|
|
(generate-finite-type-definition
|
|
"ldap-scope-arguments" (make-drop-common-prefix-name-converter "LDAP_SCOPE_")
|
|
ldap-scope-arguments)
|
|
|
|
(generate-finite-type-definition
|
|
"ldap-session-options" (make-drop-common-prefix-name-converter "LDAP_OPT_")
|
|
ldap-session-options)
|
|
|
|
(string-join
|
|
(map generate-binding ldap-attribute-selectors)))))
|
|
|
|
(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))))
|
|
|
|
))
|
|
|