openssl: hacky way to support SSL_get1_peer_certificate

diff --git a/basis/alien/libraries/finder/finder.factor b/basis/alien/libraries/finder/finder.factor
index a2762fc700b1a10a022e1be885e7311079506cb0..ab140569df51097eae5b0969a21381ac6b66b787 100644 (file)
--- a/basis/alien/libraries/finder/finder.factor
+++ b/basis/alien/libraries/finder/finder.factor
@@ -17,12 +17,12 @@ HOOK: find-library* os ( name -- path/f )
 
 ERROR: library-missing library ;
 
-: find-first-function ( names library -- function/f )
+: find-first-function ( names library -- alien/f name )
     libraries get ?at [
-        dll>> '[ _ dlsym ] map-find nip
+        dll>> '[ _ dlsym ] map-find
     ] [
         library-missing
-    ] if ;
+    ] if ; inline
 
 ! Try to find the library from a list, but if it's not found,
 ! try to open a library that is the first name in that list anyway

diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor
index c67505a769ba3d808bc0acbaf56753c86fc3c400..46a5ed2f4dd9301bd7981f8e92c1c4771660594b 100644 (file)
--- a/basis/io/sockets/secure/openssl/openssl.factor
+++ b/basis/io/sockets/secure/openssl/openssl.factor
@@ -446,11 +446,8 @@ M: ssl-handle dispose*
         =
     ] if ;
 
-: get-peer-certificate-function ( -- word/f )
-    { "SSL_get1_peer_certificate" "SSL_get_peer_certificate" } "libssl" find-first-function ;
-
 : check-subject-name ( host ssl-handle -- )
-    get-peer-certificate-function execute( ssl -- x509 ) [
+    get-ssl-peer-certificate [
         [ alternative-dns-names ]
         [ subject-name ] bi suffix members
         2dup [ subject-names-match? ] with any?

diff --git a/basis/openssl/libssl/libssl-tests.factor b/basis/openssl/libssl/libssl-tests.factor
index 03ba8cfe67052c08ac2cda5c98971e84c2dfe1fc..ca5e8ff2268288f63731b27eec36a869ca578da6 100644 (file)
--- a/basis/openssl/libssl/libssl-tests.factor
+++ b/basis/openssl/libssl/libssl-tests.factor
@@ -53,13 +53,18 @@ maybe-init-ssl
 ] unit-test
 
 {
-    { "read header" 1 f }
+    { "read header" 1 }
 } [
     [
         new-tls1-ctx new-ssl {
             SSL_rstate_string_long
             SSL_want
-            get-peer-certificate-function
         } [ execute( x -- x ) ] with map
     ] with-destructors
 ] unit-test
+
+{ f } [
+    [
+        new-tls1-ctx new-ssl get-ssl-peer-certificate
+    ] with-destructors
+] unit-test

diff --git a/basis/openssl/libssl/libssl.factor b/basis/openssl/libssl/libssl.factor
index c9bca772e06b8dd64bb2aa2d0fb0b3788293470a..c868e8519d6006e68f8f1e5de897664cd104c59e 100644 (file)
--- a/basis/openssl/libssl/libssl.factor
+++ b/basis/openssl/libssl/libssl.factor
@@ -2,9 +2,9 @@
 ! Portions copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.destructors alien.libraries
-alien.parser alien.syntax classes.struct combinators kernel
-literals namespaces openssl.libcrypto system ;
-SLOT: alpn-supported-protocols
+alien.libraries.finder alien.parser alien.syntax classes.struct
+combinators kernel literals namespaces openssl.libcrypto system
+words ;
 IN: openssl.libssl
 
 << "libssl" {
@@ -457,6 +457,10 @@ FUNCTION: X509* SSL_get_peer_certificate ( SSL* s )
 FUNCTION: X509 *SSL_get0_peer_certificate ( SSL *ssl )
 FUNCTION: X509 *SSL_get1_peer_certificate ( SSL *ssl )
 
+: get-ssl-peer-certificate ( ssl -- x509 )
+    { "SSL_get1_peer_certificate" "SSL_get_peer_certificate" } "libssl" find-first-function nip
+    "openssl.libssl" lookup-word execute( ssl -- x509 ) ; inline
+
 FUNCTION: int SSL_set_cipher_list ( SSL* ssl, c-string str )
 FUNCTION: int SSL_use_RSAPrivateKey_file ( SSL* ssl, c-string str )
 FUNCTION: int SSL_use_certificate_file ( SSL* ssl, c-string str, int type )