anope

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

enc_bcrypt.cpp (33668B)

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