Changeset 26314 in project


Ignore:
Timestamp:
04/01/12 22:58:08 (9 years ago)
Author:
Kon Lovett
Message:

Add blob->hex.

Location:
release/4/message-digest
Files:
8 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/message-digest/tags/2.3.8/message-digest.meta

    r24715 r26314  
    77 (doc-from-wiki)
    88 (synopsis "Message Digest Support")
    9  (depends 
    10         (setup-helper "1.3.1")
     9 (depends
     10        (setup-helper "1.3.3")
    1111        (miscmacros "2.91")
    1212        (check-errors "1.9.0")
    1313        (variable-item "1.3.0")
    14         (string-utils "1.1.0"))
     14        (string-utils "1.2.1"))
    1515 (test-depends test)
    1616 (files "message-digest.scm" "message-digest.meta" "message-digest-port.scm" "message-digest.setup" "message-digest.release-info" "tests/run.scm" "tests/alpha.txt") )
  • release/4/message-digest/tags/2.3.8/message-digest.scm

    r24715 r26314  
    44;; Issues
    55;;
    6 ;; - Use of 'sys namespace procedures.
    7 ;;   - ##sys#size used since returns byte-length for blob & string.
    8 ;;
    96;; - Uses string type as a byte-vector - a kludge.
    107;;
     
    1613;; - Could use core-inline for n-bit packing but need to disambiguate scheme
    1714;; types in the C code. May not be worth it.
    18 ;;
    19 ;; - Should use blob when hex result & `blob_to_hex'.
    2015
    2116(module message-digest
     
    8580    chicken
    8681    foreign
    87     (only lolevel allocate free)
     82    (only lolevel allocate free number-of-bytes)
    8883    srfi-4
    8984    (only srfi-13 substring/shared)
    9085    (only miscmacros while*)
    9186    variable-item
    92     (only string-hexadecimal string->hex)
     87    (only string-hexadecimal string->hex blob->hex)
    9388    (only type-checks
    9489      define-check+error-type
     
    197192
    198193(define-inline (pack-u64/u8vector! u8vec n size direction start)
    199   ((foreign-lambda void "pack_uint64" nonnull-u8vector integer64 int int int)
     194  ((foreign-lambda void "pack_uint64" nonnull-u8vector unsigned-integer64 int int int)
    200195     u8vec n size direction start)
    201196  u8vec )
    202197
    203198(define-inline (pack-u64/bytevector! bv n size direction start)
    204   ((foreign-lambda void "pack_uint64" nonnull-scheme-pointer integer64 int int int)
     199  ((foreign-lambda void "pack_uint64" nonnull-scheme-pointer unsigned-integer64 int int int)
    205200    bv n size direction start)
    206201  bv )
     
    257252            (error-byte-buffer loc bufsel) ) ) )
    258253      ((string? bufsel)
    259         (check-byte-buffer-size loc need-size (##sys#size bufsel))
     254        (check-byte-buffer-size loc need-size (number-of-bytes bufsel))
    260255        (values 'string bufsel) )
    261256      ((blob? bufsel)
    262         (check-byte-buffer-size loc need-size (##sys#size bufsel))
     257        (check-byte-buffer-size loc need-size (number-of-bytes bufsel))
    263258        (values 'blob bufsel) )
    264259      ((u8vector? bufsel)
     
    367362
    368363(define-inline (bytevector-like? obj)
    369   (or (string? obj) (blob? obj)) )
     364  (or (string? obj)
     365                (blob? obj)) )
    370366
    371367(define-inline (object->bytevector-like obj)
     
    376372  (cond
    377373    ; simple bytes
    378     ((bytevector-like? src)           (updt ctx src (##sys#size src)) )
     374    ((bytevector-like? src)           (updt ctx src (number-of-bytes src)) )
    379375    ; more complicated bytes
    380376    ((object->bytevector-like src) => (cut *do-bytes-update loc ctx <> updt) )
     
    405401  (error-argument-type loc obj "symbol in {string hex blob u8vector}" 'result-form) )
    406402
    407 ;select representation "closest" to desired result representation
    408 (define (get-result-buffer loc len rt)
    409   (case rt
    410     ((string byte-string hexstring hex) (make-string len) )
    411     ((blob u8vector)                    (make-blob len) )
    412     (else
    413       (error-result-form loc rt) ) ) )
    414 
    415403;perform any conversion necessary for final result representation
    416404(define (get-result-form loc res rt)
    417405  (case rt
    418     ((string byte-string blob)  res )
    419     ((hexstring hex)            (string->hex res) )
     406    ((blob)                                                                             res )
     407    ((string byte-string)                       (blob->string res) )
     408    ((hexstring hex)            (blob->hex res) )
    420409    ((u8vector)                 (blob->u8vector/shared res) )
    421410    (else
     
    502491(define-inline (get-buffer/message-digest md size)
    503492  (let ((buf (message-digest-buffer md)))
    504     (if (and buf (fx<= size (##sys#size buf))) buf
    505       (let ((buf (##sys#make-blob size)))
     493    (if (and buf (fx<= size (number-of-bytes buf))) buf
     494      (let ((buf (make-blob size)))
    506495        (message-digest-buffer-set! md buf)
    507496        buf ) ) ) )
     
    516505  (let ((mdp (message-digest-algorithm md))
    517506        (ctx (message-digest-context md)) )
    518     ((message-digest-primitive-update mdp) ctx str (##sys#size str)) ) )
     507    ((message-digest-primitive-update mdp) ctx str (number-of-bytes str)) ) )
    519508
    520509(define-inline (*message-digest-update-blob md blb)
    521510  (let ((mdp (message-digest-algorithm md))
    522511        (ctx (message-digest-context md)) )
    523     ((message-digest-primitive-update mdp) ctx blb (##sys#size blb)) ) )
     512    ((message-digest-primitive-update mdp) ctx blb (number-of-bytes blb)) ) )
    524513
    525514(define-inline (*message-digest-update-u64 loc md n order size)
     
    544533  (let ((mdp (message-digest-algorithm md))
    545534        (ctx (message-digest-context md)) )
    546     (let ((res
    547             (get-result-buffer 'finalize-message-digest
    548               (message-digest-primitive-digest-length mdp) result-type)))
     535    (let ((res (make-blob (message-digest-primitive-digest-length mdp))))
    549536      ((message-digest-primitive-final mdp) ctx res)
    550537      (get-result-form 'finalize-message-digest res result-type) ) ) )
     
    553540
    554541; string or blob only but it doesn't verify
    555 (define (message-digest-update-bytevector md bv #!optional (len (##sys#size bv)))
     542(define (message-digest-update-bytevector md bv #!optional (len (number-of-bytes bv)))
    556543  (check-message-digest 'message-digest-update-bytevector md)
    557544  (let ((mdp (message-digest-algorithm md))
  • release/4/message-digest/tags/2.3.8/message-digest.setup

    r24772 r26314  
    1111  'check-errors     "1.9.0")
    1212
    13 (setup-shared+static-extension-module 'message-digest (extension-version "2.3.7")
     13(setup-shared+static-extension-module 'message-digest (extension-version "2.3.8")
    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.7")
     19(setup-shared+static-extension-module 'message-digest-port (extension-version "2.3.8")
    2020  ;#:inline? #t
    2121  #:compile-options '(
  • release/4/message-digest/tags/2.3.8/tests/run.scm

    r23257 r26314  
    6969    (assert (pointer? ctx))
    7070    (assert (eq? ctx the-ctx))
    71     (assert (string? result))
    72     (assert (= digest-length (string-length result)))  ; So no mem overflow
     71    (assert (blob? result))
     72    (assert (= digest-length (blob-size result)))  ; So no mem overflow
    7373    (move-memory! ctx result digest-length) )
    7474
     
    104104    (assert (blob? ctx))
    105105    (assert (eq? ctx the-ctx))
    106     (assert (string? result))
    107     (assert (= digest-length (string-length result)))  ; So no mem overflow
     106    (assert (blob? result))
     107    (assert (= digest-length (blob-size result)))  ; So no mem overflow
    108108    (move-memory! ctx result digest-length) )
    109109
     
    130130
    131131  (define (final ctx result)
    132     (assert (= digest-length (string-length result)))  ; So no mem overflow
     132    (assert (= digest-length (blob-size result)))  ; So no mem overflow
    133133    (move-memory! ctx result digest-length) )
    134134
     
    226226
    227227  (define (final ctx result)
    228     (assert (= digest-length (string-length result)))  ; So no mem overflow
     228    (assert (= digest-length (blob-size result)))  ; So no mem overflow
    229229    (move-memory! ctx result digest-length) )
    230230
  • release/4/message-digest/trunk/message-digest.meta

    r24715 r26314  
    77 (doc-from-wiki)
    88 (synopsis "Message Digest Support")
    9  (depends 
    10         (setup-helper "1.3.1")
     9 (depends
     10        (setup-helper "1.3.3")
    1111        (miscmacros "2.91")
    1212        (check-errors "1.9.0")
    1313        (variable-item "1.3.0")
    14         (string-utils "1.1.0"))
     14        (string-utils "1.2.1"))
    1515 (test-depends test)
    1616 (files "message-digest.scm" "message-digest.meta" "message-digest-port.scm" "message-digest.setup" "message-digest.release-info" "tests/run.scm" "tests/alpha.txt") )
  • release/4/message-digest/trunk/message-digest.scm

    r24715 r26314  
    44;; Issues
    55;;
    6 ;; - Use of 'sys namespace procedures.
    7 ;;   - ##sys#size used since returns byte-length for blob & string.
    8 ;;
    96;; - Uses string type as a byte-vector - a kludge.
    107;;
     
    1613;; - Could use core-inline for n-bit packing but need to disambiguate scheme
    1714;; types in the C code. May not be worth it.
    18 ;;
    19 ;; - Should use blob when hex result & `blob_to_hex'.
    2015
    2116(module message-digest
     
    8580    chicken
    8681    foreign
    87     (only lolevel allocate free)
     82    (only lolevel allocate free number-of-bytes)
    8883    srfi-4
    8984    (only srfi-13 substring/shared)
    9085    (only miscmacros while*)
    9186    variable-item
    92     (only string-hexadecimal string->hex)
     87    (only string-hexadecimal string->hex blob->hex)
    9388    (only type-checks
    9489      define-check+error-type
     
    197192
    198193(define-inline (pack-u64/u8vector! u8vec n size direction start)
    199   ((foreign-lambda void "pack_uint64" nonnull-u8vector integer64 int int int)
     194  ((foreign-lambda void "pack_uint64" nonnull-u8vector unsigned-integer64 int int int)
    200195     u8vec n size direction start)
    201196  u8vec )
    202197
    203198(define-inline (pack-u64/bytevector! bv n size direction start)
    204   ((foreign-lambda void "pack_uint64" nonnull-scheme-pointer integer64 int int int)
     199  ((foreign-lambda void "pack_uint64" nonnull-scheme-pointer unsigned-integer64 int int int)
    205200    bv n size direction start)
    206201  bv )
     
    257252            (error-byte-buffer loc bufsel) ) ) )
    258253      ((string? bufsel)
    259         (check-byte-buffer-size loc need-size (##sys#size bufsel))
     254        (check-byte-buffer-size loc need-size (number-of-bytes bufsel))
    260255        (values 'string bufsel) )
    261256      ((blob? bufsel)
    262         (check-byte-buffer-size loc need-size (##sys#size bufsel))
     257        (check-byte-buffer-size loc need-size (number-of-bytes bufsel))
    263258        (values 'blob bufsel) )
    264259      ((u8vector? bufsel)
     
    367362
    368363(define-inline (bytevector-like? obj)
    369   (or (string? obj) (blob? obj)) )
     364  (or (string? obj)
     365                (blob? obj)) )
    370366
    371367(define-inline (object->bytevector-like obj)
     
    376372  (cond
    377373    ; simple bytes
    378     ((bytevector-like? src)           (updt ctx src (##sys#size src)) )
     374    ((bytevector-like? src)           (updt ctx src (number-of-bytes src)) )
    379375    ; more complicated bytes
    380376    ((object->bytevector-like src) => (cut *do-bytes-update loc ctx <> updt) )
     
    405401  (error-argument-type loc obj "symbol in {string hex blob u8vector}" 'result-form) )
    406402
    407 ;select representation "closest" to desired result representation
    408 (define (get-result-buffer loc len rt)
    409   (case rt
    410     ((string byte-string hexstring hex) (make-string len) )
    411     ((blob u8vector)                    (make-blob len) )
    412     (else
    413       (error-result-form loc rt) ) ) )
    414 
    415403;perform any conversion necessary for final result representation
    416404(define (get-result-form loc res rt)
    417405  (case rt
    418     ((string byte-string blob)  res )
    419     ((hexstring hex)            (string->hex res) )
     406    ((blob)                                                                             res )
     407    ((string byte-string)                       (blob->string res) )
     408    ((hexstring hex)            (blob->hex res) )
    420409    ((u8vector)                 (blob->u8vector/shared res) )
    421410    (else
     
    502491(define-inline (get-buffer/message-digest md size)
    503492  (let ((buf (message-digest-buffer md)))
    504     (if (and buf (fx<= size (##sys#size buf))) buf
    505       (let ((buf (##sys#make-blob size)))
     493    (if (and buf (fx<= size (number-of-bytes buf))) buf
     494      (let ((buf (make-blob size)))
    506495        (message-digest-buffer-set! md buf)
    507496        buf ) ) ) )
     
    516505  (let ((mdp (message-digest-algorithm md))
    517506        (ctx (message-digest-context md)) )
    518     ((message-digest-primitive-update mdp) ctx str (##sys#size str)) ) )
     507    ((message-digest-primitive-update mdp) ctx str (number-of-bytes str)) ) )
    519508
    520509(define-inline (*message-digest-update-blob md blb)
    521510  (let ((mdp (message-digest-algorithm md))
    522511        (ctx (message-digest-context md)) )
    523     ((message-digest-primitive-update mdp) ctx blb (##sys#size blb)) ) )
     512    ((message-digest-primitive-update mdp) ctx blb (number-of-bytes blb)) ) )
    524513
    525514(define-inline (*message-digest-update-u64 loc md n order size)
     
    544533  (let ((mdp (message-digest-algorithm md))
    545534        (ctx (message-digest-context md)) )
    546     (let ((res
    547             (get-result-buffer 'finalize-message-digest
    548               (message-digest-primitive-digest-length mdp) result-type)))
     535    (let ((res (make-blob (message-digest-primitive-digest-length mdp))))
    549536      ((message-digest-primitive-final mdp) ctx res)
    550537      (get-result-form 'finalize-message-digest res result-type) ) ) )
     
    553540
    554541; string or blob only but it doesn't verify
    555 (define (message-digest-update-bytevector md bv #!optional (len (##sys#size bv)))
     542(define (message-digest-update-bytevector md bv #!optional (len (number-of-bytes bv)))
    556543  (check-message-digest 'message-digest-update-bytevector md)
    557544  (let ((mdp (message-digest-algorithm md))
  • release/4/message-digest/trunk/message-digest.setup

    r24772 r26314  
    1111  'check-errors     "1.9.0")
    1212
    13 (setup-shared+static-extension-module 'message-digest (extension-version "2.3.7")
     13(setup-shared+static-extension-module 'message-digest (extension-version "2.3.8")
    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.7")
     19(setup-shared+static-extension-module 'message-digest-port (extension-version "2.3.8")
    2020  ;#:inline? #t
    2121  #:compile-options '(
  • release/4/message-digest/trunk/tests/run.scm

    r23257 r26314  
    6969    (assert (pointer? ctx))
    7070    (assert (eq? ctx the-ctx))
    71     (assert (string? result))
    72     (assert (= digest-length (string-length result)))  ; So no mem overflow
     71    (assert (blob? result))
     72    (assert (= digest-length (blob-size result)))  ; So no mem overflow
    7373    (move-memory! ctx result digest-length) )
    7474
     
    104104    (assert (blob? ctx))
    105105    (assert (eq? ctx the-ctx))
    106     (assert (string? result))
    107     (assert (= digest-length (string-length result)))  ; So no mem overflow
     106    (assert (blob? result))
     107    (assert (= digest-length (blob-size result)))  ; So no mem overflow
    108108    (move-memory! ctx result digest-length) )
    109109
     
    130130
    131131  (define (final ctx result)
    132     (assert (= digest-length (string-length result)))  ; So no mem overflow
     132    (assert (= digest-length (blob-size result)))  ; So no mem overflow
    133133    (move-memory! ctx result digest-length) )
    134134
     
    226226
    227227  (define (final ctx result)
    228     (assert (= digest-length (string-length result)))  ; So no mem overflow
     228    (assert (= digest-length (blob-size result)))  ; So no mem overflow
    229229    (move-memory! ctx result digest-length) )
    230230
Note: See TracChangeset for help on using the changeset viewer.