PLT Scheme and LDAP authentication

I recently was trying to figure out how to do user authentication on our company’s Active Directory LDAP server. Using a combination of openldap and the linux and mac side and Microsoft’s LDAP library, I was able to create a small module that can authenticate users and works cross platform.

The code uses PLT Scheme’s foreign library interface.

To authenticate a user, just do (authenticate “ldap-server.host.com” “username@host.com” “user-password”) with an optional port number. It will return ‘SUCCESS for a successful connection, ‘INVALID_CREDENTIALS for a bad password / username combination, or the integer of the error code for other errors.

#lang scheme

(require
 scheme/foreign
 srfi/2
 )

(provide authenticate)

(unsafe!)

;;; library accessors...
(define libldap
  (cond [(eq? (system-type) 'windows) (ffi-lib "Wldap32")]
        [else (ffi-lib "libldap")]))

(define ldap-instance (_cpointer/null 'ldap-instance))
(define LDAP_OPT_PROTOCOL_VERSION #x0011)
(define LDAP_AUTH_SIMPLE #x80)
(define LDAP_SUCCESS #x00)
(define LDAP_INVALID_CREDENTIALS #x31)
(define ldap_init       (get-ffi-obj 'ldap_init libldap (_fun _string/utf-8 _int32 -> ldap-instance)))
(define ldap_bind_s     (get-ffi-obj 'ldap_bind_s libldap (_fun ldap-instance _string/utf-8 _string/utf-8 _int32 -> _int32)))
(define ldap_set_option (get-ffi-obj 'ldap_set_option libldap (_fun ldap-instance _int32 (foo : (_ptr i _int)) -> _int32)))
(define ldap_unbind_s   (get-ffi-obj 'ldap_unbind_s libldap (_fun ldap-instance -> _void)))

;;; high level interface...
(define (authenticate host user password #:port (port 389))
  (and-let* ([ldap-connection (ldap_init host port)])
    (ldap_set_option ldap-connection LDAP_OPT_PROTOCOL_VERSION 3)
    (let ([bind-result
           (ldap_bind_s ldap-connection user password LDAP_AUTH_SIMPLE)])
      (begin0
        (cond
          [(= bind-result LDAP_SUCCESS) 'SUCCESS]
          [(= bind-result LDAP_INVALID_CREDENTIALS) 'INVALID_CREDENTIALS]
          [else bind-result])
        (ldap_unbind_s ldap-connection)))))