~vcs-imports/mammoth-replicator/trunk

« back to all changes in this revision

Viewing changes to contrib/pgcrypto/crypt-blowfish.c

  • Committer: alvherre
  • Date: 2005-12-16 21:24:52 UTC
  • Revision ID: svn-v4:db760fc0-0f08-0410-9d63-cc6633f64896:trunk:1
Initial import of the REL8_0_3 sources from the Pgsql CVS repository.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/*
 
2
 * This code comes from John the Ripper password cracker, with reentrant
 
3
 * and crypt(3) interfaces added, but optimizations specific to password
 
4
 * cracking removed.
 
5
 *
 
6
 * Written by Solar Designer <solar@openwall.com> in 1998-2001, and placed
 
7
 * in the public domain.
 
8
 *
 
9
 * There's absolutely no warranty.
 
10
 *
 
11
 * It is my intent that you should be able to use this on your system,
 
12
 * as a part of a software package, or anywhere else to improve security,
 
13
 * ensure compatibility, or for any other purpose. I would appreciate
 
14
 * it if you give credit where it is due and keep your modifications in
 
15
 * the public domain as well, but I don't require that in order to let
 
16
 * you place this code and any modifications you make under a license
 
17
 * of your choice.
 
18
 *
 
19
 * This implementation is compatible with OpenBSD bcrypt.c (version 2a)
 
20
 * by Niels Provos <provos@physnet.uni-hamburg.de>, and uses some of his
 
21
 * ideas. The password hashing algorithm was designed by David Mazieres
 
22
 * <dm@lcs.mit.edu>.
 
23
 *
 
24
 * There's a paper on the algorithm that explains its design decisions:
 
25
 *
 
26
 *      http://www.usenix.org/events/usenix99/provos.html
 
27
 *
 
28
 * Some of the tricks in BF_ROUND might be inspired by Eric Young's
 
29
 * Blowfish library (I can't be sure if I would think of something if I
 
30
 * hadn't seen his code).
 
31
 */
 
32
 
 
33
#include "postgres.h"
 
34
 
 
35
#include "px.h"
 
36
#include "px-crypt.h"
 
37
 
 
38
#define __set_errno(v)
 
39
 
 
40
#ifndef __set_errno
 
41
#define __set_errno(val) errno = (val)
 
42
#endif
 
43
 
 
44
#ifdef __i386__
 
45
#define BF_ASM                          0       /* 1 */
 
46
#define BF_SCALE                        1
 
47
#elif defined(__alpha__)
 
48
#define BF_ASM                          0
 
49
#define BF_SCALE                        1
 
50
#else
 
51
#define BF_ASM                          0
 
52
#define BF_SCALE                        0
 
53
#endif
 
54
 
 
55
typedef unsigned int BF_word;
 
56
 
 
57
/* Number of Blowfish rounds, this is also hardcoded into a few places */
 
58
#define BF_N                            16
 
59
 
 
60
typedef BF_word BF_key[BF_N + 2];
 
61
 
 
62
typedef struct
 
63
{
 
64
        BF_word         S[4][0x100];
 
65
        BF_key          P;
 
66
}       BF_ctx;
 
67
 
 
68
/*
 
69
 * Magic IV for 64 Blowfish encryptions that we do at the end.
 
70
 * The string is "OrpheanBeholderScryDoubt" on big-endian.
 
71
 */
 
72
static BF_word BF_magic_w[6] = {
 
73
        0x4F727068, 0x65616E42, 0x65686F6C,
 
74
        0x64657253, 0x63727944, 0x6F756274
 
75
};
 
76
 
 
77
/*
 
78
 * P-box and S-box tables initialized with digits of Pi.
 
79
 */
 
