(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-option-values (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-message-types (map make-constant-from-c-name-integer '("LDAP_RES_BIND" "LDAP_RES_SEARCH_ENTRY" "LDAP_RES_SEARCH_REFERENCE" "LDAP_RES_SEARCH_RESULT" "LDAP_RES_MODIFY" "LDAP_RES_ADD" "LDAP_RES_DELETE" "LDAP_RES_MODDN" "LDAP_RES_COMPARE" "LDAP_RES_EXTENDED"))) (define ldap-all-constants (append ldap-return-codes ldap-opt-protocol-version ldap-scope-arguments ldap-attribute-selectors ldap-session-option-values ldap-message-types)) (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 \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-option-value" (make-drop-common-prefix-name-converter "LDAP_OPT_") ldap-session-option-values) (generate-finite-type-definition "ldap-message-types" (make-drop-common-prefix-name-converter "LDAP_RES_") ldap-message-types) (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)))) ))