basis/checksums/common/common.factor

   1 ! Copyright (C) 2006, 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors byte-arrays byte-vectors checksums grouping io
   4 io.backend io.binary io.encodings.binary io.files kernel make
   5 math sequences ;
   6 IN: checksums.common
   7
   8 : calculate-pad-length ( length -- length' )
   9     [ 56 < 55 119 ? ] keep - ;
  10
  11 : pad-last-block ( bytes big-endian? length -- blocks )
  12     [
  13         [ % ] 2dip 0x80 ,
  14         [ 0x3f bitand calculate-pad-length <byte-array> % ]
  15         [ 3 shift 8 rot [ >be ] [ >le ] if % ] bi
  16     ] B{ } make 64 group ;
  17
  18 MIXIN: block-checksum
  19
  20 INSTANCE: block-checksum checksum
  21
  22 TUPLE: checksum-state
  23 { bytes-read integer }
  24 { block-size integer }
  25 { bytes byte-vector } ;
  26
  27 : new-checksum-state ( class -- checksum-state )
  28     new
  29         BV{ } clone >>bytes ; inline
  30
  31 M: checksum-state clone
  32     call-next-method
  33     [ clone ] change-bytes ;
  34
  35 GENERIC: initialize-checksum-state ( checksum -- checksum-state )
  36
  37 GENERIC: checksum-block ( bytes checksum-state -- )
  38
  39 GENERIC: get-checksum ( checksum-state -- value )
  40
  41 : add-checksum-bytes ( checksum-state data -- checksum-state' )
  42     [
  43         over bytes>> [ push-all ] keep
  44         [ dup length pick block-size>> >= ]
  45         [
  46             over block-size>> cut-slice [
  47                 over checksum-block
  48                 [ block-size>> ] keep [ + ] change-bytes-read
  49             ] dip
  50         ] while
  51         >byte-vector >>bytes
  52     ] keep
  53     length 64 mod [ + ] curry change-bytes-read ;
  54
  55 : add-checksum-stream ( checksum-state stream -- checksum-state )
  56     [ [ add-checksum-bytes ] each-block ] with-input-stream ;
  57
  58 : add-checksum-file ( checksum-state path -- checksum-state )
  59     binary <file-reader> add-checksum-stream ;
  60
  61 M: block-checksum checksum-bytes
  62     initialize-checksum-state
  63     swap add-checksum-bytes get-checksum ;
  64
  65 M: block-checksum checksum-stream
  66     initialize-checksum-state
  67     swap add-checksum-stream get-checksum ;