extra/ecdsa/ecdsa.factor

   1 ! Copyright (C) 2009 Maxim Savchenko
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: kernel accessors sequences sequences.private destructors math namespaces
   5        locals openssl openssl.libcrypto byte-arrays bit-arrays.private
   6        alien.c-types ;
   7
   8 IN: ecdsa
   9
  10 <PRIVATE
  11
  12 TUPLE: openssl-object handle ;
  13
  14 GENERIC# free-handle 1 ( obj handle -- obj )
  15
  16 M: openssl-object dispose
  17     dup [ free-handle f ] change-handle 2drop ;
  18
  19 TUPLE: ec-key < openssl-object ;
  20
  21 M: ec-key free-handle EC_KEY_free ;
  22
  23 : <ec-key> ( curve -- key )
  24     OBJ_sn2nid dup zero? [ "Unknown curve name" throw ] when
  25     EC_KEY_new_by_curve_name dup ssl-error ec-key boa ;
  26
  27 : ec-key-handle ( -- handle )
  28     ec-key get dup handle>> [ nip ] [ already-disposed ] if* ;
  29
  30 TUPLE: openssl-bignum < openssl-object ;
  31
  32 M: openssl-bignum free-handle BN_clear_free ;
  33
  34 TUPLE: ec-point < openssl-object ;
  35
  36 M: ec-point free-handle EC_POINT_clear_free ;
  37
  38 PRIVATE>
  39
  40 : with-ec ( curve quot -- )
  41     swap <ec-key> [ ec-key rot with-variable ] with-disposal ; inline
  42
  43 : generate-key ( -- )
  44     ec-key get handle>> EC_KEY_generate_key ssl-error ;
  45
  46 : set-private-key ( bin -- )
  47     ec-key-handle swap
  48     dup length f BN_bin2bn dup ssl-error dup openssl-bignum boa
  49     [ drop EC_KEY_set_private_key ssl-error ] with-disposal ;
  50
  51 :: set-public-key ( BIN -- )
  52     ec-key-handle :> KEY
  53     KEY EC_KEY_get0_group :> GROUP
  54     GROUP EC_POINT_new dup ssl-error :> POINT
  55     POINT ec-point boa
  56     [
  57         drop
  58         GROUP POINT BIN dup length f EC_POINT_oct2point ssl-error
  59         KEY POINT EC_KEY_set_public_key ssl-error
  60     ] with-disposal ;
  61
  62 : get-private-key ( -- bin/f )
  63     ec-key-handle EC_KEY_get0_private_key
  64     dup [ dup BN_num_bits bits>bytes <byte-array> tuck BN_bn2bin drop ] when ;
  65
  66 :: get-public-key ( -- bin/f )
  67     ec-key-handle :> KEY
  68     KEY EC_KEY_get0_public_key dup
  69     [| PUB |
  70         KEY EC_KEY_get0_group :> GROUP
  71         GROUP EC_GROUP_get_degree bits>bytes 1+ :> LEN
  72         LEN <byte-array> :> BIN
  73         GROUP PUB POINT_CONVERSION_COMPRESSED BIN LEN f
  74         EC_POINT_point2oct ssl-error
  75         BIN
  76     ] when ;
  77
  78 :: ecdsa-sign ( DGST -- sig )
  79     ec-key-handle :> KEY
  80     KEY ECDSA_size dup ssl-error <byte-array> :> SIG
  81     "uint" <c-object> :> LEN
  82     0 DGST dup length SIG LEN KEY ECDSA_sign ssl-error
  83     LEN *uint SIG resize ;
  84
  85 : ecdsa-verify ( dgst sig -- ? )
  86     ec-key-handle [ 0 -rot [ dup length ] bi@ ] dip ECDSA_verify 0 > ;