1/*
2 * The crypt_blowfish homepage is:
3 *
4 *	http://www.openwall.com/crypt/
5 *
6 * This code comes from John the Ripper password cracker, with reentrant
7 * and crypt(3) interfaces added, but optimizations specific to password
8 * cracking removed.
9 *
10 * Written by Solar Designer <solar at openwall.com> in 1998-2011.
11 * No copyright is claimed, and the software is hereby placed in the public
12 * domain.  In case this attempt to disclaim copyright and place the software
13 * in the public domain is deemed null and void, then the software is
14 * Copyright (c) 1998-2011 Solar Designer and it is hereby released to the
15 * general public under the following terms:
16 *
17 * Redistribution and use in source and binary forms, with or without
18 * modification, are permitted.
19 *
20 * There's ABSOLUTELY NO WARRANTY, express or implied.
21 *
22 * It is my intent that you should be able to use this on your system,
23 * as part of a software package, or anywhere else to improve security,
24 * ensure compatibility, or for any other purpose.  I would appreciate
25 * it if you give credit where it is due and keep your modifications in
26 * the public domain as well, but I don't require that in order to let
27 * you place this code and any modifications you make under a license
28 * of your choice.
29 *
30 * This implementation is mostly compatible with OpenBSD's bcrypt.c (prefix
31 * "$2a$") by Niels Provos <provos at citi.umich.edu>, and uses some of his
32 * ideas.  The password hashing algorithm was designed by David Mazieres
33 * <dm at lcs.mit.edu>.  For more information on the level of compatibility,
34 * prefer refer to the comments in BF_set_key() below and to the included
35 * crypt(3) man page.
36 *
37 * There's a paper on the algorithm that explains its design decisions:
38 *
39 *	http://www.usenix.org/events/usenix99/provos.html
40 *
41 * Some of the tricks in BF_ROUND might be inspired by Eric Young's
42 * Blowfish library (I can't be sure if I would think of something if I
43 * hadn't seen his code).
44 */
45
46#include <string.h>
47
48#include <errno.h>
49#ifndef __set_errno
50#define __set_errno(val) errno = (val)
51#endif
52
53/* Just to make sure the prototypes match the actual definitions */
54#include "crypt_blowfish.h"
55
56#ifdef __i386__
57#define BF_ASM				0
58#define BF_SCALE			1
59#elif defined(__x86_64__) || defined(__alpha__) || defined(__hppa__)
60#define BF_ASM				0
61#define BF_SCALE			1
62#else
63#define BF_ASM				0
64#define BF_SCALE			0
65#endif
66
67typedef unsigned int BF_word;
68typedef signed int BF_word_signed;
69
70/* Number of Blowfish rounds, this is also hardcoded into a few places */
71#define BF_N				16
72
73typedef BF_word BF_key[BF_N + 2];
74
75typedef struct {
76	BF_word S[4][0x100];
77	BF_key P;
78} BF_ctx;
79
80/*
81 * Magic IV for 64 Blowfish encryptions that we do at the end.
82 * The string is "OrpheanBeholderScryDoubt" on big-endian.
83 */
84static BF_word BF_magic_w[6] = {
85	0x4F727068, 0x65616E42, 0x65686F6C,
86	0x64657253, 0x63727944, 0x6F756274
87};
88
89/*
90 * P-box and S-box tables initialized with digits of Pi.
91 */
92static BF_ctx BF_init_state = {
93	{
94		{
95			0xd1310ba6, 0x98dfb5ac, 0x2ffd72db, 0xd01adfb7,
96			0xb8e1afed, 0x6a267e96, 0xba7c9045, 0xf12c7f99,
97			0x24a19947, 0xb3916cf7, 0x0801f2e2, 0x858efc16,
98			0x636920d8, 0x71574e69, 0xa458fea3, 0xf4933d7e,
99			0x0d95748f, 0x728eb658, 0x718bcd58, 0x82154aee,
100			0x7b54a41d, 0xc25a59b5, 0x9c30d539, 0x2af26013,
101			0xc5d1b023, 0x286085f0, 0xca417918, 0xb8db38ef,
102			0x8e79dcb0, 0x603a180e, 0x6c9e0e8b, 0xb01e8a3e,
103			0xd71577c1, 0xbd314b27, 0x78af2fda, 0x55605c60,
104			0xe65525f3, 0xaa55ab94, 0x57489862, 0x63e81440,
105			0x55ca396a, 0x2aab10b6, 0xb4cc5c34, 0x1141e8ce,
106			0xa15486af, 0x7c72e993, 0xb3ee1411, 0x636fbc2a,
107			0x2ba9c55d, 0x741831f6, 0xce5c3e16, 0x9b87931e,
108			0xafd6ba33, 0x6c24cf5c, 0x7a325381, 0x28958677,
109			0x3b8f4898, 0x6b4bb9af, 0xc4bfe81b, 0x66282193,
110			0x61d809cc, 0xfb21a991, 0x487cac60, 0x5dec8032,
111			0xef845d5d, 0xe98575b1, 0xdc262302, 0xeb651b88,
112			0x23893e81, 0xd396acc5, 0x0f6d6ff3, 0x83f44239,
113			0x2e0b4482, 0xa4842004, 0x69c8f04a, 0x9e1f9b5e,
114			0x21c66842, 0xf6e96c9a, 0x670c9c61, 0xabd388f0,
115			0x6a51a0d2, 0xd8542f68, 0x960fa728, 0xab5133a3,
116			0x6eef0b6c, 0x137a3be4, 0xba3bf050, 0x7efb2a98,
117			0xa1f1651d, 0x39af0176, 0x66ca593e, 0x82430e88,
118			0x8cee8619, 0x456f9fb4, 0x7d84a5c3, 0x3b8b5ebe,
119			0xe06f75d8, 0x85c12073, 0x401a449f, 0x56c16aa6,
120			0x4ed3aa62, 0x363f7706, 0x1bfedf72, 0x429b023d,
121			0x37d0d724, 0xd00a1248, 0xdb0fead3, 0x49f1c09b,
122			0x075372c9, 0x80991b7b, 0x25d479d8, 0xf6e8def7,
123			0xe3fe501a, 0xb6794c3b, 0x976ce0bd, 0x04c006ba,
124			0xc1a94fb6, 0x409f60c4, 0x5e5c9ec2, 0x196a2463,
125			0x68fb6faf, 0x3e6c53b5, 0x1339b2eb, 0x3b52ec6f,
126			0x6dfc511f, 0x9b30952c, 0xcc814544, 0xaf5ebd09,
127			0xbee3d004, 0xde334afd, 0x660f2807, 0x192e4bb3,
128			0xc0cba857, 0x45c8740f, 0xd20b5f39, 0xb9d3fbdb,
129			0x5579c0bd, 0x1a60320a, 0xd6a100c6, 0x402c7279,
130			0x679f25fe, 0xfb1fa3cc, 0x8ea5e9f8, 0xdb3222f8,
131			0x3c7516df, 0xfd616b15, 0x2f501ec8, 0xad0552ab,
132			0x323db5fa, 0xfd238760, 0x53317b48, 0x3e00df82,
133			0x9e5c57bb, 0xca6f8ca0, 0x1a87562e, 0xdf1769db,
134			0xd542a8f6, 0x287effc3, 0xac6732c6, 0x8c4f5573,
135			0x695b27b0, 0xbbca58c8, 0xe1ffa35d, 0xb8f011a0,
136			0x10fa3d98, 0xfd2183b8, 0x4afcb56c, 0x2dd1d35b,
137			0x9a53e479, 0xb6f84565, 0xd28e49bc, 0x4bfb9790,
138			0xe1ddf2da, 0xa4cb7e33, 0x62fb1341, 0xcee4c6e8,
139			0xef20cada, 0x36774c01, 0xd07e9efe, 0x2bf11fb4,
140			0x95dbda4d, 0xae909198, 0xeaad8e71, 0x6b93d5a0,
141			0xd08ed1d0, 0xafc725e0, 0x8e3c5b2f, 0x8e7594b7,
142			0x8ff6e2fb, 0xf2122b64, 0x8888b812, 0x900df01c,
143			0x4fad5ea0, 0x688fc31c, 0xd1cff191, 0xb3a8c1ad,
144			0x2f2f2218, 0xbe0e1777, 0xea752dfe, 0x8b021fa1,
145			0xe5a0cc0f, 0xb56f74e8, 0x18acf3d6, 0xce89e299,
146			0xb4a84fe0, 0xfd13e0b7, 0x7cc43b81, 0xd2ada8d9,
147			0x165fa266, 0x80957705, 0x93cc7314, 0x211a1477,
148			0xe6ad2065, 0x77b5fa86, 0xc75442f5, 0xfb9d35cf,
149			0xebcdaf0c, 0x7b3e89a0, 0xd6411bd3, 0xae1e7e49,
150			0x00250e2d, 0x2071b35e, 0x226800bb, 0x57b8e0af,
151			0x2464369b, 0xf009b91e, 0x5563911d, 0x59dfa6aa,
152			0x78c14389, 0xd95a537f, 0x207d5ba2, 0x02e5b9c5,
153			0x83260376, 0x6295cfa9, 0x11c81968, 0x4e734a41,
154			0xb3472dca, 0x7b14a94a, 0x1b510052, 0x9a532915,
155			0xd60f573f, 0xbc9bc6e4, 0x2b60a476, 0x81e67400,
156			0x08ba6fb5, 0x571be91f, 0xf296ec6b, 0x2a0dd915,
157			0xb6636521, 0xe7b9f9b6, 0xff34052e, 0xc5855664,
158			0x53b02d5d, 0xa99f8fa1, 0x08ba4799, 0x6e85076a
159		}, {
160			0x4b7a70e9, 0xb5b32944, 0xdb75092e, 0xc4192623,
161			0xad6ea6b0, 0x49a7df7d, 0x9cee60b8, 0x8fedb266,
162			0xecaa8c71, 0x699a17ff, 0x5664526c, 0xc2b19ee1,
163			0x193602a5, 0x75094c29, 0xa0591340, 0xe4183a3e,
164			0x3f54989a, 0x5b429d65, 0x6b8fe4d6, 0x99f73fd6,
165			0xa1d29c07, 0xefe830f5, 0x4d2d38e6, 0xf0255dc1,
166			0x4cdd2086, 0x8470eb26, 0x6382e9c6, 0x021ecc5e,
167			0x09686b3f, 0x3ebaefc9, 0x3c971814, 0x6b6a70a1,
168			0x687f3584, 0x52a0e286, 0xb79c5305, 0xaa500737,
169			0x3e07841c, 0x7fdeae5c, 0x8e7d44ec, 0x5716f2b8,
170			0xb03ada37, 0xf0500c0d, 0xf01c1f04, 0x0200b3ff,
171			0xae0cf51a, 0x3cb574b2, 0x25837a58, 0xdc0921bd,
172			0xd19113f9, 0x7ca92ff6, 0x94324773, 0x22f54701,
173			0x3ae5e581, 0x37c2dadc, 0xc8b57634, 0x9af3dda7,
174			0xa9446146, 0x0fd0030e, 0xecc8c73e, 0xa4751e41,
175			0xe238cd99, 0x3bea0e2f, 0x3280bba1, 0x183eb331,
176			0x4e548b38, 0x4f6db908, 0x6f420d03, 0xf60a04bf,
177			0x2cb81290, 0x24977c79, 0x5679b072, 0xbcaf89af,
178			0xde9a771f, 0xd9930810, 0xb38bae12, 0xdccf3f2e,
179			0x5512721f, 0x2e6b7124, 0x501adde6, 0x9f84cd87,
180			0x7a584718, 0x7408da17, 0xbc9f9abc, 0xe94b7d8c,
181			0xec7aec3a, 0xdb851dfa, 0x63094366, 0xc464c3d2,
182			0xef1c1847, 0x3215d908, 0xdd433b37, 0x24c2ba16,
183			0x12a14d43, 0x2a65c451, 0x50940002, 0x133ae4dd,
184			0x71dff89e, 0x10314e55, 0x81ac77d6, 0x5f11199b,
185			0x043556f1, 0xd7a3c76b, 0x3c11183b, 0x5924a509,
186			0xf28fe6ed, 0x97f1fbfa, 0x9ebabf2c, 0x1e153c6e,
187			0x86e34570, 0xeae96fb1, 0x860e5e0a, 0x5a3e2ab3,
188			0x771fe71c, 0x4e3d06fa, 0x2965dcb9, 0x99e71d0f,
189			0x803e89d6, 0x5266c825, 0x2e4cc978, 0x9c10b36a,
190			0xc6150eba, 0x94e2ea78, 0xa5fc3c53, 0x1e0a2df4,
191			0xf2f74ea7, 0x361d2b3d, 0x1939260f, 0x19c27960,
192			0x5223a708, 0xf71312b6, 0xebadfe6e, 0xeac31f66,
193			0xe3bc4595, 0xa67bc883, 0xb17f37d1, 0x018cff28,
194			0xc332ddef, 0xbe6c5aa5, 0x65582185, 0x68ab9802,
195			0xeecea50f, 0xdb2f953b, 0x2aef7dad, 0x5b6e2f84,
196			0x1521b628, 0x29076170, 0xecdd4775, 0x619f1510,
197			0x13cca830, 0xeb61bd96, 0x0334fe1e, 0xaa0363cf,
198			0xb5735c90, 0x4c70a239, 0xd59e9e0b, 0xcbaade14,
199			0xeecc86bc, 0x60622ca7, 0x9cab5cab, 0xb2f3846e,
200			0x648b1eaf, 0x19bdf0ca, 0xa02369b9, 0x655abb50,
201			0x40685a32, 0x3c2ab4b3, 0x319ee9d5, 0xc021b8f7,
202			0x9b540b19, 0x875fa099, 0x95f7997e, 0x623d7da8,
203			0xf837889a, 0x97e32d77, 0x11ed935f, 0x16681281,
204			0x0e358829, 0xc7e61fd6, 0x96dedfa1, 0x7858ba99,
205			0x57f584a5, 0x1b227263, 0x9b83c3ff, 0x1ac24696,
206			0xcdb30aeb, 0x532e3054, 0x8fd948e4, 0x6dbc3128,
207			0x58ebf2ef, 0x34c6ffea, 0xfe28ed61, 0xee7c3c73,
208			0x5d4a14d9, 0xe864b7e3, 0x42105d14, 0x203e13e0,
209			0x45eee2b6, 0xa3aaabea, 0xdb6c4f15, 0xfacb4fd0,
210			0xc742f442, 0xef6abbb5, 0x654f3b1d, 0x41cd2105,
211			0xd81e799e, 0x86854dc7, 0xe44b476a, 0x3d816250,
212			0xcf62a1f2, 0x5b8d2646, 0xfc8883a0, 0xc1c7b6a3,
213			0x7f1524c3, 0x69cb7492, 0x47848a0b, 0x5692b285,
214			0x095bbf00, 0xad19489d, 0x1462b174, 0x23820e00,
215			0x58428d2a, 0x0c55f5ea, 0x1dadf43e, 0x233f7061,
216			0x3372f092, 0x8d937e41, 0xd65fecf1, 0x6c223bdb,
217			0x7cde3759, 0xcbee7460, 0x4085f2a7, 0xce77326e,
218			0xa6078084, 0x19f8509e, 0xe8efd855, 0x61d99735,
219			0xa969a7aa, 0xc50c06c2, 0x5a04abfc, 0x800bcadc,
220			0x9e447a2e, 0xc3453484, 0xfdd56705, 0x0e1e9ec9,
221			0xdb73dbd3, 0x105588cd, 0x675fda79, 0xe3674340,
222			0xc5c43465, 0x713e38d8, 0x3d28f89e, 0xf16dff20,
223			0x153e21e7, 0x8fb03d4a, 0xe6e39f2b, 0xdb83adf7
224		}, {
225			0xe93d5a68, 0x948140f7, 0xf64c261c, 0x94692934,
226			0x411520f7, 0x7602d4f7, 0xbcf46b2e, 0xd4a20068,
227			0xd4082471, 0x3320f46a, 0x43b7d4b7, 0x500061af,
228			0x1e39f62e, 0x97244546, 0x14214f74, 0xbf8b8840,
229			0x4d95fc1d, 0x96b591af, 0x70f4ddd3, 0x66a02f45,
230			0xbfbc09ec, 0x03bd9785, 0x7fac6dd0, 0x31cb8504,
231			0x96eb27b3, 0x55fd3941, 0xda2547e6, 0xabca0a9a,
232			0x28507825, 0x530429f4, 0x0a2c86da, 0xe9b66dfb,
233			0x68dc1462, 0xd7486900, 0x680ec0a4, 0x27a18dee,
234			0x4f3ffea2, 0xe887ad8c, 0xb58ce006, 0x7af4d6b6,
235			0xaace1e7c, 0xd3375fec, 0xce78a399, 0x406b2a42,
236			0x20fe9e35, 0xd9f385b9, 0xee39d7ab, 0x3b124e8b,
237			0x1dc9faf7, 0x4b6d1856, 0x26a36631, 0xeae397b2,
238			0x3a6efa74, 0xdd5b4332, 0x6841e7f7, 0xca7820fb,
239			0xfb0af54e, 0xd8feb397, 0x454056ac, 0xba489527,
240			0x55533a3a, 0x20838d87, 0xfe6ba9b7, 0xd096954b,
241			0x55a867bc, 0xa1159a58, 0xcca92963, 0x99e1db33,
242			0xa62a4a56, 0x3f3125f9, 0x5ef47e1c, 0x9029317c,
243			0xfdf8e802, 0x04272f70, 0x80bb155c, 0x05282ce3,
244			0x95c11548, 0xe4c66d22, 0x48c1133f, 0xc70f86dc,
245			0x07f9c9ee, 0x41041f0f, 0x404779a4, 0x5d886e17,
246			0x325f51eb, 0xd59bc0d1, 0xf2bcc18f, 0x41113564,
247			0x257b7834, 0x602a9c60, 0xdff8e8a3, 0x1f636c1b,
248			0x0e12b4c2, 0x02e1329e, 0xaf664fd1, 0xcad18115,
249			0x6b2395e0, 0x333e92e1, 0x3b240b62, 0xeebeb922,
250			0x85b2a20e, 0xe6ba0d99, 0xde720c8c, 0x2da2f728,
251			0xd0127845, 0x95b794fd, 0x647d0862, 0xe7ccf5f0,
252			0x5449a36f, 0x877d48fa, 0xc39dfd27, 0xf33e8d1e,
253			0x0a476341, 0x992eff74, 0x3a6f6eab, 0xf4f8fd37,
254			0xa812dc60, 0xa1ebddf8, 0x991be14c, 0xdb6e6b0d,
255			0xc67b5510, 0x6d672c37, 0x2765d43b, 0xdcd0e804,
256			0xf1290dc7, 0xcc00ffa3, 0xb5390f92, 0x690fed0b,
257			0x667b9ffb, 0xcedb7d9c, 0xa091cf0b, 0xd9155ea3,
258			0xbb132f88, 0x515bad24, 0x7b9479bf, 0x763bd6eb,
259			0x37392eb3, 0xcc115979, 0x8026e297, 0xf42e312d,
260			0x6842ada7, 0xc66a2b3b, 0x12754ccc, 0x782ef11c,
261			0x6a124237, 0xb79251e7, 0x06a1bbe6, 0x4bfb6350,
262			0x1a6b1018, 0x11caedfa, 0x3d25bdd8, 0xe2e1c3c9,
263			0x44421659, 0x0a121386, 0xd90cec6e, 0xd5abea2a,
264			0x64af674e, 0xda86a85f, 0xbebfe988, 0x64e4c3fe,
265			0x9dbc8057, 0xf0f7c086, 0x60787bf8, 0x6003604d,
266			0xd1fd8346, 0xf6381fb0, 0x7745ae04, 0xd736fccc,
267			0x83426b33, 0xf01eab71, 0xb0804187, 0x3c005e5f,
268			0x77a057be, 0xbde8ae24, 0x55464299, 0xbf582e61,
269			0x4e58f48f, 0xf2ddfda2, 0xf474ef38, 0x8789bdc2,
270			0x5366f9c3, 0xc8b38e74, 0xb475f255, 0x46fcd9b9,
271			0x7aeb2661, 0x8b1ddf84, 0x846a0e79, 0x915f95e2,
272			0x466e598e, 0x20b45770, 0x8cd55591, 0xc902de4c,
273			0xb90bace1, 0xbb8205d0, 0x11a86248, 0x7574a99e,
274			0xb77f19b6, 0xe0a9dc09, 0x662d09a1, 0xc4324633,
275			0xe85a1f02, 0x09f0be8c, 0x4a99a025, 0x1d6efe10,
276			0x1ab93d1d, 0x0ba5a4df, 0xa186f20f, 0x2868f169,
277			0xdcb7da83, 0x573906fe, 0xa1e2ce9b, 0x4fcd7f52,
278			0x50115e01, 0xa70683fa, 0xa002b5c4, 0x0de6d027,
279			0x9af88c27, 0x773f8641, 0xc3604c06, 0x61a806b5,
280			0xf0177a28, 0xc0f586e0, 0x006058aa, 0x30dc7d62,
281			0x11e69ed7, 0x2338ea63, 0x53c2dd94, 0xc2c21634,
282			0xbbcbee56, 0x90bcb6de, 0xebfc7da1, 0xce591d76,
283			0x6f05e409, 0x4b7c0188, 0x39720a3d, 0x7c927c24,
284			0x86e3725f, 0x724d9db9, 0x1ac15bb4, 0xd39eb8fc,
285			0xed545578, 0x08fca5b5, 0xd83d7cd3, 0x4dad0fc4,
286			0x1e50ef5e, 0xb161e6f8, 0xa28514d9, 0x6c51133c,
287			0x6fd5c7e7, 0x56e14ec4, 0x362abfce, 0xddc6c837,
288			0xd79a3234, 0x92638212, 0x670efa8e, 0x406000e0
289		}, {
290			0x3a39ce37, 0xd3faf5cf, 0xabc27737, 0x5ac52d1b,
291			0x5cb0679e, 0x4fa33742, 0xd3822740, 0x99bc9bbe,
292			0xd5118e9d, 0xbf0f7315, 0xd62d1c7e, 0xc700c47b,
293			0xb78c1b6b, 0x21a19045, 0xb26eb1be, 0x6a366eb4,
294			0x5748ab2f, 0xbc946e79, 0xc6a376d2, 0x6549c2c8,
295			0x530ff8ee, 0x468dde7d, 0xd5730a1d, 0x4cd04dc6,
296			0x2939bbdb, 0xa9ba4650, 0xac9526e8, 0xbe5ee304,
297			0xa1fad5f0, 0x6a2d519a, 0x63ef8ce2, 0x9a86ee22,
298			0xc089c2b8, 0x43242ef6, 0xa51e03aa, 0x9cf2d0a4,
299			0x83c061ba, 0x9be96a4d, 0x8fe51550, 0xba645bd6,
300			0x2826a2f9, 0xa73a3ae1, 0x4ba99586, 0xef5562e9,
301			0xc72fefd3, 0xf752f7da, 0x3f046f69, 0x77fa0a59,
302			0x80e4a915, 0x87b08601, 0x9b09e6ad, 0x3b3ee593,
303			0xe990fd5a, 0x9e34d797, 0x2cf0b7d9, 0x022b8b51,
304			0x96d5ac3a, 0x017da67d, 0xd1cf3ed6, 0x7c7d2d28,
305			0x1f9f25cf, 0xadf2b89b, 0x5ad6b472, 0x5a88f54c,
306			0xe029ac71, 0xe019a5e6, 0x47b0acfd, 0xed93fa9b,
307			0xe8d3c48d, 0x283b57cc, 0xf8d56629, 0x79132e28,
308			0x785f0191, 0xed756055, 0xf7960e44, 0xe3d35e8c,
309			0x15056dd4, 0x88f46dba, 0x03a16125, 0x0564f0bd,
310			0xc3eb9e15, 0x3c9057a2, 0x97271aec, 0xa93a072a,
311			0x1b3f6d9b, 0x1e6321f5, 0xf59c66fb, 0x26dcf319,
312			0x7533d928, 0xb155fdf5, 0x03563482, 0x8aba3cbb,
313			0x28517711, 0xc20ad9f8, 0xabcc5167, 0xccad925f,
314			0x4de81751, 0x3830dc8e, 0x379d5862, 0x9320f991,
315			0xea7a90c2, 0xfb3e7bce, 0x5121ce64, 0x774fbe32,
316			0xa8b6e37e, 0xc3293d46, 0x48de5369, 0x6413e680,
317			0xa2ae0810, 0xdd6db224, 0x69852dfd, 0x09072166,
318			0xb39a460a, 0x6445c0dd, 0x586cdecf, 0x1c20c8ae,
319			0x5bbef7dd, 0x1b588d40, 0xccd2017f, 0x6bb4e3bb,
320			0xdda26a7e, 0x3a59ff45, 0x3e350a44, 0xbcb4cdd5,
321			0x72eacea8, 0xfa6484bb, 0x8d6612ae, 0xbf3c6f47,
322			0xd29be463, 0x542f5d9e, 0xaec2771b, 0xf64e6370,
323			0x740e0d8d, 0xe75b1357, 0xf8721671, 0xaf537d5d,
324			0x4040cb08, 0x4eb4e2cc, 0x34d2466a, 0x0115af84,
325			0xe1b00428, 0x95983a1d, 0x06b89fb4, 0xce6ea048,
326			0x6f3f3b82, 0x3520ab82, 0x011a1d4b, 0x277227f8,
327			0x611560b1, 0xe7933fdc, 0xbb3a792b, 0x344525bd,
328			0xa08839e1, 0x51ce794b, 0x2f32c9b7, 0xa01fbac9,
329			0xe01cc87e, 0xbcc7d1f6, 0xcf0111c3, 0xa1e8aac7,
330			0x1a908749, 0xd44fbd9a, 0xd0dadecb, 0xd50ada38,
331			0x0339c32a, 0xc6913667, 0x8df9317c, 0xe0b12b4f,
332			0xf79e59b7, 0x43f5bb3a, 0xf2d519ff, 0x27d9459c,
333			0xbf97222c, 0x15e6fc2a, 0x0f91fc71, 0x9b941525,
334			0xfae59361, 0xceb69ceb, 0xc2a86459, 0x12baa8d1,
335			0xb6c1075e, 0xe3056a0c, 0x10d25065, 0xcb03a442,
336			0xe0ec6e0e, 0x1698db3b, 0x4c98a0be, 0x3278e964,
337			0x9f1f9532, 0xe0d392df, 0xd3a0342b, 0x8971f21e,
338			0x1b0a7441, 0x4ba3348c, 0xc5be7120, 0xc37632d8,
339			0xdf359f8d, 0x9b992f2e, 0xe60b6f47, 0x0fe3f11d,
340			0xe54cda54, 0x1edad891, 0xce6279cf, 0xcd3e7e6f,
341			0x1618b166, 0xfd2c1d05, 0x848fd2c5, 0xf6fb2299,
342			0xf523f357, 0xa6327623, 0x93a83531, 0x56cccd02,
343			0xacf08162, 0x5a75ebb5, 0x6e163697, 0x88d273cc,
344			0xde966292, 0x81b949d0, 0x4c50901b, 0x71c65614,
345			0xe6c6c7bd, 0x327a140a, 0x45e1d006, 0xc3f27b9a,
346			0xc9aa53fd, 0x62a80f00, 0xbb25bfe2, 0x35bdd2f6,
347			0x71126905, 0xb2040222, 0xb6cbcf7c, 0xcd769c2b,
348			0x53113ec0, 0x1640e3d3, 0x38abbd60, 0x2547adf0,
349			0xba38209c, 0xf746ce76, 0x77afa1c5, 0x20756060,
350			0x85cbfe4e, 0x8ae88dd8, 0x7aaaf9b0, 0x4cf9aa7e,
351			0x1948c25c, 0x02fb8a8c, 0x01c36ae4, 0xd6ebe1f9,
352			0x90d4f869, 0xa65cdea0, 0x3f09252d, 0xc208e69f,
353			0xb74e6132, 0xce77e25b, 0x578fdfe3, 0x3ac372e6
354		}
355	}, {
356		0x243f6a88, 0x85a308d3, 0x13198a2e, 0x03707344,
357		0xa4093822, 0x299f31d0, 0x082efa98, 0xec4e6c89,
358		0x452821e6, 0x38d01377, 0xbe5466cf, 0x34e90c6c,
359		0xc0ac29b7, 0xc97c50dd, 0x3f84d5b5, 0xb5470917,
360		0x9216d5d9, 0x8979fb1b
361	}
362};
363
364static unsigned char BF_itoa64[64 + 1] =
365	"./ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789";
366
367static unsigned char BF_atoi64[0x60] = {
368	64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 0, 1,
369	54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 64, 64, 64, 64, 64,
370	64, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,
371	17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 64, 64, 64, 64, 64,
372	64, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42,
373	43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 64, 64, 64, 64, 64
374};
375
376#define BF_safe_atoi64(dst, src) \
377{ \
378	tmp = (unsigned char)(src); \
379	if ((unsigned int)(tmp -= 0x20) >= 0x60) return -1; \
380	tmp = BF_atoi64[tmp]; \
381	if (tmp > 63) return -1; \
382	(dst) = tmp; \
383}
384
385static int BF_decode(BF_word *dst, const char *src, int size)
386{
387	unsigned char *dptr = (unsigned char *)dst;
388	unsigned char *end = dptr + size;
389	const unsigned char *sptr = (const unsigned char *)src;
390	unsigned int tmp, c1, c2, c3, c4;
391
392	do {
393		BF_safe_atoi64(c1, *sptr++);
394		BF_safe_atoi64(c2, *sptr++);
395		*dptr++ = (c1 << 2) | ((c2 & 0x30) >> 4);
396		if (dptr >= end) break;
397
398		BF_safe_atoi64(c3, *sptr++);
399		*dptr++ = ((c2 & 0x0F) << 4) | ((c3 & 0x3C) >> 2);
400		if (dptr >= end) break;
401
402		BF_safe_atoi64(c4, *sptr++);
403		*dptr++ = ((c3 & 0x03) << 6) | c4;
404	} while (dptr < end);
405
406	return 0;
407}
408
409static void BF_encode(char *dst, const BF_word *src, int size)
410{
411	const unsigned char *sptr = (const unsigned char *)src;
412	const unsigned char *end = sptr + size;
413	unsigned char *dptr = (unsigned char *)dst;
414	unsigned int c1, c2;
415
416	do {
417		c1 = *sptr++;
418		*dptr++ = BF_itoa64[c1 >> 2];
419		c1 = (c1 & 0x03) << 4;
420		if (sptr >= end) {
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			*dptr++ = BF_itoa64[c1];
431			break;
432		}
433
434		c2 = *sptr++;
435		c1 |= c2 >> 6;
436		*dptr++ = BF_itoa64[c1];
437		*dptr++ = BF_itoa64[c2 & 0x3f];
438	} while (sptr < end);
439}
440
441static void BF_swap(BF_word *x, int count)
442{
443	static int endianness_check = 1;
444	char *is_little_endian = (char *)&endianness_check;
445	BF_word tmp;
446
447	if (*is_little_endian)
448	do {
449		tmp = *x;
450		tmp = (tmp << 16) | (tmp >> 16);
451		*x++ = ((tmp & 0x00FF00FF) << 8) | ((tmp >> 8) & 0x00FF00FF);
452	} while (--count);
453}
454
455#if BF_SCALE
456/* Architectures which can shift addresses left by 2 bits with no extra cost */
457#define BF_ROUND(L, R, N) \
458	tmp1 = L & 0xFF; \
459	tmp2 = L >> 8; \
460	tmp2 &= 0xFF; \
461	tmp3 = L >> 16; \
462	tmp3 &= 0xFF; \
463	tmp4 = L >> 24; \
464	tmp1 = data.ctx.S[3][tmp1]; \
465	tmp2 = data.ctx.S[2][tmp2]; \
466	tmp3 = data.ctx.S[1][tmp3]; \
467	tmp3 += data.ctx.S[0][tmp4]; \
468	tmp3 ^= tmp2; \
469	R ^= data.ctx.P[N + 1]; \
470	tmp3 += tmp1; \
471	R ^= tmp3;
472#else
473/* Architectures with no complicated addressing modes supported */
474#define BF_INDEX(S, i) \
475	(*((BF_word *)(((unsigned char *)S) + (i))))
476#define BF_ROUND(L, R, N) \
477	tmp1 = L & 0xFF; \
478	tmp1 <<= 2; \
479	tmp2 = L >> 6; \
480	tmp2 &= 0x3FC; \
481	tmp3 = L >> 14; \
482	tmp3 &= 0x3FC; \
483	tmp4 = L >> 22; \
484	tmp4 &= 0x3FC; \
485	tmp1 = BF_INDEX(data.ctx.S[3], tmp1); \
486	tmp2 = BF_INDEX(data.ctx.S[2], tmp2); \
487	tmp3 = BF_INDEX(data.ctx.S[1], tmp3); \
488	tmp3 += BF_INDEX(data.ctx.S[0], tmp4); \
489	tmp3 ^= tmp2; \
490	R ^= data.ctx.P[N + 1]; \
491	tmp3 += tmp1; \
492	R ^= tmp3;
493#endif
494
495/*
496 * Encrypt one block, BF_N is hardcoded here.
497 */
498#define BF_ENCRYPT \
499	L ^= data.ctx.P[0]; \
500	BF_ROUND(L, R, 0); \
501	BF_ROUND(R, L, 1); \
502	BF_ROUND(L, R, 2); \
503	BF_ROUND(R, L, 3); \
504	BF_ROUND(L, R, 4); \
505	BF_ROUND(R, L, 5); \
506	BF_ROUND(L, R, 6); \
507	BF_ROUND(R, L, 7); \
508	BF_ROUND(L, R, 8); \
509	BF_ROUND(R, L, 9); \
510	BF_ROUND(L, R, 10); \
511	BF_ROUND(R, L, 11); \
512	BF_ROUND(L, R, 12); \
513	BF_ROUND(R, L, 13); \
514	BF_ROUND(L, R, 14); \
515	BF_ROUND(R, L, 15); \
516	tmp4 = R; \
517	R = L; \
518	L = tmp4 ^ data.ctx.P[BF_N + 1];
519
520#if BF_ASM
521#define BF_body() \
522	_BF_body_r(&data.ctx);
523#else
524#define BF_body() \
525	L = R = 0; \
526	ptr = data.ctx.P; \
527	do { \
528		ptr += 2; \
529		BF_ENCRYPT; \
530		*(ptr - 2) = L; \
531		*(ptr - 1) = R; \
532	} while (ptr < &data.ctx.P[BF_N + 2]); \
533\
534	ptr = data.ctx.S[0]; \
535	do { \
536		ptr += 2; \
537		BF_ENCRYPT; \
538		*(ptr - 2) = L; \
539		*(ptr - 1) = R; \
540	} while (ptr < &data.ctx.S[3][0xFF]);
541#endif
542
543static void BF_set_key(const char *key, BF_key expanded, BF_key initial,
544    unsigned char flags)
545{
546	const char *ptr = key;
547	unsigned int bug, i, j;
548	BF_word safety, sign, diff, tmp[2];
549
550/*
551 * There was a sign extension bug in older revisions of this function.  While
552 * we would have liked to simply fix the bug and move on, we have to provide
553 * a backwards compatibility feature (essentially the bug) for some systems and
554 * a safety measure for some others.  The latter is needed because for certain
555 * multiple inputs to the buggy algorithm there exist easily found inputs to
556 * the correct algorithm that produce the same hash.  Thus, we optionally
557 * deviate from the correct algorithm just enough to avoid such collisions.
558 * While the bug itself affected the majority of passwords containing
559 * characters with the 8th bit set (although only a percentage of those in a
560 * collision-producing way), the anti-collision safety measure affects
561 * only a subset of passwords containing the '\xff' character (not even all of
562 * those passwords, just some of them).  This character is not found in valid
563 * UTF-8 sequences and is rarely used in popular 8-bit character encodings.
564 * Thus, the safety measure is unlikely to cause much annoyance, and is a
565 * reasonable tradeoff to use when authenticating against existing hashes that
566 * are not reliably known to have been computed with the correct algorithm.
567 *
568 * We use an approach that tries to minimize side-channel leaks of password
569 * information - that is, we mostly use fixed-cost bitwise operations instead
570 * of branches or table lookups.  (One conditional branch based on password
571 * length remains.  It is not part of the bug aftermath, though, and is
572 * difficult and possibly unreasonable to avoid given the use of C strings by
573 * the caller, which results in similar timing leaks anyway.)
574 *
575 * For actual implementation, we set an array index in the variable "bug"
576 * (0 means no bug, 1 means sign extension bug emulation) and a flag in the
577 * variable "safety" (bit 16 is set when the safety measure is requested).
578 * Valid combinations of settings are:
579 *
580 * Prefix "$2a$": bug = 0, safety = 0x10000
581 * Prefix "$2x$": bug = 1, safety = 0
582 * Prefix "$2y$": bug = 0, safety = 0
583 */
584	bug = (unsigned int)flags & 1;
585	safety = ((BF_word)flags & 2) << 15;
586
587	sign = diff = 0;
588
589	for (i = 0; i < BF_N + 2; i++) {
590		tmp[0] = tmp[1] = 0;
591		for (j = 0; j < 4; j++) {
592			tmp[0] <<= 8;
593			tmp[0] |= (unsigned char)*ptr; /* correct */
594			tmp[1] <<= 8;
595			tmp[1] |= (BF_word_signed)(signed char)*ptr; /* bug */
596/*
597 * Sign extension in the first char has no effect - nothing to overwrite yet,
598 * and those extra 24 bits will be fully shifted out of the 32-bit word.  For
599 * chars 2, 3, 4 in each four-char block, we set bit 7 of "sign" if sign
600 * extension in tmp[1] occurs.  Once this flag is set, it remains set.
601 */
602			if (j)
603				sign |= tmp[1] & 0x80;
604			if (!*ptr)
605				ptr = key;
606			else
607				ptr++;
608		}
609		diff |= tmp[0] ^ tmp[1]; /* Non-zero on any differences */
610
611		expanded[i] = tmp[bug];
612		initial[i] = BF_init_state.P[i] ^ tmp[bug];
613	}
614
615/*
616 * At this point, "diff" is zero iff the correct and buggy algorithms produced
617 * exactly the same result.  If so and if "sign" is non-zero, which indicates
618 * that there was a non-benign sign extension, this means that we have a
619 * collision between the correctly computed hash for this password and a set of
620 * passwords that could be supplied to the buggy algorithm.  Our safety measure
621 * is meant to protect from such many-buggy to one-correct collisions, by
622 * deviating from the correct algorithm in such cases.  Let's check for this.
623 */
624	diff |= diff >> 16; /* still zero iff exact match */
625	diff &= 0xffff; /* ditto */
626	diff += 0xffff; /* bit 16 set iff "diff" was non-zero (on non-match) */
627	sign <<= 9; /* move the non-benign sign extension flag to bit 16 */
628	sign &= ~diff & safety; /* action needed? */
629
630/*
631 * If we have determined that we need to deviate from the correct algorithm,
632 * flip bit 16 in initial expanded key.  (The choice of 16 is arbitrary, but
633 * let's stick to it now.  It came out of the approach we used above, and it's
634 * not any worse than any other choice we could make.)
635 *
636 * It is crucial that we don't do the same to the expanded key used in the main
637 * Eksblowfish loop.  By doing it to only one of these two, we deviate from a
638 * state that could be directly specified by a password to the buggy algorithm
639 * (and to the fully correct one as well, but that's a side-effect).
640 */
641	initial[0] ^= sign;
642}
643
644static char *BF_crypt(const char *key, const char *setting,
645	char *output, int size,
646	BF_word min)
647{
648#if BF_ASM
649	extern void _BF_body_r(BF_ctx *ctx);
650#endif
651	static const unsigned char flags_by_subtype[26] =
652		{2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
653		0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 4, 0};
654	struct {
655		BF_ctx ctx;
656		BF_key expanded_key;
657		union {
658			BF_word salt[4];
659			BF_word output[6];
660		} binary;
661	} data;
662	BF_word L, R;
663	BF_word tmp1, tmp2, tmp3, tmp4;
664	BF_word *ptr;
665	BF_word count;
666	int i;
667
668	if (size < 7 + 22 + 31 + 1) {
669		__set_errno(ERANGE);
670		return NULL;
671	}
672
673	if (setting[0] != '$' ||
674	    setting[1] != '2' ||
675	    setting[2] < 'a' || setting[2] > 'z' ||
676	    !flags_by_subtype[(unsigned int)(unsigned char)setting[2] - 'a'] ||
677	    setting[3] != '$' ||
678	    setting[4] < '0' || setting[4] > '3' ||
679	    setting[5] < '0' || setting[5] > '9' ||
680	    (setting[4] == '3' && setting[5] > '1') ||
681	    setting[6] != '$') {
682		__set_errno(EINVAL);
683		return NULL;
684	}
685
686	count = (BF_word)1 << ((setting[4] - '0') * 10 + (setting[5] - '0'));
687	if (count < min || BF_decode(data.binary.salt, &setting[7], 16)) {
688		__set_errno(EINVAL);
689		return NULL;
690	}
691	BF_swap(data.binary.salt, 4);
692
693	BF_set_key(key, data.expanded_key, data.ctx.P,
694	    flags_by_subtype[(unsigned int)(unsigned char)setting[2] - 'a']);
695
696	memcpy(data.ctx.S, BF_init_state.S, sizeof(data.ctx.S));
697
698	L = R = 0;
699	for (i = 0; i < BF_N + 2; i += 2) {
700		L ^= data.binary.salt[i & 2];
701		R ^= data.binary.salt[(i & 2) + 1];
702		BF_ENCRYPT;
703		data.ctx.P[i] = L;
704		data.ctx.P[i + 1] = R;
705	}
706
707	ptr = data.ctx.S[0];
708	do {
709		ptr += 4;
710		L ^= data.binary.salt[(BF_N + 2) & 3];
711		R ^= data.binary.salt[(BF_N + 3) & 3];
712		BF_ENCRYPT;
713		*(ptr - 4) = L;
714		*(ptr - 3) = R;
715
716		L ^= data.binary.salt[(BF_N + 4) & 3];
717		R ^= data.binary.salt[(BF_N + 5) & 3];
718		BF_ENCRYPT;
719		*(ptr - 2) = L;
720		*(ptr - 1) = R;
721	} while (ptr < &data.ctx.S[3][0xFF]);
722
723	do {
724		int done;
725
726		for (i = 0; i < BF_N + 2; i += 2) {
727			data.ctx.P[i] ^= data.expanded_key[i];
728			data.ctx.P[i + 1] ^= data.expanded_key[i + 1];
729		}
730
731		done = 0;
732		do {
733			BF_body();
734			if (done)
735				break;
736			done = 1;
737
738			tmp1 = data.binary.salt[0];
739			tmp2 = data.binary.salt[1];
740			tmp3 = data.binary.salt[2];
741			tmp4 = data.binary.salt[3];
742			for (i = 0; i < BF_N; i += 4) {
743				data.ctx.P[i] ^= tmp1;
744				data.ctx.P[i + 1] ^= tmp2;
745				data.ctx.P[i + 2] ^= tmp3;
746				data.ctx.P[i + 3] ^= tmp4;
747			}
748			data.ctx.P[16] ^= tmp1;
749			data.ctx.P[17] ^= tmp2;
750		} while (1);
751	} while (--count);
752
753	for (i = 0; i < 6; i += 2) {
754		L = BF_magic_w[i];
755		R = BF_magic_w[i + 1];
756
757		count = 64;
758		do {
759			BF_ENCRYPT;
760		} while (--count);
761
762		data.binary.output[i] = L;
763		data.binary.output[i + 1] = R;
764	}
765
766	memcpy(output, setting, 7 + 22 - 1);
767	output[7 + 22 - 1] = BF_itoa64[(int)
768		BF_atoi64[(int)setting[7 + 22 - 1] - 0x20] & 0x30];
769
770/* This has to be bug-compatible with the original implementation, so
771 * only encode 23 of the 24 bytes. :-) */
772	BF_swap(data.binary.output, 6);
773	BF_encode(&output[7 + 22], data.binary.output, 23);
774	output[7 + 22 + 31] = '\0';
775
776	return output;
777}
778
779int _crypt_output_magic(const char *setting, char *output, int size)
780{
781	if (size < 3)
782		return -1;
783
784	output[0] = '*';
785	output[1] = '0';
786	output[2] = '\0';
787
788	if (setting[0] == '*' && setting[1] == '0')
789		output[1] = '1';
790
791	return 0;
792}
793
794/*
795 * Please preserve the runtime self-test.  It serves two purposes at once:
796 *
797 * 1. We really can't afford the risk of producing incompatible hashes e.g.
798 * when there's something like gcc bug 26587 again, whereas an application or
799 * library integrating this code might not also integrate our external tests or
800 * it might not run them after every build.  Even if it does, the miscompile
801 * might only occur on the production build, but not on a testing build (such
802 * as because of different optimization settings).  It is painful to recover
803 * from incorrectly-computed hashes - merely fixing whatever broke is not
804 * enough.  Thus, a proactive measure like this self-test is needed.
805 *
806 * 2. We don't want to leave sensitive data from our actual password hash
807 * computation on the stack or in registers.  Previous revisions of the code
808 * would do explicit cleanups, but simply running the self-test after hash
809 * computation is more reliable.
810 *
811 * The performance cost of this quick self-test is around 0.6% at the "$2a$08"
812 * setting.
813 */
814char *_crypt_blowfish_rn(const char *key, const char *setting,
815	char *output, int size)
816{
817	const char *test_key = "8b \xd0\xc1\xd2\xcf\xcc\xd8";
818	const char *test_setting = "$2a$00$abcdefghijklmnopqrstuu";
819	static const char * const test_hash[2] =
820		{"VUrPmXD6q/nVSSp7pNDhCR9071IfIRe\0\x55", /* $2x$ */
821		"i1D709vfamulimlGcq0qq3UvuUasvEa\0\x55"}; /* $2a$, $2y$ */
822	char *retval;
823	const char *p;
824	int save_errno, ok;
825	struct {
826		char s[7 + 22 + 1];
827		char o[7 + 22 + 31 + 1 + 1 + 1];
828	} buf;
829
830/* Hash the supplied password */
831	_crypt_output_magic(setting, output, size);
832	retval = BF_crypt(key, setting, output, size, 16);
833	save_errno = errno;
834
835/*
836 * Do a quick self-test.  It is important that we make both calls to BF_crypt()
837 * from the same scope such that they likely use the same stack locations,
838 * which makes the second call overwrite the first call's sensitive data on the
839 * stack and makes it more likely that any alignment related issues would be
840 * detected by the self-test.
841 */
842	memcpy(buf.s, test_setting, sizeof(buf.s));
843	if (retval)
844		buf.s[2] = setting[2];
845	memset(buf.o, 0x55, sizeof(buf.o));
846	buf.o[sizeof(buf.o) - 1] = 0;
847	p = BF_crypt(test_key, buf.s, buf.o, sizeof(buf.o) - (1 + 1), 1);
848
849	ok = (p == buf.o &&
850	    !memcmp(p, buf.s, 7 + 22) &&
851	    !memcmp(p + (7 + 22),
852	    test_hash[(unsigned int)(unsigned char)buf.s[2] & 1],
853	    31 + 1 + 1 + 1));
854
855	{
856		const char *k = "\xff\xa3" "34" "\xff\xff\xff\xa3" "345";
857		BF_key ae, ai, ye, yi;
858		BF_set_key(k, ae, ai, 2); /* $2a$ */
859		BF_set_key(k, ye, yi, 4); /* $2y$ */
860		ai[0] ^= 0x10000; /* undo the safety (for comparison) */
861		ok = ok && ai[0] == 0xdb9c59bc && ye[17] == 0x33343500 &&
862		    !memcmp(ae, ye, sizeof(ae)) &&
863		    !memcmp(ai, yi, sizeof(ai));
864	}
865
866	__set_errno(save_errno);
867	if (ok)
868		return retval;
869
870/* Should not happen */
871	_crypt_output_magic(setting, output, size);
872	__set_errno(EINVAL); /* pretend we don't support this hash type */
873	return NULL;
874}
875
876char *_crypt_gensalt_blowfish_rn(const char *prefix, unsigned long count,
877	const char *input, int size, char *output, int output_size)
878{
879	if (size < 16 || output_size < 7 + 22 + 1 ||
880	    (count && (count < 4 || count > 31)) ||
881	    prefix[0] != '$' || prefix[1] != '2' ||
882	    (prefix[2] != 'a' && prefix[2] != 'y')) {
883		if (output_size > 0) output[0] = '\0';
884		__set_errno((output_size < 7 + 22 + 1) ? ERANGE : EINVAL);
885		return NULL;
886	}
887
888	if (!count) count = 5;
889
890	output[0] = '$';
891	output[1] = '2';
892	output[2] = prefix[2];
893	output[3] = '$';
894	output[4] = '0' + count / 10;
895	output[5] = '0' + count % 10;
896	output[6] = '$';
897
898	BF_encode(&output[7], (const BF_word *)input, 16);
899	output[7 + 22] = '\0';
900
901	return output;
902}
903