Changeset 36731 in project


Ignore:
Timestamp:
10/28/18 13:45:43 (2 weeks ago)
Author:
kon
Message:

add init! for own ctx (yeah, ! misused), common message-digest-primitive-context type, reflow, inlining, shared code,

Location:
release/5/message-digest-type/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/message-digest-type/trunk/message-digest-type.egg

    r36141 r36731  
    33
    44((synopsis "Message Digest Type")
    5  (version "4.0.2")
     5 (version "4.1.0")
    66 (category crypt)
    77 (author "[[kon lovett]]")
  • release/5/message-digest-type/trunk/message-digest-type.scm

    r35918 r36731  
    99;;
    1010;; - Uses 'context-info' to determine whether active context is "own" allocation or
    11 ;; callers.
     11;;callers.
    1212
    1313(declare
     
    1818(;export
    1919  message-digest-result-form
    20   ; MD API
     20  ;MD API
    2121  message-digest? check-message-digest error-message-digest
    2222  message-digest-algorithm message-digest-context
     23  initialize-message-digest initialize-message-digest!
    2324  ensure-message-digest-buffer!
    24   initialize-message-digest
    2525  finalize-message-digest finalize-message-digest!)
    2626
     
    5050(define-type message-digest-buffer (or string blob u8vector))
    5151
    52 (define-type message-digest-context *)
    53 
    5452(define-type message-digest-primitive (struct message-digest-primitive))
    5553
    56 ;;
    57 
    58 (define (%u8vector-blob u8vec)
    59   (##sys#slot u8vec 1) )
     54(define-type message-digest-primitive-context *)
     55
     56(define-type message-digest (struct message-digest))
     57
     58;;
     59
     60(define (%u8vector-blob u8vec) (##sys#slot u8vec 1))
    6061
    6162;;
     
    6869  (error-argument-type loc obj "symbol in {string hex blob u8vector}" 'result-form) )
    6970
     71(: canonical-result-name (message-digest-result-form -> (or boolean message-digest-result-form)))
     72;
     73(define-inline (canonical-result-name x)
     74  (case x
     75    ((blob)                       'blob )
     76    ((byte-string string)         'byte-string )
     77    ((hex-string hex hexstring)   'hex-string )
     78    ((u8vector)                   'u8vector )
     79    (else
     80      #f ) ) )
     81
    7082;perform any conversion necessary for final result representation
    7183
    7284(: get-result-form (symbol blob message-digest-result-form -> message-digest-result-type))
    7385;
    74 (define (get-result-form loc res restyp)
     86(define-inline (get-result-form loc res restyp)
    7587  (case (canonical-result-name restyp)
    7688    ((blob)           res )
     
    8597  (case restyp
    8698    ((blob)
    87       (if (fx= len (blob-size res)) res
     99      (if (fx= len (blob-size res))
     100        res
    88101        (string->blob (substring (blob->string res) 0 len)) ) )
    89102    ((byte-string string)
    90103      (let ((str (blob->string res)))
    91         (if (fx= len (string-length str)) str
     104        (if (fx= len (string-length str))
     105          str
    92106          (substring str 0 len) ) ) )
    93107    ((hex-string hex hexstring)
     
    95109    ((u8vector)
    96110      (let ((vec (blob->u8vector/shared res)))
    97         (if (fx= len (u8vector-length vec)) vec
     111        (if (fx= len (u8vector-length vec))
     112          vec
    98113          (subu8vector vec 0 len) ) ) )
    99114    (else
    100115      (error-result-form loc restyp) ) ) )
    101116
    102 (: canonical-result-name (message-digest-result-form -> (or boolean message-digest-result-form)))
    103 ;
    104 (define (canonical-result-name x)
    105   (case x
    106     ((blob)                       'blob )
    107     ((byte-string string)         'byte-string )
    108     ((hex-string hex hexstring)   'hex-string )
    109     ((u8vector)                   'u8vector )
    110     (else
    111       #f ) ) )
    112 
    113117(: check-result-type (symbol message-digest-primitive message-digest-result-type -> message-digest-result-type))
    114118;
    115 (define (check-result-type loc mdp obj)
     119(define-inline (check-result-type loc mdp obj)
    116120  (let (
    117121    (siz
    118122      (cond
    119         ((string? obj)
    120           (string-length obj))
    121         ((blob? obj)
    122           (blob-size obj))
    123         ((u8vector? obj)
    124           (u8vector-length obj))
     123        ((string? obj)    (string-length obj))
     124        ((blob? obj)      (blob-size obj))
     125        ((u8vector? obj)  (u8vector-length obj))
    125126        (else
    126127          (error loc "unsupported result buffer" obj) ) ) )
    127       (rqr (message-digest-primitive-digest-length mdp)) )
     128    (rqr
     129      (message-digest-primitive-digest-length mdp)) )
    128130    (unless (<= rqr siz)
    129131      (error loc "result buffer too small" rqr obj) ) )
     
    138140(define message-digest-result-form (make-parameter DEFAULT-RESULT-TYPE
    139141  (lambda (x)
    140     (or
    141       (if x
    142         (canonical-result-name x)
    143         (begin
    144           (warning 'message-digest-result-form "invalid result-form" x)
    145           (message-digest-result-form) ) ) ) ) ) )
    146 
    147 ;;
    148 
    149 (define-type message-digest (struct message-digest))
    150 
    151 (: *make-message-digest (message-digest-primitive message-digest-context (or boolean message-digest-buffer) -> message-digest))
     142    (cond
     143      ((not x)                    DEFAULT-RESULT-TYPE)
     144      ((canonical-result-name x)  => identity)
     145      (else
     146        (warning 'message-digest-result-form "invalid result-form" x)
     147        (message-digest-result-form) ) ) ) ) )
     148
     149;;
     150
     151(: *make-message-digest (message-digest-primitive message-digest-primitive-context (or boolean message-digest-buffer) -> message-digest))
    152152(: message-digest? (* -> boolean : message-digest))
    153153(: message-digest-algorithm (message-digest -> message-digest-primitive))
    154 (: message-digest-context (message-digest -> message-digest-context))
     154(: message-digest-context (message-digest -> message-digest-primitive-context))
    155155(: message-digest-buffer (message-digest -> (or boolean message-digest-buffer)))
    156156(: message-digest-buffer-set! (message-digest (or boolean message-digest-buffer) -> void))
     
    165165(define-check+error-type message-digest)
    166166
    167 ;;
    168 
    169 (: new-message-digest-buffer! (message-digest fixnum -> message-digest-buffer))
    170 ;
    171 (define (new-message-digest-buffer! md siz)
    172   (let (
    173     (buf (make-blob siz)) )
     167;; Support
     168
     169(: new-message-digest-buffer (message-digest fixnum -> message-digest-buffer))
     170;
     171(define-inline (new-message-digest-buffer md siz)
     172  (let ((buf (make-blob siz)))
    174173    (message-digest-buffer-set! md buf)
    175174    buf ) )
    176175
     176(: new-message-digest (message-digest-primitive message-digest-primitive-context -> message-digest))
     177;
     178(define-inline (new-message-digest mdp ctx)
     179  ((message-digest-primitive-init mdp) ctx)
     180  (*make-message-digest mdp ctx #f) )
     181
     182(: *finalize-message-digest (message-digest-buffer message-digest message-digest-primitive -> message-digest-buffer))
     183;
     184(define-inline (*finalize-message-digest res md mdp)
     185  ;side-effects res
     186  (let ((buf (if (u8vector? res) (%u8vector-blob res) res)))
     187    ((message-digest-primitive-final mdp) (message-digest-context md) buf) )
     188  res )
     189
     190;;
     191
     192(: initialize-message-digest (message-digest-primitive -> message-digest))
     193;
     194(define (initialize-message-digest mdp)
     195  ;(check-message-digest-primitive 'initialize-message-digest mdp)
     196  (new-message-digest mdp (make-message-digest-primitive-context mdp)) )
     197
     198(: initialize-message-digest! (message-digest-primitive message-digest-primitive-context -> message-digest))
     199;
     200(define (initialize-message-digest! mdp ctx)
     201  (new-message-digest (check-message-digest-primitive 'initialize-message-digest! mdp) ctx) )
     202
     203;;
     204
    177205(: ensure-message-digest-buffer! (message-digest fixnum -> message-digest-buffer))
    178206;
    179207(define (ensure-message-digest-buffer! md siz)
    180208  (let (
     209    (siz
     210      (fxmax (check-positive-fixnum 'ensure-message-digest-buffer! siz) MINIMUM-BUFFER-SIZE))
    181211    (buf
    182       (message-digest-buffer (check-message-digest 'ensure-message-digest-buffer! md)))
    183     (siz
    184       (fxmax
    185         (check-positive-fixnum 'ensure-message-digest-buffer! siz)
    186         MINIMUM-BUFFER-SIZE)) )
    187     ;enough space? then reuse, otherwise new buffer
     212      (message-digest-buffer (check-message-digest 'ensure-message-digest-buffer! md))) )
     213    ;existing buffer has enough space? then reuse, otherwise new buffer
    188214    (if (and buf (fx<= siz (number-of-bytes buf)))
    189215      buf
    190       (new-message-digest-buffer! md siz) ) ) )
    191 
    192 ;;
    193 
    194 (: initialize-message-digest (message-digest-primitive -> message-digest))
    195 ;
    196 (define (initialize-message-digest mdp)
    197   (let (
    198     (ctx (make-message-digest-primitive-context mdp)) )
    199     ((message-digest-primitive-init mdp) ctx)
    200     (*make-message-digest mdp ctx #f) ) )
     216      (new-message-digest-buffer md siz) ) ) )
    201217
    202218;;
     
    208224    (mdp (message-digest-algorithm (check-message-digest 'finalize-message-digest md)))
    209225    (res (make-blob (message-digest-primitive-digest-length mdp))) )
    210     ;side-effects res
    211     ((message-digest-primitive-final mdp) (message-digest-context md) res)
     226    (*finalize-message-digest res md mdp)
    212227    (get-result-form 'finalize-message-digest res restyp) ) )
    213228
    214229(: finalize-message-digest! (message-digest message-digest-buffer -> message-digest-result-type))
    215230;
    216 (define (finalize-message-digest! md result-buffer)
     231(define (finalize-message-digest! md resbuf)
    217232  (let* (
    218     (mdp
    219       (message-digest-algorithm (check-message-digest 'finalize-message-digest md)))
    220     (res
    221       (check-result-type 'finalize-message-digest mdp result-buffer)) )
    222     ;side-effects res
    223     (let (
    224       (buf (if (u8vector? res) (%u8vector-blob res) res)) )
    225       ((message-digest-primitive-final mdp) (message-digest-context md) buf) )
    226     res ) )
     233    (mdp (message-digest-algorithm (check-message-digest 'finalize-message-digest! md)))
     234    (res (check-result-type 'finalize-message-digest mdp resbuf)) )
     235    (*finalize-message-digest res md mdp) ) )
    227236
    228237) ;module message-digest-type
Note: See TracChangeset for help on using the changeset viewer.