Artifact
f5044efa808510d73eda7abb490607c487f13211
File
crypto-api.fs
— part of check-in
[a7d674ebd4]
at
2016-03-04 21:22:24
on branch trunk
— use smove for string moves to known buffer sizes
(user:
bernd
size: 2039)
0000: 5c 20 67 65 6e 65 72 69 63 20 63 72 79 70 74 6f \ generic crypto
0010: 20 61 70 69 20 66 6f 72 20 6e 65 74 32 6f 0a 0a api for net2o..
0020: 72 65 71 75 69 72 65 20 6d 69 6e 69 2d 6f 6f 66 require mini-oof
0030: 32 2e 66 73 0a 72 65 71 75 69 72 65 20 75 73 65 2.fs.require use
0040: 72 2d 6f 62 6a 65 63 74 2e 66 73 0a 0a 5c 20 67 r-object.fs..\ g
0050: 65 6e 65 72 69 63 20 70 61 64 64 69 6e 67 20 70 eneric padding p
0060: 72 69 6d 69 74 69 76 65 73 0a 0a 3a 20 3e 70 61 rimitives..: >pa
0070: 64 20 28 20 61 64 64 72 20 75 20 75 32 20 2d 2d d ( addr u u2 --
0080: 20 61 64 64 72 20 75 32 20 29 20 5c 20 75 20 3c addr u2 ) \ u <
0090: 3d 20 75 32 0a 20 20 20 20 73 77 61 70 20 3e 72 = u2. swap >r
00a0: 20 32 64 75 70 20 72 40 20 73 61 66 65 2f 73 74 2dup r@ safe/st
00b0: 72 69 6e 67 20 72 3e 20 66 69 6c 6c 20 3b 0a 3a ring r> fill ;.:
00c0: 20 3e 75 6e 70 61 64 20 28 20 61 64 64 72 20 75 >unpad ( addr u
00d0: 27 20 2d 2d 20 61 64 64 72 20 75 20 29 20 6f 76 ' -- addr u ) ov
00e0: 65 72 20 2b 20 31 2d 20 63 40 20 3b 0a 3a 20 3f er + 1- c@ ;.: ?
00f0: 70 61 64 64 65 64 20 28 20 61 64 64 72 20 75 27 padded ( addr u'
0100: 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 32 -- flag ). 2
0110: 64 75 70 20 2b 20 31 2d 20 63 40 20 64 75 70 20 dup + 1- c@ dup
0120: 3e 72 20 73 61 66 65 2f 73 74 72 69 6e 67 20 72 >r safe/string r
0130: 3e 20 73 6b 69 70 20 6e 69 70 20 30 3d 20 3b 0a > skip nip 0= ;.
0140: 0a 3a 20 3e 70 61 64 64 65 64 20 7b 20 61 64 64 .: >padded { add
0150: 72 31 20 75 31 20 61 64 64 72 32 20 75 32 20 2d r1 u1 addr2 u2 -
0160: 2d 20 7d 0a 20 20 20 20 61 64 64 72 31 20 75 31 - }. addr1 u1
0170: 20 61 64 64 72 32 20 75 32 20 73 6d 6f 76 65 0a addr2 u2 smove.
0180: 20 20 20 20 75 31 20 75 32 20 75 3c 20 49 46 20 u1 u2 u< IF
0190: 20 61 64 64 72 32 20 75 31 20 75 32 20 3e 70 61 addr2 u1 u2 >pa
01a0: 64 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a d 2drop THEN ;.
01b0: 0a 5c 20 46 6f 72 20 77 75 72 73 74 6b 65 73 73 .\ For wurstkess
01c0: 65 6c 20 63 6f 6d 70 61 74 69 62 69 6c 69 74 79 el compatibility
01d0: 2c 20 74 68 65 20 73 74 61 74 65 73 20 61 72 65 , the states are
01e0: 20 61 6c 6c 20 31 32 38 20 62 79 74 65 73 0a 5c all 128 bytes.\
01f0: 20 49 66 20 74 68 65 20 63 72 79 70 74 6f 73 79 If the cryptosy
0200: 73 74 65 6d 20 68 61 73 20 6d 6f 72 65 20 69 6e stem has more in
0210: 74 65 72 6e 61 6c 20 73 74 61 74 65 2c 20 69 74 ternal state, it
0220: 20 6d 61 79 20 63 6f 70 79 20 74 68 65 20 6b 65 may copy the ke
0230: 79 2b 69 76 20 74 68 65 72 65 2e 0a 5c 20 49 66 y+iv there..\ If
0240: 20 69 74 20 68 61 73 20 6c 65 73 73 2c 20 69 74 it has less, it
0250: 20 73 68 6f 75 6c 64 20 75 73 65 20 61 20 73 75 should use a su
0260: 69 74 61 62 6c 65 20 66 72 61 63 74 69 6f 6e 20 itable fraction
0270: 6f 66 20 74 68 65 20 6b 65 79 20 61 6e 64 20 74 of the key and t
0280: 68 65 20 69 76 0a 0a 55 73 65 72 2d 6f 20 63 72 he iv..User-o cr
0290: 79 70 74 6f 2d 6f 0a 0a 6f 62 6a 65 63 74 20 63 ypto-o..object c
02a0: 6c 61 73 73 0a 20 20 20 20 24 31 30 20 75 76 61 lass. $10 uva
02b0: 72 20 63 72 79 70 74 6f 2d 75 70 20 5c 20 6d 61 r crypto-up \ ma
02c0: 6b 65 20 73 75 72 65 20 72 65 73 74 20 69 73 20 ke sure rest is
02d0: 73 74 69 6c 6c 20 62 79 20 24 31 30 20 61 6c 69 still by $10 ali
02e0: 67 6e 65 64 0a 20 20 20 20 75 6d 65 74 68 6f 64 gned. umethod
02f0: 20 63 3a 69 6e 69 74 20 28 20 2d 2d 20 29 0a 20 c:init ( -- ).
0300: 20 20 20 5c 47 20 69 6e 69 74 69 61 6c 69 7a 65 \G initialize
0310: 20 63 72 79 70 74 6f 20 66 75 6e 63 74 69 6f 6e crypto function
0320: 20 66 6f 72 20 61 20 74 61 73 6b 0a 20 20 20 20 for a task.
0330: 75 6d 65 74 68 6f 64 20 63 3a 66 72 65 65 20 28 umethod c:free (
0340: 20 2d 2d 20 29 0a 20 20 20 20 5c 47 20 66 72 65 -- ). \G fre
0350: 65 20 63 72 79 70 74 6f 20 66 75 6e 63 74 69 6f e crypto functio
0360: 6e 20 66 6f 72 20 61 20 74 61 73 6b 0a 20 20 20 n for a task.
0370: 20 75 6d 65 74 68 6f 64 20 63 3a 30 6b 65 79 20 umethod c:0key
0380: 28 20 2d 2d 20 29 0a 20 20 20 20 5c 47 20 73 65 ( -- ). \G se
0390: 74 20 7a 65 72 6f 20 6b 65 79 0a 20 20 20 20 75 t zero key. u
03a0: 6d 65 74 68 6f 64 20 63 3a 6b 65 79 21 20 28 20 method c:key! (
03b0: 61 64 64 72 20 2d 2d 20 29 0a 20 20 20 20 5c 47 addr -- ). \G
03c0: 20 75 73 65 20 61 64 64 72 20 61 73 20 6b 65 79 use addr as key
03d0: 20 73 74 6f 72 61 67 65 0a 20 20 20 20 75 6d 65 storage. ume
03e0: 74 68 6f 64 20 63 3a 6b 65 79 40 20 28 20 2d 2d thod c:key@ ( --
03f0: 20 61 64 64 72 20 29 0a 20 20 20 20 5c 47 20 6f addr ). \G o
0400: 62 74 61 69 6e 20 74 68 65 20 6b 65 79 20 73 74 btain the key st
0410: 6f 72 61 67 65 0a 20 20 20 20 75 6d 65 74 68 6f orage. umetho
0420: 64 20 63 3a 6b 65 79 23 20 28 20 2d 2d 20 6e 20 d c:key# ( -- n
0430: 29 0a 20 20 20 20 5c 47 20 6f 62 74 61 69 6e 20 ). \G obtain
0440: 6b 65 79 20 73 74 6f 72 61 67 65 20 73 69 7a 65 key storage size
0450: 0a 20 20 20 20 75 6d 65 74 68 6f 64 20 3e 63 3a . umethod >c:
0460: 6b 65 79 20 28 20 61 64 64 72 20 2d 2d 20 29 0a key ( addr -- ).
0470: 20 20 20 20 5c 47 20 6d 6f 76 65 20 31 32 38 20 \G move 128
0480: 62 79 74 65 73 20 66 72 6f 6d 20 61 64 64 72 20 bytes from addr
0490: 74 6f 20 74 68 65 20 73 74 61 74 65 0a 20 20 20 to the state.
04a0: 20 75 6d 65 74 68 6f 64 20 63 3a 6b 65 79 3e 20 umethod c:key>
04b0: 28 20 61 64 64 72 20 2d 2d 20 29 0a 20 20 20 20 ( addr -- ).
04c0: 5c 47 20 67 65 74 20 31 32 38 20 62 79 74 65 73 \G get 128 bytes
04d0: 20 66 72 6f 6d 20 74 68 65 20 73 74 61 74 65 20 from the state
04e0: 74 6f 20 61 64 64 72 0a 20 20 20 20 75 6d 65 74 to addr. umet
04f0: 68 6f 64 20 63 3a 64 69 66 66 75 73 65 20 28 20 hod c:diffuse (
0500: 2d 2d 20 29 0a 20 20 20 20 5c 47 20 70 65 72 66 -- ). \G perf
0510: 6f 72 6d 20 61 20 64 69 66 66 75 73 65 20 72 6f orm a diffuse ro
0520: 75 6e 64 0a 20 20 20 20 75 6d 65 74 68 6f 64 20 und. umethod
0530: 63 3a 65 6e 63 72 79 70 74 20 28 20 61 64 64 72 c:encrypt ( addr
0540: 20 75 20 2d 2d 20 29 0a 20 20 20 20 5c 47 20 45 u -- ). \G E
0550: 6e 63 72 79 70 74 20 6d 65 73 73 61 67 65 20 69 ncrypt message i
0560: 6e 20 62 75 66 66 65 72 20 61 64 64 72 20 75 0a n buffer addr u.
0570: 20 20 20 20 75 6d 65 74 68 6f 64 20 63 3a 64 65 umethod c:de
0580: 63 72 79 70 74 20 28 20 61 64 64 72 20 75 20 2d crypt ( addr u -
0590: 2d 20 29 0a 20 20 20 20 5c 47 20 44 65 63 72 79 - ). \G Decry
05a0: 70 74 20 6d 65 73 73 61 67 65 20 69 6e 20 62 75 pt message in bu
05b0: 66 66 65 72 20 61 64 64 72 20 75 0a 20 20 20 20 ffer addr u.
05c0: 75 6d 65 74 68 6f 64 20 63 3a 65 6e 63 72 79 70 umethod c:encryp
05d0: 74 2b 61 75 74 68 20 28 20 61 64 64 72 20 75 20 t+auth ( addr u
05e0: 74 61 67 20 2d 2d 20 29 0a 20 20 20 20 5c 47 20 tag -- ). \G
05f0: 45 6e 63 72 79 70 74 20 6d 65 73 73 61 67 65 20 Encrypt message
0600: 69 6e 20 62 75 66 66 65 72 20 61 64 64 72 20 75 in buffer addr u
0610: 0a 20 20 20 20 75 6d 65 74 68 6f 64 20 63 3a 64 . umethod c:d
0620: 65 63 72 79 70 74 2b 61 75 74 68 20 28 20 61 64 ecrypt+auth ( ad
0630: 64 72 20 75 20 74 61 67 20 2d 2d 20 66 6c 61 67 dr u tag -- flag
0640: 20 29 0a 20 20 20 20 5c 47 20 44 65 63 72 79 70 ). \G Decryp
0650: 74 20 6d 65 73 73 61 67 65 20 69 6e 20 62 75 66 t message in buf
0660: 66 65 72 20 61 64 64 72 20 75 0a 20 20 20 20 75 fer addr u. u
0670: 6d 65 74 68 6f 64 20 63 3a 68 61 73 68 20 28 20 method c:hash (
0680: 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 addr u -- ).
0690: 5c 47 20 48 61 73 68 20 6d 65 73 73 61 67 65 20 \G Hash message
06a0: 69 6e 20 62 75 66 66 65 72 20 61 64 64 72 20 75 in buffer addr u
06b0: 0a 20 20 20 20 75 6d 65 74 68 6f 64 20 63 3a 70 . umethod c:p
06c0: 72 6e 67 20 28 20 61 64 64 72 20 75 20 2d 2d 20 rng ( addr u --
06d0: 29 0a 20 20 20 20 5c 47 20 46 69 6c 6c 20 62 75 ). \G Fill bu
06e0: 66 66 65 72 20 61 64 64 72 20 75 20 77 69 74 68 ffer addr u with
06f0: 20 50 52 4e 47 20 73 65 71 75 65 6e 63 65 0a 20 PRNG sequence.
0700: 20 20 20 75 6d 65 74 68 6f 64 20 63 3a 73 68 6f umethod c:sho
0710: 72 74 68 61 73 68 20 28 20 61 64 64 72 20 75 20 rthash ( addr u
0720: 2d 2d 20 29 0a 20 20 20 20 5c 47 20 61 62 73 6f -- ). \G abso
0730: 72 62 20 2b 20 68 61 73 68 20 66 6f 72 20 61 20 rb + hash for a
0740: 6d 65 73 73 61 67 65 20 3c 3d 20 36 34 20 62 79 message <= 64 by
0750: 74 65 73 0a 20 20 20 20 75 6d 65 74 68 6f 64 20 tes. umethod
0760: 63 3a 68 61 73 68 40 20 28 20 61 64 64 72 20 75 c:hash@ ( addr u
0770: 20 2d 2d 20 29 0a 20 20 20 20 5c 47 20 65 78 74 -- ). \G ext
0780: 72 61 63 74 20 73 68 6f 72 74 20 68 61 73 68 20 ract short hash
0790: 28 75 70 20 74 6f 20 36 34 20 62 79 74 65 73 29 (up to 64 bytes)
07a0: 0a 20 20 20 20 75 6d 65 74 68 6f 64 20 63 3a 74 . umethod c:t
07b0: 77 65 61 6b 6b 65 79 21 20 28 20 78 31 32 38 20 weakkey! ( x128
07c0: 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 addr u -- ).
07d0: 5c 47 20 73 65 74 20 6b 65 79 20 70 6c 75 73 20 \G set key plus
07e0: 74 77 65 61 6b 0a 65 6e 64 2d 63 6c 61 73 73 20 tweak.end-class
07f0: 63 72 79 70 74 6f 0a crypto.