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