86 lines
2.4 KiB
Factor
86 lines
2.4 KiB
Factor
|
! Copyright (C) 2009 Maxim Savchenko
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
|
||
|
|
USING: kernel accessors sequences sequences.private destructors math namespaces
|
||
|
|
locals openssl openssl.libcrypto byte-arrays bit-arrays.private
|
||
|
|
alien.c-types ;
|
||
|
|
|
||
|
|
IN: ecdsa
|
||
|
|
|
||
|
|
<PRIVATE
|
||
|
|
|
||
|
|
TUPLE: openssl-object handle ;
|
||
|
|
|
||
|
|
GENERIC# free-handle 1 ( obj handle -- obj )
|
||
|
|
|
||
|
|
M: openssl-object dispose
|
||
|
|
dup [ free-handle f ] change-handle 2drop ;
|
||
|
|
|
||
|
|
TUPLE: ec-key < openssl-object ;
|
||
|
|
|
||
|
|
M: ec-key free-handle EC_KEY_free ;
|
||
|
|
|
||
|
|
: <ec-key> ( curve -- key )
|
||
|
|
OBJ_sn2nid dup zero? [ "Unknown curve name" throw ] when
|
||
|
|
EC_KEY_new_by_curve_name dup ssl-error ec-key boa ;
|
||
|
|
|
||
|
|
: ec-key-handle ( -- handle )
|
||
|
|
ec-key get dup handle>> [ nip ] [ already-disposed ] if* ;
|
||
|
|
|
||
|
|
TUPLE: openssl-bignum < openssl-object ;
|
||
|
|
|
||
|
|
M: openssl-bignum free-handle BN_clear_free ;
|
||
|
|
|
||
|
|
TUPLE: ec-point < openssl-object ;
|
||
|
|
|
||
|
|
M: ec-point free-handle EC_POINT_clear_free ;
|
||
|
|
|
||
|
|
PRIVATE>
|
||
|
|
|
||
|
|
: with-ec ( curve quot -- )
|
||
|
|
swap <ec-key> [ ec-key rot with-variable ] with-disposal ; inline
|
||
|
|
|
||
|
|
: generate-key ( -- )
|
||
|
|
ec-key get handle>> EC_KEY_generate_key ssl-error ;
|
||
|
|
|
||
|
|
: set-private-key ( bin -- )
|
||
|
|
ec-key-handle swap
|
||
|
|
dup length f BN_bin2bn dup ssl-error dup openssl-bignum boa
|
||
|
|
[ drop EC_KEY_set_private_key ssl-error ] with-disposal ;
|
||
|
|
|
||
|
|
:: set-public-key ( BIN -- )
|
||
|
|
ec-key-handle :> KEY
|
||
|
|
KEY EC_KEY_get0_group :> GROUP
|
||
|
|
GROUP EC_POINT_new dup ssl-error :> POINT
|
||
|
|
POINT ec-point boa
|
||
|
|
[
|
||
|
|
drop
|
||
|
|
GROUP POINT BIN dup length f EC_POINT_oct2point ssl-error
|
||
|
|
KEY POINT EC_KEY_set_public_key ssl-error
|
||
|
|
] with-disposal ;
|
||
|
|
|
||
|
|
: get-private-key ( -- bin/f )
|
||
|
|
ec-key-handle EC_KEY_get0_private_key
|
||
|
|
dup [ dup BN_num_bits bits>bytes <byte-array> tuck BN_bn2bin drop ] when ;
|
||
|
|
|
||
|
|
:: get-public-key ( -- bin/f )
|
||
|
|
ec-key-handle :> KEY
|
||
|
|
KEY EC_KEY_get0_public_key dup
|
||
|
|
[| PUB |
|
||
|
|
KEY EC_KEY_get0_group :> GROUP
|
||
|
|
GROUP EC_GROUP_get_degree bits>bytes 1+ :> LEN
|
||
|
|
LEN <byte-array> :> BIN
|
||
|
|
GROUP PUB POINT_CONVERSION_COMPRESSED BIN LEN f
|
||
|
|
EC_POINT_point2oct ssl-error
|
||
|
|
BIN
|
||
|
|
] when ;
|
||
|
|
|
||
|
|
:: ecdsa-sign ( DGST -- sig )
|
||
|
|
ec-key-handle :> KEY
|
||
|
|
KEY ECDSA_size dup ssl-error <byte-array> :> SIG
|
||
|
|
"uint" <c-object> :> LEN
|
||
|
|
0 DGST dup length SIG LEN KEY ECDSA_sign ssl-error
|
||
|
|
LEN *uint SIG resize ;
|
||
|
|
|
||
|
|
: ecdsa-verify ( dgst sig -- ? )
|
||
|
|
ec-key-handle [ 0 -rot [ dup length ] bi@ ] dip ECDSA_verify 0 > ;
|