lispworks without usocket #3

Closed
Fazerty opened this Issue Jan 31, 2013 · 1 comment

Projects

None yet

2 participants

Fazerty commented Jan 31, 2013

I'm using the original trivial-ldap.
I modified the code to avoid to use usocket while using lispworks.
It could be usefull to add the modifications to your trivial-ldap.

Here are the modifications

(defpackage :trivial-ldap
(:use :cl-user :common-lisp
#-lispworks :usocket)
...

-lispworks

(defmethod get-stream ((ldap ldap))
"Open a usocket to the ldap server and set the ldap object's slot.
If the port number is 636 or the SSLflag is not null, the stream
will be made with CL+SSL."
(let ((existing-stream (ldapstream ldap)))
(unless (and (streamp existing-stream)
(open-stream-p existing-stream))
(let* ((sock (usocket:socket-connect (host ldap) (port ldap)
:element-type '(unsigned-byte 8)))
(stream
(if (or (sslflag ldap) (= (port ldap) 636))
(cl+ssl:make-ssl-client-stream (usocket:socket-stream sock))
(usocket:socket-stream sock))))
(debug-mesg ldap "Opening socket and stream.")
(setf (ldapsock ldap) sock)
(setf (ldapstream ldap) stream))))
(ldapstream ldap))

-lispworks

(defmethod close-stream ((ldap ldap))
"Close an ldap connection if it is currently open."
(let ((existing-stream (ldapstream ldap))
(existing-sock (ldapsock ldap)))
(when (and (streamp existing-stream) (open-stream-p existing-stream))
(ignore-errors
(setf (ldapstream ldap) nil)
(setf (ldapsock ldap) nil)
(close existing-stream)
(usocket:socket-close existing-sock)))))

+lispworks

(defmethod get-stream ((ldap ldap))
"Open a usocket to the ldap server and set the ldap object's slot.
If the port number is 636 or the SSLflag is not null, the stream
will be made with CL+SSL."
(let ((connection-timeout 20)
(read-timeout 20)
(write-timeout 20)
(existing-stream (ldapstream ldap))
(certificate-path (certificate-path ldap)))
(unless (and (streamp existing-stream)
(open-stream-p existing-stream))
(let* ((ssl-ctx (when (or (sslflag ldap) (= (port ldap) 636))
(comm:make-ssl-ctx :ssl-side :client)))
stream)
(when (and ssl-ctx certificate-path)
#+ignore ;; To test
(comm:ssl-ctx-use-certificate-file ssl-ctx
certificate-path
comm:SSL_FILETYPE_PEM)
)
(setf stream (comm:open-tcp-stream (host ldap) (port ldap)
:element-type '(unsigned-byte 8)
:timeout connection-timeout
:read-timeout read-timeout
:ssl-ctx ssl-ctx
#-:lw-does-not-have-write-timeout
:write-timeout
#-:lw-does-not-have-write-timeout
write-timeout
:errorp t))
(debug-mesg ldap "Opening socket and stream.")
(setf (ldapstream ldap) stream))
))
(ldapstream ldap))

+lispworks

(defmethod close-stream ((ldap ldap))
"Close an ldap connection if it is currently open."
(let ((existing-stream (ldapstream ldap)))
(when (and (streamp existing-stream) (open-stream-p existing-stream))
(ignore-errors
(setf (ldapstream ldap) nil)
(close existing-stream)
))))

Regards

Fazerty

Owner
rwiker commented Dec 16, 2014

This has taken much too long, but I've merged in your proposed changes (with a couple of minor changes). Thanks, and sorry for the delay!

@rwiker rwiker closed this Dec 16, 2014
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment