1#!/usr/bin/env perl
2
3##
4## Author......: See docs/credits.txt
5## License.....: MIT
6##
7
8use strict;
9use warnings;
10
11use Crypt::CBC;
12use Digest::MD5 qw (md5);
13
14sub module_constraints { [[0, 256], [32, 32], [-1, -1], [-1, -1], [-1, -1]] }
15
16sub generate_key
17{
18  my $word  = shift;
19  my $salt  = shift;
20  my $bytes = shift;
21
22  my $salt8 = substr ($salt, 0, 8);
23
24  my $out = md5 ($word . $salt8);
25
26  $out .= md5 ($out . $word . $salt8);
27
28  return substr ($out, 0, 32);
29}
30
31sub module_generate_hash
32{
33  my $word = shift;
34  my $salt = shift;
35  my $cid  = shift // 5;
36  my $data = shift;
37
38  my $salt_bin = pack ("H*", $salt);
39  my $data_bin;
40
41  my $key = generate_key ($word, $salt_bin);
42
43  my $is_decrypt = defined ($data);
44
45  if ($is_decrypt == 1)
46  {
47    $data_bin = pack ("H*", $data);
48
49    my $aes = Crypt::CBC->new ({
50      cipher      => "Crypt::Rijndael",
51      key         => $key,
52      iv          => $salt_bin,
53      keysize     => 32,
54      literal_key => 1,
55      header      => "none",
56      padding     => "standard",
57    });
58
59    my $dec_bin = $aes->decrypt ($data_bin);
60
61    ## This is a ridiculous check of successfull decryption
62    ## There are no useable asn1 parsers for perl available
63    ## We have to rely on a combination of padding check and pattern matching
64    ## The (minimum) 16 bit should be good enough for a unit test
65
66    if (length ($dec_bin) < length ($data_bin))
67    {
68      if (substr ($dec_bin, 0, 1) eq "\x30")
69      {
70        $data_bin = $dec_bin;
71      }
72    }
73  }
74  else
75  {
76    $data_bin = pack ("H*",
77      "308204bd020100300d06092a864886f70d0101010500048204a7308204a30201000282010100b7a2" .
78      "e4c254c8174219e60d9cce96737a906797b8edb86af8f055f60db7bd298b0d31d7ce97ebeae393d5" .
79      "0e6da5215b58dcd72f4d3cac9e79b6ccaed7da47d2bd04f6a767f5ab7dc0f58beb6298c1e2358ed6" .
80      "d3ef441f2326ac5db0027e08ae6c7724ff9a2a220a07e97319b6eff5cd653c7ab8b6ea9f9e89a40a" .
81      "b856f036acfd39b1e5926964a024de35052de6d3423fe763569f48869c834750b28f09cecdddb54a" .
82      "5526a2c5159d22d24606a2af6c6f47a5d9c04c454896192b8e7b82cf6f6934a23d3495059cb7e43b" .
83      "98a20bd5b5782e15d93c8b289838c0a1df82ee429f0708d97aa40d6e75ec57ff12a2714871f241a8" .
84      "6f6d8d3472b084aeb748da33e2d50203010001028201004afab8dadc1122e5fb7b225dbf4051005f" .
85      "4bdcf84620019589541ff633ea89b6dbf958fb62ae9226bfeac34c639b3e18077bd935792ba63d5e" .
86      "352ec2b5be93be57f37a21097f2f06857bceed601ff2041a417f2177b81afb246fd079040af96512" .
87      "34ca24a1456ac11641c7e319114cff23f59bcc1bfa769a0e9fcdeab98429973e10caf303f2bcb065" .
88      "f22c1cc259556de8377431237da7082cf03ce8da9530be398022f0171d468d92fcabbe776a5e9cf2" .
89      "045642868406fd03ab735a70bfec3a951bb3c7a1de0fb3ff63cef23897e4fc3f9c5edf62fd45d058" .
90      "fedc7d2fb22ec928984a061053a7138ce0417b5512579a92be0775104c0bc911f68a5e8ede298102" .
91      "818100e4e17e2c752dbf1ad1025a074dc5f9c3c5989d23c84594313373d3e4ed0c0ddd74429ab026" .
92      "535c5e77549d888835bc94f069ebc5e77fdbd2ddf4c8be6cf777799a6d8d18e2b8cecfc13ab26df8" .
93      "b71ca3d94c2193c294042fb1025fdab38ba7aaeafebd8dd1f9d78ee67100693e99255dad6b964ebf" .
94      "b7401a03b67d412fabb33502818100cd65067097e307643df1fc8214db1dd7d09342ef01417a2620" .
95      "adad87352a58b8fcf07521289da3851623d8d045935fab7ecccc52ba0b86adcb92da76255e00289b" .
96      "af9aacd936201861b0021249f4ab5e6020db823af7171aef0bbbd02dc94d2489fc0b68500bd1b7d2" .
97      "81ed69fe4a44384161fe906e49bc91e0362b446ec2c521028180497662d40c2c49b966ba758100a2" .
98      "799f2f8de369f7bef568b1560cfdde63cf13745c685fff7d2419a1fd83aeade1698cf87956d6a78e" .
99      "2f55482e683c4ea7432ec1b545e365e9e15f676ada98578b166334bcadce4a56cddd2cd85141d5fd" .
100      "0e2cdace36b30d613ea1bc2f2aed9cccf4e4536443d334cfb180680eabb73f80c1bd0281803f30fc" .
101      "b93951a4dd875d62e5968b0f746d7c51147d5b6abc3e4390e6cf4997005af993dfbec23923e1fae7" .
102      "62b47531f2ee510defc9c3700d1a5bb510b2506856160801db79fc78056850a16285145c80edac4e" .
103      "3c93ed9f532f067a2303633273b26c340a44ce4e1873107c3da6f9ac616e643ad0aecdcad14a9cff" .
104      "d4cf0ae76102818100b82528a3dfc595cf9c6a025998491e3b4849c71aa8d1222ddb14af7f82fbe5" .
105      "169ec3ba18ec28d5a9501e95bc9da72cea99e4cdfdf898f40bec6b28f838243d2f39d7226e0873ed" .
106      "ee752bcae07639a4bd0eb31be1718c456391630b83ad0e9bf3fa18a645007e64fe59af467ea021f9" .
107      "e9a0dd759b21cd0b93333a73116abcaa2a"
108     );
109  }
110
111  my $aes = Crypt::CBC->new ({
112    cipher      => "Crypt::Rijndael",
113    key         => $key,
114    iv          => $salt_bin,
115    keysize     => 32,
116    literal_key => 1,
117    header      => "none",
118    padding     => "standard",
119  });
120
121  my $enc_bin = $aes->encrypt ($data_bin);
122
123  my $hash = sprintf ('$sshng$%d$%d$%s$%d$%s', $cid, length ($salt_bin), unpack ("H*", $salt_bin), length ($enc_bin), unpack ("H*", $enc_bin));
124
125  return $hash;
126}
127
128sub module_verify_hash
129{
130  my $line = shift;
131
132  my $idx = index ($line, ':');
133
134  return unless $idx >= 0;
135
136  my $hash = substr ($line, 0, $idx);
137  my $word = substr ($line, $idx + 1);
138
139  return unless substr ($hash, 0, 7) eq '$sshng$';
140
141  my (undef, $signature, $cid, undef, $salt, undef, $data) = split '\$', $hash;
142
143  return unless defined $signature;
144  return unless defined $cid;
145  return unless defined $salt;
146  return unless defined $data;
147
148  return unless ($signature eq 'sshng');
149
150  return unless ($cid == 5);
151
152  my $word_packed = pack_if_HEX_notation ($word);
153
154  my $new_hash = module_generate_hash ($word_packed, $salt, $cid, $data);
155
156  return ($new_hash, $word);
157}
158
1591;
160