unrealircd

- supernets unrealircd source & configuration
git clone git://git.acid.vegas/unrealircd.git
Log | Files | Refs | Archive | README | LICENSE

crypt_blowfish.c (32368B)

      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-2014.
     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-2014 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 fully compatible with OpenBSD's bcrypt.c for prefix
     31  * "$2b$", originally by Niels Provos <provos at citi.umich.edu>, and it uses
     32  * some of his ideas.  The password hashing algorithm was designed by David
     33  * Mazieres <dm at lcs.mit.edu>.  For information on the level of
     34  * compatibility for bcrypt hash prefixes other than "$2b$", please refer to
     35  * the comments in BF_set_key() below and to the included 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 /* old x86 asm not included in UnrealIRCd */
     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 
     67 typedef unsigned int BF_word;
     68 typedef 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 
     73 typedef BF_word BF_key[BF_N + 2];
     74 
     75 typedef 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  */
     84 static 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  */
     92 static 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 
    364 static unsigned char BF_itoa64[64 + 1] =
    365 	"./ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789";
    366 
    367 static 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 
    385 static 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 *client = (const unsigned char *)src;
    390 	unsigned int tmp, c1, c2, c3, c4;
    391 
    392 	do {
    393 		BF_safe_atoi64(c1, *client++);
    394 		BF_safe_atoi64(c2, *client++);
    395 		*dptr++ = (c1 << 2) | ((c2 & 0x30) >> 4);
    396 		if (dptr >= end) break;
    397 
    398 		BF_safe_atoi64(c3, *client++);
    399 		*dptr++ = ((c2 & 0x0F) << 4) | ((c3 & 0x3C) >> 2);
    400 		if (dptr >= end) break;
    401 
    402 		BF_safe_atoi64(c4, *client++);
    403 		*dptr++ = ((c3 & 0x03) << 6) | c4;
    404 	} while (dptr < end);
    405 
    406 	return 0;
    407 }
    408 
    409 static void BF_encode(char *dst, const BF_word *src, int size)
    410 {
    411 	const unsigned char *client = (const unsigned char *)src;
    412 	const unsigned char *end = client + size;
    413 	unsigned char *dptr = (unsigned char *)dst;
    414 	unsigned int c1, c2;
    415 
    416 	do {
    417 		c1 = *client++;
    418 		*dptr++ = BF_itoa64[c1 >> 2];
    419 		c1 = (c1 & 0x03) << 4;
    420 		if (client >= end) {
    421 			*dptr++ = BF_itoa64[c1];
    422 			break;
    423 		}
    424 
    425 		c2 = *client++;
    426 		c1 |= c2 >> 4;
    427 		*dptr++ = BF_itoa64[c1];
    428 		c1 = (c2 & 0x0f) << 2;
    429 		if (client >= end) {
    430 			*dptr++ = BF_itoa64[c1];
    431 			break;
    432 		}
    433 
    434 		c2 = *client++;
    435 		c1 |= c2 >> 6;
    436 		*dptr++ = BF_itoa64[c1];
    437 		*dptr++ = BF_itoa64[c2 & 0x3f];
    438 	} while (client < end);
    439 }
    440 
    441 static 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 
    543 static 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 "$2b$": bug = 0, safety = 0
    582  * Prefix "$2x$": bug = 1, safety = 0
    583  * Prefix "$2y$": bug = 0, safety = 0
    584  */
    585 	bug = (unsigned int)flags & 1;
    586 	safety = ((BF_word)flags & 2) << 15;
    587 
    588 	sign = diff = 0;
    589 
    590 	for (i = 0; i < BF_N + 2; i++) {
    591 		tmp[0] = tmp[1] = 0;
    592 		for (j = 0; j < 4; j++) {
    593 			tmp[0] <<= 8;
    594 			tmp[0] |= (unsigned char)*ptr; /* correct */
    595 			tmp[1] <<= 8;
    596 			tmp[1] |= (BF_word_signed)(signed char)*ptr; /* bug */
    597 /*
    598  * Sign extension in the first char has no effect - nothing to overwrite yet,
    599  * and those extra 24 bits will be fully shifted out of the 32-bit word.  For
    600  * chars 2, 3, 4 in each four-char block, we set bit 7 of "sign" if sign
    601  * extension in tmp[1] occurs.  Once this flag is set, it remains set.
    602  */
    603 			if (j)
    604 				sign |= tmp[1] & 0x80;
    605 			if (!*ptr)
    606 				ptr = key;
    607 			else
    608 				ptr++;
    609 		}
    610 		diff |= tmp[0] ^ tmp[1]; /* Non-zero on any differences */
    611 
    612 		expanded[i] = tmp[bug];
    613 		initial[i] = BF_init_state.P[i] ^ tmp[bug];
    614 	}
    615 
    616 /*
    617  * At this point, "diff" is zero iff the correct and buggy algorithms produced
    618  * exactly the same result.  If so and if "sign" is non-zero, which indicates
    619  * that there was a non-benign sign extension, this means that we have a
    620  * collision between the correctly computed hash for this password and a set of
    621  * passwords that could be supplied to the buggy algorithm.  Our safety measure
    622  * is meant to protect from such many-buggy to one-correct collisions, by
    623  * deviating from the correct algorithm in such cases.  Let's check for this.
    624  */
    625 	diff |= diff >> 16; /* still zero iff exact match */
    626 	diff &= 0xffff; /* ditto */
    627 	diff += 0xffff; /* bit 16 set iff "diff" was non-zero (on non-match) */
    628 	sign <<= 9; /* move the non-benign sign extension flag to bit 16 */
    629 	sign &= ~diff & safety; /* action needed? */
    630 
    631 /*
    632  * If we have determined that we need to deviate from the correct algorithm,
    633  * flip bit 16 in initial expanded key.  (The choice of 16 is arbitrary, but
    634  * let's stick to it now.  It came out of the approach we used above, and it's
    635  * not any worse than any other choice we could make.)
    636  *
    637  * It is crucial that we don't do the same to the expanded key used in the main
    638  * Eksblowfish loop.  By doing it to only one of these two, we deviate from a
    639  * state that could be directly specified by a password to the buggy algorithm
    640  * (and to the fully correct one as well, but that's a side-effect).
    641  */
    642 	initial[0] ^= sign;
    643 }
    644 
    645 static const unsigned char flags_by_subtype[26] =
    646 	{2, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    647 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 4, 0};
    648 
    649 static char *BF_crypt(const char *key, const char *setting,
    650 	char *output, int size,
    651 	BF_word min)
    652 {
    653 #if BF_ASM
    654 	extern void _BF_body_r(BF_ctx *ctx);
    655 #endif
    656 	struct {
    657 		BF_ctx ctx;
    658 		BF_key expanded_key;
    659 		union {
    660 			BF_word salt[4];
    661 			BF_word output[6];
    662 		} binary;
    663 	} data;
    664 	BF_word L, R;
    665 	BF_word tmp1, tmp2, tmp3, tmp4;
    666 	BF_word *ptr;
    667 	BF_word count;
    668 	int i;
    669 
    670 	if (size < 7 + 22 + 31 + 1) {
    671 		__set_errno(ERANGE);
    672 		return NULL;
    673 	}
    674 
    675 	if (setting[0] != '$' ||
    676 	    setting[1] != '2' ||
    677 	    setting[2] < 'a' || setting[2] > 'z' ||
    678 	    !flags_by_subtype[(unsigned int)(unsigned char)setting[2] - 'a'] ||
    679 	    setting[3] != '$' ||
    680 	    setting[4] < '0' || setting[4] > '3' ||
    681 	    setting[5] < '0' || setting[5] > '9' ||
    682 	    (setting[4] == '3' && setting[5] > '1') ||
    683 	    setting[6] != '$') {
    684 		__set_errno(EINVAL);
    685 		return NULL;
    686 	}
    687 
    688 	count = (BF_word)1 << ((setting[4] - '0') * 10 + (setting[5] - '0'));
    689 	if (count < min || BF_decode(data.binary.salt, &setting[7], 16)) {
    690 		__set_errno(EINVAL);
    691 		return NULL;
    692 	}
    693 	BF_swap(data.binary.salt, 4);
    694 
    695 	BF_set_key(key, data.expanded_key, data.ctx.P,
    696 	    flags_by_subtype[(unsigned int)(unsigned char)setting[2] - 'a']);
    697 
    698 	memcpy(data.ctx.S, BF_init_state.S, sizeof(data.ctx.S));
    699 
    700 	L = R = 0;
    701 	for (i = 0; i < BF_N + 2; i += 2) {
    702 		L ^= data.binary.salt[i & 2];
    703 		R ^= data.binary.salt[(i & 2) + 1];
    704 		BF_ENCRYPT;
    705 		data.ctx.P[i] = L;
    706 		data.ctx.P[i + 1] = R;
    707 	}
    708 
    709 	ptr = data.ctx.S[0];
    710 	do {
    711 		ptr += 4;
    712 		L ^= data.binary.salt[(BF_N + 2) & 3];
    713 		R ^= data.binary.salt[(BF_N + 3) & 3];
    714 		BF_ENCRYPT;
    715 		*(ptr - 4) = L;
    716 		*(ptr - 3) = R;
    717 
    718 		L ^= data.binary.salt[(BF_N + 4) & 3];
    719 		R ^= data.binary.salt[(BF_N + 5) & 3];
    720 		BF_ENCRYPT;
    721 		*(ptr - 2) = L;
    722 		*(ptr - 1) = R;
    723 	} while (ptr < &data.ctx.S[3][0xFF]);
    724 
    725 	do {
    726 		int done;
    727 
    728 		for (i = 0; i < BF_N + 2; i += 2) {
    729 			data.ctx.P[i] ^= data.expanded_key[i];
    730 			data.ctx.P[i + 1] ^= data.expanded_key[i + 1];
    731 		}
    732 
    733 		done = 0;
    734 		do {
    735 			BF_body();
    736 			if (done)
    737 				break;
    738 			done = 1;
    739 
    740 			tmp1 = data.binary.salt[0];
    741 			tmp2 = data.binary.salt[1];
    742 			tmp3 = data.binary.salt[2];
    743 			tmp4 = data.binary.salt[3];
    744 			for (i = 0; i < BF_N; i += 4) {
    745 				data.ctx.P[i] ^= tmp1;
    746 				data.ctx.P[i + 1] ^= tmp2;
    747 				data.ctx.P[i + 2] ^= tmp3;
    748 				data.ctx.P[i + 3] ^= tmp4;
    749 			}
    750 			data.ctx.P[16] ^= tmp1;
    751 			data.ctx.P[17] ^= tmp2;
    752 		} while (1);
    753 	} while (--count);
    754 
    755 	for (i = 0; i < 6; i += 2) {
    756 		L = BF_magic_w[i];
    757 		R = BF_magic_w[i + 1];
    758 
    759 		count = 64;
    760 		do {
    761 			BF_ENCRYPT;
    762 		} while (--count);
    763 
    764 		data.binary.output[i] = L;
    765 		data.binary.output[i + 1] = R;
    766 	}
    767 
    768 	memcpy(output, setting, 7 + 22 - 1);
    769 	output[7 + 22 - 1] = BF_itoa64[(int)
    770 		BF_atoi64[(int)setting[7 + 22 - 1] - 0x20] & 0x30];
    771 
    772 /* This has to be bug-compatible with the original implementation, so
    773  * only encode 23 of the 24 bytes. :-) */
    774 	BF_swap(data.binary.output, 6);
    775 	BF_encode(&output[7 + 22], data.binary.output, 23);
    776 	output[7 + 22 + 31] = '\0';
    777 
    778 	return output;
    779 }
    780 
    781 int _crypt_output_magic(const char *setting, char *output, int size)
    782 {
    783 	if (size < 3)
    784 		return -1;
    785 
    786 	output[0] = '*';
    787 	output[1] = '0';
    788 	output[2] = '\0';
    789 
    790 	if (setting[0] == '*' && setting[1] == '0')
    791 		output[1] = '1';
    792 
    793 	return 0;
    794 }
    795 
    796 /*
    797  * Please preserve the runtime self-test.  It serves two purposes at once:
    798  *
    799  * 1. We really can't afford the risk of producing incompatible hashes e.g.
    800  * when there's something like gcc bug 26587 again, whereas an application or
    801  * library integrating this code might not also integrate our external tests or
    802  * it might not run them after every build.  Even if it does, the miscompile
    803  * might only occur on the production build, but not on a testing build (such
    804  * as because of different optimization settings).  It is painful to recover
    805  * from incorrectly-computed hashes - merely fixing whatever broke is not
    806  * enough.  Thus, a proactive measure like this self-test is needed.
    807  *
    808  * 2. We don't want to leave sensitive data from our actual password hash
    809  * computation on the stack or in registers.  Previous revisions of the code
    810  * would do explicit cleanups, but simply running the self-test after hash
    811  * computation is more reliable.
    812  *
    813  * The performance cost of this quick self-test is around 0.6% at the "$2a$08"
    814  * setting.
    815  */
    816 char *_crypt_blowfish_rn(const char *key, const char *setting,
    817 	char *output, int size)
    818 {
    819 	const char *test_key = "8b \xd0\xc1\xd2\xcf\xcc\xd8";
    820 	const char *test_setting = "$2a$00$abcdefghijklmnopqrstuu";
    821 	static const char * const test_hashes[2] =
    822 		{"i1D709vfamulimlGcq0qq3UvuUasvEa\0\x55", /* 'a', 'b', 'y' */
    823 		"VUrPmXD6q/nVSSp7pNDhCR9071IfIRe\0\x55"}; /* 'x' */
    824 	const char *test_hash = test_hashes[0];
    825 	char *retval;
    826 	const char *p;
    827 	int save_errno, ok;
    828 	struct {
    829 		char s[7 + 22 + 1];
    830 		char o[7 + 22 + 31 + 1 + 1 + 1];
    831 	} buf;
    832 
    833 /* Hash the supplied password */
    834 	_crypt_output_magic(setting, output, size);
    835 	retval = BF_crypt(key, setting, output, size, 16);
    836 	save_errno = errno;
    837 
    838 /*
    839  * Do a quick self-test.  It is important that we make both calls to BF_crypt()
    840  * from the same scope such that they likely use the same stack locations,
    841  * which makes the second call overwrite the first call's sensitive data on the
    842  * stack and makes it more likely that any alignment related issues would be
    843  * detected by the self-test.
    844  */
    845 	memcpy(buf.s, test_setting, sizeof(buf.s));
    846 	if (retval) {
    847 		unsigned int flags = flags_by_subtype[
    848 		    (unsigned int)(unsigned char)setting[2] - 'a'];
    849 		test_hash = test_hashes[flags & 1];
    850 		buf.s[2] = setting[2];
    851 	}
    852 	memset(buf.o, 0x55, sizeof(buf.o));
    853 	buf.o[sizeof(buf.o) - 1] = 0;
    854 	p = BF_crypt(test_key, buf.s, buf.o, sizeof(buf.o) - (1 + 1), 1);
    855 
    856 	ok = (p == buf.o &&
    857 	    !memcmp(p, buf.s, 7 + 22) &&
    858 	    !memcmp(p + (7 + 22), test_hash, 31 + 1 + 1 + 1));
    859 
    860 	{
    861 		const char *k = "\xff\xa3" "34" "\xff\xff\xff\xa3" "345";
    862 		BF_key ae, ai, ye, yi;
    863 		BF_set_key(k, ae, ai, 2); /* $2a$ */
    864 		BF_set_key(k, ye, yi, 4); /* $2y$ */
    865 		ai[0] ^= 0x10000; /* undo the safety (for comparison) */
    866 		ok = ok && ai[0] == 0xdb9c59bc && ye[17] == 0x33343500 &&
    867 		    !memcmp(ae, ye, sizeof(ae)) &&
    868 		    !memcmp(ai, yi, sizeof(ai));
    869 	}
    870 
    871 	__set_errno(save_errno);
    872 	if (ok)
    873 		return retval;
    874 
    875 /* Should not happen */
    876 	_crypt_output_magic(setting, output, size);
    877 	__set_errno(EINVAL); /* pretend we don't support this hash type */
    878 	return NULL;
    879 }
    880 
    881 char *_crypt_gensalt_blowfish_rn(const char *prefix, unsigned long count,
    882 	const char *input, int size, char *output, int output_size)
    883 {
    884 	if (size < 16 || output_size < 7 + 22 + 1 ||
    885 	    (count && (count < 4 || count > 31)) ||
    886 	    prefix[0] != '$' || prefix[1] != '2' ||
    887 	    (prefix[2] != 'a' && prefix[2] != 'b' && prefix[2] != 'y')) {
    888 		if (output_size > 0) output[0] = '\0';
    889 		__set_errno((output_size < 7 + 22 + 1) ? ERANGE : EINVAL);
    890 		return NULL;
    891 	}
    892 
    893 	if (!count) count = 5;
    894 
    895 	output[0] = '$';
    896 	output[1] = '2';
    897 	output[2] = prefix[2];
    898 	output[3] = '$';
    899 	output[4] = '0' + count / 10;
    900 	output[5] = '0' + count % 10;
    901 	output[6] = '$';
    902 
    903 	BF_encode(&output[7], (const BF_word *)input, 16);
    904 	output[7 + 22] = '\0';
    905 
    906 	return output;
    907 }