Skip to content

Patches for Lispworks 8. #121

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
tdrhq wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Patches for Lispworks 8. #121

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
fa08ed0
Patches for Lispworks 8.
tdrhq Apr 18, 2022
c4abd82
Fix typo
tdrhq Apr 18, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion drakma.asd
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,8 @@
:cl-ppcre
#-:drakma-no-chipz :chipz
#-:lispworks :usocket
#-(or :lispworks7.1 (and :allegro (not :allegro-cl-express)) :mocl-ssl :drakma-no-ssl) :cl+ssl)
#-(or :lispworks7.1 :lispworks8 (and :allegro (not :allegro-cl-express)) :mocl-ssl :drakma-no-ssl
) :cl+ssl)
:perform (test-op (o s)
(asdf:load-system :drakma-test)
(asdf:perform 'asdf:test-op :drakma-test)))
20 changes: 10 additions & 10 deletions request.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -160,7 +160,7 @@ headers of the chunked stream \(if any) as a second value."
(header-value :content-length headers)))
(parse-integer value)))
(element-type (if textp
#+:lispworks7.1 'lw:simple-char #-:lispworks7.1 'character
#+(or :lispworks7.1 :lispworks8) 'lw:simple-char #-(or :lispworks7.1 :lispworks8) 'character
'octet)))
(values (cond ((eql content-length 0) nil)
(content-length
Expand Down Expand Up @@ -233,8 +233,8 @@ headers of the chunked stream \(if any) as a second value."
decode-content ; default to nil for backwards compatibility
#+(or abcl clisp lispworks mcl openmcl sbcl)
(connection-timeout 20)
#+:lispworks7.1 (read-timeout 20)
#+(and :lispworks7.1 (not :lw-does-not-have-write-timeout))
#+(or :lispworks7.1 :lispworks8) (read-timeout 20)
#+(and (or :lispworks7.1 :lispworks8) (not :lw-does-not-have-write-timeout))
(write-timeout 20 write-timeout-provided-p)
#+:openmcl
deadline
Expand Down Expand Up @@ -483,7 +483,7 @@ decoded according to any encodings specified in the Content-Encoding
header. The actual decoding is done by the DECODE-STREAM generic function,
and you can implement new methods to support additional encodings.
Any encodings in Transfer-Encoding, such as chunking, are always performed."
#+lispworks7.1
#+ (or :lispworks7.1 :lispworks8)
(declare (ignore certificate key certificate-password verify max-depth ca-file ca-directory))
(unless (member protocol '(:http/1.0 :http/1.1) :test #'eq)
(parameter-error "Don't know how to handle protocol ~S." protocol))
Expand Down Expand Up @@ -559,7 +559,7 @@ Any encodings in Transfer-Encoding, such as chunking, are always performed."
(drakma-warn "Disabling WRITE-TIMEOUT because it doesn't mix well with SSL."))
(setq write-timeout nil))
(setq http-stream (or stream
#+:lispworks7.1
#+(or :lispworks7.1 :lispworks8)
(comm:open-tcp-stream host port
:element-type 'octet
:timeout connection-timeout
Expand All @@ -569,7 +569,7 @@ Any encodings in Transfer-Encoding, such as chunking, are always performed."
#-:lw-does-not-have-write-timeout
write-timeout
:errorp t)
#-:lispworks7.1
#-(or :lispworks7.1 :lispworks8)
(usocket:socket-stream
(usocket:socket-connect host port
:element-type 'octet
Expand Down Expand Up @@ -601,14 +601,14 @@ Any encodings in Transfer-Encoding, such as chunking, are always performed."
(when (and use-ssl
;; don't attach SSL to existing streams
(not stream))
#+:lispworks7.1
#+(or :lispworks7.1 :lispworks8)
(comm:attach-ssl http-stream
:ssl-side :client
#-(or lispworks4 lispworks5 lispworks6)
:tlsext-host-name
#-(or lispworks4 lispworks5 lispworks6)
(puri:uri-host uri))
#-:lispworks7.1
#-(or :lispworks7.1 :lispworks8)
(setq http-stream (make-ssl-stream http-stream
:hostname (puri:uri-host uri)
:certificate certificate
Expand Down Expand Up @@ -642,14 +642,14 @@ Any encodings in Transfer-Encoding, such as chunking, are always performed."
;; got a connection; we have to read a blank line,
;; turn on SSL, and then we can transmit
(read-line* http-stream)
#+:lispworks7.1
#+(or :lispworks7.1 :lispworks8)
(comm:attach-ssl raw-http-stream
:ssl-side :client
#-(or lispworks4 lispworks5 lispworks6)
:tlsext-host-name
#-(or lispworks4 lispworks5 lispworks6)
(puri:uri-host uri))
#-:lispworks7.1
#+(or :lispworks7.1 :lispworks8)
Copy link
Copy Markdown
Author

@tdrhq tdrhq Apr 18, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

oops typo here.

(setq http-stream (wrap-stream
(make-ssl-stream raw-http-stream
:hostname (puri:uri-host uri)
Expand Down
5 changes: 3 additions & 2 deletions util.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -295,12 +295,13 @@ which are not meant as separators."
(setq cookie-start (1+ end-pos))
(go next-cookie))))))

#-:lispworks7.1
#-(or :lispworks7.1 :lispworks8)
(defun make-ssl-stream (http-stream &key certificate key certificate-password verify (max-depth 10) ca-file ca-directory
hostname)
"Attaches SSL to the stream HTTP-STREAM and returns the SSL stream
\(which will not be equal to HTTP-STREAM)."
(declare (ignorable http-stream certificate-password max-depth ca-directory hostname))
(declare (ignorable http-stream certificate-password max-depth ca-directory hostname)
(optimize (debug 3) (speed 0)))
(check-type verify (member nil :optional :required))
(when (and certificate
(not (probe-file certificate)))
Expand Down