80
static BF_ctx BF_init_state = {
 
81
        {
 
82
                {
 
83
                        0xd1310ba6, 0x98dfb5ac, 0x2ffd72db, 0xd01adfb7,
 
84
                        0xb8e1afed, 0x6a267e96, 0xba7c9045, 0xf12c7f99,
 
85
                        0x24a19947, 0xb3916cf7, 0x0801f2e2, 0x858efc16,
 
86
                        0x636920d8, 0x71574e69, 0xa458fea3, 0xf4933d7e,
 
87
                        0x0d95748f, 0x728eb658, 0x718bcd58, 0x82154aee,
 
88
                        0x7b54a41d, 0xc25a59b5, 0x9c30d539, 0x2af26013,
 
89
                        0xc5d1b023, 0x286085f0, 0xca417918, 0xb8db38ef,
 
90
                        0x8e79dcb0, 0x603a180e, 0x6c9e0e8b, 0xb01e8a3e,
 
91
                        0xd71577c1, 0xbd314b27, 0x78af2fda, 0x55605c60,
 
92
                        0xe65525f3, 0xaa55ab94, 0x57489862, 0x63e81440,
 
93
                        0x55ca396a, 0x2aab10b6, 0xb4cc5c34, 0x1141e8ce,
 
94
                        0xa15486af, 0x7c72e993, 0xb3ee1411, 0x636fbc2a,
 
95
                        0x2ba9c55d, 0x741831f6, 0xce5c3e16, 0x9b87931e,
 
96
                        0xafd6ba33, 0x6c24cf5c, 0x7a325381, 0x28958677,
 
97
                        0x3b8f4898, 0x6b4bb9af, 0xc4bfe81b, 0x66282193,
 
98
                        0x61d809cc, 0xfb21a991, 0x487cac60, 0x5dec8032,
 
99
                        0xef845d5d, 0xe98575b1, 0xdc262302, 0xeb651b88,
 
100
                        0x23893e81, 0xd396acc5, 0x0f6d6ff3, 0x83f44239,
 
101
                        0x2e0b4482, 0xa4842004, 0x69c8f04a, 0x9e1f9b5e,
 
102
                        0x21c66842, 0xf6e96c9a, 0x670c9c61, 0xabd388f0,
 
103
                        0x6a51a0d2, 0xd8542f68, 0x960fa728, 0xab5133a3,
 
104
                        0x6eef0b6c, 0x137a3be4, 0xba3bf050, 0x7efb2a98,
 
105
                        0xa1f1651d, 0x39af0176, 0x66ca593e, 0x82430e88,
 
106
                        0x8cee8619, 0x456f9fb4, 0x7d84a5c3, 0x3b8b5ebe,
 
107
                        0xe06f75d8, 0x85c12073, 0x401a449f, 0x56c16aa6,
 
108
                        0x4ed3aa62, 0x363f7706, 0x1bfedf72, 0x429b023d,
 
109
                        0x37d0d724, 0xd00a1248, 0xdb0fead3, 0x49f1c09b,
 
110
                        0x075372c9, 0x80991b7b, 0x25d479d8, 0xf6e8def7,
 
111
                        0xe3fe501a, 0xb6794c3b, 0x976ce0bd, 0x04c006ba,
 
112
                        0xc1a94fb6, 0x409f60c4, 0x5e5c9ec2, 0x196a2463,
 
113
                        0x68fb6faf, 0x3e6c53b5, 0x1339b2eb, 0x3b52ec6f,
 
114
                        0x6dfc511f, 0x9b30952c, 0xcc814544, 0xaf5ebd09,
 
115
                        0xbee3d004, 0xde334afd, 0x660f2807, 0x192e4bb3,
 
116
                        0xc0cba857, 0x45c8740f, 0xd20b5f39, 0xb9d3fbdb,
 
117
                        0x5579c0bd, 0x1a60320a, 0xd6a100c6, 0x402c7279,
 
118
                        0x679f25fe, 0xfb1fa3cc, 0x8ea5e9f8, 0xdb3222f8,
 
119
                        0x3c7516df, 0xfd616b15, 0x2f501ec8, 0xad0552ab,
 
120
                        0x323db5fa, 0xfd238760, 0x53317b48, 0x3e00df82,
 
121
                        0x9e5c57bb, 0xca6f8ca0, 0x1a87562e, 0xdf1769db,
 
122
                        0xd542a8f6, 0x287effc3, 0xac6732c6, 0x8c4f5573,
 
123
                        0x695b27b0, 0xbbca58c8, 0xe1ffa35d, 0xb8f011a0,
 
124
                        0x10fa3d98, 0xfd2183b8, 0x4afcb56c, 0x2dd1d35b,
 
125
                        0x9a53e479, 0xb6f84565, 0xd28e49bc, 0x4bfb9790,
 
126
                        0xe1ddf2da, 0xa4cb7e33, 0x62fb1341, 0xcee4c6e8,
 
127
                        0xef20cada, 0x36774c01, 0xd07e9efe, 0x2bf11fb4,
 
128
                        0x95dbda4d, 0xae909198, 0xeaad8e71, 0x6b93d5a0,
 
129
                        0xd08ed1d0, 0xafc725e0, 0x8e3c5b2f, 0x8e7594b7,
 
130
                        0x8ff6e2fb, 0xf2122b64, 0x8888b812, 0x900df01c,
 
131
                        0x4fad5ea0, 0x688fc31c, 0xd1cff191, 0xb3a8c1ad,
 
132
                        0x2f2f2218, 0xbe0e1777, 0xea752dfe, 0x8b021fa1,
 
133
                        0xe5a0cc0f, 0xb56f74e8, 0x18acf3d6, 0xce89e299,
 
134
                        0xb4a84fe0, 0xfd13e0b7, 0x7cc43b81, 0xd2ada8d9,
 
135
                        0x165fa266, 0x80957705, 0x93cc7314, 0x211a1477,
 
136
                        0xe6ad2065, 0x77b5fa86, 0xc75442f5, 0xfb9d35cf,
 
137
                        0xebcdaf0c, 0x7b3e89a0, 0xd6411bd3, 0xae1e7e49,
 
138
                        0x00250e2d, 0x2071b35e, 0x226800bb, 0x57b8e0af,
 
139
                        0x2464369b, 0xf009b91e, 0x5563911d, 0x59dfa6aa,
 
140
                        0x78c14389, 0xd95a537f, 0x207d5ba2, 0x02e5b9c5,
 
141
                        0x83260376, 0x6295cfa9, 0x11c81968, 0x4e734a41,
 
142
                        0xb3472dca, 0x7b14a94a, 0x1b510052, 0x9a532915,
 
143
                        0xd60f573f, 0xbc9bc6e4, 0x2b60a476, 0x81e67400,
 
144
                        0x08ba6fb5, 0x571be91f, 0xf296ec6b, 0x2a0dd915,
 
145
                        0xb6636521, 0xe7b9f9b6, 0xff34052e, 0xc5855664,
 
146
                        0x53b02d5d, 0xa99f8fa1, 0x08ba4799, 0x6e85076a
 
147
                }, {
 
148
                        0x4b7a70e9, 0xb5b32944, 0xdb75092e, 0xc4192623,
 
149
                        0xad6ea6b0, 0x49a7df7d, 0x9cee60b8, 0x8fedb266,
 
150
                        0xecaa8c71, 0x699a17ff, 0x5664526c, 0xc2b19ee1,
 
151
                        0x193602a5, 0x75094c29, 0xa0591340, 0xe4183a3e,
 
152
                        0x3f54989a, 0x5b429d65, 0x6b8fe4d6, 0x99f73fd6,
 
153
                        0xa1d29c07, 0xefe830f5, 0x4d2d38e6, 0xf0255dc1,
 
154
                        0x4cdd2086, 0x8470eb26, 0x6382e9c6, 0x021ecc5e,
 
155
                        0x09686b3f, 0x3ebaefc9, 0x3c971814, 0x6b6a70a1,
 
156
                        0x687f3584, 0x52a0e286, 0xb79c5305, 0xaa500737,
 
157
                        0x3e07841c, 0x7fdeae5c, 0x8e7d44ec, 0x5716f2b8,
 
158
                        0xb03ada37, 0xf0500c0d, 0xf01c1f04, 0x0200b3ff,
 
159
                        0xae0cf51a, 0x3cb574b2, 0x25837a58, 0xdc0921bd,
 
160
                        0xd19113f9, 0x7ca92ff6, 0x94324773, 0x22f54701,
 
161
                        0x3ae5e581, 0x37c2dadc, 0xc8b57634, 0x9af3dda7,
 
162
                        0xa9446146, 0x0fd0030e, 0xecc8c73e, 0xa4751e41,
 
163
                        0xe238cd99, 0x3bea0e2f, 0x3280bba1, 0x183eb331,
 
164
                        0x4e548b38, 0x4f6db908, 0x6f420d03, 0xf60a04bf,
 
165
                        0x2cb81290, 0x24977c79, 0x5679b072, 0xbcaf89af,
 
166
                        0xde9a771f, 0xd9930810, 0xb38bae12, 0xdccf3f2e,
 
167
                        0x5512721f, 0x2e6b7124, 0x501adde6, 0x9f84cd87,
 
168
                        0x7a584718, 0x7408da17, 0xbc9f9abc, 0xe94b7d8c,
 
169
                        0xec7aec3a, 0xdb851dfa, 0x63094366, 0xc464c3d2,
 
170
                        0xef1c1847, 0x3215d908, 0xdd433b37, 0x24c2ba16,
 
171
                        0x12a14d43, 0x2a65c451, 0x50940002, 0x133ae4dd,
 
172
                        0x71dff89e, 0x10314e55, 0x81ac77d6, 0x5f11199b,
 
173
                        0x043556f1, 0xd7a3c76b, 0x3c11183b, 0x5924a509,
 
174
                        0xf28fe6ed, 0x97f1fbfa, 0x9ebabf2c, 0x1e153c6e,
 
175
                        0x86e34570, 0xeae96fb1, 0x860e5e0a, 0x5a3e2ab3,
 
176
                        0x771fe71c, 0x4e3d06fa, 0x2965dcb9, 0x99e71d0f,
 
177
                        0x803e89d6, 0x5266c825, 0x2e4cc978, 0x9c10b36a,
 
178
                        0xc6150eba, 0x94e2ea78, 0xa5fc3c53, 0x1e0a2df4,
 
179
                        0xf2f74ea7, 0x361d2b3d, 0x1939260f, 0x19c27960,
 
180
                        0x5223a708, 0xf71312b6, 0xebadfe6e, 0xeac31f66,
 
181
                        0xe3bc4595, 0xa67bc883, 0xb17f37d1, 0x018cff28,
 
182
                        0xc332ddef, 0xbe6c5aa5, 0x65582185, 0x68ab9802,
 
183
                        0xeecea50f, 0xdb2f953b, 0x2aef7dad, 0x5b6e2f84,
 
184
                        0x1521b628, 0x29076170, 0xecdd4775, 0x619f1510,
 
185
                        0x13cca830, 0xeb61bd96, 0x0334fe1e, 0xaa0363cf,
 
186
                        0xb5735c90, 0x4c70a239, 0xd59e9e0b, 0xcbaade14,
 
187
                        0xeecc86bc, 0x60622ca7, 0x9cab5cab, 0xb2f3846e,
 
188
                        0x648b1eaf, 0x19bdf0ca, 0xa02369b9, 0x655abb50,
 
189
                        0x40685a32, 0x3c2ab4b3, 0x319ee9d5, 0xc021b8f7,
 
190
                        0x9b540b19, 0x875fa099, 0x95f7997e, 0x623d7da8,
 
191
                        0xf837889a, 0x97e32d77, 0x11ed935f, 0x16681281,
 
192
                        0x0e358829, 0xc7e61fd6, 0x96dedfa1, 0x7858ba99,
 
193
                        0x57f584a5, 0x1b227263, 0x9b83c3ff, 0x1ac24696,
 
194
                        0xcdb30aeb, 0x532e3054, 0x8fd948e4, 0x6dbc3128,
 
195
                        0x58ebf2ef, 0x34c6ffea, 0xfe28ed61, 0xee7c3c73,
 
196
                        0x5d4a14d9, 0xe864b7e3, 0x42105d14, 0x203e13e0,
 
197
                        0x45eee2b6, 0xa3aaabea, 0xdb6c4f15, 0xfacb4fd0,
 
198
                        0xc742f442, 0xef6abbb5, 0x654f3b1d, 0x41cd2105,
 
199
                        0xd81e799e, 0x86854dc7, 0xe44b476a, 0x3d816250,
 
200
                        0xcf62a1f2, 0x5b8d2646, 0xfc8883a0, 0xc1c7b6a3,
 
201
                        0x7f1524c3, 0x69cb7492, 0x47848a0b, 0x5692b285,
 
202
                        0x095bbf00, 0xad19489d, 0x1462b174, 0x23820e00,
 
203
                        0x58428d2a, 0x0c55f5ea, 0x1dadf43e, 0x233f7061,
 
204
                        0x3372f092, 0x8d937e41, 0xd65fecf1, 0x6c223bdb,
 
205
                        0x7cde3759, 0xcbee7460, 0x4085f2a7, 0xce77326e,
 
206
                        0xa6078084, 0x19f8509e, 0xe8efd855, 0x61d99735,
 
207
                        0xa969a7aa, 0xc50c06c2, 0x5a04abfc, 0x800bcadc,
 
208
                        0x9e447a2e, 0xc3453484, 0xfdd56705, 0x0e1e9ec9,
 
209
                        0xdb73dbd3, 0x105588cd, 0x675fda79, 0xe3674340,
 
210
                        0xc5c43465, 0x713e38d8, 0x3d28f89e, 0xf16dff20,
 
211
                        0x153e21e7, 0x8fb03d4a, 0xe6e39f2b, 0xdb83adf7
 
212
                }, {
 
213
                        0xe93d5a68, 0x948140f7, 0xf64c261c, 0x94692934,
 
214
                        0x411520f7, 0x7602d4f7, 0xbcf46b2e, 0xd4a20068,
 
215
                        0xd4082471, 0x3320f46a, 0x43b7d4b7, 0x500061af,
 
216
                        0x1e39f62e, 0x97244546, 0x14214f74, 0xbf8b8840,
 
217
                        0x4d95fc1d, 0x96b591af, 0x70f4ddd3, 0x66a02f45,
 
218
                        0xbfbc09ec, 0x03bd9785, 0x7fac6dd0, 0x31cb8504,
 
219
                        0x96eb27b3, 0x55fd3941, 0xda2547e6, 0xabca0a9a,
 
220
                        0x28507825, 0x530429f4, 0x0a2c86da, 0xe9b66dfb,
 
221
                        0x68dc1462, 0xd7486900, 0x680ec0a4, 0x27a18dee,
 
222
                        0x4f3ffea2, 0xe887ad8c, 0xb58ce006, 0x7af4d6b6,
 
223
                        0xaace1e7c, 0xd3375fec, 0xce78a399, 0x406b2a42,
 
224
                        0x20fe9e35, 0xd9f385b9, 0xee39d7ab, 0x3b124e8b,
 
225
                        0x1dc9faf7, 0x4b6d1856, 0x26a36631, 0xeae397b2,
 
226
                        0x3a6efa74, 0xdd5b4332, 0x6841e7f7, 0xca7820fb,
 
227
                        0xfb0af54e, 0xd8feb397, 0x454056ac, 0xba489527,
 
228
                        0x55533a3a, 0x20838d87, 0xfe6ba9b7, 0xd096954b,
 
229
                        0x55a867bc, 0xa1159a58, 0xcca92963, 0x99e1db33,
 
230
                        0xa62a4a56, 0x3f3125f9, 0x5ef47e1c, 0x9029317c,
 
231
                        0xfdf8e802, 0x04272f70, 0x80bb155c, 0x05282ce3,
 
232
                        0x95c11548, 0xe4c66d22, 0x48c1133f, 0xc70f86dc,
 
233
                        0x07f9c9ee, 0x41041f0f, 0x404779a4, 0x5d886e17,
 
234
                        0x325f51eb, 0xd59bc0d1, 0xf2bcc18f, 0x41113564,
 
235
                        0x257b7834, 0x602a9c60, 0xdff8e8a3, 0x1f636c1b,
 
236
                        0x0e12b4c2, 0x02e1329e, 0xaf664fd1, 0xcad18115,
 
237
                        0x6b2395e0, 0x333e92e1, 0x3b240b62, 0xeebeb922,
 
238
                        0x85b2a20e, 0xe6ba0d99, 0xde720c8c, 0x2da2f728,
 
239
                        0xd0127845, 0x95b794fd, 0x647d0862, 0xe7ccf5f0,
 
240
                        0x5449a36f, 0x877d48fa, 0xc39dfd27, 0xf33e8d1e,
 
241
                        0x0a476341, 0x992eff74, 0x3a6f6eab, 0xf4f8fd37,
 
242
                        0xa812dc60, 0xa1ebddf8, 0x991be14c, 0xdb6e6b0d,
 
243
                        0xc67b5510, 0x6d672c37, 0x2765d43b, 0xdcd0e804,
 
244
                        0xf1290dc7, 0xcc00ffa3, 0xb5390f92, 0x690fed0b,
 
245
                        0x667b9ffb, 0xcedb7d9c, 0xa091cf0b, 0xd9155ea3,
 
246
                        0xbb132f88, 0x515bad24, 0x7b9479bf, 0x763bd6eb,
 
247
                        0x37392eb3, 0xcc115979, 0x8026e297, 0xf42e312d,
 
248
                        0x6842ada7, 0xc66a2b3b, 0x12754ccc, 0x782ef11c,
 
249
                        0x6a124237, 0xb79251e7, 0x06a1bbe6, 0x4bfb6350,
 
250
                        0x1a6b1018, 0x11caedfa, 0x3d25bdd8, 0xe2e1c3c9,
 
251
                        0x44421659, 0x0a121386, 0xd90cec6e, 0xd5abea2a,
 
252
                        0x64af674e, 0xda86a85f, 0xbebfe988, 0x64e4c3fe,
 
253
                        0x9dbc8057, 0xf0f7c086, 0x60787bf8, 0x6003604d,
 
254
                        0xd1fd8346, 0xf6381fb0, 0x7745ae04, 0xd736fccc,
 
255
                        0x83426b33, 0xf01eab71, 0xb0804187, 0x3c005e5f,
 
256
                        0x77a057be, 0xbde8ae24, 0x55464299, 0xbf582e61,
 
257
                        0x4e58f48f, 0xf2ddfda2, 0xf474ef38, 0x8789bdc2,
 
258
                        0x5366f9c3, 0xc8b38e74, 0xb475f255, 0x46fcd9b9,
 
259
                        0x7aeb2661, 0x8b1ddf84, 0x846a0e79, 0x915f95e2,
 
260
                        0x466e598e, 0x20b45770, 0x8cd55591, 0xc902de4c,
 
261
                        0xb90bace1, 0xbb8205d0, 0x11a86248, 0x7574a99e,
 
262
                        0xb77f19b6, 0xe0a9dc09, 0x662d09a1, 0xc4324633,
 
263
                        0xe85a1f02, 0x09f0be8c, 0x4a99a025, 0x1d6efe10,
 
264
                        0x1ab93d1d, 0x0ba5a4df, 0xa186f20f, 0x2868f169,
 
265
                        0xdcb7da83, 0x573906fe, 0xa1e2ce9b, 0x4fcd7f52,
 
266
                        0x50115e01, 0xa70683fa, 0xa002b5c4, 0x0de6d027,
 
267
                        0x9af88c27, 0x773f8641, 0xc3604c06, 0x61a806b5,
 
268
                        0xf0177a28, 0xc0f586e0, 0x006058aa, 0x30dc7d62,
 
269
                        0x11e69ed7, 0x2338ea63, 0x53c2dd94, 0xc2c21634,
 
270
                        0xbbcbee56, 0x90bcb6de, 0xebfc7da1, 0xce591d76,
 
271
                        0x6f05e409, 0x4b7c0188, 0x39720a3d, 0x7c927c24,
 
272
                        0x86e3725f, 0x724d9db9, 0x1ac15bb4, 0xd39eb8fc,
 
273
                        0xed545578, 0x08fca5b5, 0xd83d7cd3, 0x4dad0fc4,
 
274
                        0x1e50ef5e, 0xb161e6f8, 0xa28514d9, 0x6c51133c,
 
275
                        0x6fd5c7e7, 0x56e14ec4, 0x362abfce, 0xddc6c837,
 
276
                        0xd79a3234, 0x92638212, 0x670efa8e, 0x406000e0
 
277
                }, {
 
278
                        0x3a39ce37, 0xd3faf5cf, 0xabc27737, 0x5ac52d1b,
 
279
                        0x5cb0679e, 0x4fa33742, 0xd3822740, 0x99bc9bbe,
 
280
                        0xd5118e9d, 0xbf0f7315, 0xd62d1c7e, 0xc700c47b,
 
281
                        0xb78c1b6b, 0x21a19045, 0xb26eb1be, 0x6a366eb4,
 
282
                        0x5748ab2f, 0xbc946e79, 0xc6a376d2, 0x6549c2c8,
 
283
                        0x530ff8ee, 0x468dde7d, 0xd5730a1d, 0x4cd04dc6,
 
284
                        0x2939bbdb, 0xa9ba4650, 0xac9526e8, 0xbe5ee304,
 
285
                        0xa1fad5f0, 0x6a2d519a, 0x63ef8ce2, 0x9a86ee22,
 
286
                        0xc089c2b8, 0x43242ef6, 0xa51e03aa, 0x9cf2d0a4,
 
287
                        0x83c061ba, 0x9be96a4d, 0x8fe51550, 0xba645bd6,
 
288
                        0x2826a2f9, 0xa73a3ae1, 0x4ba99586, 0xef5562e9,
 
289
                        0xc72fefd3, 0xf752f7da, 0x3f046f69, 0x77fa0a59,
 
290
                        0x80e4a915, 0x87b08601, 0x9b09e6ad, 0x3b3ee593,
 
291
                        0xe990fd5a, 0x9e34d797, 0x2cf0b7d9, 0x022b8b51,
 
292
                        0x96d5ac3a, 0x017da67d, 0xd1cf3ed6, 0x7c7d2d28,
 
293
                        0x1f9f25cf, 0xadf2b89b, 0x5ad6b472, 0x5a88f54c,
 
294
                        0xe029ac71, 0xe019a5e6, 0x47b0acfd, 0xed93fa9b,
 
295
                        0xe8d3c48d, 0x283b57cc, 0xf8d56629, 0x79132e28,
 
296
                        0x785f0191, 0xed756055, 0xf7960e44, 0xe3d35e8c,
 
297
                        0x15056dd4, 0x88f46dba, 0x03a16125, 0x0564f0bd,
 
298
                        0xc3eb9e15, 0x3c9057a2, 0x97271aec, 0xa93a072a,
 
299
                        0x1b3f6d9b, 0x1e6321f5, 0xf59c66fb, 0x26dcf319,
 
300
                        0x7533d928, 0xb155fdf5, 0x03563482, 0x8aba3cbb,
 
301
                        0x28517711, 0xc20ad9f8, 0xabcc5167, 0xccad925f,
 
302
                        0x4de81751, 0x3830dc8e, 0x379d5862, 0x9320f991,
 
303
                        0xea7a90c2, 0xfb3e7bce, 0x5121ce64, 0x774fbe32,
 
304
                        0xa8b6e37e, 0xc3293d46, 0x48de5369, 0x6413e680,
 
305
                        0xa2ae0810, 0xdd6db224, 0x69852dfd, 0x09072166,
 
306
                        0xb39a460a, 0x6445c0dd, 0x586cdecf, 0x1c20c8ae,
 
307
                        0x5bbef7dd, 0x1b588d40, 0xccd2017f, 0x6bb4e3bb,
 
308
                        0xdda26a7e, 0x3a59ff45, 0x3e350a44, 0xbcb4cdd5,
 
309
                        0x72eacea8, 0xfa6484bb, 0x8d6612ae, 0xbf3c6f47,
 
310
                        0xd29be463, 0x542f5d9e, 0xaec2771b, 0xf64e6370,
 
311
                        0x740e0d8d, 0xe75b1357, 0xf8721671, 0xaf537d5d,
 
312
                        0x4040cb08, 0x4eb4e2cc, 0x34d2466a, 0x0115af84,
 
313
                        0xe1b00428, 0x95983a1d, 0x06b89fb4, 0xce6ea048,
 
314
                        0x6f3f3b82, 0x3520ab82, 0x011a1d4b, 0x277227f8,
 
315
                        0x611560b1, 0xe7933fdc, 0xbb3a792b, 0x344525bd,
 
316
                        0xa08839e1, 0x51ce794b, 0x2f32c9b7, 0xa01fbac9,
 
317
                        0xe01cc87e, 0xbcc7d1f6, 0xcf0111c3, 0xa1e8aac7,
 
318
                        0x1a908749, 0xd44fbd9a, 0xd0dadecb, 0xd50ada38,
 
319
                        0x0339c32a, 0xc6913667, 0x8df9317c, 0xe0b12b4f,
 
320
                        0xf79e59b7, 0x43f5bb3a, 0xf2d519ff, 0x27d9459c,
 
321
                        0xbf97222c, 0x15e6fc2a, 0x0f91fc71, 0x9b941525,
 
322
                        0xfae59361, 0xceb69ceb, 0xc2a86459, 0x12baa8d1,
 
323
                        0xb6c1075e, 0xe3056a0c, 0x10d25065, 0xcb03a442,
 
324
                        0xe0ec6e0e, 0x1698db3b, 0x4c98a0be, 0x3278e964,
 
325
                        0x9f1f9532, 0xe0d392df, 0xd3a0342b, 0x8971f21e,
 
326
                        0x1b0a7441, 0x4ba3348c, 0xc5be7120, 0xc37632d8,
 
327
                        0xdf359f8d, 0x9b992f2e, 0xe60b6f47, 0x0fe3f11d,
 
328
                        0xe54cda54, 0x1edad891, 0xce6279cf, 0xcd3e7e6f,
 
329
                        0x1618b166, 0xfd2c1d05, 0x848fd2c5, 0xf6fb2299,
 
330
                        0xf523f357, 0xa6327623, 0x93a83531, 0x56cccd02,
 
331
                        0xacf08162, 0x5a75ebb5, 0x6e163697, 0x88d273cc,
 
332
                        0xde966292, 0x81b949d0, 0x4c50901b, 0x71c65614,
 
333
                        0xe6c6c7bd, 0x327a140a, 0x45e1d006, 0xc3f27b9a,
 
334
                        0xc9aa53fd, 0x62a80f00, 0xbb25bfe2, 0x35bdd2f6,
 
335
                        0x71126905, 0xb2040222, 0xb6cbcf7c, 0xcd769c2b,
 
336
                        0x53113ec0, 0x1640e3d3, 0x38abbd60, 0x2547adf0,
 
337
                        0xba38209c, 0xf746ce76, 0x77afa1c5, 0x20756060,
 
338
                        0x85cbfe4e, 0x8ae88dd8, 0x7aaaf9b0, 0x4cf9aa7e,
 
339
                        0x1948c25c, 0x02fb8a8c, 0x01c36ae4, 0xd6ebe1f9,
 
340
                        0x90d4f869, 0xa65cdea0, 0x3f09252d, 0xc208e69f,
 
341
                        0xb74e6132, 0xce77e25b, 0x578fdfe3, 0x3ac372e6
 
342
                }
 
343
        }, {
 
344
                0x243f6a88, 0x85a308d3, 0x13198a2e, 0x03707344,
 
345
                0xa4093822, 0x299f31d0, 0x082efa98, 0xec4e6c89,
 
346
                0x452821e6, 0x38d01377, 0xbe5466cf, 0x34e90c6c,
 
347
                0xc0ac29b7, 0xc97c50dd, 0x3f84d5b5, 0xb5470917,
 
348
                0x9216d5d9, 0x8979fb1b
 
349
        }
 
350
};
 
351
 
 
352
static unsigned char BF_itoa64[64 + 1] =
 
353
"./ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789";
 
354
 
 
355
static unsigned char BF_atoi64[0x60] = {
 
356
        64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 0, 1,
 
357
        54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 64, 64, 64, 64, 64,
 
358
        64, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,
 
359
        17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 64, 64, 64, 64, 64,
 
360
        64, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42,
 
361
        43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 64, 64, 64, 64, 64
 
362
};
 
363
 
 
364
#define BF_safe_atoi64(dst, src) \
 
365
do { \
 
366
        tmp = (unsigned char)(src); \
 
367
        if ((unsigned int)(tmp -= 0x20) >= 0x60) return -1; \
 
368
        tmp = BF_atoi64[tmp]; \
 
369
        if (tmp > 63) return -1; \
 
370
        (dst) = tmp; \
 
371
} while (0)
 
372
 
 
373
static int
 
374
BF_decode(BF_word * dst, const char *src, int size)
 
375
{
 
376
        unsigned char *dptr = (unsigned char *) dst;
 
377
        unsigned char *end = dptr + size;
 
378
        unsigned char *sptr = (unsigned char *) src;
 
379
        unsigned int tmp,
 
380
                                c1,
 
381
                                c2,
 
382
                                c3,
 
383
                                c4;
 
384
 
 
385
        do
 
386
        {
 
387
                BF_safe_atoi64(c1, *sptr++);
 
388
                BF_safe_atoi64(c2, *sptr++);
 
389
                *dptr++ = (c1 << 2) | ((c2 & 0x30) >> 4);
 
390
                if (dptr >= end)
 
391
                        break;
 
392
 
 
393
                BF_safe_atoi64(c3, *sptr++);
 
394
                *dptr++ = ((c2 & 0x0F) << 4) | ((c3 & 0x3C) >> 2);
 
395
                if (dptr >= end)
 
396
                        break;
 
397
 
 
398
                BF_safe_atoi64(c4, *sptr++);
 
399
                *dptr++ = ((c3 & 0x03) << 6) | c4;
 
400
        } while (dptr < end);
 
401
 
 
402
        return 0;
 
403
}
 
