]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/io/sockets/secure/openssl/openssl.factor
Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...
[factor.git] / basis / io / sockets / secure / openssl / openssl.factor
index 60402c37ea0073923bcd09735eb480cbdf2b0b9a..07246354e3e98871ecb01acd14ecd76cc52240a9 100644 (file)
@@ -1,10 +1,10 @@
 ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays kernel sequences
-namespaces math math.order combinators init alien alien.c-types
-alien.strings libc continuations destructors summary
-splitting assocs random math.parser locals unicode.case openssl
-openssl.libcrypto openssl.libssl io.backend io.ports io.files
+USING: accessors byte-arrays kernel sequences namespaces math
+math.order combinators init alien alien.c-types alien.strings
+libc continuations destructors summary splitting assocs random
+math.parser locals unicode.case openssl openssl.libcrypto
+openssl.libssl io.backend io.ports io.pathnames
 io.encodings.8-bit io.timeouts io.sockets.secure ;
 IN: io.sockets.secure.openssl
 
@@ -36,7 +36,7 @@ TUPLE: openssl-context < secure-context aliens sessions ;
         password [ B{ 0 } password! ] unless
 
         [let | len [ password strlen ] |
-            buf password len 1+ size min memcpy
+            buf password len 1 + size min memcpy
             len
         ]
     ] alien-callback ;
@@ -46,11 +46,13 @@ TUPLE: openssl-context < secure-context aliens sessions ;
     [ push ] [ drop ] 2bi ;
 
 : set-default-password ( ctx -- )
-    [ handle>> password-callback SSL_CTX_set_default_passwd_cb ]
-    [
-        [ handle>> ] [ default-pasword ] bi
-        SSL_CTX_set_default_passwd_cb_userdata
-    ] bi ;
+    dup config>> password>> [
+        [ handle>> password-callback SSL_CTX_set_default_passwd_cb ]
+        [
+            [ handle>> ] [ default-pasword ] bi
+            SSL_CTX_set_default_passwd_cb_userdata
+        ] bi
+    ] [ drop ] if ;
 
 : use-private-key-file ( ctx -- )
     dup config>> key-file>> [
@@ -141,16 +143,11 @@ TUPLE: ssl-handle file handle connected disposed ;
 
 SYMBOL: default-secure-context
 
-: context-expired? ( context -- ? )
-    dup [ handle>> expired? ] [ drop t ] if ;
-
 : current-secure-context ( -- ctx )
     secure-context get [
-        default-secure-context get dup context-expired? [
-            drop
-            <secure-config> <secure-context> default-secure-context set-global
-            current-secure-context
-        ] when
+        default-secure-context [
+            <secure-config> <secure-context>
+        ] initialize-alien
     ] unless* ;
 
 : <ssl-handle> ( fd -- ssl )
@@ -187,8 +184,7 @@ M: openssl check-certificate ( host ssl -- )
     ] [ 2drop ] if ;
 
 : get-session ( addrspec -- session/f )
-    current-secure-context sessions>> at
-    dup expired? [ drop f ] when ;
+    current-secure-context sessions>> at ;
 
 : save-session ( session addrspec -- )
     current-secure-context sessions>> set-at ;