2 {Challenge-Response Authenticator}
4 USES NetAddr
,ECC
,SHA1
,Chat
,ServerLoop
,MemStream
,opcode
;
13 Callback
:procedure of object;
14 procedure Init(const iRemote
:tNetAddr
);
17 procedure ReplyRes(msg
:tSMsg
; data
:boolean);
18 procedure ReplyPow(msg
:tSMsg
; data
:boolean);
26 procedure tAuth
.Init(const iRemote
:tNetAddr
);
29 Assert(assigned(Callback
) and (not iRemote
.isNil
));
35 Ch
.OnTimeout
:=@Timeout
;
36 Ch
.Callback
:=@ReplyRes
;
37 Ch
.SetTimeout(8001,3000);
38 {generate and send challenge}
40 ECC
.CreateChallenge(challenge
);
41 Ms
.WriteByte(opcode
.crAuthReq
);
43 Ms
.Write(ECC
.PublicKey
,sizeof(PublicKey
));
44 Ms
.Write(challenge
,sizeof(challenge
));
48 procedure tAuth
.ReplyRes(msg
:tSMsg
; data
:boolean);
49 var r
:tMemoryStream
absolute msg
.Stream
;
52 var vresp
:tSha1Digest
;
54 if not data
then exit
;
55 status
:=r
.readbyte
; {todo, set error (eg: unsuported meth)}
56 r
.Read(RemotePub
,sizeof(tEccKey
));
57 resp
:=r
.readptr(sizeof(tEccKey
));
58 ECC
.CreateResponse(Challenge
,vresp
,RemotePub
);
59 Valid
:=CompareByte(resp
^,vresp
,sizeof(vresp
))=0;
60 if (status
and 128)>0 then begin
62 Ch
.Callback
:=@ReplyPow
;
66 procedure tAuth
.ReplyPow(msg
:tSMsg
; data
:boolean);
67 var r
:tMemoryStream
absolute msg
.Stream
;
68 var ptp
:byte;{Proof TyPe}
70 var pts
: ^tPoWTimeStamp
;
72 if not data
then exit
;
73 ptp
:=r
.readbyte
; {todo}
74 nonce
:=r
.ReadPtr(sizeof(tEccKey
));
76 PoWValid
:=VerifyPoW(nonce
^,RemotePub
,pts
^);
79 procedure tAuth
.Timeout
;
85 procedure tAuth
.Conclusion
;
90 ms
.WriteByte(byte(Valid
));
91 ms
.WriteByte(byte(PowValid
));
99 FreeMem(@self
,sizeof(self
));
105 procedure SendRep(msg
:tSMsg
; data
:boolean);
106 procedure SendPow(msg
:tSMsg
; data
:boolean);
107 procedure Last(msg
:tSMsg
; data
:boolean);
111 procedure AuthHandler(var ch
:tChat
; msg
:tSMsg
);
114 msg
.stream
.skip(1); {initcode}
117 ch
.OnTimeout
:=@srv
^.Close
;
118 srv
^.SendRep(msg
,true);
125 procedure tServer
.SendRep(msg
:tSMsg
; data
:boolean);
126 var r
:tMemoryStream
absolute msg
.Stream
;
127 var ms
:tMemoryStream
;
130 var resp
:tSha1Digest
;
132 ver
:=r
.ReadByte
; {todo}
133 r
.Read(pub
,sizeof(pub
));
134 chal
:=r
.readptr(sizeof(tEccKey
));
135 CreateResponse(chal
^,resp
,pub
);
136 ch
^.StreamInit(ms
,66); {todo}
138 ms
.Write(PublicKey
,sizeof(PublicKey
));
139 ms
.Write(resp
,sizeof(resp
));
140 ch
^.Callback
:=@SendPoW
;
141 ch
^.SetTimeout(8000,0);{no reply expected}
145 procedure tServer
.SendPow(msg
:tSMsg
; data
:boolean);
146 var ms
:tMemoryStream
;
149 ch
^.StreamInit(ms
,66); {todo}
151 ms
.Write(PublicPoW
,sizeof(PublicPoW
));
152 ms
.Write(PublicPoWTS
,2);
154 ch
^.SetTimeout(8000,2000);
158 procedure tServer
.Last(msg
:tSMsg
; data
:boolean);
159 var r
:tMemoryStream
absolute msg
.Stream
;
160 var Valid
,ValidPoW
:byte;
162 if not data
then exit
; {unlikely}
164 ValidPoW
:=r
.ReadByte
;
165 if (Valid
<>1)or(ValidPoW
<>1) then begin
166 write('CRAuth: Our auth failed on remote, reason pub=',Valid
,' pow=',ValidPoW
);
167 Writeln(' remote ',string(ch
^.remote
),' ',string(pub
));
171 procedure tServer
.Close
;
174 FreeMem(@self
,sizeof(self
));
177 procedure tAuth
.Cancel
;
184 SetChatHandler(opcode
.crAuthReq
,@AuthHandler
);