404
 
 
405
static void
 
406
BF_encode(char *dst, const BF_word * src, int size)
 
407
{
 
408
        unsigned char *sptr = (unsigned char *) src;
 
409
        unsigned char *end = sptr + size;
 
410
        unsigned char *dptr = (unsigned char *) dst;
 
411
        unsigned int c1,
 
412
                                c2;
 
413
 
 
414
        do
 
415
        {
 
416
                c1 = *sptr++;
 
417
                *dptr++ = BF_itoa64[c1 >> 2];
 
418
                c1 = (c1 & 0x03) << 4;
 
419
                if (sptr >= end)
 
420
                {
 
421
                        *dptr++ = BF_itoa64[c1];
 
422
                        break;
 
423
                }
 
424
 
 
425
                c2 = *sptr++;
 
426
                c1 |= c2 >> 4;
 
427
                *dptr++ = BF_itoa64[c1];
 
428
                c1 = (c2 & 0x0f) << 2;
 
429
                if (sptr >= end)
 
430
                {
 
431
                        *dptr++ = BF_itoa64[c1];
 
432
                        break;
 
433
                }
 
434
 
 
435
                c2 = *sptr++;
 
436
                c1 |= c2 >> 6;
 
437
                *dptr++ = BF_itoa64[c1];
 
438
                *dptr++ = BF_itoa64[c2 & 0x3f];
 
439
        } while (sptr < end);
 
440
}
 
