Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 172 lines (156 sloc) 4.541 kb
4a723c8 Stijn Sanders unit headers
authored
1 {
2
3 TMongoWire: mongoAuth.pas
4
5 Copyright 2010-2014 Stijn Sanders
fb8c872 Stijn Sanders renamed COPYING into LICENSE
authored
6 Made available under terms described in file "LICENSE"
4a723c8 Stijn Sanders unit headers
authored
7 https://github.com/stijnsanders/TMongoWire
8
9 }
eb5d8a8 Stijn Sanders mongoAuth.pas (including MD5Hash!)
authored
10 unit mongoAuth;
11
3ffbbda Stijn Sanders no debug by default
authored
12 {$D-}
13
eb5d8a8 Stijn Sanders mongoAuth.pas (including MD5Hash!)
authored
14 interface
15
16 uses SysUtils, mongoWire;
17
18 function MD5Hash(x:UTF8String):UTF8String;
19
20 procedure MongoWireAuthenticate(MongoWire:TMongoWire;
48e0e99 Stijn Sanders mongoAuth issue
authored
21 const UserName,Password:WideString);
22 procedure MongoWireLogout(MongoWire:TMongoWire);
eb5d8a8 Stijn Sanders mongoAuth.pas (including MD5Hash!)
authored
23
24 type
25 EMongoAuthenticationFailed=class(EMongoException);
26
27 implementation
28
29 uses
30 bsonDoc;
31
32 function MD5Hash(x:UTF8String):UTF8String;
33 const
34 roll1:array[0..3] of cardinal=(7,12,17,22);
35 roll2:array[0..3] of cardinal=(5,9,14,20);
36 roll3:array[0..3] of cardinal=(4,11,16,23);
37 roll4:array[0..3] of cardinal=(6,10,15,21);
38 base1:array[0..15] of cardinal=(
39 $d76aa478,$e8c7b756,$242070db,$c1bdceee,
40 $f57c0faf,$4787c62a,$a8304613,$fd469501,
41 $698098d8,$8b44f7af,$ffff5bb1,$895cd7be,
42 $6b901122,$fd987193,$a679438e,$49b40821);
43 base2:array[0..15] of cardinal=(
44 $f61e2562,$c040b340,$265e5a51,$e9b6c7aa,
45 $d62f105d,$02441453,$d8a1e681,$e7d3fbc8,
46 $21e1cde6,$c33707d6,$f4d50d87,$455a14ed,
47 $a9e3e905,$fcefa3f8,$676f02d9,$8d2a4c8a);
48 base3:array[0..15] of cardinal=(
49 $fffa3942,$8771f681,$6d9d6122,$fde5380c,
50 $a4beea44,$4bdecfa9,$f6bb4b60,$bebfbc70,
51 $289b7ec6,$eaa127fa,$d4ef3085,$04881d05,
52 $d9d4d039,$e6db99e5,$1fa27cf8,$c4ac5665);
53 base4:array[0..15] of cardinal=(
54 $f4292244,$432aff97,$ab9423a7,$fc93a039,
55 $655b59c3,$8f0ccc92,$ffeff47d,$85845dd1,
56 $6fa87e4f,$fe2ce6e0,$a3014314,$4e0811a1,
57 $f7537e82,$bd3af235,$2ad7d2bb,$eb86d391);
58 hex:array[0..15] of AnsiChar='0123456789abcdef';
59 var
60 a:cardinal;
9b27643 Stijn Sanders MD5 hash issue
authored
61 dl,i,j,k,l:integer;
eb5d8a8 Stijn Sanders mongoAuth.pas (including MD5Hash!)
authored
62 d:array of cardinal;
63 g,h:array[0..3] of cardinal;
64 begin
65 //based on http://www.ietf.org/rfc/rfc1321.txt
66 a:=Length(x);
67 dl:=a+9;
68 if (dl and $3F)<>0 then dl:=(dl and $FFC0)+$40;
9b27643 Stijn Sanders MD5 hash issue
authored
69 i:=dl;
eb5d8a8 Stijn Sanders mongoAuth.pas (including MD5Hash!)
authored
70 dl:=dl shr 2;
71 SetLength(d,dl);
9b27643 Stijn Sanders MD5 hash issue
authored
72 SetLength(x,i);
73 j:=a+1;
74 x[j]:=#$80;
75 while j<i do
76 begin
77 inc(j);
78 x[j]:=#0;
79 end;
80 Move(x[1],d[0],i);
eb5d8a8 Stijn Sanders mongoAuth.pas (including MD5Hash!)
authored
81 d[dl-2]:=a shl 3;
82 h[0]:=$67452301;
83 h[1]:=$efcdab89;
84 h[2]:=$98badcfe;
85 h[3]:=$10325476;
86 i:=0;
87 while i<dl do
88 begin
89 g:=h;
90 j:=i;
91 for k:=0 to 15 do
92 begin
93 l:=k*3;
94 a:=h[l and 3]+
95 ((h[(l+1) and 3] and h[(l+2) and 3]) or
96 (not(h[(l+1) and 3]) and h[(l+3) and 3]))+
97 d[j]+
98 base1[k];
99 h[l and 3]:=h[(l+1) and 3]+
100 ((a shl roll1[k and 3]) or (a shr (32-roll1[k and 3])));
101 inc(j);
102 end;
103 j:=1;
104 for k:=0 to 15 do
105 begin
106 l:=k*3;
107 a:=h[l and 3]+
108 ((h[(l+3) and 3] and h[(l+1) and 3]) or
109 (not(h[(l+3) and 3]) and h[(l+2) and 3]))+
110 d[i or (j and $F)]+
111 base2[k];
112 h[l and 3]:=h[(l+1) and 3]+
113 ((a shl roll2[k and 3]) or (a shr (32-roll2[k and 3])));
114 inc(j,5);
115 end;
116 j:=5;
117 for k:=0 to 15 do
118 begin
119 l:=k*3;
120 a:=h[l and 3]+
121 (h[(l+1) and 3] xor h[(l+2) and 3] xor h[(l+3) and 3])+
122 d[i or (j and $F)]+
123 base3[k];
124 h[l and 3]:=h[(l+1) and 3]+
125 ((a shl roll3[k and 3]) or (a shr (32-roll3[k and 3])));
126 inc(j,3);
127 end;
128 j:=0;
129 for k:=0 to 15 do
130 begin
131 l:=k*3;
132 a:=h[l and 3]+
133 (h[(l+2) and 3] xor (h[(l+1) and 3] or not h[(l+3) and 3]))+
134 d[i or (j and $F)]+
135 base4[k];
136 h[l and 3]:=h[(l+1) and 3]+
137 ((a shl roll4[k and 3]) or (a shr (32-roll4[k and 3])));
138 inc(j,7);
139 end;
140 for k:=0 to 3 do inc(h[k],g[k]);
141 inc(i,16);
142 end;
143 SetLength(Result,32);
144 for k:=0 to 31 do
da7efab Stijn Sanders minor tweak MD5
authored
145 Result[k+1]:=hex[h[k shr 3] shr ((k xor 1) shl 2) and $F];
eb5d8a8 Stijn Sanders mongoAuth.pas (including MD5Hash!)
authored
146 end;
147
148 procedure MongoWireAuthenticate(MongoWire:TMongoWire;
48e0e99 Stijn Sanders mongoAuth issue
authored
149 const UserName,Password:WideString);
eb5d8a8 Stijn Sanders mongoAuth.pas (including MD5Hash!)
authored
150 var
151 nonce:WideString;
152 begin
48e0e99 Stijn Sanders mongoAuth issue
authored
153 nonce:=MongoWire.Get('$cmd',BSON(['getnonce',1]))['nonce'];
154 if MongoWire.Get('$cmd',BSON([
eb5d8a8 Stijn Sanders mongoAuth.pas (including MD5Hash!)
authored
155 'authenticate',1,
156 'nonce',nonce,
48e0e99 Stijn Sanders mongoAuth issue
authored
157 'user',UserName,
eb5d8a8 Stijn Sanders mongoAuth.pas (including MD5Hash!)
authored
158 'key',MD5Hash(UTF8Encode(nonce+UserName+
159 MD5Hash(UTF8Encode(UserName+':mongo:'+Password))))
160 ]))['ok']<>1 then
161 raise EMongoAuthenticationFailed.Create(
48e0e99 Stijn Sanders mongoAuth issue
authored
162 'MongoWire: failed to authenticate as "'+UserName+'"');
eb5d8a8 Stijn Sanders mongoAuth.pas (including MD5Hash!)
authored
163 end;
164
48e0e99 Stijn Sanders mongoAuth issue
authored
165 procedure MongoWireLogout(MongoWire:TMongoWire);
eb5d8a8 Stijn Sanders mongoAuth.pas (including MD5Hash!)
authored
166 begin
48e0e99 Stijn Sanders mongoAuth issue
authored
167 if MongoWire.Get('$cmd',BSON(['logout',1]))['ok']<>1 then
eb5d8a8 Stijn Sanders mongoAuth.pas (including MD5Hash!)
authored
168 raise EMongoException.Create('MongoWire: logout failed');
169 end;
170
171 end.
Something went wrong with that request. Please try again.