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 locals ;
   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 : next-level ( n size -- n' )
  42     2dup mod [ + ] [ - + ] if-zero ; inline
  43
  44 ! Update the bytes-read before calculating checksum in case checksum uses
  45 ! this in the calculation.
  46 :: add-checksum-bytes ( state data -- state' )
  47     state block-size>> :> block-size
  48     state bytes>> length :> initial-len
  49     data length :> data-len
  50     initial-len data-len + :> total-len
  51     total-len block-size /mod :> ( n extra )
  52     data state bytes>> [ push-all ] keep :> all-bytes
  53     n zero? [
  54         state [ data-len + ] change-bytes-read drop
  55     ] [
  56         all-bytes block-size <groups> [ length 64 = ] partition [
  57             [ state [ block-size next-level ] change-bytes-read drop state checksum-block ] each
  58             BV{ } clone state bytes<<
  59         ] [
  60             [
  61                 first
  62                 [ length state [ + ] change-bytes-read drop ]
  63                 [ >byte-vector state bytes<< ] bi
  64             ] unless-empty
  65         ] bi*
  66     ] if state ;
  67
  68 : add-checksum-stream ( checksum-state stream -- checksum-state )
  69     [ [ add-checksum-bytes ] each-block ] with-input-stream ;
  70
  71 : add-checksum-file ( checksum-state path -- checksum-state )
  72     binary <file-reader> add-checksum-stream ;
  73
  74 M: block-checksum checksum-bytes
  75     initialize-checksum-state
  76     swap add-checksum-bytes get-checksum ;
  77
  78 M: block-checksum checksum-stream
  79     initialize-checksum-state
  80     swap add-checksum-stream get-checksum ;