441
 
 
442
static void
 
443
BF_swap(BF_word * x, int count)
 
444
{
 
445
        static int      endianness_check = 1;
 
446
        char       *is_little_endian = (char *) &endianness_check;
 
447
        BF_word         tmp;
 
448
 
 
449
        if (*is_little_endian)
 
450
                do
 
451
                {
 
452
                        tmp = *x;
 
453
                        tmp = (tmp << 16) | (tmp >> 16);
 
454
                        *x++ = ((tmp & 0x00FF00FF) << 8) | ((tmp >> 8) & 0x00FF00FF);
 
455
                } while (--count);
 
456
}
 
457
 
 
458
#if BF_SCALE
 
459
/* Architectures which can shift addresses left by 2 bits with no extra cost */
 
460
#define BF_ROUND(L, R, N) \
 
461
        tmp1 = L & 0xFF; \
 
462
        tmp2 = L >> 8; \
 
463
        tmp2 &= 0xFF; \
 
464
        tmp3 = L >> 16; \
 
465
        tmp3 &= 0xFF; \
 
466
        tmp4 = L >> 24; \
 
467
        tmp1 = data.ctx.S[3][tmp1]; \
 
468
        tmp2 = data.ctx.S[2][tmp2]; \
 
469
        tmp3 = data.ctx.S[1][tmp3]; \
 
