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        openssl openssl.libcrypto byte-arrays bit-arrays.private
   6        alien.c-types alien.destructors alien.data ;
   7
   8 IN: ecdsa
   9
  10 <PRIVATE
  11
  12 TUPLE: ec-key handle ;
  13
  14 M: ec-key dispose
  15     [ EC_KEY_free f ] change-handle drop ;
  16
  17 : <ec-key> ( curve -- key )
  18     OBJ_sn2nid dup zero? [ "Unknown curve name" throw ] when
  19     EC_KEY_new_by_curve_name dup ssl-error ec-key boa ;
  20
  21 : ec-key-handle ( -- handle )
  22     ec-key get dup handle>> [ ] [ already-disposed ] ?if ;
  23
  24 DESTRUCTOR: BN_clear_free
  25
  26 DESTRUCTOR: EC_POINT_clear_free
  27
  28 PRIVATE>
  29
  30 : with-ec ( curve quot -- )
  31     swap <ec-key> [ ec-key rot with-variable ] with-disposal ; inline
  32
  33 : generate-key ( -- )
  34     ec-key get handle>> EC_KEY_generate_key ssl-error ;
  35
  36 : set-private-key ( bin -- )
  37     ec-key-handle swap
  38     dup length f BN_bin2bn dup ssl-error
  39     [ &BN_clear_free EC_KEY_set_private_key ssl-error ] with-destructors ;
  40
  41 :: set-public-key ( BIN -- )
  42     ec-key-handle :> KEY
  43     KEY EC_KEY_get0_group :> GROUP
  44     GROUP EC_POINT_new dup ssl-error
  45     [
  46         &EC_POINT_clear_free :> POINT
  47         GROUP POINT BIN dup length f EC_POINT_oct2point ssl-error
  48         KEY POINT EC_KEY_set_public_key ssl-error
  49     ] with-destructors ;
  50
  51 : get-private-key ( -- bin/f )
  52     ec-key-handle EC_KEY_get0_private_key
  53     dup [ dup BN_num_bits bits>bytes <byte-array> [ BN_bn2bin drop ] keep ] when ;
  54
  55 :: get-public-key ( -- bin/f )
  56     ec-key-handle :> KEY
  57     KEY EC_KEY_get0_public_key dup
  58     [| PUB |
  59         KEY EC_KEY_get0_group :> GROUP
  60         GROUP EC_GROUP_get_degree bits>bytes 1 + :> LEN
  61         LEN <byte-array> :> BIN
  62         GROUP PUB POINT_CONVERSION_COMPRESSED BIN LEN f
  63         EC_POINT_point2oct ssl-error
  64         BIN
  65     ] when ;
  66
  67 :: ecdsa-sign ( DGST -- sig )
  68     ec-key-handle :> KEY
  69     KEY ECDSA_size dup ssl-error <byte-array> :> SIG
  70     0 uint <ref> :> LEN
  71     0 DGST dup length SIG LEN KEY ECDSA_sign ssl-error
  72     LEN uint deref SIG resize ;
  73
  74 : ecdsa-verify ( dgst sig -- ? )
  75     ec-key-handle [ 0 -rot [ dup length ] bi@ ] dip ECDSA_verify 0 > ;