xref: /netbsd-src/lib/libcrypt/blowfish.c (revision 001c68bd94f75ce9270b69227c4199fbf34ee396)
1 /*	$NetBSD: blowfish.c,v 1.2 2003/04/17 00:31:04 thorpej Exp $	*/
2 /* $OpenBSD: blowfish.c,v 1.16 2002/02/19 19:39:36 millert Exp $ */
3 /*
4  * Blowfish block cipher for OpenBSD
5  * Copyright 1997 Niels Provos <provos@physnet.uni-hamburg.de>
6  * All rights reserved.
7  *
8  * Implementation advice by David Mazieres <dm@lcs.mit.edu>.
9  *
10  * Redistribution and use in source and binary forms, with or without
11  * modification, are permitted provided that the following conditions
12  * are met:
13  * 1. Redistributions of source code must retain the above copyright
14  *    notice, this list of conditions and the following disclaimer.
15  * 2. Redistributions in binary form must reproduce the above copyright
16  *    notice, this list of conditions and the following disclaimer in the
17  *    documentation and/or other materials provided with the distribution.
18  * 3. All advertising materials mentioning features or use of this software
19  *    must display the following acknowledgement:
20  *      This product includes software developed by Niels Provos.
21  * 4. The name of the author may not be used to endorse or promote products
22  *    derived from this software without specific prior written permission.
23  *
24  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
25  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
26  * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
27  * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
28  * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
29  * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
30  * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
31  * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
32  * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
33  * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34  */
35 
36 /*
37  * This code is derived from section 14.3 and the given source
38  * in section V of Applied Cryptography, second edition.
39  * Blowfish is an unpatented fast block cipher designed by
40  * Bruce Schneier.
41  */
42 
43 /*
44  * Note: This has been trimmed down to only what is needed by
45  * __bcrypt().  Also note that this file is actually included
46  * directly by bcrypt.c, not built separately.
47  */
48 
49 #include <sys/types.h>
50 
51 /* Schneier specifies a maximum key length of 56 bytes.
52  * This ensures that every key bit affects every cipher
53  * bit.  However, the subkeys can hold up to 72 bytes.
54  * Warning: For normal blowfish encryption only 56 bytes
55  * of the key affect all cipherbits.
56  */
57 
58 #define BLF_N	16			/* Number of Subkeys */
59 #define BLF_MAXKEYLEN ((BLF_N-2)*4)	/* 448 bits */
60 
61 /* Blowfish context */
62 typedef struct BlowfishContext {
63 	u_int32_t S[4][256];	/* S-Boxes */
64 	u_int32_t P[BLF_N + 2];	/* Subkeys */
65 } blf_ctx;
66 
67 #undef inline
68 #ifdef __GNUC__
69 #define inline __inline
70 #else				/* !__GNUC__ */
71 #define inline
72 #endif				/* !__GNUC__ */
73 
74 /* Function for Feistel Networks */
75 
76 #define F(s, x) ((((s)[        (((x)>>24)&0xFF)]  \
77 		 + (s)[0x100 + (((x)>>16)&0xFF)]) \
78 		 ^ (s)[0x200 + (((x)>> 8)&0xFF)]) \
79 		 + (s)[0x300 + ( (x)     &0xFF)])
80 
81 #define BLFRND(s,p,i,j,n) (i ^= F(s,j) ^ (p)[n])
82 
83 static void
84 Blowfish_encipher(blf_ctx *c, u_int32_t *xl, u_int32_t *xr)
85 {
86 	u_int32_t Xl;
87 	u_int32_t Xr;
88 	u_int32_t *s = c->S[0];
89 	u_int32_t *p = c->P;
90 
91 	Xl = *xl;
92 	Xr = *xr;
93 
94 	Xl ^= p[0];
95 	BLFRND(s, p, Xr, Xl, 1); BLFRND(s, p, Xl, Xr, 2);
96 	BLFRND(s, p, Xr, Xl, 3); BLFRND(s, p, Xl, Xr, 4);
97 	BLFRND(s, p, Xr, Xl, 5); BLFRND(s, p, Xl, Xr, 6);
98 	BLFRND(s, p, Xr, Xl, 7); BLFRND(s, p, Xl, Xr, 8);
99 	BLFRND(s, p, Xr, Xl, 9); BLFRND(s, p, Xl, Xr, 10);
100 	BLFRND(s, p, Xr, Xl, 11); BLFRND(s, p, Xl, Xr, 12);
101 	BLFRND(s, p, Xr, Xl, 13); BLFRND(s, p, Xl, Xr, 14);
102 	BLFRND(s, p, Xr, Xl, 15); BLFRND(s, p, Xl, Xr, 16);
103 
104 	*xl = Xr ^ p[17];
105 	*xr = Xl;
106 }
107 
108 static void
109 Blowfish_initstate(blf_ctx *c)
110 {
111 
112 /* P-box and S-box tables initialized with digits of Pi */
113 
114 	static const blf_ctx init_state =
115 
116 	{ {
117 		{
118 			0xd1310ba6, 0x98dfb5ac, 0x2ffd72db, 0xd01adfb7,
119 			0xb8e1afed, 0x6a267e96, 0xba7c9045, 0xf12c7f99,
120 			0x24a19947, 0xb3916cf7, 0x0801f2e2, 0x858efc16,
121 			0x636920d8, 0x71574e69, 0xa458fea3, 0xf4933d7e,
122 			0x0d95748f, 0x728eb658, 0x718bcd58, 0x82154aee,
123 			0x7b54a41d, 0xc25a59b5, 0x9c30d539, 0x2af26013,
124 			0xc5d1b023, 0x286085f0, 0xca417918, 0xb8db38ef,
125 			0x8e79dcb0, 0x603a180e, 0x6c9e0e8b, 0xb01e8a3e,
126 			0xd71577c1, 0xbd314b27, 0x78af2fda, 0x55605c60,
127 			0xe65525f3, 0xaa55ab94, 0x57489862, 0x63e81440,
128 			0x55ca396a, 0x2aab10b6, 0xb4cc5c34, 0x1141e8ce,
129 			0xa15486af, 0x7c72e993, 0xb3ee1411, 0x636fbc2a,
130 			0x2ba9c55d, 0x741831f6, 0xce5c3e16, 0x9b87931e,
131 			0xafd6ba33, 0x6c24cf5c, 0x7a325381, 0x28958677,
132 			0x3b8f4898, 0x6b4bb9af, 0xc4bfe81b, 0x66282193,
133 			0x61d809cc, 0xfb21a991, 0x487cac60, 0x5dec8032,
134 			0xef845d5d, 0xe98575b1, 0xdc262302, 0xeb651b88,
135 			0x23893e81, 0xd396acc5, 0x0f6d6ff3, 0x83f44239,
136 			0x2e0b4482, 0xa4842004, 0x69c8f04a, 0x9e1f9b5e,
137 			0x21c66842, 0xf6e96c9a, 0x670c9c61, 0xabd388f0,
138 			0x6a51a0d2, 0xd8542f68, 0x960fa728, 0xab5133a3,
139 			0x6eef0b6c, 0x137a3be4, 0xba3bf050, 0x7efb2a98,
140 			0xa1f1651d, 0x39af0176, 0x66ca593e, 0x82430e88,
141 			0x8cee8619, 0x456f9fb4, 0x7d84a5c3, 0x3b8b5ebe,
142 			0xe06f75d8, 0x85c12073, 0x401a449f, 0x56c16aa6,
143 			0x4ed3aa62, 0x363f7706, 0x1bfedf72, 0x429b023d,
144 			0x37d0d724, 0xd00a1248, 0xdb0fead3, 0x49f1c09b,
145 			0x075372c9, 0x80991b7b, 0x25d479d8, 0xf6e8def7,
146 			0xe3fe501a, 0xb6794c3b, 0x976ce0bd, 0x04c006ba,
147 			0xc1a94fb6, 0x409f60c4, 0x5e5c9ec2, 0x196a2463,
148 			0x68fb6faf, 0x3e6c53b5, 0x1339b2eb, 0x3b52ec6f,
149 			0x6dfc511f, 0x9b30952c, 0xcc814544, 0xaf5ebd09,
150 			0xbee3d004, 0xde334afd, 0x660f2807, 0x192e4bb3,
151 			0xc0cba857, 0x45c8740f, 0xd20b5f39, 0xb9d3fbdb,
152 			0x5579c0bd, 0x1a60320a, 0xd6a100c6, 0x402c7279,
153 			0x679f25fe, 0xfb1fa3cc, 0x8ea5e9f8, 0xdb3222f8,
154 			0x3c7516df, 0xfd616b15, 0x2f501ec8, 0xad0552ab,
155 			0x323db5fa, 0xfd238760, 0x53317b48, 0x3e00df82,
156 			0x9e5c57bb, 0xca6f8ca0, 0x1a87562e, 0xdf1769db,
157 			0xd542a8f6, 0x287effc3, 0xac6732c6, 0x8c4f5573,
158 			0x695b27b0, 0xbbca58c8, 0xe1ffa35d, 0xb8f011a0,
159 			0x10fa3d98, 0xfd2183b8, 0x4afcb56c, 0x2dd1d35b,
160 			0x9a53e479, 0xb6f84565, 0xd28e49bc, 0x4bfb9790,
161 			0xe1ddf2da, 0xa4cb7e33, 0x62fb1341, 0xcee4c6e8,
162 			0xef20cada, 0x36774c01, 0xd07e9efe, 0x2bf11fb4,
163 			0x95dbda4d, 0xae909198, 0xeaad8e71, 0x6b93d5a0,
164 			0xd08ed1d0, 0xafc725e0, 0x8e3c5b2f, 0x8e7594b7,
165 			0x8ff6e2fb, 0xf2122b64, 0x8888b812, 0x900df01c,
166 			0x4fad5ea0, 0x688fc31c, 0xd1cff191, 0xb3a8c1ad,
167 			0x2f2f2218, 0xbe0e1777, 0xea752dfe, 0x8b021fa1,
168 			0xe5a0cc0f, 0xb56f74e8, 0x18acf3d6, 0xce89e299,
169 			0xb4a84fe0, 0xfd13e0b7, 0x7cc43b81, 0xd2ada8d9,
170 			0x165fa266, 0x80957705, 0x93cc7314, 0x211a1477,
171 			0xe6ad2065, 0x77b5fa86, 0xc75442f5, 0xfb9d35cf,
172 			0xebcdaf0c, 0x7b3e89a0, 0xd6411bd3, 0xae1e7e49,
173 			0x00250e2d, 0x2071b35e, 0x226800bb, 0x57b8e0af,
174 			0x2464369b, 0xf009b91e, 0x5563911d, 0x59dfa6aa,
175 			0x78c14389, 0xd95a537f, 0x207d5ba2, 0x02e5b9c5,
176 			0x83260376, 0x6295cfa9, 0x11c81968, 0x4e734a41,
177 			0xb3472dca, 0x7b14a94a, 0x1b510052, 0x9a532915,
178 			0xd60f573f, 0xbc9bc6e4, 0x2b60a476, 0x81e67400,
179 			0x08ba6fb5, 0x571be91f, 0xf296ec6b, 0x2a0dd915,
180 			0xb6636521, 0xe7b9f9b6, 0xff34052e, 0xc5855664,
181 		0x53b02d5d, 0xa99f8fa1, 0x08ba4799, 0x6e85076a},
182 		{
183 			0x4b7a70e9, 0xb5b32944, 0xdb75092e, 0xc4192623,
184 			0xad6ea6b0, 0x49a7df7d, 0x9cee60b8, 0x8fedb266,
185 			0xecaa8c71, 0x699a17ff, 0x5664526c, 0xc2b19ee1,
186 			0x193602a5, 0x75094c29, 0xa0591340, 0xe4183a3e,
187 			0x3f54989a, 0x5b429d65, 0x6b8fe4d6, 0x99f73fd6,
188 			0xa1d29c07, 0xefe830f5, 0x4d2d38e6, 0xf0255dc1,
189 			0x4cdd2086, 0x8470eb26, 0x6382e9c6, 0x021ecc5e,
190 			0x09686b3f, 0x3ebaefc9, 0x3c971814, 0x6b6a70a1,
191 			0x687f3584, 0x52a0e286, 0xb79c5305, 0xaa500737,
192 			0x3e07841c, 0x7fdeae5c, 0x8e7d44ec, 0x5716f2b8,
193 			0xb03ada37, 0xf0500c0d, 0xf01c1f04, 0x0200b3ff,
194 			0xae0cf51a, 0x3cb574b2, 0x25837a58, 0xdc0921bd,
195 			0xd19113f9, 0x7ca92ff6, 0x94324773, 0x22f54701,
196 			0x3ae5e581, 0x37c2dadc, 0xc8b57634, 0x9af3dda7,
197 			0xa9446146, 0x0fd0030e, 0xecc8c73e, 0xa4751e41,
198 			0xe238cd99, 0x3bea0e2f, 0x3280bba1, 0x183eb331,
199 			0x4e548b38, 0x4f6db908, 0x6f420d03, 0xf60a04bf,
200 			0x2cb81290, 0x24977c79, 0x5679b072, 0xbcaf89af,
201 			0xde9a771f, 0xd9930810, 0xb38bae12, 0xdccf3f2e,
202 			0x5512721f, 0x2e6b7124, 0x501adde6, 0x9f84cd87,
203 			0x7a584718, 0x7408da17, 0xbc9f9abc, 0xe94b7d8c,
204 			0xec7aec3a, 0xdb851dfa, 0x63094366, 0xc464c3d2,
205 			0xef1c1847, 0x3215d908, 0xdd433b37, 0x24c2ba16,
206 			0x12a14d43, 0x2a65c451, 0x50940002, 0x133ae4dd,
207 			0x71dff89e, 0x10314e55, 0x81ac77d6, 0x5f11199b,
208 			0x043556f1, 0xd7a3c76b, 0x3c11183b, 0x5924a509,
209 			0xf28fe6ed, 0x97f1fbfa, 0x9ebabf2c, 0x1e153c6e,
210 			0x86e34570, 0xeae96fb1, 0x860e5e0a, 0x5a3e2ab3,
211 			0x771fe71c, 0x4e3d06fa, 0x2965dcb9, 0x99e71d0f,
212 			0x803e89d6, 0x5266c825, 0x2e4cc978, 0x9c10b36a,
213 			0xc6150eba, 0x94e2ea78, 0xa5fc3c53, 0x1e0a2df4,
214 			0xf2f74ea7, 0x361d2b3d, 0x1939260f, 0x19c27960,
215 			0x5223a708, 0xf71312b6, 0xebadfe6e, 0xeac31f66,
216 			0xe3bc4595, 0xa67bc883, 0xb17f37d1, 0x018cff28,
217 			0xc332ddef, 0xbe6c5aa5, 0x65582185, 0x68ab9802,
218 			0xeecea50f, 0xdb2f953b, 0x2aef7dad, 0x5b6e2f84,
219 			0x1521b628, 0x29076170, 0xecdd4775, 0x619f1510,
220 			0x13cca830, 0xeb61bd96, 0x0334fe1e, 0xaa0363cf,
221 			0xb5735c90, 0x4c70a239, 0xd59e9e0b, 0xcbaade14,
222 			0xeecc86bc, 0x60622ca7, 0x9cab5cab, 0xb2f3846e,
223 			0x648b1eaf, 0x19bdf0ca, 0xa02369b9, 0x655abb50,
224 			0x40685a32, 0x3c2ab4b3, 0x319ee9d5, 0xc021b8f7,
225 			0x9b540b19, 0x875fa099, 0x95f7997e, 0x623d7da8,
226 			0xf837889a, 0x97e32d77, 0x11ed935f, 0x16681281,
227 			0x0e358829, 0xc7e61fd6, 0x96dedfa1, 0x7858ba99,
228 			0x57f584a5, 0x1b227263, 0x9b83c3ff, 0x1ac24696,
229 			0xcdb30aeb, 0x532e3054, 0x8fd948e4, 0x6dbc3128,
230 			0x58ebf2ef, 0x34c6ffea, 0xfe28ed61, 0xee7c3c73,
231 			0x5d4a14d9, 0xe864b7e3, 0x42105d14, 0x203e13e0,
232 			0x45eee2b6, 0xa3aaabea, 0xdb6c4f15, 0xfacb4fd0,
233 			0xc742f442, 0xef6abbb5, 0x654f3b1d, 0x41cd2105,
234 			0xd81e799e, 0x86854dc7, 0xe44b476a, 0x3d816250,
235 			0xcf62a1f2, 0x5b8d2646, 0xfc8883a0, 0xc1c7b6a3,
236 			0x7f1524c3, 0x69cb7492, 0x47848a0b, 0x5692b285,
237 			0x095bbf00, 0xad19489d, 0x1462b174, 0x23820e00,
238 			0x58428d2a, 0x0c55f5ea, 0x1dadf43e, 0x233f7061,
239 			0x3372f092, 0x8d937e41, 0xd65fecf1, 0x6c223bdb,
240 			0x7cde3759, 0xcbee7460, 0x4085f2a7, 0xce77326e,
241 			0xa6078084, 0x19f8509e, 0xe8efd855, 0x61d99735,
242 			0xa969a7aa, 0xc50c06c2, 0x5a04abfc, 0x800bcadc,
243 			0x9e447a2e, 0xc3453484, 0xfdd56705, 0x0e1e9ec9,
244 			0xdb73dbd3, 0x105588cd, 0x675fda79, 0xe3674340,
245 			0xc5c43465, 0x713e38d8, 0x3d28f89e, 0xf16dff20,
246 		0x153e21e7, 0x8fb03d4a, 0xe6e39f2b, 0xdb83adf7},
247 		{
248 			0xe93d5a68, 0x948140f7, 0xf64c261c, 0x94692934,
249 			0x411520f7, 0x7602d4f7, 0xbcf46b2e, 0xd4a20068,
250 			0xd4082471, 0x3320f46a, 0x43b7d4b7, 0x500061af,
251 			0x1e39f62e, 0x97244546, 0x14214f74, 0xbf8b8840,
252 			0x4d95fc1d, 0x96b591af, 0x70f4ddd3, 0x66a02f45,
253 			0xbfbc09ec, 0x03bd9785, 0x7fac6dd0, 0x31cb8504,
254 			0x96eb27b3, 0x55fd3941, 0xda2547e6, 0xabca0a9a,
255 			0x28507825, 0x530429f4, 0x0a2c86da, 0xe9b66dfb,
256 			0x68dc1462, 0xd7486900, 0x680ec0a4, 0x27a18dee,
257 			0x4f3ffea2, 0xe887ad8c, 0xb58ce006, 0x7af4d6b6,
258 			0xaace1e7c, 0xd3375fec, 0xce78a399, 0x406b2a42,
259 			0x20fe9e35, 0xd9f385b9, 0xee39d7ab, 0x3b124e8b,
260 			0x1dc9faf7, 0x4b6d1856, 0x26a36631, 0xeae397b2,
261 			0x3a6efa74, 0xdd5b4332, 0x6841e7f7, 0xca7820fb,
262 			0xfb0af54e, 0xd8feb397, 0x454056ac, 0xba489527,
263 			0x55533a3a, 0x20838d87, 0xfe6ba9b7, 0xd096954b,
264 			0x55a867bc, 0xa1159a58, 0xcca92963, 0x99e1db33,
265 			0xa62a4a56, 0x3f3125f9, 0x5ef47e1c, 0x9029317c,
266 			0xfdf8e802, 0x04272f70, 0x80bb155c, 0x05282ce3,
267 			0x95c11548, 0xe4c66d22, 0x48c1133f, 0xc70f86dc,
268 			0x07f9c9ee, 0x41041f0f, 0x404779a4, 0x5d886e17,
269 			0x325f51eb, 0xd59bc0d1, 0xf2bcc18f, 0x41113564,
270 			0x257b7834, 0x602a9c60, 0xdff8e8a3, 0x1f636c1b,
271 			0x0e12b4c2, 0x02e1329e, 0xaf664fd1, 0xcad18115,
272 			0x6b2395e0, 0x333e92e1, 0x3b240b62, 0xeebeb922,
273 			0x85b2a20e, 0xe6ba0d99, 0xde720c8c, 0x2da2f728,
274 			0xd0127845, 0x95b794fd, 0x647d0862, 0xe7ccf5f0,
275 			0x5449a36f, 0x877d48fa, 0xc39dfd27, 0xf33e8d1e,
276 			0x0a476341, 0x992eff74, 0x3a6f6eab, 0xf4f8fd37,
277 			0xa812dc60, 0xa1ebddf8, 0x991be14c, 0xdb6e6b0d,
278 			0xc67b5510, 0x6d672c37, 0x2765d43b, 0xdcd0e804,
279 			0xf1290dc7, 0xcc00ffa3, 0xb5390f92, 0x690fed0b,
280 			0x667b9ffb, 0xcedb7d9c, 0xa091cf0b, 0xd9155ea3,
281 			0xbb132f88, 0x515bad24, 0x7b9479bf, 0x763bd6eb,
282 			0x37392eb3, 0xcc115979, 0x8026e297, 0xf42e312d,
283 			0x6842ada7, 0xc66a2b3b, 0x12754ccc, 0x782ef11c,
284 			0x6a124237, 0xb79251e7, 0x06a1bbe6, 0x4bfb6350,
285 			0x1a6b1018, 0x11caedfa, 0x3d25bdd8, 0xe2e1c3c9,
286 			0x44421659, 0x0a121386, 0xd90cec6e, 0xd5abea2a,
287 			0x64af674e, 0xda86a85f, 0xbebfe988, 0x64e4c3fe,
288 			0x9dbc8057, 0xf0f7c086, 0x60787bf8, 0x6003604d,
289 			0xd1fd8346, 0xf6381fb0, 0x7745ae04, 0xd736fccc,
290 			0x83426b33, 0xf01eab71, 0xb0804187, 0x3c005e5f,
291 			0x77a057be, 0xbde8ae24, 0x55464299, 0xbf582e61,
292 			0x4e58f48f, 0xf2ddfda2, 0xf474ef38, 0x8789bdc2,
293 			0x5366f9c3, 0xc8b38e74, 0xb475f255, 0x46fcd9b9,
294 			0x7aeb2661, 0x8b1ddf84, 0x846a0e79, 0x915f95e2,
295 			0x466e598e, 0x20b45770, 0x8cd55591, 0xc902de4c,
296 			0xb90bace1, 0xbb8205d0, 0x11a86248, 0x7574a99e,
297 			0xb77f19b6, 0xe0a9dc09, 0x662d09a1, 0xc4324633,
298 			0xe85a1f02, 0x09f0be8c, 0x4a99a025, 0x1d6efe10,
299 			0x1ab93d1d, 0x0ba5a4df, 0xa186f20f, 0x2868f169,
300 			0xdcb7da83, 0x573906fe, 0xa1e2ce9b, 0x4fcd7f52,
301 			0x50115e01, 0xa70683fa, 0xa002b5c4, 0x0de6d027,
302 			0x9af88c27, 0x773f8641, 0xc3604c06, 0x61a806b5,
303 			0xf0177a28, 0xc0f586e0, 0x006058aa, 0x30dc7d62,
304 			0x11e69ed7, 0x2338ea63, 0x53c2dd94, 0xc2c21634,
305 			0xbbcbee56, 0x90bcb6de, 0xebfc7da1, 0xce591d76,
306 			0x6f05e409, 0x4b7c0188, 0x39720a3d, 0x7c927c24,
307 			0x86e3725f, 0x724d9db9, 0x1ac15bb4, 0xd39eb8fc,
308 			0xed545578, 0x08fca5b5, 0xd83d7cd3, 0x4dad0fc4,
309 			0x1e50ef5e, 0xb161e6f8, 0xa28514d9, 0x6c51133c,
310 			0x6fd5c7e7, 0x56e14ec4, 0x362abfce, 0xddc6c837,
311 		0xd79a3234, 0x92638212, 0x670efa8e, 0x406000e0},
312 		{
313 			0x3a39ce37, 0xd3faf5cf, 0xabc27737, 0x5ac52d1b,
314 			0x5cb0679e, 0x4fa33742, 0xd3822740, 0x99bc9bbe,
315 			0xd5118e9d, 0xbf0f7315, 0xd62d1c7e, 0xc700c47b,
316 			0xb78c1b6b, 0x21a19045, 0xb26eb1be, 0x6a366eb4,
317 			0x5748ab2f, 0xbc946e79, 0xc6a376d2, 0x6549c2c8,
318 			0x530ff8ee, 0x468dde7d, 0xd5730a1d, 0x4cd04dc6,
319 			0x2939bbdb, 0xa9ba4650, 0xac9526e8, 0xbe5ee304,
320 			0xa1fad5f0, 0x6a2d519a, 0x63ef8ce2, 0x9a86ee22,
321 			0xc089c2b8, 0x43242ef6, 0xa51e03aa, 0x9cf2d0a4,
322 			0x83c061ba, 0x9be96a4d, 0x8fe51550, 0xba645bd6,
323 			0x2826a2f9, 0xa73a3ae1, 0x4ba99586, 0xef5562e9,
324 			0xc72fefd3, 0xf752f7da, 0x3f046f69, 0x77fa0a59,
325 			0x80e4a915, 0x87b08601, 0x9b09e6ad, 0x3b3ee593,
326 			0xe990fd5a, 0x9e34d797, 0x2cf0b7d9, 0x022b8b51,
327 			0x96d5ac3a, 0x017da67d, 0xd1cf3ed6, 0x7c7d2d28,
328 			0x1f9f25cf, 0xadf2b89b, 0x5ad6b472, 0x5a88f54c,
329 			0xe029ac71, 0xe019a5e6, 0x47b0acfd, 0xed93fa9b,
330 			0xe8d3c48d, 0x283b57cc, 0xf8d56629, 0x79132e28,
331 			0x785f0191, 0xed756055, 0xf7960e44, 0xe3d35e8c,
332 			0x15056dd4, 0x88f46dba, 0x03a16125, 0x0564f0bd,
333 			0xc3eb9e15, 0x3c9057a2, 0x97271aec, 0xa93a072a,
334 			0x1b3f6d9b, 0x1e6321f5, 0xf59c66fb, 0x26dcf319,
335 			0x7533d928, 0xb155fdf5, 0x03563482, 0x8aba3cbb,
336 			0x28517711, 0xc20ad9f8, 0xabcc5167, 0xccad925f,
337 			0x4de81751, 0x3830dc8e, 0x379d5862, 0x9320f991,
338 			0xea7a90c2, 0xfb3e7bce, 0x5121ce64, 0x774fbe32,
339 			0xa8b6e37e, 0xc3293d46, 0x48de5369, 0x6413e680,
340 			0xa2ae0810, 0xdd6db224, 0x69852dfd, 0x09072166,
341 			0xb39a460a, 0x6445c0dd, 0x586cdecf, 0x1c20c8ae,
342 			0x5bbef7dd, 0x1b588d40, 0xccd2017f, 0x6bb4e3bb,
343 			0xdda26a7e, 0x3a59ff45, 0x3e350a44, 0xbcb4cdd5,
344 			0x72eacea8, 0xfa6484bb, 0x8d6612ae, 0xbf3c6f47,
345 			0xd29be463, 0x542f5d9e, 0xaec2771b, 0xf64e6370,
346 			0x740e0d8d, 0xe75b1357, 0xf8721671, 0xaf537d5d,
347 			0x4040cb08, 0x4eb4e2cc, 0x34d2466a, 0x0115af84,
348 			0xe1b00428, 0x95983a1d, 0x06b89fb4, 0xce6ea048,
349 			0x6f3f3b82, 0x3520ab82, 0x011a1d4b, 0x277227f8,
350 			0x611560b1, 0xe7933fdc, 0xbb3a792b, 0x344525bd,
351 			0xa08839e1, 0x51ce794b, 0x2f32c9b7, 0xa01fbac9,
352 			0xe01cc87e, 0xbcc7d1f6, 0xcf0111c3, 0xa1e8aac7,
353 			0x1a908749, 0xd44fbd9a, 0xd0dadecb, 0xd50ada38,
354 			0x0339c32a, 0xc6913667, 0x8df9317c, 0xe0b12b4f,
355 			0xf79e59b7, 0x43f5bb3a, 0xf2d519ff, 0x27d9459c,
356 			0xbf97222c, 0x15e6fc2a, 0x0f91fc71, 0x9b941525,
357 			0xfae59361, 0xceb69ceb, 0xc2a86459, 0x12baa8d1,
358 			0xb6c1075e, 0xe3056a0c, 0x10d25065, 0xcb03a442,
359 			0xe0ec6e0e, 0x1698db3b, 0x4c98a0be, 0x3278e964,
360 			0x9f1f9532, 0xe0d392df, 0xd3a0342b, 0x8971f21e,
361 			0x1b0a7441, 0x4ba3348c, 0xc5be7120, 0xc37632d8,
362 			0xdf359f8d, 0x9b992f2e, 0xe60b6f47, 0x0fe3f11d,
363 			0xe54cda54, 0x1edad891, 0xce6279cf, 0xcd3e7e6f,
364 			0x1618b166, 0xfd2c1d05, 0x848fd2c5, 0xf6fb2299,
365 			0xf523f357, 0xa6327623, 0x93a83531, 0x56cccd02,
366 			0xacf08162, 0x5a75ebb5, 0x6e163697, 0x88d273cc,
367 			0xde966292, 0x81b949d0, 0x4c50901b, 0x71c65614,
368 			0xe6c6c7bd, 0x327a140a, 0x45e1d006, 0xc3f27b9a,
369 			0xc9aa53fd, 0x62a80f00, 0xbb25bfe2, 0x35bdd2f6,
370 			0x71126905, 0xb2040222, 0xb6cbcf7c, 0xcd769c2b,
371 			0x53113ec0, 0x1640e3d3, 0x38abbd60, 0x2547adf0,
372 			0xba38209c, 0xf746ce76, 0x77afa1c5, 0x20756060,
373 			0x85cbfe4e, 0x8ae88dd8, 0x7aaaf9b0, 0x4cf9aa7e,
374 			0x1948c25c, 0x02fb8a8c, 0x01c36ae4, 0xd6ebe1f9,
375 			0x90d4f869, 0xa65cdea0, 0x3f09252d, 0xc208e69f,
376 		0xb74e6132, 0xce77e25b, 0x578fdfe3, 0x3ac372e6}
377 	},
378 	{
379 		0x243f6a88, 0x85a308d3, 0x13198a2e, 0x03707344,
380 		0xa4093822, 0x299f31d0, 0x082efa98, 0xec4e6c89,
381 		0x452821e6, 0x38d01377, 0xbe5466cf, 0x34e90c6c,
382 		0xc0ac29b7, 0xc97c50dd, 0x3f84d5b5, 0xb5470917,
383 		0x9216d5d9, 0x8979fb1b
384 	} };
385 
386 	*c = init_state;
387 
388 }
389 
390 static u_int32_t
391 Blowfish_stream2word(const u_int8_t *data, u_int16_t databytes, u_int16_t *current)
392 {
393 	u_int8_t i;
394 	u_int16_t j;
395 	u_int32_t temp;
396 
397 	temp = 0x00000000;
398 	j = *current;
399 
400 	for (i = 0; i < 4; i++, j++) {
401 		if (j >= databytes)
402 			j = 0;
403 		temp = (temp << 8) | data[j];
404 	}
405 
406 	*current = j;
407 	return temp;
408 }
409 
410 static void
411 Blowfish_expand0state(blf_ctx *c, const u_int8_t *key, u_int16_t keybytes)
412 {
413 	u_int16_t i;
414 	u_int16_t j;
415 	u_int16_t k;
416 	u_int32_t temp;
417 	u_int32_t datal;
418 	u_int32_t datar;
419 
420 	j = 0;
421 	for (i = 0; i < BLF_N + 2; i++) {
422 		/* Extract 4 int8 to 1 int32 from keystream */
423 		temp = Blowfish_stream2word(key, keybytes, &j);
424 		c->P[i] = c->P[i] ^ temp;
425 	}
426 
427 	j = 0;
428 	datal = 0x00000000;
429 	datar = 0x00000000;
430 	for (i = 0; i < BLF_N + 2; i += 2) {
431 		Blowfish_encipher(c, &datal, &datar);
432 
433 		c->P[i] = datal;
434 		c->P[i + 1] = datar;
435 	}
436 
437 	for (i = 0; i < 4; i++) {
438 		for (k = 0; k < 256; k += 2) {
439 			Blowfish_encipher(c, &datal, &datar);
440 
441 			c->S[i][k] = datal;
442 			c->S[i][k + 1] = datar;
443 		}
444 	}
445 }
446 
447 
448 static void
449 Blowfish_expandstate(blf_ctx *c, const u_int8_t *data, u_int16_t databytes,
450 		     const u_int8_t *key, u_int16_t keybytes)
451 {
452 	u_int16_t i;
453 	u_int16_t j;
454 	u_int16_t k;
455 	u_int32_t temp;
456 	u_int32_t datal;
457 	u_int32_t datar;
458 
459 	j = 0;
460 	for (i = 0; i < BLF_N + 2; i++) {
461 		/* Extract 4 int8 to 1 int32 from keystream */
462 		temp = Blowfish_stream2word(key, keybytes, &j);
463 		c->P[i] = c->P[i] ^ temp;
464 	}
465 
466 	j = 0;
467 	datal = 0x00000000;
468 	datar = 0x00000000;
469 	for (i = 0; i < BLF_N + 2; i += 2) {
470 		datal ^= Blowfish_stream2word(data, databytes, &j);
471 		datar ^= Blowfish_stream2word(data, databytes, &j);
472 		Blowfish_encipher(c, &datal, &datar);
473 
474 		c->P[i] = datal;
475 		c->P[i + 1] = datar;
476 	}
477 
478 	for (i = 0; i < 4; i++) {
479 		for (k = 0; k < 256; k += 2) {
480 			datal ^= Blowfish_stream2word(data, databytes, &j);
481 			datar ^= Blowfish_stream2word(data, databytes, &j);
482 			Blowfish_encipher(c, &datal, &datar);
483 
484 			c->S[i][k] = datal;
485 			c->S[i][k + 1] = datar;
486 		}
487 	}
488 
489 }
490 
491 static void
492 blf_enc(blf_ctx *c, u_int32_t *data, u_int16_t blocks)
493 {
494 	u_int32_t *d;
495 	u_int16_t i;
496 
497 	d = data;
498 	for (i = 0; i < blocks; i++) {
499 		Blowfish_encipher(c, d, d + 1);
500 		d += 2;
501 	}
502 }
503