470
        tmp3 += data.ctx.S[0][tmp4]; \
 
471
        tmp3 ^= tmp2; \
 
472
        R ^= data.ctx.P[N + 1]; \
 
473
        tmp3 += tmp1; \
 
474
        R ^= tmp3;
 
475
#else
 
476
/* Architectures with no complicated addressing modes supported */
 
477
#define BF_INDEX(S, i) \
 
478
        (*((BF_word *)(((unsigned char *)S) + (i))))
 
479
#define BF_ROUND(L, R, N) \
 
480
        tmp1 = L & 0xFF; \
 
481
        tmp1 <<= 2; \
 
482
        tmp2 = L >> 6; \
 
483
        tmp2 &= 0x3FC; \
 
484
        tmp3 = L >> 14; \
 
485
        tmp3 &= 0x3FC; \
 
486
        tmp4 = L >> 22; \
 
487
        tmp4 &= 0x3FC; \
 
488
        tmp1 = BF_INDEX(data.ctx.S[3], tmp1); \
 
489
        tmp2 = BF_INDEX(data.ctx.S[2], tmp2); \
 
490
        tmp3 = BF_INDEX(data.ctx.S[1], tmp3); \
 
491
        tmp3 += BF_INDEX(data.ctx.S[0], tmp4); \
 
