basis/checksums/openssl/openssl.factor

   1 ! Copyright (C) 2008, 2010, 2016 Slava Pestov, Alexander Ilin
   2 ! See https://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 CONSTANT: openssl-sha256 T{ openssl-checksum f "sha256" }
  18
  19 C: <openssl-checksum> openssl-checksum
  20
  21 <PRIVATE
  22
  23 TUPLE: evp-md-context < disposable handle ;
  24
  25 : evp-md-ctx-new ( -- ctx )
  26     ssl-new-api? get-global [ EVP_MD_CTX_new ] [ EVP_MD_CTX_create ] if ;
  27
  28 : evp-md-ctx-free ( ctx -- )
  29     ssl-new-api? get-global [ EVP_MD_CTX_free ] [ EVP_MD_CTX_destroy ] if ;
  30
  31 : <evp-md-context> ( -- ctx )
  32     evp-md-context new-disposable evp-md-ctx-new >>handle ;
  33
  34 M: evp-md-context dispose*
  35     handle>> evp-md-ctx-free ;
  36
  37 : digest-named ( name -- md )
  38     [ EVP_get_digestbyname ] [ unknown-digest ] ?unless ;
  39
  40 : set-digest ( name ctx -- )
  41     handle>> swap digest-named f EVP_DigestInit_ex ssl-error ;
  42
  43 M: openssl-checksum initialize-checksum-state
  44     maybe-init-ssl name>> <evp-md-context> [ set-digest ] keep ;
  45
  46 M: evp-md-context add-checksum-bytes
  47     [ dup handle>> ] dip dup length EVP_DigestUpdate ssl-error ;
  48
  49 M: evp-md-context get-checksum
  50     handle>>
  51     { { int EVP_MAX_MD_SIZE } int }
  52     [ EVP_DigestFinal_ex ssl-error ] with-out-parameters
  53     memory>byte-array ;
  54
  55 PRIVATE>