basis/checksums/openssl/openssl.factor

   1 ! Copyright (C) 2008, 2010, 2016 Slava Pestov, Alexander Ilin
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types alien.data checksums checksums.common
   4 destructors kernel namespaces openssl openssl.libcrypto sequences ;
   5 IN: checksums.openssl
   6
   7 ERROR: unknown-digest name ;
   8
   9 TUPLE: openssl-checksum name ;
  10
  11 INSTANCE: openssl-checksum block-checksum
  12
  13 CONSTANT: openssl-md5 T{ openssl-checksum f "md5" }
  14
  15 CONSTANT: openssl-sha1 T{ openssl-checksum f "sha1" }
  16
  17 C: <openssl-checksum> openssl-checksum
  18
  19 <PRIVATE
  20
  21 TUPLE: evp-md-context < disposable handle ;
  22
  23 : evp-md-ctx-new ( -- ctx )
  24     ssl-new-api? get-global [ EVP_MD_CTX_new ] [ EVP_MD_CTX_create ] if ;
  25
  26 : evp-md-ctx-free ( ctx -- )
  27     ssl-new-api? get-global [ EVP_MD_CTX_free ] [ EVP_MD_CTX_destroy ] if ;
  28
  29 : <evp-md-context> ( -- ctx )
  30     evp-md-context new-disposable evp-md-ctx-new >>handle ;
  31
  32 M: evp-md-context dispose*
  33     handle>> evp-md-ctx-free ;
  34
  35 : digest-named ( name -- md )
  36     dup EVP_get_digestbyname [ ] [ unknown-digest ] ?if ;
  37
  38 : set-digest ( name ctx -- )
  39     handle>> swap digest-named f EVP_DigestInit_ex ssl-error ;
  40
  41 M: openssl-checksum initialize-checksum-state ( checksum -- evp-md-context )
  42     maybe-init-ssl name>> <evp-md-context> [ set-digest ] keep ;
  43
  44 M: evp-md-context add-checksum-bytes ( ctx bytes -- ctx' )
  45     [ dup handle>> ] dip dup length EVP_DigestUpdate ssl-error ;
  46
  47 M: evp-md-context get-checksum ( ctx -- value )
  48     handle>>
  49     { { int EVP_MAX_MD_SIZE } int }
  50     [ EVP_DigestFinal_ex ssl-error ] with-out-parameters
  51     memory>byte-array ;
  52
  53 PRIVATE>