492
        tmp3 ^= tmp2; \
 
493
        R ^= data.ctx.P[N + 1]; \
 
494
        tmp3 += tmp1; \
 
495
        R ^= tmp3;
 
496
#endif
 
497
 
 
498
/*
 
499
 * Encrypt one block, BF_N is hardcoded here.
 
500
 */
 
501
#define BF_ENCRYPT \
 
502
        L ^= data.ctx.P[0]; \
 
503
        BF_ROUND(L, R, 0); \
 
504
        BF_ROUND(R, L, 1); \
 
505
        BF_ROUND(L, R, 2); \
 
506
        BF_ROUND(R, L, 3); \
 
507
        BF_ROUND(L, R, 4); \
 
508
        BF_ROUND(R, L, 5); \
 
509
        BF_ROUND(L, R, 6); \
 
510
        BF_ROUND(R, L, 7); \
 
511
        BF_ROUND(L, R, 8); \
 
512
        BF_ROUND(R, L, 9); \
 
513
        BF_ROUND(L, R, 10); \
 
514
        BF_ROUND(R, L, 11); \
 
515
        BF_ROUND(L, R, 12); \
 
516
        BF_ROUND(R, L, 13); \
 
517
        BF_ROUND(L, R, 14); \
 
518
        BF_ROUND(R, L, 15); \
 
519
        tmp4 = R; \
 
520
        R = L; \
 
521
        L = tmp4 ^ data.ctx.P[BF_N + 1];
 
522
 
 
523
#if BF_ASM
 
524
 
 
525
extern void _BF_body_r(BF_ctx * ctx);
 
526
 
 
527
#define BF_body() \
 
528
        _BF_body_r(&data.ctx);
 
529
 
 
530
#else
 
531
 
 
532
#define BF_body() \
 
533
        L = R = 0; \
 
534
        ptr = data.ctx.P; \
 
535
        do { \
 
536
                ptr += 2; \
 
537
                BF_ENCRYPT; \
 
538
                *(ptr - 2) = L; \
 
539
                *(ptr - 1) = R; \
 
540
        } while (ptr < &data.ctx.P[BF_N + 2]); \
 
541
\
 
542
        ptr = data.ctx.S[0]; \
 
543
        do { \
 
544
                ptr += 2; \
 
545
                BF_ENCRYPT; \
 
546
                *(ptr - 2) = L; \
 
547
                *(ptr - 1) = R; \
 
548
        } while (ptr < &data.ctx.S[3][0xFF]);
 
549
#endif
 
550
 
 
551
static void
 
552
BF_set_key(const char *key, BF_key expanded, BF_key initial)
 
553
{
 
554
        const char *ptr = key;
 
555
        int                     i,
 
556
                                j;
 
557
        BF_word         tmp;
 
558
 
 
559
        for (i = 0; i < BF_N + 2; i++)
 
560
        {
 
561
                tmp = 0;
 
562
                for (j = 0; j < 4; j++)
 
563
                {
 
564
                        tmp <<= 8;
 
565
                        tmp |= *ptr;
 
566
 
 
567
                        if (!*ptr)
 
568
                                ptr = key;
 
569
                        else
 
570
                                ptr++;
 
571
                }
 
572
 
 
573
                expanded[i] = tmp;
 
574
                initial[i] = BF_init_state.P[i] ^ tmp;
 
575
        }
 
576
}
 
577
 
 
578
char *
 
579
_crypt_blowfish_rn(const char *key, const char *setting,
 
580
                                   char *output, int size)
 
