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