]> gitweb.factorcode.org Git - factor.git/commitdiff
Fix doublec's http.client bugs
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 5 Jun 2008 00:14:20 +0000 (19:14 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 5 Jun 2008 00:14:20 +0000 (19:14 -0500)
extra/http/client/client.factor
extra/openssl/openssl.factor

index e6c8791e20e37f4253d98fb9e3320d12428b21f1..7b48bf93aff086c449ef026cfea499dd3a315921 100755 (executable)
@@ -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 ;
index 03343820db648539bf6a3e9945c5a7cbacdd46d7..28fa49dfce5cf55e9a592fed1c9e79d3a70b4f15 100755 (executable)
@@ -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 -- )