Fix doublec's http.client bugs
parent
d0edbccf67
commit
180c7d3178
extra
http/client
openssl
|
@ -22,7 +22,7 @@ DEFER: http-request
|
|||
SYMBOL: redirects
|
||||
|
||||
: redirect-url ( request url -- request )
|
||||
'[ , >url derive-url ensure-port ] change-url ;
|
||||
'[ , >url ensure-port derive-url ensure-port ] change-url ;
|
||||
|
||||
: do-redirect ( response data -- response data )
|
||||
over code>> 300 399 between? [
|
||||
|
@ -100,12 +100,11 @@ M: download-failed error.
|
|||
: download ( url -- )
|
||||
dup download-name download-to ;
|
||||
|
||||
: <post-request> ( content-type content url -- request )
|
||||
: <post-request> ( post-data url -- request )
|
||||
<request>
|
||||
"POST" >>method
|
||||
swap >url ensure-port >>url
|
||||
swap >>post-data
|
||||
swap >>post-data-type ;
|
||||
swap >>post-data ;
|
||||
|
||||
: http-post ( content-type content url -- response data )
|
||||
: http-post ( post-data url -- response data )
|
||||
<post-request> http-request ;
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors byte-arrays kernel debugger sequences namespaces math
|
||||
math.order combinators init alien alien.c-types alien.strings libc
|
||||
continuations destructors debugger inspector
|
||||
continuations destructors debugger inspector splitting
|
||||
locals unicode.case
|
||||
openssl.libcrypto openssl.libssl
|
||||
io.backend io.ports io.files io.encodings.8-bit io.sockets.secure
|
||||
|
@ -188,8 +188,12 @@ M: ssl-handle dispose*
|
|||
[ 256 X509_NAME_get_text_by_NID ] keep
|
||||
swap -1 = [ drop f ] [ latin1 alien>string ] if ;
|
||||
|
||||
: common-names-match? ( expected actual -- ? )
|
||||
[ >lower ] bi@ "*." ?head [ tail? ] [ = ] if ;
|
||||
|
||||
: check-common-name ( host ssl-handle -- )
|
||||
SSL_get_peer_certificate common-name 2dup [ >lower ] bi@ =
|
||||
SSL_get_peer_certificate common-name
|
||||
2dup common-names-match?
|
||||
[ 2drop ] [ common-name-verify-error ] if ;
|
||||
|
||||
M: openssl check-certificate ( host ssl -- )
|
||||
|
|
Loading…
Reference in New Issue