extra/crypto/common/common.factor

   1 USING: arrays kernel io io.binary sbufs splitting strings sequences
   2 namespaces math math.parser parser hints ;
   3 IN: crypto.common
   4
   5 : >32-bit ( x -- y ) HEX: ffffffff bitand ; inline
   6 : >64-bit ( x -- y ) HEX: ffffffffffffffff bitand ; inline
   7
   8 : w+ ( int int -- int ) + >32-bit ; inline
   9
  10 : (nth-int) ( string n -- int )
  11     2 shift dup 4 + rot <slice> ; inline
  12
  13 : nth-int ( string n -- int ) (nth-int) le> ; inline
  14
  15 : nth-int-be ( string n -- int ) (nth-int) be> ; inline
  16
  17 : update ( num var -- ) [ w+ ] change ; inline
  18
  19 : calculate-pad-length ( length -- pad-length )
  20     dup 56 < 55 119 ? swap - ;
  21
  22 : preprocess-plaintext ( string big-endian? -- padded-string )
  23     #! pad 0x80 then 00 til 8 bytes left, then 64bit length in bits
  24     >r >sbuf r> over [
  25         HEX: 80 ,
  26         dup length HEX: 3f bitand
  27         calculate-pad-length 0 <string> %
  28         length 3 shift 8 rot [ >be ] [ >le ] if %
  29     ] "" make over push-all ;
  30
  31 SYMBOL: bytes-read
  32 SYMBOL: big-endian?
  33
  34 : pad-last-block ( str big-endian? length -- str )
  35     [
  36         rot %
  37         HEX: 80 ,
  38         dup HEX: 3f bitand calculate-pad-length 0 <string> %
  39         3 shift 8 rot [ >be ] [ >le ] if %
  40     ] "" make 64 group ;
  41
  42 : shift-mod ( n s w -- n )
  43     >r shift r> 1 swap shift 1 - bitand ; inline
  44
  45 : update-old-new ( old new -- )
  46     [ get >r get r> ] 2keep >r >r w+ dup r> set r> set ; inline
  47
  48 : bitroll ( x s w -- y )
  49      [ 1 - bitand ] keep
  50      over 0 < [ [ + ] keep ] when
  51      [ shift-mod ] 3keep
  52      [ - ] keep shift-mod bitor ; inline
  53
  54 : bitroll-32 ( n s -- n' ) 32 bitroll ;
  55
  56 HINTS: bitroll-32 bignum fixnum ;
  57
  58 : bitroll-64 ( n s -- n' ) 64 bitroll ;
  59
  60 HINTS: bitroll-64 bignum fixnum ;
  61
  62 : hex-string ( seq -- str )
  63     [ [ >hex 2 48 pad-left % ] each ] "" make ;
  64
  65 : slice3 ( n seq -- a b c ) >r dup 3 + r> <slice> first3 ;
  66
  67 : seq>2seq ( seq -- seq1 seq2 )
  68     #! { abcdefgh } -> { aceg } { bdfh }
  69     2 group flip dup empty? [ drop { } { } ] [ first2 ] if ;
  70
  71 : 2seq>seq ( seq1 seq2 -- seq )
  72     #! { aceg } { bdfh } -> { abcdefgh }
  73     swap ! error?
  74     [ 2array flip concat ] keep like ;
  75
  76 : mod-nth ( n seq -- elt )
  77     #! 5 "abcd" -> b
  78     [ length mod ] keep nth ;