581
{
 
582
        struct
 
583
        {
 
584
                BF_ctx          ctx;
 
585
                BF_key          expanded_key;
 
586
                union
 
587
                {
 
588
                        BF_word         salt[4];
 
589
                        BF_word         output[6];
 
590
                }                       binary;
 
591
        }                       data;
 
592
        BF_word         L,
 
593
                                R;
 
594
        BF_word         tmp1,
 
595
                                tmp2,
 
596
                                tmp3,
 
597
                                tmp4;
 
598
        BF_word    *ptr;
 
599
        BF_word         count;
 
600
        int                     i;
 
601
 
 
602
        if (size < 7 + 22 + 31 + 1)
 
603
        {
 
604
                __set_errno(ERANGE);
 
605
                return NULL;
 
606
        }
 
607
 
 
608
        if (setting[0] != '$' ||
 
609
                setting[1] != '2' ||
 
610
                setting[2] != 'a' ||
 
611
                setting[3] != '$' ||
 
612
                setting[4] < '0' || setting[4] > '3' ||
 
613
                setting[5] < '0' || setting[5] > '9' ||
 
614
                setting[6] != '$')
 
615
        {
 
616
                __set_errno(EINVAL);
 
617
                return NULL;
 
618
        }
 
619
 
 
620
        count = (BF_word) 1 << ((setting[4] - '0') * 10 + (setting[5] - '0'));
 
621
        if (count < 16 || BF_decode(data.binary.salt, &setting[7], 16))
 
622
        {
 
623
                memset(data.binary.salt, 0, sizeof(data.binary.salt));
 
624
                __set_errno(EINVAL);
 
625
                return NULL;
 
626
        }
 
627
        BF_swap(data.binary.salt, 4);
 
628
 
 
629
        BF_set_key(key, data.expanded_key, data.ctx.P);
 
630
 
 
631
        memcpy(data.ctx.S, BF_init_state.S, sizeof(data.ctx.S));
 
632
 
 
633
        L = R = 0;
 
634
        for (i = 0; i < BF_N + 2; i += 2)
 
635
        {
 
636
                L ^= data.binary.salt[i & 2];
 
637
                R ^= data.binary.salt[(i & 2) + 1];
 
638
                BF_ENCRYPT;
 
639
                data.ctx.P[i] = L;
 
640
                data.ctx.P[i + 1] = R;
 
641
        }
 
642
 
 
643
        ptr = data.ctx.S[0];
 
644
        do
 
645
        {
 
646
                ptr += 4;
 
647
                L ^= data.binary.salt[(BF_N + 2) & 3];
 
648
                R ^= data.binary.salt[(BF_N + 3) & 3];
 
649
                BF_ENCRYPT;
 
650
                *(ptr - 4) = L;
 
651
                *(ptr - 3) = R;
 
652
 
 
653
                L ^= data.binary.salt[(BF_N + 4) & 3];
 
654
                R ^= data.binary.salt[(BF_N + 5) & 3];
 
655
                BF_ENCRYPT;
 
656
                *(ptr - 2) = L;
 
657
                *(ptr - 1) = R;
 
658
        } while (ptr < &data.ctx.S[3][0xFF]);
 
659
 
 
660
        do
 
661
        {
 
662
                data.ctx.P[0] ^= data.expanded_key[0];
 
663
                data.ctx.P[1] ^= data.expanded_key[1];
 
664
                data.ctx.P[2] ^= data.expanded_key[2];
 
665
                data.ctx.P[3] ^= data.expanded_key[3];
 
666
                data.ctx.P[4] ^= data.expanded_key[4];
 
667
                data.ctx.P[5] ^= data.expanded_key[5];
 
668
                data.ctx.P[6] ^= data.expanded_key[6];
 
669
                data.ctx.P[7] ^= data.expanded_key[7];
 
670
                data.ctx.P[8] ^= data.expanded_key[8];
 
671
                data.ctx.P[9] ^= data.expanded_key[9];
 
672
                data.ctx.P[10] ^= data.expanded_key[10];
 
673
                data.ctx.P[11] ^= data.expanded_key[11];
 
674
                data.ctx.P[12] ^= data.expanded_key[12];
 
675
                data.ctx.P[13] ^= data.expanded_key[13];
 
676
                data.ctx.P[14] ^= data.expanded_key[14];
 
677
                data.ctx.P[15] ^= data.expanded_key[15];
 
678
                data.ctx.P[16] ^= data.expanded_key[16];
 
679
                data.ctx.P[17] ^= data.expanded_key[17];
 
680
 
 
681
                BF_body();
 
682
 
 
683
                tmp1 = data.binary.salt[0];
 
684
                tmp2 = data.binary.salt[1];
 
685
                tmp3 = data.binary.salt[2];
 
686
                tmp4 = data.binary.salt[3];
 
687
                data.ctx.P[0] ^= tmp1;
 
688
                data.ctx.P[1] ^= tmp2;
 
689
                data.ctx.P[2] ^= tmp3;
 
690
                data.ctx.P[3] ^= tmp4;
 
691
                data.ctx.P[4] ^= tmp1;
 
692
                data.ctx.P[5] ^= tmp2;
 
693
                data.ctx.P[6] ^= tmp3;
 
694
                data.ctx.P[7] ^= tmp4;
 
695
                data.ctx.P[8] ^= tmp1;
 
696
                data.ctx.P[9] ^= tmp2;
 
697
                data.ctx.P[10] ^= tmp3;
 
698
                data.ctx.P[11] ^= tmp4;
 
699
                data.ctx.P[12] ^= tmp1;
 
700
                data.ctx.P[13] ^= tmp2;
 
701
                data.ctx.P[14] ^= tmp3;
 
702
                data.ctx.P[15] ^= tmp4;
 
703
                data.ctx.P[16] ^= tmp1;
 
704
                data.ctx.P[17] ^= tmp2;
 
705
 
 
706
                BF_body();
 
707
        } while (--count);
 
708
 
 
709
        for (i = 0; i < 6; i += 2)
 
710
        {
 
711
                L = BF_magic_w[i];
 
712
                R = BF_magic_w[i + 1];
 
713
 
 
714
                count = 64;
 
715
                do
 
716
                {
 
717
                        BF_ENCRYPT;
 
718
                } while (--count);
 
719
 
 
720
                data.binary.output[i] = L;
 
721
                data.binary.output[i + 1] = R;
 
722
        }
 
723
 
 
724
        memcpy(output, setting, 7 + 22 - 1);
 
725
        output[7 + 22 - 1] = BF_itoa64[(int)
 
726
                                         BF_atoi64[(int) setting[7 + 22 - 1] - 0x20] & 0x30];
 
727
 
 
728
/* This has to be bug-compatible with the original implementation, so
 
729
 * only encode 23 of the 24 bytes. :-) */
 
730
        BF_swap(data.binary.output, 6);
 
731
        BF_encode(&output[7 + 22], data.binary.output, 23);
 
732
        output[7 + 22 + 31] = '\0';
 
733
 
 
734
/* Overwrite the most obvious sensitive data we have on the stack. Note
 
735
 * that this does not guarantee there's no sensitive data left on the
 
736
 * stack and/or in registers; I'm not aware of portable code that does. */
 
737
        memset(&data, 0, sizeof(data));
 
738
 
 
739
        return output;
 
740
}