source: trunk/third/ssh/blowfish.c @ 10564

Revision 10564, 18.3 KB checked in by danw, 27 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r10563, which included commits to RCS files with non-trunk default branches.
Line 
1/*
2
3  blowfish.c
4
5author: Mika Kojo, 1996
6
7Copyrights (c) 1996 SSH Communications Security Oy, Espoo, Finland
8             
9Code is heavily based on Bruce Schneier's, implementor of blowfish, code.
10
11This algorithm is ideal for long usage of one secret key. Each time
12key is changed all S and P -boxes are to be recalculated.
13
14*/
15
16#ifndef WITHOUT_BLOWFISH
17
18#include "includes.h"
19#include "blowfish.h"
20#include "getput.h"
21
22/* Blowfish's P and S -boxes, respectively. These were taken
23   from Bruce Schneier's public-domain implementation. */
24
25static word32 blowfish_pbox[16 + 2] =
26{
27  0x243f6a88, 0x85a308d3, 0x13198a2e, 0x03707344,
28  0xa4093822, 0x299f31d0, 0x082efa98, 0xec4e6c89,
29  0x452821e6, 0x38d01377, 0xbe5466cf, 0x34e90c6c,
30  0xc0ac29b7, 0xc97c50dd, 0x3f84d5b5, 0xb5470917,
31  0x9216d5d9, 0x8979fb1b,
32};
33
34static word32 blowfish_sbox[256 * 4] =
35{
36  0xd1310ba6, 0x98dfb5ac, 0x2ffd72db, 0xd01adfb7,
37  0xb8e1afed, 0x6a267e96, 0xba7c9045, 0xf12c7f99,
38  0x24a19947, 0xb3916cf7, 0x0801f2e2, 0x858efc16,
39  0x636920d8, 0x71574e69, 0xa458fea3, 0xf4933d7e,
40  0x0d95748f, 0x728eb658, 0x718bcd58, 0x82154aee,
41  0x7b54a41d, 0xc25a59b5, 0x9c30d539, 0x2af26013,
42  0xc5d1b023, 0x286085f0, 0xca417918, 0xb8db38ef,
43  0x8e79dcb0, 0x603a180e, 0x6c9e0e8b, 0xb01e8a3e,
44  0xd71577c1, 0xbd314b27, 0x78af2fda, 0x55605c60,
45  0xe65525f3, 0xaa55ab94, 0x57489862, 0x63e81440,
46  0x55ca396a, 0x2aab10b6, 0xb4cc5c34, 0x1141e8ce,
47  0xa15486af, 0x7c72e993, 0xb3ee1411, 0x636fbc2a,
48  0x2ba9c55d, 0x741831f6, 0xce5c3e16, 0x9b87931e,
49  0xafd6ba33, 0x6c24cf5c, 0x7a325381, 0x28958677,
50  0x3b8f4898, 0x6b4bb9af, 0xc4bfe81b, 0x66282193,
51  0x61d809cc, 0xfb21a991, 0x487cac60, 0x5dec8032,
52  0xef845d5d, 0xe98575b1, 0xdc262302, 0xeb651b88,
53  0x23893e81, 0xd396acc5, 0x0f6d6ff3, 0x83f44239,
54  0x2e0b4482, 0xa4842004, 0x69c8f04a, 0x9e1f9b5e,
55  0x21c66842, 0xf6e96c9a, 0x670c9c61, 0xabd388f0,
56  0x6a51a0d2, 0xd8542f68, 0x960fa728, 0xab5133a3,
57  0x6eef0b6c, 0x137a3be4, 0xba3bf050, 0x7efb2a98,
58  0xa1f1651d, 0x39af0176, 0x66ca593e, 0x82430e88,
59  0x8cee8619, 0x456f9fb4, 0x7d84a5c3, 0x3b8b5ebe,
60  0xe06f75d8, 0x85c12073, 0x401a449f, 0x56c16aa6,
61  0x4ed3aa62, 0x363f7706, 0x1bfedf72, 0x429b023d,
62  0x37d0d724, 0xd00a1248, 0xdb0fead3, 0x49f1c09b,
63  0x075372c9, 0x80991b7b, 0x25d479d8, 0xf6e8def7,
64  0xe3fe501a, 0xb6794c3b, 0x976ce0bd, 0x04c006ba,
65  0xc1a94fb6, 0x409f60c4, 0x5e5c9ec2, 0x196a2463,
66  0x68fb6faf, 0x3e6c53b5, 0x1339b2eb, 0x3b52ec6f,
67  0x6dfc511f, 0x9b30952c, 0xcc814544, 0xaf5ebd09,
68  0xbee3d004, 0xde334afd, 0x660f2807, 0x192e4bb3,
69  0xc0cba857, 0x45c8740f, 0xd20b5f39, 0xb9d3fbdb,
70  0x5579c0bd, 0x1a60320a, 0xd6a100c6, 0x402c7279,
71  0x679f25fe, 0xfb1fa3cc, 0x8ea5e9f8, 0xdb3222f8,
72  0x3c7516df, 0xfd616b15, 0x2f501ec8, 0xad0552ab,
73  0x323db5fa, 0xfd238760, 0x53317b48, 0x3e00df82,
74  0x9e5c57bb, 0xca6f8ca0, 0x1a87562e, 0xdf1769db,
75  0xd542a8f6, 0x287effc3, 0xac6732c6, 0x8c4f5573,
76  0x695b27b0, 0xbbca58c8, 0xe1ffa35d, 0xb8f011a0,
77  0x10fa3d98, 0xfd2183b8, 0x4afcb56c, 0x2dd1d35b,
78  0x9a53e479, 0xb6f84565, 0xd28e49bc, 0x4bfb9790,
79  0xe1ddf2da, 0xa4cb7e33, 0x62fb1341, 0xcee4c6e8,
80  0xef20cada, 0x36774c01, 0xd07e9efe, 0x2bf11fb4,
81  0x95dbda4d, 0xae909198, 0xeaad8e71, 0x6b93d5a0,
82  0xd08ed1d0, 0xafc725e0, 0x8e3c5b2f, 0x8e7594b7,
83  0x8ff6e2fb, 0xf2122b64, 0x8888b812, 0x900df01c,
84  0x4fad5ea0, 0x688fc31c, 0xd1cff191, 0xb3a8c1ad,
85  0x2f2f2218, 0xbe0e1777, 0xea752dfe, 0x8b021fa1,
86  0xe5a0cc0f, 0xb56f74e8, 0x18acf3d6, 0xce89e299,
87  0xb4a84fe0, 0xfd13e0b7, 0x7cc43b81, 0xd2ada8d9,
88  0x165fa266, 0x80957705, 0x93cc7314, 0x211a1477,
89  0xe6ad2065, 0x77b5fa86, 0xc75442f5, 0xfb9d35cf,
90  0xebcdaf0c, 0x7b3e89a0, 0xd6411bd3, 0xae1e7e49,
91  0x00250e2d, 0x2071b35e, 0x226800bb, 0x57b8e0af,
92  0x2464369b, 0xf009b91e, 0x5563911d, 0x59dfa6aa,
93  0x78c14389, 0xd95a537f, 0x207d5ba2, 0x02e5b9c5,
94  0x83260376, 0x6295cfa9, 0x11c81968, 0x4e734a41,
95  0xb3472dca, 0x7b14a94a, 0x1b510052, 0x9a532915,
96  0xd60f573f, 0xbc9bc6e4, 0x2b60a476, 0x81e67400,
97  0x08ba6fb5, 0x571be91f, 0xf296ec6b, 0x2a0dd915,
98  0xb6636521, 0xe7b9f9b6, 0xff34052e, 0xc5855664,
99  0x53b02d5d, 0xa99f8fa1, 0x08ba4799, 0x6e85076a,
100  0x4b7a70e9, 0xb5b32944, 0xdb75092e, 0xc4192623,
101  0xad6ea6b0, 0x49a7df7d, 0x9cee60b8, 0x8fedb266,
102  0xecaa8c71, 0x699a17ff, 0x5664526c, 0xc2b19ee1,
103  0x193602a5, 0x75094c29, 0xa0591340, 0xe4183a3e,
104  0x3f54989a, 0x5b429d65, 0x6b8fe4d6, 0x99f73fd6,
105  0xa1d29c07, 0xefe830f5, 0x4d2d38e6, 0xf0255dc1,
106  0x4cdd2086, 0x8470eb26, 0x6382e9c6, 0x021ecc5e,
107  0x09686b3f, 0x3ebaefc9, 0x3c971814, 0x6b6a70a1,
108  0x687f3584, 0x52a0e286, 0xb79c5305, 0xaa500737,
109  0x3e07841c, 0x7fdeae5c, 0x8e7d44ec, 0x5716f2b8,
110  0xb03ada37, 0xf0500c0d, 0xf01c1f04, 0x0200b3ff,
111  0xae0cf51a, 0x3cb574b2, 0x25837a58, 0xdc0921bd,
112  0xd19113f9, 0x7ca92ff6, 0x94324773, 0x22f54701,
113  0x3ae5e581, 0x37c2dadc, 0xc8b57634, 0x9af3dda7,
114  0xa9446146, 0x0fd0030e, 0xecc8c73e, 0xa4751e41,
115  0xe238cd99, 0x3bea0e2f, 0x3280bba1, 0x183eb331,
116  0x4e548b38, 0x4f6db908, 0x6f420d03, 0xf60a04bf,
117  0x2cb81290, 0x24977c79, 0x5679b072, 0xbcaf89af,
118  0xde9a771f, 0xd9930810, 0xb38bae12, 0xdccf3f2e,
119  0x5512721f, 0x2e6b7124, 0x501adde6, 0x9f84cd87,
120  0x7a584718, 0x7408da17, 0xbc9f9abc, 0xe94b7d8c,
121  0xec7aec3a, 0xdb851dfa, 0x63094366, 0xc464c3d2,
122  0xef1c1847, 0x3215d908, 0xdd433b37, 0x24c2ba16,
123  0x12a14d43, 0x2a65c451, 0x50940002, 0x133ae4dd,
124  0x71dff89e, 0x10314e55, 0x81ac77d6, 0x5f11199b,
125  0x043556f1, 0xd7a3c76b, 0x3c11183b, 0x5924a509,
126  0xf28fe6ed, 0x97f1fbfa, 0x9ebabf2c, 0x1e153c6e,
127  0x86e34570, 0xeae96fb1, 0x860e5e0a, 0x5a3e2ab3,
128  0x771fe71c, 0x4e3d06fa, 0x2965dcb9, 0x99e71d0f,
129  0x803e89d6, 0x5266c825, 0x2e4cc978, 0x9c10b36a,
130  0xc6150eba, 0x94e2ea78, 0xa5fc3c53, 0x1e0a2df4,
131  0xf2f74ea7, 0x361d2b3d, 0x1939260f, 0x19c27960,
132  0x5223a708, 0xf71312b6, 0xebadfe6e, 0xeac31f66,
133  0xe3bc4595, 0xa67bc883, 0xb17f37d1, 0x018cff28,
134  0xc332ddef, 0xbe6c5aa5, 0x65582185, 0x68ab9802,
135  0xeecea50f, 0xdb2f953b, 0x2aef7dad, 0x5b6e2f84,
136  0x1521b628, 0x29076170, 0xecdd4775, 0x619f1510,
137  0x13cca830, 0xeb61bd96, 0x0334fe1e, 0xaa0363cf,
138  0xb5735c90, 0x4c70a239, 0xd59e9e0b, 0xcbaade14,
139  0xeecc86bc, 0x60622ca7, 0x9cab5cab, 0xb2f3846e,
140  0x648b1eaf, 0x19bdf0ca, 0xa02369b9, 0x655abb50,
141  0x40685a32, 0x3c2ab4b3, 0x319ee9d5, 0xc021b8f7,
142  0x9b540b19, 0x875fa099, 0x95f7997e, 0x623d7da8,
143  0xf837889a, 0x97e32d77, 0x11ed935f, 0x16681281,
144  0x0e358829, 0xc7e61fd6, 0x96dedfa1, 0x7858ba99,
145  0x57f584a5, 0x1b227263, 0x9b83c3ff, 0x1ac24696,
146  0xcdb30aeb, 0x532e3054, 0x8fd948e4, 0x6dbc3128,
147  0x58ebf2ef, 0x34c6ffea, 0xfe28ed61, 0xee7c3c73,
148  0x5d4a14d9, 0xe864b7e3, 0x42105d14, 0x203e13e0,
149  0x45eee2b6, 0xa3aaabea, 0xdb6c4f15, 0xfacb4fd0,
150  0xc742f442, 0xef6abbb5, 0x654f3b1d, 0x41cd2105,
151  0xd81e799e, 0x86854dc7, 0xe44b476a, 0x3d816250,
152  0xcf62a1f2, 0x5b8d2646, 0xfc8883a0, 0xc1c7b6a3,
153  0x7f1524c3, 0x69cb7492, 0x47848a0b, 0x5692b285,
154  0x095bbf00, 0xad19489d, 0x1462b174, 0x23820e00,
155  0x58428d2a, 0x0c55f5ea, 0x1dadf43e, 0x233f7061,
156  0x3372f092, 0x8d937e41, 0xd65fecf1, 0x6c223bdb,
157  0x7cde3759, 0xcbee7460, 0x4085f2a7, 0xce77326e,
158  0xa6078084, 0x19f8509e, 0xe8efd855, 0x61d99735,
159  0xa969a7aa, 0xc50c06c2, 0x5a04abfc, 0x800bcadc,
160  0x9e447a2e, 0xc3453484, 0xfdd56705, 0x0e1e9ec9,
161  0xdb73dbd3, 0x105588cd, 0x675fda79, 0xe3674340,
162  0xc5c43465, 0x713e38d8, 0x3d28f89e, 0xf16dff20,
163  0x153e21e7, 0x8fb03d4a, 0xe6e39f2b, 0xdb83adf7,
164  0xe93d5a68, 0x948140f7, 0xf64c261c, 0x94692934,
165  0x411520f7, 0x7602d4f7, 0xbcf46b2e, 0xd4a20068,
166  0xd4082471, 0x3320f46a, 0x43b7d4b7, 0x500061af,
167  0x1e39f62e, 0x97244546, 0x14214f74, 0xbf8b8840,
168  0x4d95fc1d, 0x96b591af, 0x70f4ddd3, 0x66a02f45,
169  0xbfbc09ec, 0x03bd9785, 0x7fac6dd0, 0x31cb8504,
170  0x96eb27b3, 0x55fd3941, 0xda2547e6, 0xabca0a9a,
171  0x28507825, 0x530429f4, 0x0a2c86da, 0xe9b66dfb,
172  0x68dc1462, 0xd7486900, 0x680ec0a4, 0x27a18dee,
173  0x4f3ffea2, 0xe887ad8c, 0xb58ce006, 0x7af4d6b6,
174  0xaace1e7c, 0xd3375fec, 0xce78a399, 0x406b2a42,
175  0x20fe9e35, 0xd9f385b9, 0xee39d7ab, 0x3b124e8b,
176  0x1dc9faf7, 0x4b6d1856, 0x26a36631, 0xeae397b2,
177  0x3a6efa74, 0xdd5b4332, 0x6841e7f7, 0xca7820fb,
178  0xfb0af54e, 0xd8feb397, 0x454056ac, 0xba489527,
179  0x55533a3a, 0x20838d87, 0xfe6ba9b7, 0xd096954b,
180  0x55a867bc, 0xa1159a58, 0xcca92963, 0x99e1db33,
181  0xa62a4a56, 0x3f3125f9, 0x5ef47e1c, 0x9029317c,
182  0xfdf8e802, 0x04272f70, 0x80bb155c, 0x05282ce3,
183  0x95c11548, 0xe4c66d22, 0x48c1133f, 0xc70f86dc,
184  0x07f9c9ee, 0x41041f0f, 0x404779a4, 0x5d886e17,
185  0x325f51eb, 0xd59bc0d1, 0xf2bcc18f, 0x41113564,
186  0x257b7834, 0x602a9c60, 0xdff8e8a3, 0x1f636c1b,
187  0x0e12b4c2, 0x02e1329e, 0xaf664fd1, 0xcad18115,
188  0x6b2395e0, 0x333e92e1, 0x3b240b62, 0xeebeb922,
189  0x85b2a20e, 0xe6ba0d99, 0xde720c8c, 0x2da2f728,
190  0xd0127845, 0x95b794fd, 0x647d0862, 0xe7ccf5f0,
191  0x5449a36f, 0x877d48fa, 0xc39dfd27, 0xf33e8d1e,
192  0x0a476341, 0x992eff74, 0x3a6f6eab, 0xf4f8fd37,
193  0xa812dc60, 0xa1ebddf8, 0x991be14c, 0xdb6e6b0d,
194  0xc67b5510, 0x6d672c37, 0x2765d43b, 0xdcd0e804,
195  0xf1290dc7, 0xcc00ffa3, 0xb5390f92, 0x690fed0b,
196  0x667b9ffb, 0xcedb7d9c, 0xa091cf0b, 0xd9155ea3,
197  0xbb132f88, 0x515bad24, 0x7b9479bf, 0x763bd6eb,
198  0x37392eb3, 0xcc115979, 0x8026e297, 0xf42e312d,
199  0x6842ada7, 0xc66a2b3b, 0x12754ccc, 0x782ef11c,
200  0x6a124237, 0xb79251e7, 0x06a1bbe6, 0x4bfb6350,
201  0x1a6b1018, 0x11caedfa, 0x3d25bdd8, 0xe2e1c3c9,
202  0x44421659, 0x0a121386, 0xd90cec6e, 0xd5abea2a,
203  0x64af674e, 0xda86a85f, 0xbebfe988, 0x64e4c3fe,
204  0x9dbc8057, 0xf0f7c086, 0x60787bf8, 0x6003604d,
205  0xd1fd8346, 0xf6381fb0, 0x7745ae04, 0xd736fccc,
206  0x83426b33, 0xf01eab71, 0xb0804187, 0x3c005e5f,
207  0x77a057be, 0xbde8ae24, 0x55464299, 0xbf582e61,
208  0x4e58f48f, 0xf2ddfda2, 0xf474ef38, 0x8789bdc2,
209  0x5366f9c3, 0xc8b38e74, 0xb475f255, 0x46fcd9b9,
210  0x7aeb2661, 0x8b1ddf84, 0x846a0e79, 0x915f95e2,
211  0x466e598e, 0x20b45770, 0x8cd55591, 0xc902de4c,
212  0xb90bace1, 0xbb8205d0, 0x11a86248, 0x7574a99e,
213  0xb77f19b6, 0xe0a9dc09, 0x662d09a1, 0xc4324633,
214  0xe85a1f02, 0x09f0be8c, 0x4a99a025, 0x1d6efe10,
215  0x1ab93d1d, 0x0ba5a4df, 0xa186f20f, 0x2868f169,
216  0xdcb7da83, 0x573906fe, 0xa1e2ce9b, 0x4fcd7f52,
217  0x50115e01, 0xa70683fa, 0xa002b5c4, 0x0de6d027,
218  0x9af88c27, 0x773f8641, 0xc3604c06, 0x61a806b5,
219  0xf0177a28, 0xc0f586e0, 0x006058aa, 0x30dc7d62,
220  0x11e69ed7, 0x2338ea63, 0x53c2dd94, 0xc2c21634,
221  0xbbcbee56, 0x90bcb6de, 0xebfc7da1, 0xce591d76,
222  0x6f05e409, 0x4b7c0188, 0x39720a3d, 0x7c927c24,
223  0x86e3725f, 0x724d9db9, 0x1ac15bb4, 0xd39eb8fc,
224  0xed545578, 0x08fca5b5, 0xd83d7cd3, 0x4dad0fc4,
225  0x1e50ef5e, 0xb161e6f8, 0xa28514d9, 0x6c51133c,
226  0x6fd5c7e7, 0x56e14ec4, 0x362abfce, 0xddc6c837,
227  0xd79a3234, 0x92638212, 0x670efa8e, 0x406000e0,
228  0x3a39ce37, 0xd3faf5cf, 0xabc27737, 0x5ac52d1b,
229  0x5cb0679e, 0x4fa33742, 0xd3822740, 0x99bc9bbe,
230  0xd5118e9d, 0xbf0f7315, 0xd62d1c7e, 0xc700c47b,
231  0xb78c1b6b, 0x21a19045, 0xb26eb1be, 0x6a366eb4,
232  0x5748ab2f, 0xbc946e79, 0xc6a376d2, 0x6549c2c8,
233  0x530ff8ee, 0x468dde7d, 0xd5730a1d, 0x4cd04dc6,
234  0x2939bbdb, 0xa9ba4650, 0xac9526e8, 0xbe5ee304,
235  0xa1fad5f0, 0x6a2d519a, 0x63ef8ce2, 0x9a86ee22,
236  0xc089c2b8, 0x43242ef6, 0xa51e03aa, 0x9cf2d0a4,
237  0x83c061ba, 0x9be96a4d, 0x8fe51550, 0xba645bd6,
238  0x2826a2f9, 0xa73a3ae1, 0x4ba99586, 0xef5562e9,
239  0xc72fefd3, 0xf752f7da, 0x3f046f69, 0x77fa0a59,
240  0x80e4a915, 0x87b08601, 0x9b09e6ad, 0x3b3ee593,
241  0xe990fd5a, 0x9e34d797, 0x2cf0b7d9, 0x022b8b51,
242  0x96d5ac3a, 0x017da67d, 0xd1cf3ed6, 0x7c7d2d28,
243  0x1f9f25cf, 0xadf2b89b, 0x5ad6b472, 0x5a88f54c,
244  0xe029ac71, 0xe019a5e6, 0x47b0acfd, 0xed93fa9b,
245  0xe8d3c48d, 0x283b57cc, 0xf8d56629, 0x79132e28,
246  0x785f0191, 0xed756055, 0xf7960e44, 0xe3d35e8c,
247  0x15056dd4, 0x88f46dba, 0x03a16125, 0x0564f0bd,
248  0xc3eb9e15, 0x3c9057a2, 0x97271aec, 0xa93a072a,
249  0x1b3f6d9b, 0x1e6321f5, 0xf59c66fb, 0x26dcf319,
250  0x7533d928, 0xb155fdf5, 0x03563482, 0x8aba3cbb,
251  0x28517711, 0xc20ad9f8, 0xabcc5167, 0xccad925f,
252  0x4de81751, 0x3830dc8e, 0x379d5862, 0x9320f991,
253  0xea7a90c2, 0xfb3e7bce, 0x5121ce64, 0x774fbe32,
254  0xa8b6e37e, 0xc3293d46, 0x48de5369, 0x6413e680,
255  0xa2ae0810, 0xdd6db224, 0x69852dfd, 0x09072166,
256  0xb39a460a, 0x6445c0dd, 0x586cdecf, 0x1c20c8ae,
257  0x5bbef7dd, 0x1b588d40, 0xccd2017f, 0x6bb4e3bb,
258  0xdda26a7e, 0x3a59ff45, 0x3e350a44, 0xbcb4cdd5,
259  0x72eacea8, 0xfa6484bb, 0x8d6612ae, 0xbf3c6f47,
260  0xd29be463, 0x542f5d9e, 0xaec2771b, 0xf64e6370,
261  0x740e0d8d, 0xe75b1357, 0xf8721671, 0xaf537d5d,
262  0x4040cb08, 0x4eb4e2cc, 0x34d2466a, 0x0115af84,
263  0xe1b00428, 0x95983a1d, 0x06b89fb4, 0xce6ea048,
264  0x6f3f3b82, 0x3520ab82, 0x011a1d4b, 0x277227f8,
265  0x611560b1, 0xe7933fdc, 0xbb3a792b, 0x344525bd,
266  0xa08839e1, 0x51ce794b, 0x2f32c9b7, 0xa01fbac9,
267  0xe01cc87e, 0xbcc7d1f6, 0xcf0111c3, 0xa1e8aac7,
268  0x1a908749, 0xd44fbd9a, 0xd0dadecb, 0xd50ada38,
269  0x0339c32a, 0xc6913667, 0x8df9317c, 0xe0b12b4f,
270  0xf79e59b7, 0x43f5bb3a, 0xf2d519ff, 0x27d9459c,
271  0xbf97222c, 0x15e6fc2a, 0x0f91fc71, 0x9b941525,
272  0xfae59361, 0xceb69ceb, 0xc2a86459, 0x12baa8d1,
273  0xb6c1075e, 0xe3056a0c, 0x10d25065, 0xcb03a442,
274  0xe0ec6e0e, 0x1698db3b, 0x4c98a0be, 0x3278e964,
275  0x9f1f9532, 0xe0d392df, 0xd3a0342b, 0x8971f21e,
276  0x1b0a7441, 0x4ba3348c, 0xc5be7120, 0xc37632d8,
277  0xdf359f8d, 0x9b992f2e, 0xe60b6f47, 0x0fe3f11d,
278  0xe54cda54, 0x1edad891, 0xce6279cf, 0xcd3e7e6f,
279  0x1618b166, 0xfd2c1d05, 0x848fd2c5, 0xf6fb2299,
280  0xf523f357, 0xa6327623, 0x93a83531, 0x56cccd02,
281  0xacf08162, 0x5a75ebb5, 0x6e163697, 0x88d273cc,
282  0xde966292, 0x81b949d0, 0x4c50901b, 0x71c65614,
283  0xe6c6c7bd, 0x327a140a, 0x45e1d006, 0xc3f27b9a,
284  0xc9aa53fd, 0x62a80f00, 0xbb25bfe2, 0x35bdd2f6,
285  0x71126905, 0xb2040222, 0xb6cbcf7c, 0xcd769c2b,
286  0x53113ec0, 0x1640e3d3, 0x38abbd60, 0x2547adf0,
287  0xba38209c, 0xf746ce76, 0x77afa1c5, 0x20756060,
288  0x85cbfe4e, 0x8ae88dd8, 0x7aaaf9b0, 0x4cf9aa7e,
289  0x1948c25c, 0x02fb8a8c, 0x01c36ae4, 0xd6ebe1f9,
290  0x90d4f869, 0xa65cdea0, 0x3f09252d, 0xc208e69f,
291  0xb74e6132, 0xce77e25b, 0x578fdfe3, 0x3ac372e6,
292};
293
294/* Round loop unrolling macros,
295   S is a pointer to a S-Box array organized in 4 unsigned longs at
296   a row.
297   */
298
299#define GET32_3(x) (((x) & 0x00ff))
300#define GET32_2(x) (((x) >> (8)) & (0x00ff))
301#define GET32_1(x) (((x) >> (16)) & (0x00ff))
302#define GET32_0(x) (((x) >> (24)) & (0x00ff))
303
304#define bf_F(x) (((S[0 * 256 + GET32_0(x)] + S[1 * 256 + GET32_1(x)]) ^ \
305                  S[2 * 256 + GET32_2(x)]) + S[3 * 256 + GET32_3(x)])
306
307#define ROUND(a, b, n) (a ^= (bf_F(b) ^ P[n]))
308
309/*  The internal encipher, processes 64-bit blocks (as standard). */
310     
311static void blowfish_encrypt(BlowfishContext *context,
312                      word32 xl, word32 xr, word32 *output)
313{
314  word32 yl;
315  word32 yr;
316  word32 *S = context -> S;
317  word32 *P = context -> P;
318
319  yl = xl;
320  yr = xr;
321 
322  yl ^= P[0];
323  ROUND(yr, yl, 1);  ROUND(yl, yr, 2);
324  ROUND(yr, yl, 3);  ROUND(yl, yr, 4);
325  ROUND(yr, yl, 5);  ROUND(yl, yr, 6);
326  ROUND(yr, yl, 7);  ROUND(yl, yr, 8);
327  ROUND(yr, yl, 9);  ROUND(yl, yr, 10);
328  ROUND(yr, yl, 11); ROUND(yl, yr, 12);
329  ROUND(yr, yl, 13); ROUND(yl, yr, 14);
330  ROUND(yr, yl, 15); ROUND(yl, yr, 16);
331  yr ^= P[17];
332 
333  output[0] = yr;
334  output[1] = yl;
335}
336 
337/*
338  Internal decipher, two 32 bit blocks at once. */
339
340static void blowfish_decrypt(BlowfishContext *context,
341                             word32 xl, word32 xr, word32 *output)
342{
343  word32 yl;
344  word32 yr;
345  word32 *S = context -> S;
346  word32 *P = context -> P;
347
348  yl = xl;
349  yr = xr;
350
351  yl ^= P[17];
352  ROUND (yr, yl, 16); ROUND (yl, yr, 15);
353  ROUND (yr, yl, 14); ROUND (yl, yr, 13);
354  ROUND (yr, yl, 12); ROUND (yl, yr, 11);
355  ROUND (yr, yl, 10); ROUND (yl, yr, 9);
356  ROUND (yr, yl, 8);  ROUND (yl, yr, 7);
357  ROUND (yr, yl, 6);  ROUND (yl, yr, 5);
358  ROUND (yr, yl, 4);  ROUND (yl, yr, 3);
359  ROUND (yr, yl, 2);  ROUND (yl, yr, 1);
360  yr ^= P[0];
361
362  output[0] = yr;
363  output[1] = yl;
364 
365}
366
367void blowfish_transform(word32 l, word32 r, word32 *output,
368                        int encrypt, void *context)
369{
370  if (encrypt)
371    blowfish_encrypt((BlowfishContext *)context,
372                     l, r, output);
373  else
374    blowfish_decrypt((BlowfishContext *)context,
375                     l, r, output);
376}
377
378/* Encrypt a buffer using mode cbc and initialization vector in
379   context structure */
380
381void blowfish_cbc_encrypt(BlowfishContext *ctx, unsigned char *dst,
382                          const unsigned char *src, unsigned int len)
383{
384  word32 iv0, iv1, out[2];
385  unsigned int i;
386
387  assert((len & 7) == 0);
388
389  iv0 = GET_32BIT_LSB_FIRST(ctx->iv);
390  iv1 = GET_32BIT_LSB_FIRST(ctx->iv + 4);
391
392  for (i = 0; i < len; i += 8)
393    {
394      iv0 ^= GET_32BIT_LSB_FIRST(src + i);
395      iv1 ^= GET_32BIT_LSB_FIRST(src + i + 4);
396      blowfish_transform(iv0, iv1, out, 1, ctx);
397      iv0 = out[0];
398      iv1 = out[1];
399      PUT_32BIT_LSB_FIRST(dst + i, iv0);
400      PUT_32BIT_LSB_FIRST(dst + i + 4, iv1);
401    }
402  PUT_32BIT_LSB_FIRST(ctx->iv, iv0);
403  PUT_32BIT_LSB_FIRST(ctx->iv + 4, iv1);
404}
405
406/* Encrypt a buffer using mode cbc and initialization vector in
407   context structure */
408
409void blowfish_cbc_decrypt(BlowfishContext *ctx, unsigned char *dst,
410                          const unsigned char *src, unsigned int len)
411{
412  word32 iv0, iv1, d0, d1, out[2];
413  unsigned int i;
414
415  assert((len & 7) == 0);
416
417  iv0 = GET_32BIT_LSB_FIRST(ctx->iv);
418  iv1 = GET_32BIT_LSB_FIRST(ctx->iv + 4);
419
420  for (i = 0; i < len; i += 8)
421    {
422      d0 = GET_32BIT_LSB_FIRST(src + i);
423      d1 = GET_32BIT_LSB_FIRST(src + i + 4);
424      blowfish_transform(d0, d1, out, 0, ctx);
425      iv0 ^= out[0];
426      iv1 ^= out[1];
427      PUT_32BIT_LSB_FIRST(dst + i, iv0);
428      PUT_32BIT_LSB_FIRST(dst + i + 4, iv1);
429      iv0 = d0;
430      iv1 = d1;
431    }
432  PUT_32BIT_LSB_FIRST(ctx->iv, iv0);
433  PUT_32BIT_LSB_FIRST(ctx->iv + 4, iv1);
434}
435
436/* Sets the blowfish S and P boxes for encryption and decryption. */
437
438void blowfish_set_key(BlowfishContext *context,
439                      const unsigned char *key, short keybytes,
440                      int for_encyption)
441{
442  short i;
443  short j;
444  short count;
445  word32 data_l;
446  word32 data_r;
447  word32 temp;
448  word32 *P = context -> P;
449  word32 *S = context -> S;
450  word32 output[2];
451 
452  /* Copy the initialization s-boxes */
453   
454  for (i = 0, count = 0; i < 256; i ++)
455    for (j = 0; j < 4; j++, count++ )
456      S[count] = blowfish_sbox[count];
457
458  /* Set the p-boxes */
459 
460  for (i = 0; i < 16 + 2; i++)
461    P[i] = blowfish_pbox[i];
462 
463  /* Actual subkey generation */
464 
465  for (j = 0, i = 0; i < 16 + 2; i++)
466    {
467      temp = (((word32)key[j] << 24) |
468             ((word32)key[(j + 1) % keybytes] << 16) |
469             ((word32)key[(j + 2) % keybytes] << 8) |
470             ((word32)key[(j + 3) % keybytes]));
471       
472      P[i] = P[i] ^ temp;
473      j = (j + 4) % keybytes;
474    }
475
476  data_l = 0x00000000;
477  data_r = 0x00000000;
478
479  for (i = 0; i < 16 + 2; i += 2)
480    {
481      blowfish_encrypt(context, data_l, data_r, output);
482
483      data_l = output[0];
484      data_r = output[1];
485
486      P[i] = data_l;
487      P[i + 1] = data_r;
488    }
489
490  for (i = 0; i < 4; i++)
491    {
492      for (j = 0, count = i * 256; j < 256; j += 2, count += 2)
493        {
494          blowfish_encrypt(context, data_l, data_r, output);
495
496          data_l = output[0];
497          data_r = output[1];
498         
499          S[count] = data_l;
500          S[count + 1] = data_r;
501        }
502    }
503}
504
505
506#endif /* WITHOUT_BLOWFISH */
507
508
509
Note: See TracBrowser for help on using the repository browser.