Changeset 26369 in project


Ignore:
Timestamp:
04/05/12 06:44:56 (8 years ago)
Author:
Kon Lovett
Message:

Rmvd Dep procs. Rmvd pack-integer. Added unint blob set procs. Rmvd some update proces.

Location:
release/4/message-digest/trunk
Files:
3 added
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/message-digest/trunk/message-digest-port.scm

    r24715 r26369  
    3333    (only message-digest
    3434      initialize-message-digest finalize-message-digest
    35       message-digest-update-bytevector
     35      message-digest-update-string message-digest-update-blob
    3636      message-digest-primitive-name))
    3737
     
    7070(define (open-output-digest mdp)
    7171  (let* ((md (initialize-message-digest mdp))
    72          (writer (cut message-digest-update-bytevector md <>))
     72         (writer (lambda (obj)
     73                                                        (if (string? obj) (message-digest-update-string md obj)
     74                                                                (message-digest-update-blob md obj))))
    7375         (port (make-output-port writer void)) ) ;use default close behavior
    7476    (##sys#set-port-data! port md)
  • release/4/message-digest/trunk/message-digest.scm

    r26314 r26369  
    11;;;; message-digest.scm
    22;;;; Kon Lovett, Jan '06
     3;;;; Kon Lovett, Aug '10
     4;;;; Kon Lovett, Apr '12
    35
    46;; Issues
    5 ;;
    6 ;; - Uses string type as a byte-vector - a kludge.
    77;;
    88;; - Uses 'context-info' to determine whether active context is "own" allocation or
     
    1010;;
    1111;; - Passes u8vector to update phase as a blob.
    12 ;;
    13 ;; - Could use core-inline for n-bit packing but need to disambiguate scheme
    14 ;; types in the C code. May not be worth it.
    1512
    1613(module message-digest
    1714
    1815  (;export
    19     ; Utilities
    20     ;FIXME this doesn't belong here
    21     pack-u8 pack-u16 pack-u32 pack-u64 pack-integer
    2216    ; Parameters
    2317    message-digest-chunk-size
     
    3933    finalize-message-digest
    4034    message-digest-update-object
    41     message-digest-update-bytevector
     35    #;message-digest-update-bytevector
    4236    message-digest-update-blob
    4337    message-digest-update-string
    44     message-digest-update-substring
     38    #;message-digest-update-substring
    4539    message-digest-update-u8vector
    46     message-digest-update-subu8vector
    47     message-digest-update-char
    48     message-digest-update-char-u8
     40    #;message-digest-update-subu8vector
     41    #;message-digest-update-char
     42    #;message-digest-update-char-u8
    4943    message-digest-update-char-be
    5044    message-digest-update-char-le
    5145    message-digest-update-u8
    52     message-digest-update-u16
     46    #;message-digest-update-u16
    5347    message-digest-update-u16-be
    5448    message-digest-update-u16-le
    55     message-digest-update-u32
     49    #;message-digest-update-u32
    5650    message-digest-update-u32-be
    5751    message-digest-update-u32-le
    58     message-digest-update-u64
     52    #;message-digest-update-u64
    5953    message-digest-update-u64-be
    6054    message-digest-update-u64-le
     
    6862    message-digest-u8vector
    6963    message-digest-file
    70     message-digest-port
    71     ; DEPRECATED
    72     string->hex ;available from string-hexadecimal
    73     byte-string->hexadecimal
    74     make-binary-message-digest
    75     make-message-digest
    76     message-digest-primitive-apply)
     64    message-digest-port)
    7765
    7866  (import
     
    8573    (only miscmacros while*)
    8674    variable-item
     75    blob-set
    8776    (only string-hexadecimal string->hex blob->hex)
    8877    (only type-checks
    8978      define-check+error-type
    90       check-integer check-positive-integer
     79      check-integer check-positive-fixnum
    9180      check-blob check-string check-char
    9281      check-input-port check-procedure)
    9382    (only srfi-4-checks check-u8vector)
    9483    (only type-errors
    95       error-half-closed-interval
    96       make-error-type-message
    97       error-argument-type signal-type-error
    98       define-error-type))
     84      error-argument-type signal-type-error))
    9985
    10086  (require-library
     
    10288    miscmacros
    10389    variable-item
     90    blob-set
    10491    string-hexadecimal
    10592    srfi-4-checks type-checks type-errors)
    10693
    107 ;;; Byte-string Utilities
    108 
    109 (define byte-string->hexadecimal string->hex)
    110 
    111 ;;; Integer Packing Utilities
    112 
    113 ;;
    114 
    115 #>
    116 /* start is not a general offset. bytes length <= size */
    117 static void
    118 pack_uint64( uint8_t *bytes, uint64_t n, int size, int direction, int start )
    119 {
    120   int end;
    121 
    122   if (size == 1) {                        /* 1 byte */
    123 
    124     bytes[start] = n;
    125 
    126   } else if (direction == -1) { /* Big endian */
    127 
    128     end = start;
    129 
    130     bytes[start += size - 1] = n & 0xff;  /* 2 bytes */
    131     bytes[--start] = (n >> 8) & 0xff;
    132 
    133     if (start != end) {                   /* 4 bytes */
    134 
    135       bytes[--start] = (n >> 16) & 0xff;
    136       bytes[--start] = (n >> 24) & 0xff;
    137 
    138       if (start != end) {                 /* 8 bytes */
    139 
    140         bytes[--start] = (n >> 32) & 0xff;
    141         bytes[--start] = (n >> 40) & 0xff;
    142         bytes[--start] = (n >> 48) & 0xff;
    143         bytes[--start] = (n >> 56) & 0xff;
    144       }
    145     }
    146 
    147   } else {                      /* Little endian */
    148 
    149     end = start + size - 1;
    150 
    151     bytes[start] = n & 0xff;              /* 2 bytes */
    152     bytes[++start] = (n >> 8) & 0xff;
    153 
    154     if (start != end) {                   /* 4 bytes */
    155 
    156       bytes[++start] = (n >> 16) & 0xff;
    157       bytes[++start] = (n >> 24) & 0xff;
    158 
    159       if (start != end) {                 /* 8 bytes */
    160 
    161         bytes[++start] = (n >> 32) & 0xff;
    162         bytes[++start] = (n >> 40) & 0xff;
    163         bytes[++start] = (n >> 48) & 0xff;
    164         bytes[++start] = (n >> 56) & 0xff;
    165       }
    166     }
    167   }
    168 }
    169 <#
    170 
    171 ;;
    172 
    173 ; All the below primitive pack routines must return the supplied buffer object.
    174 
    175 ;; Pack an 8 bit integer
    176 
    177 (define-inline (pack-u8/u8vector! u8vec n i)
    178   (u8vector-set! u8vec i n)
    179   u8vec )
    180 
    181 (define-inline (pack-u8/bytevector! bv n i)
    182   (##core#inline "C_setbyte" bv i n) ;(bytevector-set! bv i n)
    183   bv )
    184 
    185 (define-inline (pack-u8/blob! blb n i)
    186   (pack-u8/bytevector! blb n i) )
    187 
    188 (define-inline (pack-u8/string! str n i)
    189   (pack-u8/bytevector! str n i) )
    190 
    191 ; Pack a 16, 32, or 64 bit integer with endian order
    192 
    193 (define-inline (pack-u64/u8vector! u8vec n size direction start)
    194   ((foreign-lambda void "pack_uint64" nonnull-u8vector unsigned-integer64 int int int)
    195      u8vec n size direction start)
    196   u8vec )
    197 
    198 (define-inline (pack-u64/bytevector! bv n size direction start)
    199   ((foreign-lambda void "pack_uint64" nonnull-scheme-pointer unsigned-integer64 int int int)
    200     bv n size direction start)
    201   bv )
    202 
    203 (define-inline (pack-u64/blob! blb n size direction start)
    204   (pack-u64/bytevector! blb n size direction start) )
    205 
    206 (define-inline (pack-u64/string! str n size direction start)
    207   (pack-u64/bytevector! str n size direction start) )
    208 
    209 ;;
    210 
    211 (define (byte-order? obj)
    212   (and (memq obj '(big-endian be big little-endian le little))
    213        #t) )
    214 
    215 (define-check+error-type byte-order byte-order? "symbol in {big-endian little-endian be le}")
    216 
    217 #; ;UNUSED
    218 (define (direction->byte-order n)
    219   (if (negative? n) 'big-endian
    220     'little-endian ) )
    221 
    222 (define-inline (byte-order->direction order)
    223   (case order
    224     ((big-endian be big)        -1 )
    225     ((little-endian le little)  1 ) ) )
    226 
    227 (define-error-type byte-buffer "u8vector, blob, string or symbol in {u8vector blob string}" )
    228 
    229 (define-inline (check-byte-size loc obj)
    230   (unless (memq obj '(1 2 4 8))
    231     (error-argument-type loc obj "integer in {1 2 4 8}" 'size) )
    232   obj )
    233 
    234 (define-constant MAX-BV-LEN 16777215) ; 2^24-1 is the maximum length of a bytevector
    235 
    236 (define-inline (check-byte-buffer-size loc dessiz actsiz)
    237   (unless (fx<= dessiz actsiz)
    238     ;FIXME this message is too strong
    239     (error-half-closed-interval loc actsiz dessiz MAX-BV-LEN "byte-buffer size+start") )
    240   actsiz )
    241 
    242 (define (ensure-byte-buffer loc size bufsel start)
    243   (let ((need-size (fx+ start size)))
    244     ; Cases ordered by a guess of probability
    245     (cond
    246       ((symbol? bufsel)
    247         (case bufsel
    248           ((string)     (values 'string (make-string need-size)) )
    249           ((blob)       (values 'blob (make-blob need-size)) )
    250           ((u8vector)   (values 'u8vector (make-u8vector need-size)) )
    251           (else
    252             (error-byte-buffer loc bufsel) ) ) )
    253       ((string? bufsel)
    254         (check-byte-buffer-size loc need-size (number-of-bytes bufsel))
    255         (values 'string bufsel) )
    256       ((blob? bufsel)
    257         (check-byte-buffer-size loc need-size (number-of-bytes bufsel))
    258         (values 'blob bufsel) )
    259       ((u8vector? bufsel)
    260         (check-byte-buffer-size loc need-size (u8vector-length bufsel))
    261         (values 'u8vector bufsel) )
    262       (else
    263         (error-byte-buffer loc bufsel) ) ) ) )
    264 
    265 ;;
    266 
    267 (define (*pack-u8 loc n bufsel start)
    268   (check-integer loc n)
    269   (let-values (((typ obj) (ensure-byte-buffer loc 1 bufsel start)))
    270     (case typ
    271       ((string)   (pack-u8/string! obj n start) )
    272       ((blob)     (pack-u8/blob! obj n start) )
    273       ((u8vector) (pack-u8/u8vector! obj n start) ) )
    274     obj ) )
    275 
    276 (define (pack-u8 n #!key (bufsel 'string) (start 0))
    277   (*pack-u8 'pack-u8 n bufsel start) )
    278 
    279 ;;
    280 
    281 (define (*pack-integer loc n bufsel size order start)
    282   (check-integer loc n)
    283   (check-byte-order loc order)
    284   (let-values (((typ obj) (ensure-byte-buffer loc size bufsel start)))
    285     (let ((direction (byte-order->direction order)))
    286       (case typ
    287         ((string)   (pack-u64/string! obj n size direction start) )
    288         ((blob)     (pack-u64/blob! obj n size direction start) )
    289         ((u8vector) (pack-u64/u8vector! obj n size direction start) ) ) )
    290     obj ) )
    291 
    292 ;;
    293 
    294 (define (pack-u16 n #!key (bufsel 'string) (start 0) (order (machine-byte-order)))
    295   (*pack-integer 'pack-u16 n bufsel 2 order start) )
    296 
    297 ;;
    298 
    299 (define (pack-u32 n #!key (bufsel 'string) (start 0) (order (machine-byte-order)))
    300   (*pack-integer 'pack-u32 n bufsel 4 order start) )
    301 
    302 ;;
    303 
    304 (define (pack-u64 n #!key (bufsel 'string) (start 0) (order (machine-byte-order)))
    305   (*pack-integer 'pack-u64 n bufsel 8 order start) )
    306 
    307 ;;
    308 
    309 (define (pack-integer n #!key (bufsel 'string) (start 0) (order (machine-byte-order)) (size 4))
    310   (check-byte-size 'pack-integer size)
    311   (if (fx= 1 size) (*pack-u8 'pack-integer n bufsel start)
    312     (*pack-integer 'pack-integer n bufsel size order start) ) )
    313 
    314 ;;
    315 
    316 (define (positive-integer? obj)
    317   (and (integer? obj) (positive? obj)) )
     94;;
     95
     96(define (positive-fixnum? obj)
     97  (and (fixnum? obj) (positive? obj)) )
    31898
    31999;;; Update Phase Helpers
     
    351131;;
    352132
    353 (define-inline (chunk-convert obj)
     133(define (chunk-convert obj)
    354134  (and-let* ((cnv (message-digest-chunk-converter))) (cnv obj)) )
    355135
    356 (define-inline (get-chunk-reader in) ((message-digest-chunk-read-maker) in))
    357 
    358 (define-inline (get-update md)
     136(define (get-chunk-reader in)
     137        ((message-digest-chunk-read-maker) in) )
     138
     139(define (get-update md)
    359140  (message-digest-primitive-update (message-digest-algorithm md)) )
    360141
    361142;;
    362143
    363 (define-inline (bytevector-like? obj)
     144(define (bytevector-like? obj)
    364145  (or (string? obj)
    365146                (blob? obj)) )
    366147
    367 (define-inline (object->bytevector-like obj)
     148#;
     149(define (get-bytevector-object loc obj)
     150        (or (and (bytevector-like? obj) obj)
     151                        (error-argment-type loc obj "string or blob" 'bytevector) ) )
     152
     153(define (object->bytevector-like obj)
    368154  (or (packed-vector->blob obj)
    369155      (chunk-convert obj)) )
     
    379165      (signal-type-error loc "indigestible object" src) ) ) )
    380166
    381 (define-inline (do-procedure-update loc md proc)
     167(define (do-procedure-update loc md proc)
    382168  (let ((updt (get-update md))
    383169        (ctx (message-digest-context md)) )
    384170    (while* (proc) (*do-bytes-update loc ctx it updt) ) ) )
    385171
    386 (define-inline (do-port-update loc md in)
     172(define (do-port-update loc md in)
    387173  (do-procedure-update loc md (get-chunk-reader in)) )
    388174
    389 (define-inline (do-bytes-update loc md src)
     175(define (do-bytes-update loc md src)
    390176  (let ((updt (get-update md))
    391177        (ctx (message-digest-context md)) )
     
    417203(define-checked-variable message-digest-chunk-size
    418204  DEFAULT-CHUNK-SIZE
    419   positive-integer)
     205  positive-fixnum)
    420206
    421207;;
     
    437223;;
    438224
    439 (define-inline (check-message-digest-arguments loc ctx-info digest-len init update final)
    440   (unless (or (procedure? ctx-info) (positive-integer? ctx-info))
    441     (error-argument-type loc ctx-info "positive-integer or procedure" 'context-info) )
    442   (check-positive-integer loc digest-len 'digest-length)
     225(define (check-message-digest-arguments loc ctx-info digest-len init update final)
     226  (unless (or (procedure? ctx-info) (positive-fixnum? ctx-info))
     227    (error-argument-type loc ctx-info "positive-fixnum or procedure" 'context-info) )
     228  (check-positive-fixnum loc digest-len 'digest-length)
    443229  (check-procedure loc init 'digest-initializer)
    444230  (check-procedure loc update 'digest-updater)
     
    484270;;
    485271
    486 (define-inline (get-context/message-digest-primitive mdp)
     272(define (get-message-digest-primitive-context mdp)
    487273  (let ((ctx-info (message-digest-primitive-context-info mdp)))
    488274    (if (procedure? ctx-info) (ctx-info)
    489275      (set-finalizer! (allocate ctx-info) free) ) ) )
    490276
    491 (define-inline (get-buffer/message-digest md size)
     277(define (get-message-digest-buffer md size)
    492278  (let ((buf (message-digest-buffer md)))
    493279    (if (and buf (fx<= size (number-of-bytes buf))) buf
     
    496282        buf ) ) ) )
    497283
    498 (define-inline (*u64->blob! blb n order size)
    499   (if (fx= 1 size) (pack-u8/blob! blb n 0)
    500     (pack-u64/blob! blb n size (byte-order->direction order) 0) ) )
    501 
    502 ;;
    503 
    504 (define-inline (*message-digest-update-string md str)
     284;;
     285
     286(define (*message-digest-update-string md str)
    505287  (let ((mdp (message-digest-algorithm md))
    506288        (ctx (message-digest-context md)) )
    507289    ((message-digest-primitive-update mdp) ctx str (number-of-bytes str)) ) )
    508290
    509 (define-inline (*message-digest-update-blob md blb)
     291(define (*message-digest-update-blob md blb)
    510292  (let ((mdp (message-digest-algorithm md))
    511293        (ctx (message-digest-context md)) )
    512294    ((message-digest-primitive-update mdp) ctx blb (number-of-bytes blb)) ) )
    513295
    514 (define-inline (*message-digest-update-u64 loc md n order size)
     296(define (*message-digest-update-uint loc md n size setter)
    515297  (check-message-digest loc md)
    516298  (check-integer loc n)
    517   (check-byte-order loc order)
    518   (*message-digest-update-blob md
    519     (*u64->blob! (get-buffer/message-digest md size) n order size)) )
     299  (let ((blb (get-message-digest-buffer md size)))
     300        (setter blb n 0)
     301  (*message-digest-update-blob md blb) ) )
    520302
    521303;;
     
    523305(define (initialize-message-digest mdp)
    524306  (check-message-digest-primitive 'initialize-message-digest mdp)
    525   (let ((ctx (get-context/message-digest-primitive mdp)))
     307  (let ((ctx (get-message-digest-primitive-context mdp)))
    526308    ((message-digest-primitive-init mdp) ctx)
    527309    (*make-message-digest mdp ctx #f) ) )
     
    539321;;
    540322
    541 ; string or blob only but it doesn't verify
     323#; ;Useful interface?
    542324(define (message-digest-update-bytevector md bv #!optional (len (number-of-bytes bv)))
    543325  (check-message-digest 'message-digest-update-bytevector md)
    544326  (let ((mdp (message-digest-algorithm md))
    545327        (ctx (message-digest-context md)) )
    546     ((message-digest-primitive-update mdp) ctx bv len) ) )
     328    ((message-digest-primitive-update mdp) ctx
     329        (get-bytevector-object 'message-digest-update-bytevector obj) len) ) )
    547330
    548331;;
     
    568351;;
    569352
     353#; ;Useful interface?
    570354(define (message-digest-update-substring md str start end)
    571355  (check-message-digest 'message-digest-update-substring md)
     
    582366;;
    583367
     368#; ;Useful interface?
    584369(define (message-digest-update-subu8vector md u8vec start end)
    585370  (check-message-digest 'message-digest-update-u8vector md)
     
    596381        (error-argument-type 'message-digest-update-packed-vector pkdvec 'srfi-4-vector) ) ) )
    597382
    598 ;;
    599 
     383;; Char
     384
     385#; ;Useful interface?
    600386(define (message-digest-update-char-u8 md ch)
    601   (check-message-digest 'message-digest-update-char-u8 md)
    602387  (check-char 'message-digest-update-char-u8 ch)
    603   ;FIXME this has too much overhead
    604   (*message-digest-update-blob md
    605     (pack-u8/blob!
    606       (get-buffer/message-digest md 1)
    607       (char->integer ch)
    608       0)) )
    609 
     388        (*message-digest-update-uint 'message-digest-update-char-u8 md (char->integer ch) 1 *blob-set-u8!) )
     389
     390(define (message-digest-update-char-be md ch)
     391  (check-char 'message-digest-update-char ch)
     392        (*message-digest-update-uint 'message-digest-update-char-be md (char->integer ch) 4 *blob-set-u32-be!) )
     393
     394(define (message-digest-update-char-le md ch)
     395  (check-char 'message-digest-update-char ch)
     396        (*message-digest-update-uint 'message-digest-update-char-le md (char->integer ch) 4 *blob-set-u32-le!) )
     397
     398;; Unsigned Integer 8, 16, 32, & 64 bits
     399
     400(define (message-digest-update-u8 md n)
     401        (*message-digest-update-uint 'message-digest-update-u8 md n 1 *blob-set-u8!) )
     402
     403(define (message-digest-update-u16-be md n)
     404        (*message-digest-update-uint 'message-digest-update-u16-be md n 2 *blob-set-u16-be!) )
     405
     406(define (message-digest-update-u16-le md n)
     407        (*message-digest-update-uint 'message-digest-update-u16-le md n 2 *blob-set-u16-le!) )
     408
     409(define (message-digest-update-u32-be md n)
     410        (*message-digest-update-uint 'message-digest-update-u32-be md n 4 *blob-set-u32-be!) )
     411
     412(define (message-digest-update-u32-le md n)
     413        (*message-digest-update-uint 'message-digest-update-u32-le md n 4 *blob-set-u32-le!) )
     414
     415(define (message-digest-update-u64-be md n)
     416        (*message-digest-update-uint 'message-digest-update-u64-be md n 8 *blob-set-u64-be!) )
     417
     418(define (message-digest-update-u64-le md n)
     419        (*message-digest-update-uint 'message-digest-update-u64-le md n 8 *blob-set-u64-le!) )
     420
     421;; Machine Byte Order
     422
     423#; ;Useful interface?
    610424(define (message-digest-update-char md ch #!optional (order (machine-byte-order)))
    611425  (check-char 'message-digest-update-char ch)
    612426  (*message-digest-update-u64 'message-digest-update-char md (char->integer ch) order 4) )
    613427
    614 (define (message-digest-update-char-be md ch)
    615   (check-char 'message-digest-update-char ch)
    616   (*message-digest-update-u64 'message-digest-update-char-be md (char->integer ch) 'be 4) )
    617 
    618 (define (message-digest-update-char-le md ch)
    619   (check-char 'message-digest-update-char ch)
    620   (*message-digest-update-u64 'message-digest-update-char-le md (char->integer ch) 'le 4) )
    621 
    622 ;;
    623 
    624 (define (message-digest-update-u8 md n)
    625   (check-message-digest 'message-digest-update-u8 md)
    626   (check-integer 'message-digest-update-u8 n)
    627   ;FIXME this has too much overhead
    628   (*message-digest-update-blob md (pack-u8/blob! (get-buffer/message-digest md 1) n 0)) )
    629 
     428#; ;Useful interface?
    630429(define (message-digest-update-u16 md n #!optional (order (machine-byte-order)))
    631430  (*message-digest-update-u64 'message-digest-update-u16 md n order 2) )
    632431
    633 (define (message-digest-update-u16-be md n)
    634   (*message-digest-update-u64 'message-digest-update-u16-be md n 'be 2) )
    635 
    636 (define (message-digest-update-u16-le md n)
    637   (*message-digest-update-u64 'message-digest-update-u16-le md n 'le 2) )
    638 
     432#; ;Useful interface?
    639433(define (message-digest-update-u32 md n #!optional (order (machine-byte-order)))
    640434  (*message-digest-update-u64 'message-digest-update-u32 md n order 4) )
    641435
    642 (define (message-digest-update-u32-be md n)
    643   (*message-digest-update-u64 'message-digest-update-u32-be md n 'be 4) )
    644 
    645 (define (message-digest-update-u32-le md n)
    646   (*message-digest-update-u64 'message-digest-update-u32-le md n 'le 4) )
    647 
     436#; ;Useful interface?
    648437(define (message-digest-update-u64 md n #!optional (order (machine-byte-order)))
    649438  (*message-digest-update-u64 'message-digest-update-u64 md n order 8) )
    650 
    651 (define (message-digest-update-u64-be md n)
    652   (*message-digest-update-u64 'message-digest-update-u64-be md n 'be 8) )
    653 
    654 (define (message-digest-update-u64-le md n)
    655   (*message-digest-update-u64 'message-digest-update-u64-le md n 'le 8) )
    656439
    657440;;
     
    678461    (close-input-port in) ) )
    679462
    680 ;;; Till completion API
     463#;
     464(define (message-digest-update-file md flnm)
     465  (check-message-digest 'message-digest-update-file md)
     466  (check-string 'message-digest-update-file flnm)
     467  (let ((in #f))
     468        (dynamic-wind
     469                (lambda () (set! in (open-input-file flnm)) )
     470                (lambda () (do-port-update 'message-digest-update-file md in) )
     471        (lambda () (close-input-port in) ) ) ) )
     472
     473;;; Single Source API
    681474
    682475(define (message-digest-object mdp obj #!optional (result-type 'hex))
     
    710503    (finalize-message-digest md result-type) ) )
    711504
    712 ;;; Old API
    713 
    714 ;;
    715 
    716 (define (message-digest-primitive-apply mdp src . args) ;DEPRECATED
    717   (message-digest-object mdp src 'string) )
    718 
    719 ;;
    720 
    721 (define (make-binary-message-digest src ctx-info digest-len init update final
    722                                     #!optional (name 'make-binary-message-digest)) ;DEPRECATED
    723   (message-digest-object
    724     (make-message-digest-primitive ctx-info digest-len init update final name)
    725     src
    726     'string) )
    727 
    728 ;;
    729 
    730 (define (make-message-digest src ctx-info digest-len init update final
    731                              #!optional (name 'make-message-digest)) ;DEPRECATED
    732   (message-digest-object
    733     (make-message-digest-primitive ctx-info digest-len init update final name)
    734     src
    735     'hex) )
    736 
    737505) ;module message-digest
  • release/4/message-digest/trunk/message-digest.setup

    r26314 r26369  
    1111  'check-errors     "1.9.0")
    1212
    13 (setup-shared+static-extension-module 'message-digest (extension-version "2.3.8")
     13(setup-shared+static-extension-module 'blob-set (extension-version "1.0.0")
    1414  ;#:inline? #t
    1515  #:compile-options '(
     
    1717    -optimize-level 3 -debug-level 1))
    1818
    19 (setup-shared+static-extension-module 'message-digest-port (extension-version "2.3.8")
     19(setup-shared+static-extension-module 'message-digest (extension-version "3.0.0")
    2020  ;#:inline? #t
    2121  #:compile-options '(
    2222    -scrutinize
    2323    -optimize-level 3 -debug-level 1))
     24
     25(setup-shared+static-extension-module 'message-digest-port (extension-version "3.0.0")
     26  ;#:inline? #t
     27  #:compile-options '(
     28    -scrutinize
     29    -optimize-level 3 -debug-level 1))
  • release/4/message-digest/trunk/tests/run.scm

    r26314 r26369  
    175175                ) )
    176176
     177        #; ;REMOVED
    177178  (test-group "Message Digest char-u8 Source"
    178179    (let ((md (initialize-message-digest mdp)))
     
    214215)
    215216
     217#; ;REMOVED
    216218(let ()
    217219
Note: See TracChangeset for help on using the changeset viewer.