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? [
: 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 ;
! 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
[ 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 -- )